module Distribution.Simple.UHC (
configure, getInstalledPackages,
buildLib, buildExe, installLib, registerPackage
) where
import Control.Monad
import Data.List
import Distribution.Compat.ReadP
import Distribution.InstalledPackageInfo
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler as C
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PackageIndex
import Distribution.Simple.Program
import Distribution.Simple.Utils
import Distribution.Text
import Distribution.Verbosity
import Distribution.Version
import Language.Haskell.Extension
import System.Directory
import System.FilePath
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration -> IO (Compiler, ProgramConfiguration)
configure verbosity hcPath _hcPkgPath conf = do
(_uhcProg, uhcVersion, conf') <-
requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity uhcProgram :: ProgramuhcProgram
(orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [1,0,2] [] :: [a][]))
(userMaybeSpecifyPath ::
String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "uhc" hcPath :: Maybe FilePathhcPath conf :: ProgramConfigurationconf)
let comp = Compiler {
compilerId = CompilerId :: CompilerFlavor -> Version -> CompilerIdCompilerId UHC :: CompilerFlavorUHC uhcVersion :: VersionuhcVersion,
compilerLanguages = uhcLanguages :: [(Language, Flag)]uhcLanguages,
compilerExtensions = uhcLanguageExtensions :: [(Extension, Flag)]uhcLanguageExtensions
}
return :: Monad m => forall a. a -> m areturn (comp :: Compilercomp, conf' :: ProgramDbconf')
uhcLanguages :: [(Language, C.Flag)]
uhcLanguages = [(Haskell98 :: LanguageHaskell98, "")]
uhcLanguageExtensions :: [(Extension, C.Flag)]
uhcLanguageExtensions =
let doFlag (f, (enable, disable)) = [(EnableExtension :: KnownExtension -> ExtensionEnableExtension f :: KnownExtensionf, enable :: tenable),
(DisableExtension :: KnownExtension -> ExtensionDisableExtension f :: KnownExtensionf, disable :: tdisable)]
alwaysOn = ("", "")
in concatMap :: (a -> [b]) -> [a] -> [b]concatMap doFlag :: (KnownExtension, (t, t)) -> [(Extension, t)]doFlag
[(CPP :: KnownExtensionCPP, ("--cpp", "")),
(PolymorphicComponents :: KnownExtensionPolymorphicComponents, alwaysOn :: ([Char], [Char])alwaysOn),
(ExistentialQuantification :: KnownExtensionExistentialQuantification, alwaysOn :: ([Char], [Char])alwaysOn),
(ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface, alwaysOn :: ([Char], [Char])alwaysOn),
(UndecidableInstances :: KnownExtensionUndecidableInstances, alwaysOn :: ([Char], [Char])alwaysOn),
(MultiParamTypeClasses :: KnownExtensionMultiParamTypeClasses, alwaysOn :: ([Char], [Char])alwaysOn),
(Rank2Types :: KnownExtensionRank2Types, alwaysOn :: ([Char], [Char])alwaysOn),
(PatternSignatures :: KnownExtensionPatternSignatures, alwaysOn :: ([Char], [Char])alwaysOn),
(EmptyDataDecls :: KnownExtensionEmptyDataDecls, alwaysOn :: ([Char], [Char])alwaysOn),
(ImplicitPrelude :: KnownExtensionImplicitPrelude, ("", "--no-prelude")),
(TypeOperators :: KnownExtensionTypeOperators, alwaysOn :: ([Char], [Char])alwaysOn),
(OverlappingInstances :: KnownExtensionOverlappingInstances, alwaysOn :: ([Char], [Char])alwaysOn),
(FlexibleInstances :: KnownExtensionFlexibleInstances, alwaysOn :: ([Char], [Char])alwaysOn)]
getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
getInstalledPackages verbosity comp packagedbs conf = do
let compilerid = compilerId :: Compiler -> CompilerIdcompilerId comp :: Compilercomp
systemPkgDir <- rawSystemProgramStdoutConf ::
Verbosity
-> Program
-> ProgramConfiguration
-> [ProgArg]
-> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity uhcProgram :: ProgramuhcProgram conf :: ProgramConfigurationconf ["--meta-pkgdir-system"]
userPkgDir <- getUserPackageDir :: IO FilePathgetUserPackageDir
let pkgDirs = nub :: Eq a => [a] -> [a]nub (concatMap :: (a -> [b]) -> [a] -> [b]concatMap (packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath]packageDbPaths userPkgDir :: FilePathuserPkgDir systemPkgDir :: StringsystemPkgDir) packagedbs :: PackageDBStackpackagedbs)
pkgs <- liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM (map :: (a -> b) -> [a] -> [b]map addBuiltinVersions :: String -> StringaddBuiltinVersions (.) :: (b -> c) -> (a -> b) -> a -> c. concat :: [[a]] -> [a]concat) (.) :: (b -> c) -> (a -> b) -> a -> c.
mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM (\ d -> getDirectoryContents :: FilePath -> IO [FilePath]getDirectoryContents d :: FilePathd (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]filterM (isPkgDir :: String -> String -> String -> IO BoolisPkgDir (display :: Text a => a -> Stringdisplay compilerid :: CompilerIdcompilerid) d :: FilePathd)) (.) :: (b -> c) -> (a -> b) -> a -> c.
concatMap :: (a -> [b]) -> [a] -> [b]concatMap lines :: String -> [String]lines ($) :: (a -> b) -> a -> b$ pkgDirs :: [FilePath]pkgDirs
let iPkgs =
map :: (a -> b) -> [a] -> [b]map mkInstalledPackageInfo :: PackageId -> InstalledPackageInfomkInstalledPackageInfo ($) :: (a -> b) -> a -> b$
concatMap :: (a -> [b]) -> [a] -> [b]concatMap parsePackage :: String -> [PackageId]parsePackage ($) :: (a -> b) -> a -> b$
pkgs :: [String]pkgs
return :: Monad m => forall a. a -> m areturn (fromList :: [InstalledPackageInfo] -> PackageIndexfromList iPkgs :: [InstalledPackageInfo]iPkgs)
getUserPackageDir :: IO FilePath
getUserPackageDir =
do
homeDir <- getHomeDirectory :: IO FilePathgetHomeDirectory
return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ homeDir :: FilePathhomeDir (</>) :: FilePath -> FilePath -> FilePath</> ".cabal" (</>) :: FilePath -> FilePath -> FilePath</> "lib"
packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath]
packageDbPaths user system db =
case db :: PackageDBStackdb of
GlobalPackageDB -> [ system :: FilePathsystem ]
UserPackageDB -> [ user :: FilePathuser ]
SpecificPackageDB path -> [ path :: FilePathpath ]
addBuiltinVersions :: String -> String
addBuiltinVersions xs = xs :: Stringxs
installedPkgConfig :: String
installedPkgConfig = "installed-pkg-config"
isPkgDir :: String -> String -> String -> IO Bool
isPkgDir _ _ ('.' : _) = return :: Monad m => forall a. a -> m areturn False :: BoolFalse
isPkgDir c dir xs = do
let candidate = dir :: Stringdir (</>) :: FilePath -> FilePath -> FilePath</> uhcPackageDir :: String -> String -> FilePathuhcPackageDir xs :: Stringxs c :: Charc
doesFileExist :: FilePath -> IO BooldoesFileExist (candidate :: FilePathcandidate (</>) :: FilePath -> FilePath -> FilePath</> installedPkgConfig :: StringinstalledPkgConfig)
parsePackage :: String -> [PackageId]
parsePackage x = map :: (a -> b) -> [a] -> [b]map fst :: (a, b) -> afst (filter :: (a -> Bool) -> [a] -> [a]filter (\ (_,y) -> null :: [a] -> Boolnull y :: [Char]y) (readP_to_S :: ReadP a a -> ReadS areadP_to_S parse :: Text a => forall r. ReadP r aparse x :: [Char]x))
mkInstalledPackageInfo :: PackageId -> InstalledPackageInfo
mkInstalledPackageInfo p = emptyInstalledPackageInfo :: InstalledPackageInfo_ memptyInstalledPackageInfo
{ installedPackageId = InstalledPackageId :: String -> InstalledPackageIdInstalledPackageId (display :: Text a => a -> Stringdisplay p :: PackageIdp),
sourcePackageId = p :: PackageIdp }
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
systemPkgDir <- rawSystemProgramStdoutConf ::
Verbosity
-> Program
-> ProgramConfiguration
-> [ProgArg]
-> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity uhcProgram :: ProgramuhcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) ["--meta-pkgdir-system"]
userPkgDir <- getUserPackageDir :: IO FilePathgetUserPackageDir
let runUhcProg = rawSystemProgramConf ::
Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity uhcProgram :: ProgramuhcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
let uhcArgs =
["--pkg-build=" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr)]
(++) :: [a] -> [a] -> [a]++ constructUHCCmdLine ::
FilePath
-> FilePath
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [String]constructUHCCmdLine userPkgDir :: FilePathuserPkgDir systemPkgDir :: StringsystemPkgDir
lbi :: LocalBuildInfolbi (libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib) clbi :: ComponentLocalBuildInfoclbi
(buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi) verbosity :: Verbosityverbosity
(++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (map :: (a -> b) -> [a] -> [b]map (\ c -> if c :: Charc (==) :: Eq a => a -> a -> Bool== '.' then pathSeparator :: CharpathSeparator else c :: Charc))
(map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay (libModules :: Library -> [ModuleName]libModules lib :: Librarylib))
runUhcProg :: [ProgArg] -> IO ()runUhcProg uhcArgs :: [String]uhcArgs
return :: Monad m => forall a. a -> m areturn ()
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe verbosity _pkg_descr lbi exe clbi = do
systemPkgDir <- rawSystemProgramStdoutConf ::
Verbosity
-> Program
-> ProgramConfiguration
-> [ProgArg]
-> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity uhcProgram :: ProgramuhcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) ["--meta-pkgdir-system"]
userPkgDir <- getUserPackageDir :: IO FilePathgetUserPackageDir
let runUhcProg = rawSystemProgramConf ::
Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity uhcProgram :: ProgramuhcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
let uhcArgs =
constructUHCCmdLine ::
FilePath
-> FilePath
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [String]constructUHCCmdLine userPkgDir :: FilePathuserPkgDir systemPkgDir :: StringsystemPkgDir
lbi :: LocalBuildInfolbi (buildInfo :: Executable -> BuildInfobuildInfo exe :: Executableexe) clbi :: ComponentLocalBuildInfoclbi
(buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi) verbosity :: Verbosityverbosity
(++) :: [a] -> [a] -> [a]++ ["--output", buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> exeName :: Executable -> StringexeName exe :: Executableexe]
(++) :: [a] -> [a] -> [a]++ [modulePath :: Executable -> FilePathmodulePath exe :: Executableexe]
runUhcProg :: [ProgArg] -> IO ()runUhcProg uhcArgs :: [String]uhcArgs
constructUHCCmdLine :: FilePath -> FilePath
-> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> Verbosity -> [String]
constructUHCCmdLine user system lbi bi clbi odir verbosity =
(if verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening then ["-v4"]
else if verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= normal :: Verbositynormal then [] :: [a][]
else ["-v0"])
(++) :: [a] -> [a] -> [a]++ hcOptions :: CompilerFlavor -> BuildInfo -> [String]hcOptions UHC :: CompilerFlavorUHC bi :: BuildInfobi
(++) :: [a] -> [a] -> [a]++ languageToFlags :: Compiler -> Maybe Language -> [Flag]languageToFlags (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (defaultLanguage :: BuildInfo -> Maybe LanguagedefaultLanguage bi :: BuildInfobi)
(++) :: [a] -> [a] -> [a]++ extensionsToFlags :: Compiler -> [Extension] -> [Flag]extensionsToFlags (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (usedExtensions :: BuildInfo -> [Extension]usedExtensions bi :: BuildInfobi)
(++) :: [a] -> [a] -> [a]++ ["--hide-all-packages"]
(++) :: [a] -> [a] -> [a]++ uhcPackageDbOptions ::
FilePath -> FilePath -> PackageDBStack -> [String]uhcPackageDbOptions user :: FilePathuser system :: FilePathsystem (withPackageDB :: LocalBuildInfo -> PackageDBStackwithPackageDB lbi :: LocalBuildInfolbi)
(++) :: [a] -> [a] -> [a]++ ["--package=uhcbase"]
(++) :: [a] -> [a] -> [a]++ ["--package=" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay (pkgName :: PackageIdentifier -> PackageNamepkgName pkgid :: PackageIdpkgid) | (_, pkgid) <- componentPackageDeps ::
ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]componentPackageDeps clbi :: ComponentLocalBuildInfoclbi ]
(++) :: [a] -> [a] -> [a]++ ["-i" (++) :: [a] -> [a] -> [a]++ odir :: FilePathodir]
(++) :: [a] -> [a] -> [a]++ ["-i" (++) :: [a] -> [a] -> [a]++ l :: FilePathl | l <- nub :: Eq a => [a] -> [a]nub (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi)]
(++) :: [a] -> [a] -> [a]++ ["-i" (++) :: [a] -> [a] -> [a]++ autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi]
(++) :: [a] -> [a] -> [a]++ ["--odir=" (++) :: [a] -> [a] -> [a]++ odir :: FilePathodir]
(++) :: [a] -> [a] -> [a]++ (case withOptimization :: LocalBuildInfo -> OptimisationLevelwithOptimization lbi :: LocalBuildInfolbi of
NoOptimisation -> ["-O0"]
NormalOptimisation -> ["-O1"]
MaximumOptimisation -> ["-O2"])
uhcPackageDbOptions :: FilePath -> FilePath -> PackageDBStack -> [String]
uhcPackageDbOptions user system db = map :: (a -> b) -> [a] -> [b]map (\ x -> "--pkg-searchpath=" (++) :: [a] -> [a] -> [a]++ x :: [Char]x)
(concatMap :: (a -> [b]) -> [a] -> [b]concatMap (packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath]packageDbPaths user :: FilePathuser system :: FilePathsystem) db :: PackageDBStackdb)
installLib :: Verbosity -> LocalBuildInfo
-> FilePath -> FilePath -> FilePath
-> PackageDescription -> Library -> IO ()
installLib verbosity _lbi targetDir _dynlibTargetDir builtDir pkg _library = do
installDirectoryContents ::
Verbosity -> FilePath -> FilePath -> IO ()installDirectoryContents verbosity :: Verbosityverbosity (builtDir :: FilePathbuiltDir (</>) :: FilePath -> FilePath -> FilePath</> display :: Text a => a -> Stringdisplay (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg :: PackageDescriptionpkg)) targetDir :: FilePathtargetDir
uhcTarget, uhcTargetVariant :: String
uhcTarget = "bc"
uhcTargetVariant = "plain"
uhcPackageDir :: String -> String -> FilePath
uhcPackageSubDir :: String -> FilePath
uhcPackageDir pkgid compilerid = pkgid :: PackageIdpkgid (</>) :: FilePath -> FilePath -> FilePath</> uhcPackageSubDir :: String -> FilePathuhcPackageSubDir compilerid :: CompilerIdcompilerid
uhcPackageSubDir compilerid = compilerid :: CompilerIdcompilerid (</>) :: FilePath -> FilePath -> FilePath</> uhcTarget :: StringuhcTarget (</>) :: FilePath -> FilePath -> FilePath</> uhcTargetVariant :: StringuhcTargetVariant
registerPackage
:: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDBStack
-> IO ()
registerPackage verbosity installedPkgInfo pkg lbi inplace _packageDbs = do
let installDirs = absoluteInstallDirs ::
PackageDescription
-> LocalBuildInfo
-> CopyDest
-> InstallDirs FilePathabsoluteInstallDirs pkg :: PackageDescriptionpkg lbi :: LocalBuildInfolbi NoCopyDest :: CopyDestNoCopyDest
pkgdir | inplace :: Boolinplace = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> uhcPackageDir :: String -> String -> FilePathuhcPackageDir (display :: Text a => a -> Stringdisplay pkgid :: PackageIdpkgid) (display :: Text a => a -> Stringdisplay compilerid :: CompilerIdcompilerid)
| otherwise :: Boolotherwise = libdir :: InstallDirs dir -> dirlibdir installDirs :: InstallDirs FilePathinstallDirs (</>) :: FilePath -> FilePath -> FilePath</> uhcPackageSubDir :: String -> FilePathuhcPackageSubDir (display :: Text a => a -> Stringdisplay compilerid :: CompilerIdcompilerid)
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue pkgdir :: FilePathpkgdir
writeUTF8File :: FilePath -> String -> IO ()writeUTF8File (pkgdir :: FilePathpkgdir (</>) :: FilePath -> FilePath -> FilePath</> installedPkgConfig :: StringinstalledPkgConfig)
(showInstalledPackageInfo :: InstalledPackageInfo -> StringshowInstalledPackageInfo installedPkgInfo :: InstalledPackageInfoinstalledPkgInfo)
where
pkgid = packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg :: PackageDescriptionpkg
compilerid = compilerId :: Compiler -> CompilerIdcompilerId (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi)