{-# LANGUAGE OverloadedStrings #-}

module Distribution.Cab.GenPaths (genPaths) where

import Control.Exception
import Control.Monad
import Data.List (isSuffixOf)
import Distribution.Cab.Utils (readGenericPackageDescription, unPackageName)
import Distribution.Package (pkgName, pkgVersion)
import Distribution.PackageDescription (package, packageDescription)
import Distribution.Verbosity (silent)
import Distribution.Version
import System.Directory

genPaths :: IO ()
genPaths :: IO ()
genPaths = do
    (nm, ver) <- IO [Char]
getCabalFile IO [Char]
-> ([Char] -> IO ([Char], Version)) -> IO ([Char], Version)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO ([Char], Version)
getNameVersion
    let file = [Char]
"Paths_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".hs"
    check file >> do
        putStrLn $ "Writing " ++ file ++ "..."
        writeFile file $
            "module Paths_"
                ++ nm
                ++ "  where\n"
                ++ "import Data.Version\n"
                ++ "\n"
                ++ "version :: Version\n"
                ++ "version = "
                ++ show ver
                ++ "\n"
  where
    check :: [Char] -> IO ()
check [Char]
file = do
        exist <- [Char] -> IO Bool
doesFileExist [Char]
file
        when exist . throwIO . userError $ file ++ " already exists"

getNameVersion :: FilePath -> IO (String, Version)
getNameVersion :: [Char] -> IO ([Char], Version)
getNameVersion [Char]
file = do
    desc <- Verbosity -> [Char] -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
silent [Char]
file
    let pkg = PackageDescription -> PackageIdentifier
package (PackageDescription -> PackageIdentifier)
-> (GenericPackageDescription -> PackageDescription)
-> GenericPackageDescription
-> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
packageDescription (GenericPackageDescription -> PackageIdentifier)
-> GenericPackageDescription -> PackageIdentifier
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
desc
        nm = PackageName -> [Char]
unPackageName (PackageName -> [Char]) -> PackageName -> [Char]
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkg
        name = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> Char -> Char
forall {p}. Eq p => p -> p -> p -> p
trans Char
'-' Char
'_') [Char]
nm
        version = PackageIdentifier -> Version
pkgVersion PackageIdentifier
pkg
    return (name, version)
  where
    trans :: p -> p -> p -> p
trans p
c1 p
c2 p
c
        | p
c p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
c1 = p
c2
        | Bool
otherwise = p
c

getCabalFile :: IO FilePath
getCabalFile :: IO [Char]
getCabalFile = do
    cnts <-
        (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
isCabal ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
getDirectoryContents [Char]
".")
            IO [[Char]] -> ([[Char]] -> IO [[Char]]) -> IO [[Char]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist
    case cnts of
        [] -> IOError -> IO [Char]
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOError -> IO [Char]) -> IOError -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError [Char]
"Cabal file does not exist"
        [Char]
cfile : [[Char]]
_ -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
cfile
  where
    isCabal :: String -> Bool
    isCabal :: [Char] -> Bool
isCabal [Char]
nm = [Char]
".cabal" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
nm Bool -> Bool -> Bool
&& [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
nm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
6