{-# 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
    ([Char]
nm,Version
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]
file = [Char]
"Paths_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".hs"
    [Char] -> IO ()
check [Char]
file IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Writing " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
        [Char] -> [Char] -> IO ()
writeFile [Char]
file ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"module Paths_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  where\n"
                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"import Data.Version\n"
                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"version :: Version\n"
                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"version = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
forall a. Show a => a -> [Char]
show Version
ver [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
  where
    check :: [Char] -> IO ()
check [Char]
file = do
        Bool
exist <- [Char] -> IO Bool
doesFileExist [Char]
file
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exist (IO () -> IO ()) -> ([Char] -> IO ()) -> [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO ()) -> ([Char] -> IOError) -> [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IOError
userError ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" already exists"

getNameVersion :: FilePath -> IO (String,Version)
getNameVersion :: [Char] -> IO ([Char], Version)
getNameVersion [Char]
file = do
    GenericPackageDescription
desc <- Verbosity -> [Char] -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
silent [Char]
file
    let pkg :: PackageIdentifier
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 :: [Char]
nm = PackageName -> [Char]
unPackageName (PackageName -> [Char]) -> PackageName -> [Char]
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkg
        name :: [Char]
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 :: Version
version = PackageIdentifier -> Version
pkgVersion PackageIdentifier
pkg
    ([Char], Version) -> IO ([Char], Version)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
name, Version
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
    [[Char]]
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 [[Char]]
cnts of
        []      -> IOError -> IO [Char]
forall e a. 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