{-# LANGUAGE OverloadedStrings #-} module Distribution.Cab.GenPaths (genPaths) where import Control.Applicative import Control.Exception import Control.Monad import Data.List (isSuffixOf) import Distribution.Cab.Utils (readGenericPackageDescription, unPackageName) import Distribution.Package (pkgName, pkgVersion) import Distribution.PackageDescription import Distribution.Verbosity (silent) import Distribution.Version import System.Directory genPaths :: IO () genPaths :: IO () genPaths = do (nm :: String nm,ver :: Version ver) <- IO String getCabalFile IO String -> (String -> IO (String, Version)) -> IO (String, Version) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= String -> IO (String, Version) getNameVersion let file :: String file = "Paths_" String -> String -> String forall a. [a] -> [a] -> [a] ++ String nm String -> String -> String forall a. [a] -> [a] -> [a] ++ ".hs" String -> IO () check String file IO () -> IO () -> IO () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> do String -> IO () putStrLn (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ "Writing " String -> String -> String forall a. [a] -> [a] -> [a] ++ String file String -> String -> String forall a. [a] -> [a] -> [a] ++ "..." String -> String -> IO () writeFile String file (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ "module Paths_" String -> String -> String forall a. [a] -> [a] -> [a] ++ String nm String -> String -> String forall a. [a] -> [a] -> [a] ++ " where\n" String -> String -> String forall a. [a] -> [a] -> [a] ++ "import Data.Version\n" String -> String -> String forall a. [a] -> [a] -> [a] ++ "\n" String -> String -> String forall a. [a] -> [a] -> [a] ++ "version :: Version\n" String -> String -> String forall a. [a] -> [a] -> [a] ++ "version = " String -> String -> String forall a. [a] -> [a] -> [a] ++ Version -> String forall a. Show a => a -> String show Version ver String -> String -> String forall a. [a] -> [a] -> [a] ++ "\n" where check :: String -> IO () check file :: String file = do Bool exist <- String -> IO Bool doesFileExist String file Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool exist (IO () -> IO ()) -> (String -> IO ()) -> String -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . IOError -> IO () forall e a. Exception e => e -> IO a throwIO (IOError -> IO ()) -> (String -> IOError) -> String -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> IOError userError (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String file String -> String -> String forall a. [a] -> [a] -> [a] ++ " already exists" getNameVersion :: FilePath -> IO (String,Version) getNameVersion :: String -> IO (String, Version) getNameVersion file :: String file = do GenericPackageDescription desc <- Verbosity -> String -> IO GenericPackageDescription readGenericPackageDescription Verbosity silent String 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 :: String nm = PackageName -> String unPackageName (PackageName -> String) -> PackageName -> String forall a b. (a -> b) -> a -> b $ PackageIdentifier -> PackageName pkgName PackageIdentifier pkg name :: String name = (Char -> Char) -> String -> String forall a b. (a -> b) -> [a] -> [b] map (Char -> Char -> Char -> Char forall p. Eq p => p -> p -> p -> p trans '-' '_') String nm version :: Version version = PackageIdentifier -> Version pkgVersion PackageIdentifier pkg (String, Version) -> IO (String, Version) forall (m :: * -> *) a. Monad m => a -> m a return (String name, Version version) where trans :: p -> p -> p -> p trans c1 :: p c1 c2 :: p c2 c :: 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 String getCabalFile = do [String] cnts <- ((String -> Bool) -> [String] -> [String] forall a. (a -> Bool) -> [a] -> [a] filter String -> Bool isCabal ([String] -> [String]) -> IO [String] -> IO [String] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> IO [String] getDirectoryContents ".") IO [String] -> ([String] -> IO [String]) -> IO [String] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (String -> IO Bool) -> [String] -> IO [String] forall (m :: * -> *) a. Applicative m => (a -> m Bool) -> [a] -> m [a] filterM String -> IO Bool doesFileExist case [String] cnts of [] -> IOError -> IO String forall e a. Exception e => e -> IO a throwIO (IOError -> IO String) -> IOError -> IO String forall a b. (a -> b) -> a -> b $ String -> IOError userError "Cabal file does not exist" cfile :: String cfile:_ -> String -> IO String forall (m :: * -> *) a. Monad m => a -> m a return String cfile where isCabal :: String -> Bool isCabal :: String -> Bool isCabal nm :: String nm = ".cabal" String -> String -> Bool forall a. Eq a => [a] -> [a] -> Bool `isSuffixOf` String nm Bool -> Bool -> Bool && String -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length String nm Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > 6