module Distribution.Simple.GHC (
configure, getInstalledPackages,
buildLib, buildExe,
installLib, installExe,
libAbiHash,
registerPackage,
ghcOptions,
ghcVerbosityOptions,
ghcPackageDbOptions,
ghcLibDir,
) where
import qualified Distribution.Simple.GHC.IPI641 as IPI641
import qualified Distribution.Simple.GHC.IPI642 as IPI642
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..), Executable(..)
, Library(..), libModules, hcOptions, usedExtensions, allExtensions )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(..) )
import Distribution.Simple.PackageIndex (PackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, absoluteInstallDirs )
import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
( PackageIdentifier, Package(..), PackageName(..) )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), ProgramConfiguration, ProgArg
, ProgramLocation(..), rawSystemProgram, rawSystemProgramConf
, rawSystemProgramStdout, rawSystemProgramStdoutConf
, requireProgramVersion, requireProgram, getProgramOutput
, userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
, ghcProgram, ghcPkgProgram, hsc2hsProgram
, arProgram, ranlibProgram, ldProgram
, gccProgram, stripProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar as Ar
import qualified Distribution.Simple.Program.Ld as Ld
import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
, OptimisationLevel(..), PackageDB(..), PackageDBStack
, Flag, languageToFlags, extensionsToFlags )
import Distribution.Version
( Version(..), anyVersion, orLaterVersion )
import Distribution.System
( OS(..), buildOS )
import Distribution.Verbosity
import Distribution.Text
( display, simpleParse )
import Language.Haskell.Extension (Language(..), Extension(..), KnownExtension(..))
import Control.Monad ( unless, when, liftM )
import Data.Char ( isSpace )
import Data.List
import Data.Maybe ( catMaybes )
import Data.Monoid ( Monoid(..) )
import System.Directory
( removeFile, getDirectoryContents, doesFileExist
, getTemporaryDirectory )
import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension, splitExtension )
import System.IO (hClose, hPutStrLn)
import Distribution.Compat.Exception (catchExit, catchIO)
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration -> IO (Compiler, ProgramConfiguration)
configure verbosity hcPath hcPkgPath conf0 = do
(ghcProg, ghcVersion, conf1) <-
requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity ghcProgram :: ProgramghcProgram
(orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [6,4] [] :: [a][]))
(userMaybeSpecifyPath ::
String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "ghc" hcPath :: Maybe FilePathhcPath conf0 :: ProgramConfigurationconf0)
(ghcPkgProg, ghcPkgVersion, conf2) <-
requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity ghcPkgProgram :: ProgramghcPkgProgram {
programFindLocation = guessGhcPkgFromGhcPath ::
ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)guessGhcPkgFromGhcPath ghcProg :: ConfiguredProgramghcProg
}
anyVersion :: VersionRangeanyVersion (userMaybeSpecifyPath ::
String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "ghc-pkg" hcPkgPath :: Maybe FilePathhcPkgPath conf1 :: ProgramDbconf1)
when :: Monad m => Bool -> m () -> m ()when (ghcVersion :: VersionghcVersion (/=) :: Eq a => a -> a -> Bool/= ghcPkgVersion :: VersionghcPkgVersion) ($) :: (a -> b) -> a -> b$ die :: String -> IO adie ($) :: (a -> b) -> a -> b$
"Version mismatch between ghc and ghc-pkg: "
(++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath ghcProg :: ConfiguredProgramghcProg (++) :: [a] -> [a] -> [a]++ " is version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay ghcVersion :: VersionghcVersion (++) :: [a] -> [a] -> [a]++ " "
(++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath ghcPkgProg :: ConfiguredProgramghcPkgProg (++) :: [a] -> [a] -> [a]++ " is version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay ghcPkgVersion :: VersionghcPkgVersion
let hsc2hsProgram' = hsc2hsProgram :: Programhsc2hsProgram {
programFindLocation = guessHsc2hsFromGhcPath ::
ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)guessHsc2hsFromGhcPath ghcProg :: ConfiguredProgramghcProg
}
conf3 = addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram hsc2hsProgram' :: Programhsc2hsProgram' conf2 :: ProgramDbconf2
languages <- getLanguages ::
Verbosity -> ConfiguredProgram -> IO [(Language, Flag)]getLanguages verbosity :: Verbosityverbosity ghcProg :: ConfiguredProgramghcProg
extensions <- getExtensions ::
Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]getExtensions verbosity :: Verbosityverbosity ghcProg :: ConfiguredProgramghcProg
ghcInfo <- if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,7] [] :: [a][]
then do xs <- getProgramOutput ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO StringgetProgramOutput verbosity :: Verbosityverbosity ghcProg :: ConfiguredProgramghcProg ["--info"]
case reads :: Read a => ReadS areads xs :: Stringxs of
[(i, ss)]
| all :: (a -> Bool) -> [a] -> Boolall isSpace :: Char -> BoolisSpace ss :: Stringss ->
return :: Monad m => forall a. a -> m areturn i :: [(String, String)]i
_ ->
die :: String -> IO adie "Can't parse --info output of GHC"
else return :: Monad m => forall a. a -> m areturn [] :: [a][]
let comp = Compiler {
compilerId = CompilerId :: CompilerFlavor -> Version -> CompilerIdCompilerId GHC :: CompilerFlavorGHC ghcVersion :: VersionghcVersion,
compilerLanguages = languages :: [(Language, Flag)]languages,
compilerExtensions = extensions :: [(Extension, Flag)]extensions
}
conf4 = configureToolchain ::
ConfiguredProgram
-> [(String, String)]
-> ProgramConfiguration
-> ProgramConfigurationconfigureToolchain ghcProg :: ConfiguredProgramghcProg ghcInfo :: [(String, String)]ghcInfo conf3 :: ProgramDbconf3
return :: Monad m => forall a. a -> m areturn (comp :: Compilercomp, conf4 :: ProgramConfigurationconf4)
guessToolFromGhcPath :: FilePath -> ConfiguredProgram -> Verbosity
-> IO (Maybe FilePath)
guessToolFromGhcPath tool ghcProg verbosity
= do let path = programPath :: ConfiguredProgram -> FilePathprogramPath ghcProg :: ConfiguredProgramghcProg
dir = takeDirectory :: FilePath -> FilePathtakeDirectory path :: FilePathpath
versionSuffix = takeVersionSuffix :: FilePath -> StringtakeVersionSuffix (dropExeExtension :: FilePath -> FilePathdropExeExtension path :: FilePathpath)
guessNormal = dir :: FilePathdir (</>) :: FilePath -> FilePath -> FilePath</> tool :: FilePathtool (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension
guessGhcVersioned = dir :: FilePathdir (</>) :: FilePath -> FilePath -> FilePath</> (tool :: FilePathtool (++) :: [a] -> [a] -> [a]++ "-ghc" (++) :: [a] -> [a] -> [a]++ versionSuffix :: StringversionSuffix) (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension
guessVersioned = dir :: FilePathdir (</>) :: FilePath -> FilePath -> FilePath</> (tool :: FilePathtool (++) :: [a] -> [a] -> [a]++ versionSuffix :: StringversionSuffix) (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension
guesses | null :: [a] -> Boolnull versionSuffix :: StringversionSuffix = [guessNormal :: FilePathguessNormal]
| otherwise :: Boolotherwise = [guessGhcVersioned :: FilePathguessGhcVersioned,
guessVersioned :: FilePathguessVersioned,
guessNormal :: FilePathguessNormal]
info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "looking for tool " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow tool :: FilePathtool (++) :: [a] -> [a] -> [a]++ " near compiler in " (++) :: [a] -> [a] -> [a]++ dir :: FilePathdir
exists <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM doesFileExist :: FilePath -> IO BooldoesFileExist guesses :: [FilePath]guesses
case [ file :: FilePathfile | (file, True) <- zip :: [a] -> [b] -> [(a, b)]zip guesses :: [FilePath]guesses exists :: [Bool]exists ] of
[] -> return :: Monad m => forall a. a -> m areturn Nothing :: Maybe aNothing
(fp:_) -> do info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "found " (++) :: [a] -> [a] -> [a]++ tool :: FilePathtool (++) :: [a] -> [a] -> [a]++ " in " (++) :: [a] -> [a] -> [a]++ fp :: FilePathfp
return :: Monad m => forall a. a -> m areturn (Just :: a -> Maybe aJust fp :: FilePathfp)
where takeVersionSuffix :: FilePath -> String
takeVersionSuffix = reverse :: [a] -> [a]reverse (.) :: (b -> c) -> (a -> b) -> a -> c. takeWhile :: (a -> Bool) -> [a] -> [a]takeWhile (elem :: Eq a => a -> [a] -> Bool`elem ` "0123456789.-") (.) :: (b -> c) -> (a -> b) -> a -> c. reverse :: [a] -> [a]reverse
dropExeExtension :: FilePath -> FilePath
dropExeExtension filepath =
case splitExtension :: FilePath -> (String, String)splitExtension filepath :: FilePathfilepath of
(filepath', extension) | extension :: Stringextension (==) :: Eq a => a -> a -> Bool== exeExtension :: StringexeExtension -> filepath' :: Stringfilepath'
| otherwise :: Boolotherwise -> filepath :: FilePathfilepath
guessGhcPkgFromGhcPath :: ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)
guessGhcPkgFromGhcPath = guessToolFromGhcPath ::
FilePath -> ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)guessToolFromGhcPath "ghc-pkg"
guessHsc2hsFromGhcPath :: ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)
guessHsc2hsFromGhcPath = guessToolFromGhcPath ::
FilePath -> ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)guessToolFromGhcPath "hsc2hs"
configureToolchain :: ConfiguredProgram -> [(String, String)]
-> ProgramConfiguration
-> ProgramConfiguration
configureToolchain ghcProg ghcInfo =
addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram gccProgram :: ProgramgccProgram {
programFindLocation = findProg ::
Program -> [FilePath] -> Verbosity -> IO (Maybe FilePath)findProg gccProgram :: ProgramgccProgram
[ if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,12] [] :: [a][]
then mingwBinDir :: FilePathmingwBinDir (</>) :: FilePath -> FilePath -> FilePath</> "gcc.exe"
else baseDir :: FilePathbaseDir (</>) :: FilePath -> FilePath -> FilePath</> "gcc.exe" ],
programPostConf = configureGcc :: Verbosity -> ConfiguredProgram -> IO [ProgArg]configureGcc
}
(.) :: (b -> c) -> (a -> b) -> a -> c. addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram ldProgram :: ProgramldProgram {
programFindLocation = findProg ::
Program -> [FilePath] -> Verbosity -> IO (Maybe FilePath)findProg ldProgram :: ProgramldProgram
[ if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,12] [] :: [a][]
then mingwBinDir :: FilePathmingwBinDir (</>) :: FilePath -> FilePath -> FilePath</> "ld.exe"
else libDir :: FilePathlibDir (</>) :: FilePath -> FilePath -> FilePath</> "ld.exe" ],
programPostConf = configureLd :: Verbosity -> ConfiguredProgram -> IO [ProgArg]configureLd
}
(.) :: (b -> c) -> (a -> b) -> a -> c. addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram arProgram :: ProgramarProgram {
programFindLocation = findProg ::
Program -> [FilePath] -> Verbosity -> IO (Maybe FilePath)findProg arProgram :: ProgramarProgram
[ if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,12] [] :: [a][]
then mingwBinDir :: FilePathmingwBinDir (</>) :: FilePath -> FilePath -> FilePath</> "ar.exe"
else libDir :: FilePathlibDir (</>) :: FilePath -> FilePath -> FilePath</> "ar.exe" ]
}
where
Just ghcVersion = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion ghcProg :: ConfiguredProgramghcProg
compilerDir = takeDirectory :: FilePath -> FilePathtakeDirectory (programPath :: ConfiguredProgram -> FilePathprogramPath ghcProg :: ConfiguredProgramghcProg)
baseDir = takeDirectory :: FilePath -> FilePathtakeDirectory compilerDir :: FilePathcompilerDir
mingwBinDir = baseDir :: FilePathbaseDir (</>) :: FilePath -> FilePath -> FilePath</> "mingw" (</>) :: FilePath -> FilePath -> FilePath</> "bin"
libDir = baseDir :: FilePathbaseDir (</>) :: FilePath -> FilePath -> FilePath</> "gcc-lib"
includeDir = baseDir :: FilePathbaseDir (</>) :: FilePath -> FilePath -> FilePath</> "include" (</>) :: FilePath -> FilePath -> FilePath</> "mingw"
isWindows = case buildOS :: OSbuildOS of Windows -> True :: BoolTrue; _ -> False :: BoolFalse
findProg :: Program -> [FilePath] -> Verbosity -> IO (Maybe FilePath)
findProg prog locations
| isWindows :: BoolisWindows = \verbosity -> look :: [FilePath] -> Verbosity -> IO (Maybe FilePath)look locations :: [FilePath]locations verbosity :: Verbosityverbosity
| otherwise :: Boolotherwise = programFindLocation :: Program -> Verbosity -> IO (Maybe FilePath)programFindLocation prog :: Programprog
where
look [] verbosity = do
warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity ("Couldn't find " (++) :: [a] -> [a] -> [a]++ programName :: Program -> StringprogramName prog :: Programprog (++) :: [a] -> [a] -> [a]++ " where I expected it. Trying the search path.")
programFindLocation :: Program -> Verbosity -> IO (Maybe FilePath)programFindLocation prog :: Programprog verbosity :: Verbosityverbosity
look (f:fs) verbosity = do
exists <- doesFileExist :: FilePath -> IO BooldoesFileExist f :: FilePathf
if exists :: [Bool]exists then return :: Monad m => forall a. a -> m areturn (Just :: a -> Maybe aJust f :: FilePathf)
else look :: [FilePath] -> Verbosity -> IO (Maybe FilePath)look fs :: [FilePath]fs verbosity :: Verbosityverbosity
ccFlags = getFlags :: Read a => String -> [a]getFlags "C compiler flags"
gccLinkerFlags = getFlags :: Read a => String -> [a]getFlags "Gcc Linker flags"
ldLinkerFlags = getFlags :: Read a => String -> [a]getFlags "Ld Linker flags"
getFlags key = case lookup :: Eq a => a -> [(a, b)] -> Maybe blookup key :: Stringkey ghcInfo :: [(String, String)]ghcInfo of
Nothing -> [] :: [a][]
Just flags ->
case reads :: Read a => ReadS areads flags :: Stringflags of
[(args, "")] -> args :: [a]args
_ -> [] :: [a][]
configureGcc :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
configureGcc v cp = liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM ((++) :: [a] -> [a] -> [a]++ (ccFlags :: [ProgArg]ccFlags (++) :: [a] -> [a] -> [a]++ gccLinkerFlags :: [ProgArg]gccLinkerFlags))
($) :: (a -> b) -> a -> b$ configureGcc' :: Verbosity -> ConfiguredProgram -> IO [ProgArg]configureGcc' v :: Verbosityv cp :: ConfiguredProgramcp
configureGcc' :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
configureGcc'
| isWindows :: BoolisWindows = \_ gccProg -> case programLocation :: ConfiguredProgram -> ProgramLocationprogramLocation gccProg :: ConfiguredProgramgccProg of
FoundOnSystem {}
| ghcVersion :: VersionghcVersion (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [6,11] [] :: [a][] ->
return :: Monad m => forall a. a -> m areturn ["-B" (++) :: [a] -> [a] -> [a]++ libDir :: FilePathlibDir, "-I" (++) :: [a] -> [a] -> [a]++ includeDir :: FilePathincludeDir]
_ -> return :: Monad m => forall a. a -> m areturn [] :: [a][]
| otherwise :: Boolotherwise = \_ _ -> return :: Monad m => forall a. a -> m areturn [] :: [a][]
configureLd :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
configureLd v cp = liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM ((++) :: [a] -> [a] -> [a]++ ldLinkerFlags :: [ProgArg]ldLinkerFlags) ($) :: (a -> b) -> a -> b$ configureLd' :: Verbosity -> ConfiguredProgram -> IO [ProgArg]configureLd' v :: Verbosityv cp :: ConfiguredProgramcp
configureLd' :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
configureLd' verbosity ldProg = do
tempDir <- getTemporaryDirectory :: IO FilePathgetTemporaryDirectory
ldx <- withTempFile ::
FilePath -> String -> (FilePath -> Handle -> IO a) -> IO awithTempFile tempDir :: FilePathtempDir ".c" ($) :: (a -> b) -> a -> b$ \testcfile testchnd ->
withTempFile ::
FilePath -> String -> (FilePath -> Handle -> IO a) -> IO awithTempFile tempDir :: FilePathtempDir ".o" ($) :: (a -> b) -> a -> b$ \testofile testohnd -> do
hPutStrLn :: Handle -> String -> IO ()hPutStrLn testchnd :: Handletestchnd "int foo() {}"
hClose :: Handle -> IO ()hClose testchnd :: Handletestchnd; hClose :: Handle -> IO ()hClose testohnd :: Handletestohnd
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity ghcProg :: ConfiguredProgramghcProg ["-c", testcfile :: FilePathtestcfile,
"-o", testofile :: FilePathtestofile]
withTempFile ::
FilePath -> String -> (FilePath -> Handle -> IO a) -> IO awithTempFile tempDir :: FilePathtempDir ".o" ($) :: (a -> b) -> a -> b$ \testofile' testohnd' ->
do
hClose :: Handle -> IO ()hClose testohnd' :: Handletestohnd'
_ <- rawSystemProgramStdout ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO StringrawSystemProgramStdout verbosity :: Verbosityverbosity ldProg :: ConfiguredProgramldProg
["-x", "-r", testofile :: FilePathtestofile, "-o", testofile' :: FilePathtestofile']
return :: Monad m => forall a. a -> m areturn True :: BoolTrue
catchIO :: IO a -> (IOException -> IO a) -> IO a`catchIO` (\_ -> return :: Monad m => forall a. a -> m areturn False :: BoolFalse)
catchExit :: IO a -> (ExitCode -> IO a) -> IO a`catchExit` (\_ -> return :: Monad m => forall a. a -> m areturn False :: BoolFalse)
if ldx :: Boolldx
then return :: Monad m => forall a. a -> m areturn ["-x"]
else return :: Monad m => forall a. a -> m areturn [] :: [a][]
getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Flag)]
getLanguages _ ghcProg
| ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [7] [] :: [a][] = return :: Monad m => forall a. a -> m areturn [(Haskell98 :: LanguageHaskell98, "-XHaskell98")
,(Haskell2010 :: LanguageHaskell2010, "-XHaskell2010")]
| otherwise :: Boolotherwise = return :: Monad m => forall a. a -> m areturn [(Haskell98 :: LanguageHaskell98, "")]
where
Just ghcVersion = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion ghcProg :: ConfiguredProgramghcProg
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]
getExtensions verbosity ghcProg
| ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,7] [] :: [a][] = do
str <- rawSystemStdout :: Verbosity -> FilePath -> [String] -> IO StringrawSystemStdout verbosity :: Verbosityverbosity (programPath :: ConfiguredProgram -> FilePathprogramPath ghcProg :: ConfiguredProgramghcProg)
["--supported-languages"]
let extStrs = if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [7] [] :: [a][]
then lines :: String -> [String]lines str :: Stringstr
else
[ extStr'' :: StringextStr''
| extStr <- lines :: String -> [String]lines str :: Stringstr
, let extStr' = case extStr :: StringextStr of
'N' : 'o' : xs -> xs :: Stringxs
_ -> "No" (++) :: [a] -> [a] -> [a]++ extStr :: StringextStr
, extStr'' <- [extStr :: StringextStr, extStr' :: [Char]extStr']
]
let extensions0 = [ (ext :: Extensionext, "-X" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay ext :: Extensionext)
| Just ext <- map :: (a -> b) -> [a] -> [b]map simpleParse :: Text a => String -> Maybe asimpleParse extStrs :: [String]extStrs ]
extensions1 = if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,8] [] :: [a][] (&&) :: Bool -> Bool -> Bool&&
ghcVersion :: VersionghcVersion (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [6,10] [] :: [a][]
then
(EnableExtension :: KnownExtension -> ExtensionEnableExtension NamedFieldPuns :: KnownExtensionNamedFieldPuns, "-XRecordPuns") (:) :: a -> [a] -> [a]:
(DisableExtension :: KnownExtension -> ExtensionDisableExtension NamedFieldPuns :: KnownExtensionNamedFieldPuns, "-XNoRecordPuns") (:) :: a -> [a] -> [a]:
extensions0 :: [(Extension, [Char])]extensions0
else extensions0 :: [(Extension, [Char])]extensions0
extensions2 = if ghcVersion :: VersionghcVersion (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [7,1] [] :: [a][]
then
(EnableExtension :: KnownExtension -> ExtensionEnableExtension NondecreasingIndentation :: KnownExtensionNondecreasingIndentation, "") (:) :: a -> [a] -> [a]:
(DisableExtension :: KnownExtension -> ExtensionDisableExtension NondecreasingIndentation :: KnownExtensionNondecreasingIndentation, "") (:) :: a -> [a] -> [a]:
extensions1 :: [(Extension, [Char])]extensions1
else extensions1 :: [(Extension, [Char])]extensions1
return :: Monad m => forall a. a -> m areturn extensions2 :: [(Extension, [Char])]extensions2
| otherwise :: Boolotherwise = return :: Monad m => forall a. a -> m areturn oldLanguageExtensions :: [(Extension, Flag)]oldLanguageExtensions
where
Just ghcVersion = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion ghcProg :: ConfiguredProgramghcProg
oldLanguageExtensions :: [(Extension, Flag)]
oldLanguageExtensions =
let doFlag (f, (enable, disable)) = [(EnableExtension :: KnownExtension -> ExtensionEnableExtension f :: FilePathf, enable :: tenable),
(DisableExtension :: KnownExtension -> ExtensionDisableExtension f :: FilePathf, disable :: tdisable)]
fglasgowExts = ("-fglasgow-exts",
"")
fFlag flag = ("-f" (++) :: [a] -> [a] -> [a]++ flag :: [Char]flag, "-fno-" (++) :: [a] -> [a] -> [a]++ flag :: [Char]flag)
in concatMap :: (a -> [b]) -> [a] -> [b]concatMap doFlag :: (KnownExtension, (t, t)) -> [(Extension, t)]doFlag
[(OverlappingInstances :: KnownExtensionOverlappingInstances , fFlag :: [Char] -> ([Char], [Char])fFlag "allow-overlapping-instances")
,(TypeSynonymInstances :: KnownExtensionTypeSynonymInstances , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(TemplateHaskell :: KnownExtensionTemplateHaskell , fFlag :: [Char] -> ([Char], [Char])fFlag "th")
,(ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface , fFlag :: [Char] -> ([Char], [Char])fFlag "ffi")
,(MonomorphismRestriction :: KnownExtensionMonomorphismRestriction , fFlag :: [Char] -> ([Char], [Char])fFlag "monomorphism-restriction")
,(MonoPatBinds :: KnownExtensionMonoPatBinds , fFlag :: [Char] -> ([Char], [Char])fFlag "mono-pat-binds")
,(UndecidableInstances :: KnownExtensionUndecidableInstances , fFlag :: [Char] -> ([Char], [Char])fFlag "allow-undecidable-instances")
,(IncoherentInstances :: KnownExtensionIncoherentInstances , fFlag :: [Char] -> ([Char], [Char])fFlag "allow-incoherent-instances")
,(Arrows :: KnownExtensionArrows , fFlag :: [Char] -> ([Char], [Char])fFlag "arrows")
,(Generics :: KnownExtensionGenerics , fFlag :: [Char] -> ([Char], [Char])fFlag "generics")
,(ImplicitPrelude :: KnownExtensionImplicitPrelude , fFlag :: [Char] -> ([Char], [Char])fFlag "implicit-prelude")
,(ImplicitParams :: KnownExtensionImplicitParams , fFlag :: [Char] -> ([Char], [Char])fFlag "implicit-params")
,(CPP :: KnownExtensionCPP , ("-cpp", ""))
,(BangPatterns :: KnownExtensionBangPatterns , fFlag :: [Char] -> ([Char], [Char])fFlag "bang-patterns")
,(KindSignatures :: KnownExtensionKindSignatures , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(RecursiveDo :: KnownExtensionRecursiveDo , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(ParallelListComp :: KnownExtensionParallelListComp , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(MultiParamTypeClasses :: KnownExtensionMultiParamTypeClasses , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(FunctionalDependencies :: KnownExtensionFunctionalDependencies , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(Rank2Types :: KnownExtensionRank2Types , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(RankNTypes :: KnownExtensionRankNTypes , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(PolymorphicComponents :: KnownExtensionPolymorphicComponents , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(ExistentialQuantification :: KnownExtensionExistentialQuantification , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(ScopedTypeVariables :: KnownExtensionScopedTypeVariables , fFlag :: [Char] -> ([Char], [Char])fFlag "scoped-type-variables")
,(FlexibleContexts :: KnownExtensionFlexibleContexts , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(FlexibleInstances :: KnownExtensionFlexibleInstances , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(EmptyDataDecls :: KnownExtensionEmptyDataDecls , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(PatternGuards :: KnownExtensionPatternGuards , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(GeneralizedNewtypeDeriving :: KnownExtensionGeneralizedNewtypeDeriving , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(MagicHash :: KnownExtensionMagicHash , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(UnicodeSyntax :: KnownExtensionUnicodeSyntax , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(PatternSignatures :: KnownExtensionPatternSignatures , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(UnliftedFFITypes :: KnownExtensionUnliftedFFITypes , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(LiberalTypeSynonyms :: KnownExtensionLiberalTypeSynonyms , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(TypeOperators :: KnownExtensionTypeOperators , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(GADTs :: KnownExtensionGADTs , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(RelaxedPolyRec :: KnownExtensionRelaxedPolyRec , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(ExtendedDefaultRules :: KnownExtensionExtendedDefaultRules , fFlag :: [Char] -> ([Char], [Char])fFlag "extended-default-rules")
,(UnboxedTuples :: KnownExtensionUnboxedTuples , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(DeriveDataTypeable :: KnownExtensionDeriveDataTypeable , fglasgowExts :: ([Char], [Char])fglasgowExts)
,(ConstrainedClassMethods :: KnownExtensionConstrainedClassMethods , fglasgowExts :: ([Char], [Char])fglasgowExts)
]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
getInstalledPackages verbosity packagedbs conf = do
checkPackageDbStack :: PackageDBStack -> IO ()checkPackageDbStack packagedbs :: PackageDBStackpackagedbs
pkgss <- getInstalledPackages' ::
Verbosity
-> [PackageDB]
-> ProgramConfiguration
-> IO [(PackageDB, [InstalledPackageInfo])]getInstalledPackages' verbosity :: Verbosityverbosity packagedbs :: PackageDBStackpackagedbs conf :: ProgramConfigurationconf
topDir <- ghcLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePathghcLibDir' verbosity :: Verbosityverbosity ghcProg :: ConfiguredProgramghcProg
let indexes = [ fromList :: [InstalledPackageInfo] -> PackageIndexPackageIndex.fromList (map :: (a -> b) -> [a] -> [b]map (substTopDir ::
FilePath -> InstalledPackageInfo -> InstalledPackageInfosubstTopDir topDir :: FilePathtopDir) pkgs :: [InstalledPackageInfo]pkgs)
| (_, pkgs) <- pkgss :: [(PackageDB, [InstalledPackageInfo])]pkgss ]
return :: Monad m => forall a. a -> m areturn ($!) :: (a -> b) -> a -> b$! hackRtsPackage :: PackageIndex -> PackageIndexhackRtsPackage (mconcat :: Monoid a => [a] -> amconcat indexes :: [PackageIndex]indexes)
where
Just ghcProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram ghcProgram :: ProgramghcProgram conf :: ProgramConfigurationconf
hackRtsPackage index =
case lookupPackageName ::
PackageIndex -> PackageName -> [(Version, [InstalledPackageInfo])]PackageIndex.lookupPackageName index :: PackageIndexindex (PackageName :: String -> PackageNamePackageName "rts") of
[(_,[rts])]
-> insert :: InstalledPackageInfo -> PackageIndex -> PackageIndexPackageIndex.insert (removeMingwIncludeDir ::
InstalledPackageInfo -> InstalledPackageInforemoveMingwIncludeDir rts :: InstalledPackageInforts) index :: PackageIndexindex
_ -> index :: PackageIndexindex
ghcLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
ghcLibDir verbosity lbi =
(reverse :: [a] -> [a]reverse (.) :: (b -> c) -> (a -> b) -> a -> c. dropWhile :: (a -> Bool) -> [a] -> [a]dropWhile isSpace :: Char -> BoolisSpace (.) :: (b -> c) -> (a -> b) -> a -> c. reverse :: [a] -> [a]reverse) fmap :: Functor f => forall a b. (a -> b) -> f a -> f b`fmap`
rawSystemProgramStdoutConf ::
Verbosity
-> Program
-> ProgramConfiguration
-> [ProgArg]
-> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity ghcProgram :: ProgramghcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) ["--print-libdir"]
ghcLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
ghcLibDir' verbosity ghcProg =
(reverse :: [a] -> [a]reverse (.) :: (b -> c) -> (a -> b) -> a -> c. dropWhile :: (a -> Bool) -> [a] -> [a]dropWhile isSpace :: Char -> BoolisSpace (.) :: (b -> c) -> (a -> b) -> a -> c. reverse :: [a] -> [a]reverse) fmap :: Functor f => forall a b. (a -> b) -> f a -> f b`fmap`
rawSystemProgramStdout ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO StringrawSystemProgramStdout verbosity :: Verbosityverbosity ghcProg :: ConfiguredProgramghcProg ["--print-libdir"]
checkPackageDbStack :: PackageDBStack -> IO ()
checkPackageDbStack (GlobalPackageDB:rest)
| GlobalPackageDB :: PackageDBGlobalPackageDB notElem :: Eq a => a -> [a] -> Bool`notElem` rest :: [PackageDB]rest = return :: Monad m => forall a. a -> m areturn ()
checkPackageDbStack _ =
die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "GHC.getInstalledPackages: the global package db must be "
(++) :: [a] -> [a] -> [a]++ "specified first and cannot be specified multiple times"
removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
removeMingwIncludeDir pkg =
let ids = includeDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.includeDirs pkg :: InstalledPackageInfopkg
ids' = filter :: (a -> Bool) -> [a] -> [a]filter (not :: Bool -> Boolnot (.) :: (b -> c) -> (a -> b) -> a -> c. ("mingw" isSuffixOf :: Eq a => [a] -> [a] -> Bool`isSuffixOf`)) ids :: [FilePath]ids
in pkg :: InstalledPackageInfopkg { InstalledPackageInfo.includeDirs = ids' :: [[Char]]ids' }
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs conf
| ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,9] [] :: [a][] =
sequence :: Monad m => [m a] -> m [a]sequence
[ do pkgs <- dump ::
Verbosity
-> ConfiguredProgram
-> PackageDB
-> IO [InstalledPackageInfo]HcPkg.dump verbosity :: Verbosityverbosity ghcPkgProg :: ConfiguredProgramghcPkgProg packagedb :: PackageDBpackagedb
return :: Monad m => forall a. a -> m areturn (packagedb :: PackageDBpackagedb, pkgs :: [InstalledPackageInfo]pkgs)
| packagedb <- packagedbs :: PackageDBStackpackagedbs ]
where
Just ghcPkgProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram ghcPkgProgram :: ProgramghcPkgProgram conf :: ProgramConfigurationconf
Just ghcProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram ghcProgram :: ProgramghcProgram conf :: ProgramConfigurationconf
Just ghcVersion = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion ghcProg :: ConfiguredProgramghcProg
getInstalledPackages' verbosity packagedbs conf = do
str <- rawSystemProgramStdoutConf ::
Verbosity
-> Program
-> ProgramConfiguration
-> [ProgArg]
-> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity ghcPkgProgram :: ProgramghcPkgProgram conf :: ProgramConfigurationconf ["list"]
let pkgFiles = [ init :: [a] -> [a]init line :: Stringline | line <- lines :: String -> [String]lines str :: Stringstr, last :: [a] -> alast line :: Stringline (==) :: Eq a => a -> a -> Bool== ':' ]
dbFile packagedb = case (packagedb :: PackageDBpackagedb, pkgFiles :: [[Char]]pkgFiles) of
(GlobalPackageDB, global:_) -> return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Just :: a -> Maybe aJust global :: [Char]global
(UserPackageDB, _global:user:_) -> return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Just :: a -> Maybe aJust user :: [Char]user
(UserPackageDB, _global:_) -> return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Nothing :: Maybe aNothing
(SpecificPackageDB specific, _) -> return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Just :: a -> Maybe aJust specific :: FilePathspecific
_ -> die :: String -> IO adie "cannot read ghc-pkg package listing"
pkgFiles' <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM dbFile :: PackageDB -> IO (Maybe [Char])dbFile packagedbs :: PackageDBStackpackagedbs
sequence :: Monad m => [m a] -> m [a]sequence [ withFileContents :: FilePath -> (String -> IO a) -> IO awithFileContents file :: FilePathfile ($) :: (a -> b) -> a -> b$ \content -> do
pkgs <- readPackages :: [Char] -> String -> IO [InstalledPackageInfo]readPackages file :: FilePathfile content :: Stringcontent
return :: Monad m => forall a. a -> m areturn (db :: PackageDBdb, pkgs :: [InstalledPackageInfo]pkgs)
| (db , Just file) <- zip :: [a] -> [b] -> [(a, b)]zip packagedbs :: PackageDBStackpackagedbs pkgFiles' :: [Maybe [Char]]pkgFiles' ]
where
readPackages
| ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,4,2] [] :: [a][]
= \file content -> case reads :: Read a => ReadS areads content :: Stringcontent of
[(pkgs, _)] -> return :: Monad m => forall a. a -> m areturn (map :: (a -> b) -> [a] -> [b]map toCurrent :: InstalledPackageInfo -> InstalledPackageInfoIPI642.toCurrent pkgs :: [InstalledPackageInfo]pkgs)
_ -> failToRead :: [Char] -> IO afailToRead file :: FilePathfile
| otherwise :: Boolotherwise
= \file content -> case reads :: Read a => ReadS areads content :: Stringcontent of
[(pkgs, _)] -> return :: Monad m => forall a. a -> m areturn (map :: (a -> b) -> [a] -> [b]map toCurrent :: InstalledPackageInfo -> InstalledPackageInfoIPI641.toCurrent pkgs :: [InstalledPackageInfo]pkgs)
_ -> failToRead :: [Char] -> IO afailToRead file :: FilePathfile
Just ghcProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram ghcProgram :: ProgramghcProgram conf :: ProgramConfigurationconf
Just ghcVersion = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion ghcProg :: ConfiguredProgramghcProg
failToRead file = die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "cannot read ghc package database " (++) :: [a] -> [a] -> [a]++ file :: FilePathfile
substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
substTopDir topDir ipo
= ipo :: InstalledPackageInfoipo {
InstalledPackageInfo.importDirs
= map :: (a -> b) -> [a] -> [b]map f :: FilePathf (importDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.importDirs ipo :: InstalledPackageInfoipo),
InstalledPackageInfo.libraryDirs
= map :: (a -> b) -> [a] -> [b]map f :: FilePathf (libraryDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.libraryDirs ipo :: InstalledPackageInfoipo),
InstalledPackageInfo.includeDirs
= map :: (a -> b) -> [a] -> [b]map f :: FilePathf (includeDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.includeDirs ipo :: InstalledPackageInfoipo),
InstalledPackageInfo.frameworkDirs
= map :: (a -> b) -> [a] -> [b]map f :: FilePathf (frameworkDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.frameworkDirs ipo :: InstalledPackageInfoipo),
InstalledPackageInfo.haddockInterfaces
= map :: (a -> b) -> [a] -> [b]map f :: FilePathf (haddockInterfaces :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.haddockInterfaces ipo :: InstalledPackageInfoipo),
InstalledPackageInfo.haddockHTMLs
= map :: (a -> b) -> [a] -> [b]map f :: FilePathf (haddockHTMLs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.haddockHTMLs ipo :: InstalledPackageInfoipo)
}
where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir :: FilePathtopDir (++) :: [a] -> [a] -> [a]++ rest :: [PackageDB]rest
f x = x :: [Char]x
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
let pref = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi
pkgid = packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr
runGhcProg = rawSystemProgramConf ::
Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity ghcProgram :: ProgramghcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
ifVanillaLib forceVanilla = when :: Monad m => Bool -> m () -> m ()when (forceVanilla :: BoolforceVanilla (||) :: Bool -> Bool -> Bool|| withVanillaLib :: LocalBuildInfo -> BoolwithVanillaLib lbi :: LocalBuildInfolbi)
ifProfLib = when :: Monad m => Bool -> m () -> m ()when (withProfLib :: LocalBuildInfo -> BoolwithProfLib lbi :: LocalBuildInfolbi)
ifSharedLib = when :: Monad m => Bool -> m () -> m ()when (withSharedLib :: LocalBuildInfo -> BoolwithSharedLib lbi :: LocalBuildInfolbi)
ifGHCiLib = when :: Monad m => Bool -> m () -> m ()when (withGHCiLib :: LocalBuildInfo -> BoolwithGHCiLib lbi :: LocalBuildInfolbi (&&) :: Bool -> Bool -> Bool&& withVanillaLib :: LocalBuildInfo -> BoolwithVanillaLib lbi :: LocalBuildInfolbi)
comp = compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi
libBi <- hackThreadedFlag ::
Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfohackThreadedFlag verbosity :: Verbosityverbosity
comp :: Compilercomp (withProfLib :: LocalBuildInfo -> BoolwithProfLib lbi :: LocalBuildInfolbi) (libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib)
let libTargetDir = pref :: FilePathpref
forceVanillaLib = EnableExtension :: KnownExtension -> ExtensionEnableExtension TemplateHaskell :: KnownExtensionTemplateHaskell elem :: Eq a => a -> [a] -> Bool`elem` allExtensions :: BuildInfo -> [Extension]allExtensions libBi :: BuildInfolibBi
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue libTargetDir :: FilePathlibTargetDir
let ghcArgs =
"--make"
(:) :: a -> [a] -> [a]: ["-package-name", display :: Text a => a -> Stringdisplay pkgid :: PackageIdentifierpkgid ]
(++) :: [a] -> [a] -> [a]++ constructGHCCmdLine ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [String]constructGHCCmdLine lbi :: LocalBuildInfolbi libBi :: BuildInfolibBi clbi :: ComponentLocalBuildInfoclbi libTargetDir :: FilePathlibTargetDir verbosity :: Verbosityverbosity
(++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)
ghcArgsProf = ghcArgs :: [[Char]]ghcArgs
(++) :: [a] -> [a] -> [a]++ ["-prof",
"-hisuf", "p_hi",
"-osuf", "p_o"
]
(++) :: [a] -> [a] -> [a]++ ghcProfOptions :: BuildInfo -> [String]ghcProfOptions libBi :: BuildInfolibBi
ghcArgsShared = ghcArgs :: [[Char]]ghcArgs
(++) :: [a] -> [a] -> [a]++ ["-dynamic",
"-hisuf", "dyn_hi",
"-osuf", "dyn_o", "-fPIC"
]
(++) :: [a] -> [a] -> [a]++ ghcSharedOptions :: BuildInfo -> [String]ghcSharedOptions libBi :: BuildInfolibBi
unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)) ($) :: (a -> b) -> a -> b$
do ifVanillaLib :: Monad m => Bool -> m () -> m ()ifVanillaLib forceVanillaLib :: BoolforceVanillaLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg ghcArgs :: [[Char]]ghcArgs)
ifProfLib :: IO () -> IO ()ifProfLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg ghcArgsProf :: [[Char]]ghcArgsProf)
ifSharedLib :: IO () -> IO ()ifSharedLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg ghcArgsShared :: [[Char]]ghcArgsShared)
unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull (cSources :: BuildInfo -> [FilePath]cSources libBi :: BuildInfolibBi)) ($) :: (a -> b) -> a -> b$ do
info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity "Building C Sources..."
sequence_ :: Monad m => [m a] -> m ()sequence_ [do let (odir,args) = constructCcCmdLine ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Verbosity
-> Bool
-> Bool
-> (FilePath, [String])constructCcCmdLine lbi :: LocalBuildInfolbi libBi :: BuildInfolibBi clbi :: ComponentLocalBuildInfoclbi pref :: FilePathpref
filename :: FilePathfilename verbosity :: Verbosityverbosity
False :: BoolFalse
(withProfLib :: LocalBuildInfo -> BoolwithProfLib lbi :: LocalBuildInfolbi)
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue odir :: FilePathodir
runGhcProg :: [ProgArg] -> IO ()runGhcProg args :: [a]args
ifSharedLib :: IO () -> IO ()ifSharedLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg (args :: [a]args (++) :: [a] -> [a] -> [a]++ ["-fPIC", "-osuf dyn_o"]))
| filename <- cSources :: BuildInfo -> [FilePath]cSources libBi :: BuildInfolibBi]
info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity "Linking..."
let cObjs = map :: (a -> b) -> [a] -> [b]map (replaceExtension :: FilePath -> String -> FilePath`replaceExtension` objExtension :: StringobjExtension) (cSources :: BuildInfo -> [FilePath]cSources libBi :: BuildInfolibBi)
cSharedObjs = map :: (a -> b) -> [a] -> [b]map (replaceExtension :: FilePath -> String -> FilePath`replaceExtension` ("dyn_" (++) :: [a] -> [a] -> [a]++ objExtension :: StringobjExtension)) (cSources :: BuildInfo -> [FilePath]cSources libBi :: BuildInfolibBi)
vanillaLibFilePath = libTargetDir :: FilePathlibTargetDir (</>) :: FilePath -> FilePath -> FilePath</> mkLibName :: PackageIdentifier -> StringmkLibName pkgid :: PackageIdentifierpkgid
profileLibFilePath = libTargetDir :: FilePathlibTargetDir (</>) :: FilePath -> FilePath -> FilePath</> mkProfLibName :: PackageIdentifier -> StringmkProfLibName pkgid :: PackageIdentifierpkgid
sharedLibFilePath = libTargetDir :: FilePathlibTargetDir (</>) :: FilePath -> FilePath -> FilePath</> mkSharedLibName :: PackageIdentifier -> CompilerId -> StringmkSharedLibName pkgid :: PackageIdentifierpkgid
(compilerId :: Compiler -> CompilerIdcompilerId (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi))
ghciLibFilePath = libTargetDir :: FilePathlibTargetDir (</>) :: FilePath -> FilePath -> FilePath</> mkGHCiLibName :: PackageIdentifier -> StringmkGHCiLibName pkgid :: PackageIdentifierpkgid
libInstallPath = libdir :: InstallDirs dir -> dirlibdir ($) :: (a -> b) -> a -> b$ absoluteInstallDirs ::
PackageDescription
-> LocalBuildInfo
-> CopyDest
-> InstallDirs FilePathabsoluteInstallDirs pkg_descr :: PackageDescriptionpkg_descr lbi :: LocalBuildInfolbi NoCopyDest :: CopyDestNoCopyDest
sharedLibInstallPath = libInstallPath :: FilePathlibInstallPath (</>) :: FilePath -> FilePath -> FilePath</> mkSharedLibName :: PackageIdentifier -> CompilerId -> StringmkSharedLibName pkgid :: PackageIdentifierpkgid
(compilerId :: Compiler -> CompilerIdcompilerId (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi))
stubObjs <- fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap catMaybes :: [Maybe a] -> [a]catMaybes ($) :: (a -> b) -> a -> b$ sequence :: Monad m => [m a] -> m [a]sequence
[ findFileWithExtension ::
[String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension [objExtension :: StringobjExtension] [libTargetDir :: FilePathlibTargetDir]
(toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (++) :: [a] -> [a] -> [a]++"_stub")
| x <- libModules :: Library -> [ModuleName]libModules lib :: Librarylib ]
stubProfObjs <- fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap catMaybes :: [Maybe a] -> [a]catMaybes ($) :: (a -> b) -> a -> b$ sequence :: Monad m => [m a] -> m [a]sequence
[ findFileWithExtension ::
[String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension ["p_" (++) :: [a] -> [a] -> [a]++ objExtension :: StringobjExtension] [libTargetDir :: FilePathlibTargetDir]
(toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (++) :: [a] -> [a] -> [a]++"_stub")
| x <- libModules :: Library -> [ModuleName]libModules lib :: Librarylib ]
stubSharedObjs <- fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap catMaybes :: [Maybe a] -> [a]catMaybes ($) :: (a -> b) -> a -> b$ sequence :: Monad m => [m a] -> m [a]sequence
[ findFileWithExtension ::
[String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension ["dyn_" (++) :: [a] -> [a] -> [a]++ objExtension :: StringobjExtension] [libTargetDir :: FilePathlibTargetDir]
(toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (++) :: [a] -> [a] -> [a]++"_stub")
| x <- libModules :: Library -> [ModuleName]libModules lib :: Librarylib ]
hObjs <- getHaskellObjects ::
Library
-> LocalBuildInfo
-> FilePath
-> String
-> Bool
-> IO [FilePath]getHaskellObjects lib :: Librarylib lbi :: LocalBuildInfolbi
pref :: FilePathpref objExtension :: StringobjExtension True :: BoolTrue
hProfObjs <-
if (withProfLib :: LocalBuildInfo -> BoolwithProfLib lbi :: LocalBuildInfolbi)
then getHaskellObjects ::
Library
-> LocalBuildInfo
-> FilePath
-> String
-> Bool
-> IO [FilePath]getHaskellObjects lib :: Librarylib lbi :: LocalBuildInfolbi
pref :: FilePathpref ("p_" (++) :: [a] -> [a] -> [a]++ objExtension :: StringobjExtension) True :: BoolTrue
else return :: Monad m => forall a. a -> m areturn [] :: [a][]
hSharedObjs <-
if (withSharedLib :: LocalBuildInfo -> BoolwithSharedLib lbi :: LocalBuildInfolbi)
then getHaskellObjects ::
Library
-> LocalBuildInfo
-> FilePath
-> String
-> Bool
-> IO [FilePath]getHaskellObjects lib :: Librarylib lbi :: LocalBuildInfolbi
pref :: FilePathpref ("dyn_" (++) :: [a] -> [a] -> [a]++ objExtension :: StringobjExtension) False :: BoolFalse
else return :: Monad m => forall a. a -> m areturn [] :: [a][]
unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull hObjs :: [FilePath]hObjs (&&) :: Bool -> Bool -> Bool&& null :: [a] -> Boolnull cObjs :: [FilePath]cObjs (&&) :: Bool -> Bool -> Bool&& null :: [a] -> Boolnull stubObjs :: [FilePath]stubObjs) ($) :: (a -> b) -> a -> b$ do
sequence_ :: Monad m => [m a] -> m ()sequence_
[ removeFile :: FilePath -> IO ()removeFile libFilePath :: FilePathlibFilePath catchIO :: IO a -> (IOException -> IO a) -> IO a`catchIO` \_ -> return :: Monad m => forall a. a -> m areturn ()
| libFilePath <- [vanillaLibFilePath :: FilePathvanillaLibFilePath, profileLibFilePath :: FilePathprofileLibFilePath
,sharedLibFilePath :: FilePathsharedLibFilePath, ghciLibFilePath :: FilePathghciLibFilePath] ]
let staticObjectFiles =
hObjs :: [FilePath]hObjs
(++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</>) cObjs :: [FilePath]cObjs
(++) :: [a] -> [a] -> [a]++ stubObjs :: [FilePath]stubObjs
profObjectFiles =
hProfObjs :: [FilePath]hProfObjs
(++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</>) cObjs :: [FilePath]cObjs
(++) :: [a] -> [a] -> [a]++ stubProfObjs :: [FilePath]stubProfObjs
ghciObjFiles =
hObjs :: [FilePath]hObjs
(++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</>) cObjs :: [FilePath]cObjs
(++) :: [a] -> [a] -> [a]++ stubObjs :: [FilePath]stubObjs
dynamicObjectFiles =
hSharedObjs :: [FilePath]hSharedObjs
(++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</>) cSharedObjs :: [FilePath]cSharedObjs
(++) :: [a] -> [a] -> [a]++ stubSharedObjs :: [FilePath]stubSharedObjs
ghcSharedLinkArgs =
[ "-no-auto-link-packages",
"-shared",
"-dynamic",
"-o", sharedLibFilePath :: FilePathsharedLibFilePath ]
(++) :: [a] -> [a] -> [a]++ (if buildOS :: OSbuildOS (==) :: Eq a => a -> a -> Bool== OSX :: OSOSX
then ["-dylib-install-name", sharedLibInstallPath :: FilePathsharedLibInstallPath]
else [] :: [a][])
(++) :: [a] -> [a] -> [a]++ dynamicObjectFiles :: [FilePath]dynamicObjectFiles
(++) :: [a] -> [a] -> [a]++ ["-package-name", display :: Text a => a -> Stringdisplay pkgid :: PackageIdentifierpkgid ]
(++) :: [a] -> [a] -> [a]++ ghcPackageFlags ::
LocalBuildInfo -> ComponentLocalBuildInfo -> [String]ghcPackageFlags lbi :: LocalBuildInfolbi clbi :: ComponentLocalBuildInfoclbi
(++) :: [a] -> [a] -> [a]++ ["-l"(++) :: [a] -> [a] -> [a]++extraLib :: StringextraLib | extraLib <- extraLibs :: BuildInfo -> [String]extraLibs libBi :: BuildInfolibBi]
(++) :: [a] -> [a] -> [a]++ ["-L"(++) :: [a] -> [a] -> [a]++extraLibDir :: StringextraLibDir | extraLibDir <- extraLibDirs :: BuildInfo -> [String]extraLibDirs libBi :: BuildInfolibBi]
ifVanillaLib :: Monad m => Bool -> m () -> m ()ifVanillaLib False :: BoolFalse ($) :: (a -> b) -> a -> b$ do
(arProg, _) <- requireProgram ::
Verbosity
-> Program
-> ProgramDb
-> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity arProgram :: ProgramarProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
createArLibArchive ::
Verbosity -> ConfiguredProgram -> FilePath -> [FilePath] -> IO ()Ar.createArLibArchive verbosity :: Verbosityverbosity arProg :: ConfiguredProgramarProg
vanillaLibFilePath :: FilePathvanillaLibFilePath staticObjectFiles :: [FilePath]staticObjectFiles
ifProfLib :: IO () -> IO ()ifProfLib ($) :: (a -> b) -> a -> b$ do
(arProg, _) <- requireProgram ::
Verbosity
-> Program
-> ProgramDb
-> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity arProgram :: ProgramarProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
createArLibArchive ::
Verbosity -> ConfiguredProgram -> FilePath -> [FilePath] -> IO ()Ar.createArLibArchive verbosity :: Verbosityverbosity arProg :: ConfiguredProgramarProg
profileLibFilePath :: FilePathprofileLibFilePath profObjectFiles :: [FilePath]profObjectFiles
ifGHCiLib :: IO () -> IO ()ifGHCiLib ($) :: (a -> b) -> a -> b$ do
(ldProg, _) <- requireProgram ::
Verbosity
-> Program
-> ProgramDb
-> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity ldProgram :: ProgramldProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
combineObjectFiles ::
Verbosity -> ConfiguredProgram -> FilePath -> [FilePath] -> IO ()Ld.combineObjectFiles verbosity :: Verbosityverbosity ldProg :: ConfiguredProgramldProg
ghciLibFilePath :: FilePathghciLibFilePath ghciObjFiles :: [FilePath]ghciObjFiles
ifSharedLib :: IO () -> IO ()ifSharedLib ($) :: (a -> b) -> a -> b$
runGhcProg :: [ProgArg] -> IO ()runGhcProg ghcSharedLinkArgs :: [[Char]]ghcSharedLinkArgs
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe verbosity _pkg_descr lbi
exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
let pref = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi
runGhcProg = rawSystemProgramConf ::
Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity ghcProgram :: ProgramghcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
exeBi <- hackThreadedFlag ::
Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfohackThreadedFlag verbosity :: Verbosityverbosity
(compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (withProfExe :: LocalBuildInfo -> BoolwithProfExe lbi :: LocalBuildInfolbi) (buildInfo :: Executable -> BuildInfobuildInfo exe :: Executableexe)
let exeNameReal = exeName' :: StringexeName' (<.>) :: FilePath -> String -> FilePath<.>
(if null :: [a] -> Boolnull ($) :: (a -> b) -> a -> b$ takeExtension :: FilePath -> StringtakeExtension exeName' :: StringexeName' then exeExtension :: StringexeExtension else "")
let targetDir = pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> exeName' :: StringexeName'
let exeDir = targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> (exeName' :: StringexeName' (++) :: [a] -> [a] -> [a]++ "-tmp")
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue targetDir :: FilePathtargetDir
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue exeDir :: FilePathexeDir
unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull (cSources :: BuildInfo -> [FilePath]cSources exeBi :: BuildInfoexeBi)) ($) :: (a -> b) -> a -> b$ do
info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity "Building C Sources."
sequence_ :: Monad m => [m a] -> m ()sequence_ [do let (odir,args) = constructCcCmdLine ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Verbosity
-> Bool
-> Bool
-> (FilePath, [String])constructCcCmdLine lbi :: LocalBuildInfolbi exeBi :: BuildInfoexeBi clbi :: ComponentLocalBuildInfoclbi
exeDir :: FilePathexeDir filename :: FilePathfilename verbosity :: Verbosityverbosity
(withDynExe :: LocalBuildInfo -> BoolwithDynExe lbi :: LocalBuildInfolbi) (withProfExe :: LocalBuildInfo -> BoolwithProfExe lbi :: LocalBuildInfolbi)
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue odir :: FilePathodir
runGhcProg :: [ProgArg] -> IO ()runGhcProg args :: [a]args
| filename <- cSources :: BuildInfo -> [FilePath]cSources exeBi :: BuildInfoexeBi]
srcMainFile <- findFile :: [FilePath] -> FilePath -> IO FilePathfindFile (exeDir :: FilePathexeDir (:) :: a -> [a] -> [a]: hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs exeBi :: BuildInfoexeBi) modPath :: FilePathmodPath
let cObjs = map :: (a -> b) -> [a] -> [b]map (replaceExtension :: FilePath -> String -> FilePath`replaceExtension` objExtension :: StringobjExtension) (cSources :: BuildInfo -> [FilePath]cSources exeBi :: BuildInfoexeBi)
let binArgs linkExe dynExe profExe =
"--make"
(:) :: a -> [a] -> [a]: (if linkExe :: BoollinkExe
then ["-o", targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> exeNameReal :: FilePathexeNameReal]
else ["-c"])
(++) :: [a] -> [a] -> [a]++ constructGHCCmdLine ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [String]constructGHCCmdLine lbi :: LocalBuildInfolbi exeBi :: BuildInfoexeBi clbi :: ComponentLocalBuildInfoclbi exeDir :: FilePathexeDir verbosity :: Verbosityverbosity
(++) :: [a] -> [a] -> [a]++ [exeDir :: FilePathexeDir (</>) :: FilePath -> FilePath -> FilePath</> x :: [Char]x | x <- cObjs :: [FilePath]cObjs]
(++) :: [a] -> [a] -> [a]++ [srcMainFile :: FilePathsrcMainFile]
(++) :: [a] -> [a] -> [a]++ ["-optl" (++) :: [a] -> [a] -> [a]++ opt :: Stringopt | opt <- ldOptions :: BuildInfo -> [String]PD.ldOptions exeBi :: BuildInfoexeBi]
(++) :: [a] -> [a] -> [a]++ ["-l"(++) :: [a] -> [a] -> [a]++lib :: Librarylib | lib <- extraLibs :: BuildInfo -> [String]extraLibs exeBi :: BuildInfoexeBi]
(++) :: [a] -> [a] -> [a]++ ["-L"(++) :: [a] -> [a] -> [a]++libDir :: FilePathlibDir | libDir <- extraLibDirs :: BuildInfo -> [String]extraLibDirs exeBi :: BuildInfoexeBi]
(++) :: [a] -> [a] -> [a]++ concat :: [[a]] -> [a]concat [["-framework", f :: FilePathf] | f <- frameworks :: BuildInfo -> [String]PD.frameworks exeBi :: BuildInfoexeBi]
(++) :: [a] -> [a] -> [a]++ if dynExe :: BooldynExe
then ["-dynamic"]
else [] :: [a][]
(++) :: [a] -> [a] -> [a]++ if profExe :: BoolprofExe
then ["-prof",
"-hisuf", "p_hi",
"-osuf", "p_o"
] (++) :: [a] -> [a] -> [a]++ ghcProfOptions :: BuildInfo -> [String]ghcProfOptions exeBi :: BuildInfoexeBi
else [] :: [a][]
when :: Monad m => Bool -> m () -> m ()when (withProfExe :: LocalBuildInfo -> BoolwithProfExe lbi :: LocalBuildInfolbi (&&) :: Bool -> Bool -> Bool&& EnableExtension :: KnownExtension -> ExtensionEnableExtension TemplateHaskell :: KnownExtensionTemplateHaskell elem :: Eq a => a -> [a] -> Bool`elem` allExtensions :: BuildInfo -> [Extension]allExtensions exeBi :: BuildInfoexeBi)
(runGhcProg :: [ProgArg] -> IO ()runGhcProg (binArgs :: Bool -> Bool -> Bool -> [[Char]]binArgs False :: BoolFalse (withDynExe :: LocalBuildInfo -> BoolwithDynExe lbi :: LocalBuildInfolbi) False :: BoolFalse))
runGhcProg :: [ProgArg] -> IO ()runGhcProg (binArgs :: Bool -> Bool -> Bool -> [[Char]]binArgs True :: BoolTrue (withDynExe :: LocalBuildInfo -> BoolwithDynExe lbi :: LocalBuildInfolbi) (withProfExe :: LocalBuildInfo -> BoolwithProfExe lbi :: LocalBuildInfolbi))
hackThreadedFlag :: Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfo
hackThreadedFlag verbosity comp prof bi
| not :: Bool -> Boolnot mustFilterThreaded :: BoolmustFilterThreaded = return :: Monad m => forall a. a -> m areturn bi :: BuildInfobi
| otherwise :: Boolotherwise = do
warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "The ghc flag '-threaded' is not compatible with "
(++) :: [a] -> [a] -> [a]++ "profiling in ghc-6.8 and older. It will be disabled."
return :: Monad m => forall a. a -> m areturn bi :: BuildInfobi { options = filterHcOptions ::
(a -> Bool) -> [(CompilerFlavor, [a])] -> [(CompilerFlavor, [a])]filterHcOptions ((/=) :: Eq a => a -> a -> Bool/= "-threaded") (options :: BuildInfo -> [(CompilerFlavor, [String])]options bi :: BuildInfobi) }
where
mustFilterThreaded = prof :: Boolprof (&&) :: Bool -> Bool -> Bool&& compilerVersion :: Compiler -> VersioncompilerVersion comp :: Compilercomp (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [6, 10] [] :: [a][]
(&&) :: Bool -> Bool -> Bool&& "-threaded" elem :: Eq a => a -> [a] -> Bool`elem` hcOptions :: CompilerFlavor -> BuildInfo -> [String]hcOptions GHC :: CompilerFlavorGHC bi :: BuildInfobi
filterHcOptions p hcoptss =
[ (hc :: CompilerFlavorhc, if hc :: CompilerFlavorhc (==) :: Eq a => a -> a -> Bool== GHC :: CompilerFlavorGHC then filter :: (a -> Bool) -> [a] -> [a]filter p :: a -> Boolp opts :: [a]opts else opts :: [a]opts)
| (hc, opts) <- hcoptss :: [(CompilerFlavor, [a])]hcoptss ]
getHaskellObjects :: Library -> LocalBuildInfo
-> FilePath -> String -> Bool -> IO [FilePath]
getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs
| splitObjs :: LocalBuildInfo -> BoolsplitObjs lbi :: LocalBuildInfolbi (&&) :: Bool -> Bool -> Bool&& allow_split_objs :: Boolallow_split_objs = do
let splitSuffix = if compilerVersion :: Compiler -> VersioncompilerVersion (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (<) :: Ord a => a -> a -> Bool<
Version :: [Int] -> [String] -> VersionVersion [6, 11] [] :: [a][]
then "_split"
else "_" (++) :: [a] -> [a] -> [a]++ wanted_obj_ext :: Stringwanted_obj_ext (++) :: [a] -> [a] -> [a]++ "_split"
dirs = [ pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> (toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (++) :: [a] -> [a] -> [a]++ splitSuffix :: [Char]splitSuffix)
| x <- libModules :: Library -> [ModuleName]libModules lib :: Librarylib ]
objss <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM getDirectoryContents :: FilePath -> IO [FilePath]getDirectoryContents dirs :: [FilePath]dirs
let objs = [ dir :: FilePathdir (</>) :: FilePath -> FilePath -> FilePath</> obj :: FilePathobj
| (objs',dir) <- zip :: [a] -> [b] -> [(a, b)]zip objss :: [[FilePath]]objss dirs :: [FilePath]dirs, obj <- objs' :: [FilePath]objs',
let obj_ext = takeExtension :: FilePath -> StringtakeExtension obj :: FilePathobj,
'.'(:) :: a -> [a] -> [a]:wanted_obj_ext :: Stringwanted_obj_ext (==) :: Eq a => a -> a -> Bool== obj_ext :: Stringobj_ext ]
return :: Monad m => forall a. a -> m areturn objs :: [FilePath]objs
| otherwise :: Boolotherwise =
return :: Monad m => forall a. a -> m areturn [ pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (<.>) :: FilePath -> String -> FilePath<.> wanted_obj_ext :: Stringwanted_obj_ext
| x <- libModules :: Library -> [ModuleName]libModules lib :: Librarylib ]
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash verbosity pkg_descr lbi lib clbi = do
libBi <- hackThreadedFlag ::
Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfohackThreadedFlag verbosity :: Verbosityverbosity
(compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (withProfLib :: LocalBuildInfo -> BoolwithProfLib lbi :: LocalBuildInfolbi) (libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib)
let
ghcArgs =
"--abi-hash"
(:) :: a -> [a] -> [a]: ["-package-name", display :: Text a => a -> Stringdisplay (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr) ]
(++) :: [a] -> [a] -> [a]++ constructGHCCmdLine ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [String]constructGHCCmdLine lbi :: LocalBuildInfolbi libBi :: BuildInfolibBi clbi :: ComponentLocalBuildInfoclbi (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi) verbosity :: Verbosityverbosity
(++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay (exposedModules :: Library -> [ModuleName]exposedModules lib :: Librarylib)
rawSystemProgramStdoutConf ::
Verbosity
-> Program
-> ProgramConfiguration
-> [ProgArg]
-> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity ghcProgram :: ProgramghcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) ghcArgs :: [[Char]]ghcArgs
constructGHCCmdLine
:: LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [String]
constructGHCCmdLine lbi bi clbi odir verbosity =
ghcVerbosityOptions :: Verbosity -> [String]ghcVerbosityOptions verbosity :: Verbosityverbosity
(++) :: [a] -> [a] -> [a]++ ghcOptions ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> [String]ghcOptions lbi :: LocalBuildInfolbi bi :: BuildInfobi clbi :: ComponentLocalBuildInfoclbi odir :: FilePathodir
ghcVerbosityOptions :: Verbosity -> [String]
ghcVerbosityOptions verbosity
| verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening = ["-v"]
| verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= normal :: Verbositynormal = [] :: [a][]
| otherwise :: Boolotherwise = ["-w", "-v0"]
ghcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcOptions lbi bi clbi odir
= ["-hide-all-packages"]
(++) :: [a] -> [a] -> [a]++ ["-fbuilding-cabal-package" | ghcVer :: VersionghcVer (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,11] [] :: [a][] ]
(++) :: [a] -> [a] -> [a]++ ghcPackageDbOptions :: PackageDBStack -> [String]ghcPackageDbOptions (withPackageDB :: LocalBuildInfo -> PackageDBStackwithPackageDB lbi :: LocalBuildInfolbi)
(++) :: [a] -> [a] -> [a]++ ["-split-objs" | splitObjs :: LocalBuildInfo -> BoolsplitObjs lbi :: LocalBuildInfolbi ]
(++) :: [a] -> [a] -> [a]++ ["-i"]
(++) :: [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]++ ["-I" (++) :: [a] -> [a] -> [a]++ autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi]
(++) :: [a] -> [a] -> [a]++ ["-I" (++) :: [a] -> [a] -> [a]++ odir :: FilePathodir]
(++) :: [a] -> [a] -> [a]++ ["-I" (++) :: [a] -> [a] -> [a]++ dir :: FilePathdir | dir <- includeDirs :: BuildInfo -> [FilePath]PD.includeDirs bi :: BuildInfobi]
(++) :: [a] -> [a] -> [a]++ ["-optP" (++) :: [a] -> [a] -> [a]++ opt :: Stringopt | opt <- cppOptions :: BuildInfo -> [String]cppOptions bi :: BuildInfobi]
(++) :: [a] -> [a] -> [a]++ [ "-optP-include", "-optP"(++) :: [a] -> [a] -> [a]++ (autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> cppHeaderName :: StringcppHeaderName) ]
(++) :: [a] -> [a] -> [a]++ [ "-#include \"" (++) :: [a] -> [a] -> [a]++ inc :: FilePathinc (++) :: [a] -> [a] -> [a]++ "\"" | ghcVer :: VersionghcVer (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [6,11] [] :: [a][]
, inc <- includes :: BuildInfo -> [FilePath]PD.includes bi :: BuildInfobi ]
(++) :: [a] -> [a] -> [a]++ [ "-odir", odir :: FilePathodir, "-hidir", odir :: FilePathodir ]
(++) :: [a] -> [a] -> [a]++ concat :: [[a]] -> [a]concat [ ["-stubdir", odir :: FilePathodir] | ghcVer :: VersionghcVer (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,8] [] :: [a][] ]
(++) :: [a] -> [a] -> [a]++ ghcPackageFlags ::
LocalBuildInfo -> ComponentLocalBuildInfo -> [String]ghcPackageFlags lbi :: LocalBuildInfolbi clbi :: ComponentLocalBuildInfoclbi
(++) :: [a] -> [a] -> [a]++ (case withOptimization :: LocalBuildInfo -> OptimisationLevelwithOptimization lbi :: LocalBuildInfolbi of
NoOptimisation -> [] :: [a][]
NormalOptimisation -> ["-O"]
MaximumOptimisation -> ["-O2"])
(++) :: [a] -> [a] -> [a]++ hcOptions :: CompilerFlavor -> BuildInfo -> [String]hcOptions GHC :: CompilerFlavorGHC 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)
where
ghcVer = compilerVersion :: Compiler -> VersioncompilerVersion (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi)
ghcPackageFlags :: LocalBuildInfo -> ComponentLocalBuildInfo -> [String]
ghcPackageFlags lbi clbi
| ghcVer :: VersionghcVer (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,11] [] :: [a][]
= concat :: [[a]] -> [a]concat [ ["-package-id", display :: Text a => a -> Stringdisplay ipkgid :: InstalledPackageIdipkgid]
| (ipkgid, _) <- componentPackageDeps ::
ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]componentPackageDeps clbi :: ComponentLocalBuildInfoclbi ]
| otherwise :: Boolotherwise = concat :: [[a]] -> [a]concat [ ["-package", display :: Text a => a -> Stringdisplay pkgid :: PackageIdentifierpkgid]
| (_, pkgid) <- componentPackageDeps ::
ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]componentPackageDeps clbi :: ComponentLocalBuildInfoclbi ]
where
ghcVer = compilerVersion :: Compiler -> VersioncompilerVersion (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi)
ghcPackageDbOptions :: PackageDBStack -> [String]
ghcPackageDbOptions dbstack = case dbstack :: PackageDBStackdbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> concatMap :: (a -> [b]) -> [a] -> [b]concatMap specific :: FilePathspecific dbs :: [PackageDB]dbs
(GlobalPackageDB:dbs) -> "-no-user-package-conf"
(:) :: a -> [a] -> [a]: concatMap :: (a -> [b]) -> [a] -> [b]concatMap specific :: FilePathspecific dbs :: [PackageDB]dbs
_ -> ierror :: tierror
where
specific (SpecificPackageDB db) = [ "-package-conf", db :: PackageDBdb ]
specific _ = ierror :: tierror
ierror = error :: [Char] -> aerror ("internal error: unexpected package db stack: " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow dbstack :: PackageDBStackdbstack)
constructCcCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath -> Verbosity -> Bool -> Bool
->(FilePath,[String])
constructCcCmdLine lbi bi clbi pref filename verbosity dynamic profiling
= let odir | compilerVersion :: Compiler -> VersioncompilerVersion (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,4,1] [] :: [a][] = pref :: FilePathpref
| otherwise :: Boolotherwise = pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> takeDirectory :: FilePath -> FilePathtakeDirectory filename :: FilePathfilename
in
(odir :: FilePathodir,
ghcCcOptions ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> [String]ghcCcOptions lbi :: LocalBuildInfolbi bi :: BuildInfobi clbi :: ComponentLocalBuildInfoclbi odir :: FilePathodir
(++) :: [a] -> [a] -> [a]++ (if verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening then ["-v"] else [] :: [a][])
(++) :: [a] -> [a] -> [a]++ ["-c",filename :: FilePathfilename]
(++) :: [a] -> [a] -> [a]++ ["-dynamic" | dynamic :: Booldynamic]
(++) :: [a] -> [a] -> [a]++ ["-prof" | profiling :: Boolprofiling])
ghcCcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcCcOptions lbi bi clbi odir
= ["-I" (++) :: [a] -> [a] -> [a]++ dir :: FilePathdir | dir <- odir :: FilePathodir (:) :: a -> [a] -> [a]: includeDirs :: BuildInfo -> [FilePath]PD.includeDirs bi :: BuildInfobi]
(++) :: [a] -> [a] -> [a]++ ghcPackageDbOptions :: PackageDBStack -> [String]ghcPackageDbOptions (withPackageDB :: LocalBuildInfo -> PackageDBStackwithPackageDB lbi :: LocalBuildInfolbi)
(++) :: [a] -> [a] -> [a]++ ghcPackageFlags ::
LocalBuildInfo -> ComponentLocalBuildInfo -> [String]ghcPackageFlags lbi :: LocalBuildInfolbi clbi :: ComponentLocalBuildInfoclbi
(++) :: [a] -> [a] -> [a]++ ["-optc" (++) :: [a] -> [a] -> [a]++ opt :: Stringopt | opt <- ccOptions :: BuildInfo -> [String]PD.ccOptions bi :: BuildInfobi]
(++) :: [a] -> [a] -> [a]++ (case withOptimization :: LocalBuildInfo -> OptimisationLevelwithOptimization lbi :: LocalBuildInfolbi of
NoOptimisation -> [] :: [a][]
_ -> ["-optc-O2"])
(++) :: [a] -> [a] -> [a]++ ["-odir", odir :: FilePathodir]
mkGHCiLibName :: PackageIdentifier -> String
mkGHCiLibName lib = "HS" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay lib :: Librarylib (<.>) :: FilePath -> String -> FilePath<.> "o"
installExe :: Verbosity
-> LocalBuildInfo
-> InstallDirs FilePath
-> FilePath
-> (FilePath, FilePath)
-> PackageDescription
-> Executable
-> IO ()
installExe verbosity lbi installDirs buildPref (progprefix, progsuffix) _pkg exe = do
let binDir = bindir :: InstallDirs dir -> dirbindir installDirs :: InstallDirs FilePathinstallDirs
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue binDir :: FilePathbinDir
let exeFileName = exeName :: Executable -> StringexeName exe :: Executableexe (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension
fixedExeBaseName = progprefix :: FilePathprogprefix (++) :: [a] -> [a] -> [a]++ exeName :: Executable -> StringexeName exe :: Executableexe (++) :: [a] -> [a] -> [a]++ progsuffix :: FilePathprogsuffix
installBinary dest = do
installExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()installExecutableFile verbosity :: Verbosityverbosity
(buildPref :: FilePathbuildPref (</>) :: FilePath -> FilePath -> FilePath</> exeName :: Executable -> StringexeName exe :: Executableexe (</>) :: FilePath -> FilePath -> FilePath</> exeFileName :: FilePathexeFileName)
(dest :: FilePathdest (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension)
stripExe ::
Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> IO ()stripExe verbosity :: Verbosityverbosity lbi :: LocalBuildInfolbi exeFileName :: FilePathexeFileName (dest :: FilePathdest (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension)
installBinary :: FilePath -> IO ()installBinary (binDir :: FilePathbinDir (</>) :: FilePath -> FilePath -> FilePath</> fixedExeBaseName :: [Char]fixedExeBaseName)
stripExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
stripExe verbosity lbi name path = when :: Monad m => Bool -> m () -> m ()when (stripExes :: LocalBuildInfo -> BoolstripExes lbi :: LocalBuildInfolbi) ($) :: (a -> b) -> a -> b$
case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram stripProgram :: ProgramstripProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) of
Just strip -> rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity strip :: ConfiguredProgramstrip args :: [a]args
Nothing -> unless :: Monad m => Bool -> m () -> m ()unless (buildOS :: OSbuildOS (==) :: Eq a => a -> a -> Bool== Windows :: OSWindows) ($) :: (a -> b) -> a -> b$
warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "Unable to strip executable '" (++) :: [a] -> [a] -> [a]++ name :: FilePathname
(++) :: [a] -> [a] -> [a]++ "' (missing the 'strip' program)"
where
args = path :: FilePathpath (:) :: a -> [a] -> [a]: case buildOS :: OSbuildOS of
OSX -> ["-x"]
_ -> [] :: [a][]
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> IO ()
installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib = do
let copyHelper installFun src dst n = do
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue dst :: FilePathdst
installFun :: Verbosity -> FilePath -> FilePath -> IO binstallFun verbosity :: Verbosityverbosity (src :: FilePathsrc (</>) :: FilePath -> FilePath -> FilePath</> n :: FilePathn) (dst :: FilePathdst (</>) :: FilePath -> FilePath -> FilePath</> n :: FilePathn)
copy = copyHelper ::
(Verbosity -> FilePath -> FilePath -> IO b)
-> FilePath
-> FilePath
-> FilePath
-> IO bcopyHelper installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()installOrdinaryFile
copyShared = copyHelper ::
(Verbosity -> FilePath -> FilePath -> IO b)
-> FilePath
-> FilePath
-> FilePath
-> IO bcopyHelper installExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()installExecutableFile
copyModuleFiles ext =
findModuleFiles ::
[FilePath] -> [String] -> [ModuleName] -> IO [(FilePath, FilePath)]findModuleFiles [builtDir :: FilePathbuiltDir] [ext :: Extensionext] (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)
(>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= installOrdinaryFiles ::
Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()installOrdinaryFiles verbosity :: Verbosityverbosity targetDir :: FilePathtargetDir
ifVanilla :: IO () -> IO ()ifVanilla ($) :: (a -> b) -> a -> b$ copyModuleFiles :: String -> IO ()copyModuleFiles "hi"
ifProf :: IO () -> IO ()ifProf ($) :: (a -> b) -> a -> b$ copyModuleFiles :: String -> IO ()copyModuleFiles "p_hi"
ifShared :: IO () -> IO ()ifShared ($) :: (a -> b) -> a -> b$ copyModuleFiles :: String -> IO ()copyModuleFiles "dyn_hi"
ifVanilla :: IO () -> IO ()ifVanilla ($) :: (a -> b) -> a -> b$ copy :: FilePath -> FilePath -> FilePath -> IO ()copy builtDir :: FilePathbuiltDir targetDir :: FilePathtargetDir vanillaLibName :: StringvanillaLibName
ifProf :: IO () -> IO ()ifProf ($) :: (a -> b) -> a -> b$ copy :: FilePath -> FilePath -> FilePath -> IO ()copy builtDir :: FilePathbuiltDir targetDir :: FilePathtargetDir profileLibName :: StringprofileLibName
ifGHCi :: IO () -> IO ()ifGHCi ($) :: (a -> b) -> a -> b$ copy :: FilePath -> FilePath -> FilePath -> IO ()copy builtDir :: FilePathbuiltDir targetDir :: FilePathtargetDir ghciLibName :: StringghciLibName
ifShared :: IO () -> IO ()ifShared ($) :: (a -> b) -> a -> b$ copyShared :: FilePath -> FilePath -> FilePath -> IO ()copyShared builtDir :: FilePathbuiltDir dynlibTargetDir :: FilePathdynlibTargetDir sharedLibName :: StringsharedLibName
ifVanilla :: IO () -> IO ()ifVanilla ($) :: (a -> b) -> a -> b$ updateLibArchive ::
Verbosity -> LocalBuildInfo -> FilePath -> IO ()updateLibArchive verbosity :: Verbosityverbosity lbi :: LocalBuildInfolbi
(targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> vanillaLibName :: StringvanillaLibName)
ifProf :: IO () -> IO ()ifProf ($) :: (a -> b) -> a -> b$ updateLibArchive ::
Verbosity -> LocalBuildInfo -> FilePath -> IO ()updateLibArchive verbosity :: Verbosityverbosity lbi :: LocalBuildInfolbi
(targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> profileLibName :: StringprofileLibName)
where
vanillaLibName = mkLibName :: PackageIdentifier -> StringmkLibName pkgid :: PackageIdentifierpkgid
profileLibName = mkProfLibName :: PackageIdentifier -> StringmkProfLibName pkgid :: PackageIdentifierpkgid
ghciLibName = mkGHCiLibName :: PackageIdentifier -> StringmkGHCiLibName pkgid :: PackageIdentifierpkgid
sharedLibName = mkSharedLibName :: PackageIdentifier -> CompilerId -> StringmkSharedLibName pkgid :: PackageIdentifierpkgid (compilerId :: Compiler -> CompilerIdcompilerId (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi))
pkgid = packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg :: InstalledPackageInfopkg
hasLib = not :: Bool -> Boolnot ($) :: (a -> b) -> a -> b$ null :: [a] -> Boolnull (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)
(&&) :: Bool -> Bool -> Bool&& null :: [a] -> Boolnull (cSources :: BuildInfo -> [FilePath]cSources (libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib))
ifVanilla = when :: Monad m => Bool -> m () -> m ()when (hasLib :: BoolhasLib (&&) :: Bool -> Bool -> Bool&& withVanillaLib :: LocalBuildInfo -> BoolwithVanillaLib lbi :: LocalBuildInfolbi)
ifProf = when :: Monad m => Bool -> m () -> m ()when (hasLib :: BoolhasLib (&&) :: Bool -> Bool -> Bool&& withProfLib :: LocalBuildInfo -> BoolwithProfLib lbi :: LocalBuildInfolbi)
ifGHCi = when :: Monad m => Bool -> m () -> m ()when (hasLib :: BoolhasLib (&&) :: Bool -> Bool -> Bool&& withGHCiLib :: LocalBuildInfo -> BoolwithGHCiLib lbi :: LocalBuildInfolbi)
ifShared = when :: Monad m => Bool -> m () -> m ()when (hasLib :: BoolhasLib (&&) :: Bool -> Bool -> Bool&& withSharedLib :: LocalBuildInfo -> BoolwithSharedLib lbi :: LocalBuildInfolbi)
updateLibArchive :: Verbosity -> LocalBuildInfo -> FilePath -> IO ()
updateLibArchive verbosity lbi path
| buildOS :: OSbuildOS (==) :: Eq a => a -> a -> Bool== OSX :: OSOSX = do
(ranlib, _) <- requireProgram ::
Verbosity
-> Program
-> ProgramDb
-> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity ranlibProgram :: ProgramranlibProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity ranlib :: ConfiguredProgramranlib [path :: FilePathpath]
| otherwise :: Boolotherwise = return :: Monad m => forall a. a -> m areturn ()
registerPackage
:: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDBStack
-> IO ()
registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
let Just ghcPkg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram ghcPkgProgram :: ProgramghcPkgProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
reregister ::
Verbosity
-> ConfiguredProgram
-> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> IO ()HcPkg.reregister verbosity :: Verbosityverbosity ghcPkg :: ConfiguredProgramghcPkg packageDbs :: PackageDBStackpackageDbs (Right :: b -> Either a bRight installedPkgInfo :: InstalledPackageInfoinstalledPkgInfo)