module Distribution.Simple.LHC (
configure, getInstalledPackages,
buildLib, buildExe,
installLib, installExe,
registerPackage,
ghcOptions,
ghcVerbosityOptions
) where
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..), Executable(..)
, Library(..), libModules, hcOptions, usedExtensions, allExtensions )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo
, parseInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(..) )
import Distribution.Simple.PackageIndex
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.ParseUtils ( ParseResult(..) )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
import Distribution.Simple.InstallDirs
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
( PackageIdentifier, Package(..) )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), ProgramConfiguration, ProgArg
, ProgramLocation(..), rawSystemProgram, rawSystemProgramConf
, rawSystemProgramStdout, rawSystemProgramStdoutConf
, requireProgramVersion
, userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
, arProgram, ranlibProgram, ldProgram
, gccProgram, stripProgram
, lhcProgram, lhcPkgProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
, OptimisationLevel(..), PackageDB(..), PackageDBStack
, Flag, languageToFlags, extensionsToFlags )
import Distribution.Version
( Version(..), orLaterVersion )
import Distribution.System
( OS(..), buildOS )
import Distribution.Verbosity
import Distribution.Text
( display, simpleParse )
import Language.Haskell.Extension
( Language(Haskell98), Extension(..), KnownExtension(..) )
import Control.Monad ( unless, when )
import Data.List
import Data.Maybe ( catMaybes )
import Data.Monoid ( Monoid(..) )
import System.Directory ( removeFile, renameFile,
getDirectoryContents, doesFileExist,
getTemporaryDirectory )
import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension )
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 conf = do
(lhcProg, lhcVersion, conf') <-
requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity lhcProgram :: ProgramlhcProgram
(orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [0,7] [] :: [a][]))
(userMaybeSpecifyPath ::
String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "lhc" hcPath :: Maybe FilePathhcPath conf :: ProgramConfigurationconf)
(lhcPkgProg, lhcPkgVersion, conf'') <-
requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity lhcPkgProgram :: ProgramlhcPkgProgram
(orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [0,7] [] :: [a][]))
(userMaybeSpecifyPath ::
String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "lhc-pkg" hcPkgPath :: Maybe FilePathhcPkgPath conf' :: ProgramDbconf')
when :: Monad m => Bool -> m () -> m ()when (lhcVersion :: VersionlhcVersion (/=) :: Eq a => a -> a -> Bool/= lhcPkgVersion :: VersionlhcPkgVersion) ($) :: (a -> b) -> a -> b$ die :: String -> IO adie ($) :: (a -> b) -> a -> b$
"Version mismatch between lhc and lhc-pkg: "
(++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath lhcProg :: ConfiguredProgramlhcProg (++) :: [a] -> [a] -> [a]++ " is version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay lhcVersion :: VersionlhcVersion (++) :: [a] -> [a] -> [a]++ " "
(++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath lhcPkgProg :: ConfiguredProgramlhcPkgProg (++) :: [a] -> [a] -> [a]++ " is version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay lhcPkgVersion :: VersionlhcPkgVersion
languages <- getLanguages ::
Verbosity -> ConfiguredProgram -> IO [(Language, Flag)]getLanguages verbosity :: Verbosityverbosity lhcProg :: ConfiguredProgramlhcProg
extensions <- getExtensions ::
Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]getExtensions verbosity :: Verbosityverbosity lhcProg :: ConfiguredProgramlhcProg
let comp = Compiler {
compilerId = CompilerId :: CompilerFlavor -> Version -> CompilerIdCompilerId LHC :: CompilerFlavorLHC lhcVersion :: VersionlhcVersion,
compilerLanguages = languages :: [(Language, Flag)]languages,
compilerExtensions = extensions :: [(Extension, Flag)]extensions
}
conf''' = configureToolchain ::
ConfiguredProgram -> ProgramConfiguration -> ProgramConfigurationconfigureToolchain lhcProg :: ConfiguredProgramlhcProg conf'' :: ProgramDbconf''
return :: Monad m => forall a. a -> m areturn (comp :: Compilercomp, conf''' :: ProgramConfigurationconf''')
configureToolchain :: ConfiguredProgram -> ProgramConfiguration
-> ProgramConfiguration
configureToolchain lhcProg =
addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram gccProgram :: ProgramgccProgram {
programFindLocation = findProg :: Program -> FilePath -> Verbosity -> IO (Maybe FilePath)findProg gccProgram :: ProgramgccProgram (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 (libDir :: FilePathlibDir (</>) :: FilePath -> FilePath -> FilePath</> "ld.exe"),
programPostConf = configureLd :: Verbosity -> ConfiguredProgram -> IO [ProgArg]configureLd
}
where
compilerDir = takeDirectory :: FilePath -> FilePathtakeDirectory (programPath :: ConfiguredProgram -> FilePathprogramPath lhcProg :: ConfiguredProgramlhcProg)
baseDir = takeDirectory :: FilePath -> FilePathtakeDirectory compilerDir :: FilePathcompilerDir
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 location | isWindows :: BoolisWindows = \verbosity -> do
exists <- doesFileExist :: FilePath -> IO BooldoesFileExist location :: FilePathlocation
if exists :: Boolexists then return :: Monad m => forall a. a -> m areturn (Just :: a -> Maybe aJust location :: FilePathlocation)
else 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
| otherwise :: Boolotherwise = programFindLocation :: Program -> Verbosity -> IO (Maybe FilePath)programFindLocation prog :: Programprog
configureGcc :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
configureGcc
| isWindows :: BoolisWindows = \_ gccProg -> case programLocation :: ConfiguredProgram -> ProgramLocationprogramLocation gccProg :: ConfiguredProgramgccProg of
FoundOnSystem {} -> return :: Monad m => forall a. a -> m areturn ["-B" (++) :: [a] -> [a] -> [a]++ libDir :: FilePathlibDir, "-I" (++) :: [a] -> [a] -> [a]++ includeDir :: FilePathincludeDir]
UserSpecified {} -> 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 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 lhcProg :: ConfiguredProgramlhcProg ["-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 _ _ = return :: Monad m => forall a. a -> m areturn [(Haskell98 :: LanguageHaskell98, "")]
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]
getExtensions verbosity lhcProg = do
exts <- rawSystemStdout :: Verbosity -> FilePath -> [String] -> IO StringrawSystemStdout verbosity :: Verbosityverbosity (programPath :: ConfiguredProgram -> FilePathprogramPath lhcProg :: ConfiguredProgramlhcProg)
["--supported-languages"]
let readExtension str = do
ext <- simpleParse :: Text a => String -> Maybe asimpleParse ("No" (++) :: [a] -> [a] -> [a]++ str :: [Char]str)
case ext :: Extensionext of
UnknownExtension _ -> simpleParse :: Text a => String -> Maybe asimpleParse str :: [Char]str
_ -> return :: Monad m => forall a. a -> m areturn ext :: Extensionext
return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ [ (ext :: Extensionext, "-X" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay ext :: Extensionext)
| Just ext <- map :: (a -> b) -> [a] -> [b]map readExtension :: [Char] -> Maybe ExtensionreadExtension (lines :: String -> [String]lines exts :: Stringexts) ]
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
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$! (mconcat :: Monoid a => [a] -> amconcat indexes :: [PackageIndex]indexes)
where
Just ghcProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram lhcProgram :: ProgramlhcProgram conf :: ProgramConfigurationconf
compilerDir = takeDirectory :: FilePath -> FilePathtakeDirectory (programPath :: ConfiguredProgram -> FilePathprogramPath ghcProg :: ConfiguredProgramghcProg)
topDir = takeDirectory :: FilePath -> FilePathtakeDirectory compilerDir :: FilePathcompilerDir
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"
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs conf
=
sequence :: Monad m => [m a] -> m [a]sequence
[ do str <- rawSystemProgramStdoutConf ::
Verbosity
-> Program
-> ProgramConfiguration
-> [ProgArg]
-> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity lhcPkgProgram :: ProgramlhcPkgProgram conf :: ProgramConfigurationconf
["dump", packageDbGhcPkgFlag :: PackageDB -> [Char]packageDbGhcPkgFlag packagedb :: PackageDBpackagedb]
catchExit :: IO a -> (ExitCode -> IO a) -> IO a`catchExit` \_ -> die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "ghc-pkg dump failed"
case parsePackages :: String -> Either [InstalledPackageInfo] [PError]parsePackages str :: [Char]str of
Left ok -> return :: Monad m => forall a. a -> m areturn (packagedb :: PackageDBpackagedb, ok :: [InstalledPackageInfo]ok)
_ -> die :: String -> IO adie "failed to parse output of 'ghc-pkg dump'"
| packagedb <- packagedbs :: PackageDBStackpackagedbs ]
where
parsePackages str =
let parsed = map :: (a -> b) -> [a] -> [b]map parseInstalledPackageInfo ::
String -> ParseResult InstalledPackageInfoparseInstalledPackageInfo (splitPkgs :: String -> [String]splitPkgs str :: [Char]str)
in case [ msg :: PErrormsg | ParseFailed msg <- parsed :: [ParseResult InstalledPackageInfo]parsed ] of
[] -> Left :: a -> Either a bLeft [ pkg :: InstalledPackageInfopkg | ParseOk _ pkg <- parsed :: [ParseResult InstalledPackageInfo]parsed ]
msgs -> Right :: b -> Either a bRight msgs :: [PError]msgs
splitPkgs :: String -> [String]
splitPkgs = map :: (a -> b) -> [a] -> [b]map unlines :: [String] -> Stringunlines (.) :: (b -> c) -> (a -> b) -> a -> c. splitWith :: (a -> Bool) -> [a] -> [[a]]splitWith ("---" (==) :: Eq a => a -> a -> Bool==) (.) :: (b -> c) -> (a -> b) -> a -> c. lines :: String -> [String]lines
where
splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith p xs = ys :: [a]ys (:) :: a -> [a] -> [a]: case zs :: [a]zs of
[] -> [] :: [a][]
_:ws -> splitWith :: (a -> Bool) -> [a] -> [[a]]splitWith p :: a -> Boolp ws :: [a]ws
where (ys,zs) = break :: (a -> Bool) -> [a] -> ([a], [a])break p :: a -> Boolp xs :: [a]xs
packageDbGhcPkgFlag GlobalPackageDB = "--global"
packageDbGhcPkgFlag UserPackageDB = "--user"
packageDbGhcPkgFlag (SpecificPackageDB path) = "--package-conf=" (++) :: [a] -> [a] -> [a]++ path :: FilePathpath
substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
substTopDir topDir ipo
= ipo :: InstalledPackageInfoipo {
InstalledPackageInfo.importDirs
= map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (importDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.importDirs ipo :: InstalledPackageInfoipo),
InstalledPackageInfo.libraryDirs
= map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (libraryDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.libraryDirs ipo :: InstalledPackageInfoipo),
InstalledPackageInfo.includeDirs
= map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (includeDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.includeDirs ipo :: InstalledPackageInfoipo),
InstalledPackageInfo.frameworkDirs
= map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (frameworkDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.frameworkDirs ipo :: InstalledPackageInfoipo),
InstalledPackageInfo.haddockInterfaces
= map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (haddockInterfaces :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.haddockInterfaces ipo :: InstalledPackageInfoipo),
InstalledPackageInfo.haddockHTMLs
= map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (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 lhcProgram :: ProgramlhcProgram (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)
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 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 =
["-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)
lhcWrap x = ["--build-library", "--ghc-opts=" (++) :: [a] -> [a] -> [a]++ unwords :: [String] -> Stringunwords x :: [Char]x]
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 ($) :: (a -> b) -> a -> b$ lhcWrap :: [String] -> [[Char]]lhcWrap ghcArgs :: [[Char]]ghcArgs)
ifProfLib :: IO () -> IO ()ifProfLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg ($) :: (a -> b) -> a -> b$ lhcWrap :: [String] -> [[Char]]lhcWrap ghcArgsProf :: [[Char]]ghcArgsProf)
ifSharedLib :: IO () -> IO ()ifSharedLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg ($) :: (a -> b) -> a -> b$ lhcWrap :: [String] -> [[Char]]lhcWrap 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
-> (FilePath, [String])constructCcCmdLine lbi :: LocalBuildInfolbi libBi :: BuildInfolibBi clbi :: ComponentLocalBuildInfoclbi pref :: FilePathpref
filename :: FilePathfilename verbosity :: Verbosityverbosity
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue odir :: FilePathodir
runGhcProg :: [ProgArg] -> IO ()runGhcProg args :: [ProgArg]args
ifSharedLib :: IO () -> IO ()ifSharedLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg (args :: [ProgArg]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
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 arVerbosity | verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening = "v"
| verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= normal :: Verbositynormal = ""
| otherwise :: Boolotherwise = "c"
arArgs = ["q"(++) :: [a] -> [a] -> [a]++ arVerbosity :: [Char]arVerbosity]
(++) :: [a] -> [a] -> [a]++ [vanillaLibFilePath :: FilePathvanillaLibFilePath]
arObjArgs =
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
arProfArgs = ["q"(++) :: [a] -> [a] -> [a]++ arVerbosity :: [Char]arVerbosity]
(++) :: [a] -> [a] -> [a]++ [profileLibFilePath :: FilePathprofileLibFilePath]
arProfObjArgs =
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
ldArgs = ["-r"]
(++) :: [a] -> [a] -> [a]++ ["-o", ghciLibFilePath :: FilePathghciLibFilePath (<.>) :: FilePath -> String -> FilePath<.> "tmp"]
ldObjArgs =
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
ghcSharedObjArgs =
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]++ ghcSharedObjArgs :: [FilePath]ghcSharedObjArgs
(++) :: [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]
runLd ldLibName args = do
exists <- doesFileExist :: FilePath -> IO BooldoesFileExist ldLibName :: FilePathldLibName
rawSystemProgramConf ::
Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity ldProgram :: ProgramldProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
(args :: [ProgArg]args (++) :: [a] -> [a] -> [a]++ if exists :: Boolexists then [ldLibName :: FilePathldLibName] else [] :: [a][])
renameFile :: FilePath -> FilePath -> IO ()renameFile (ldLibName :: FilePathldLibName (<.>) :: FilePath -> String -> FilePath<.> "tmp") ldLibName :: FilePathldLibName
runAr = rawSystemProgramConf ::
Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity arProgram :: ProgramarProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
maxCommandLineSize = 30 (*) :: Num a => a -> a -> a* 1024
ifVanillaLib :: Monad m => Bool -> m () -> m ()ifVanillaLib False :: BoolFalse ($) :: (a -> b) -> a -> b$ xargs ::
Int -> ([String] -> IO ()) -> [String] -> [String] -> IO ()xargs maxCommandLineSize :: IntmaxCommandLineSize
runAr :: [ProgArg] -> IO ()runAr arArgs :: [[Char]]arArgs arObjArgs :: [FilePath]arObjArgs
ifProfLib :: IO () -> IO ()ifProfLib ($) :: (a -> b) -> a -> b$ xargs ::
Int -> ([String] -> IO ()) -> [String] -> [String] -> IO ()xargs maxCommandLineSize :: IntmaxCommandLineSize
runAr :: [ProgArg] -> IO ()runAr arProfArgs :: [[Char]]arProfArgs arProfObjArgs :: [FilePath]arProfObjArgs
ifGHCiLib :: IO () -> IO ()ifGHCiLib ($) :: (a -> b) -> a -> b$ xargs ::
Int -> ([String] -> IO ()) -> [String] -> [String] -> IO ()xargs maxCommandLineSize :: IntmaxCommandLineSize
(runLd :: FilePath -> [ProgArg] -> IO ()runLd ghciLibFilePath :: FilePathghciLibFilePath) ldArgs :: [[Char]]ldArgs ldObjArgs :: [FilePath]ldObjArgs
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 lhcProgram :: ProgramlhcProgram (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
-> (FilePath, [String])constructCcCmdLine lbi :: LocalBuildInfolbi exeBi :: BuildInfoexeBi clbi :: ComponentLocalBuildInfoclbi
exeDir :: FilePathexeDir filename :: FilePathfilename verbosity :: Verbosityverbosity
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue odir :: FilePathodir
runGhcProg :: [ProgArg] -> IO ()runGhcProg args :: [ProgArg]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 lhcWrap x = ("--ghc-opts\""(:) :: a -> [a] -> [a]:x :: [Char]x) (++) :: [a] -> [a] -> [a]++ ["\""]
let binArgs linkExe profExe =
(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 :: [Char] -> [Char]f] | f <- frameworks :: BuildInfo -> [String]PD.frameworks exeBi :: BuildInfoexeBi]
(++) :: [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 ($) :: (a -> b) -> a -> b$ lhcWrap :: [String] -> [[Char]]lhcWrap (binArgs :: Bool -> Bool -> [[Char]]binArgs False :: BoolFalse False :: BoolFalse))
runGhcProg :: [ProgArg] -> IO ()runGhcProg (binArgs :: Bool -> Bool -> [[Char]]binArgs True :: BoolTrue (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 dirs = [ pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> (toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (++) :: [a] -> [a] -> [a]++ "_split")
| 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 ]
constructGHCCmdLine
:: LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [String]
constructGHCCmdLine lbi bi clbi odir verbosity =
["--make"]
(++) :: [a] -> [a] -> [a]++ 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]++ ghcPackageDbOptions :: PackageDBStack -> [String]ghcPackageDbOptions (withPackageDB :: LocalBuildInfo -> PackageDBStackwithPackageDB lbi :: LocalBuildInfolbi)
(++) :: [a] -> [a] -> [a]++ (if splitObjs :: LocalBuildInfo -> BoolsplitObjs lbi :: LocalBuildInfolbi then ["-split-objs"] else [] :: [a][])
(++) :: [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]++ "\"" | inc <- includes :: BuildInfo -> [FilePath]PD.includes bi :: BuildInfobi ]
(++) :: [a] -> [a] -> [a]++ [ "-odir", odir :: FilePathodir, "-hidir", odir :: FilePathodir ]
(++) :: [a] -> [a] -> [a]++ (if compilerVersion :: Compiler -> VersioncompilerVersion c :: Compilerc (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,8] [] :: [a][]
then ["-stubdir", odir :: FilePathodir] else [] :: [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 c :: Compilerc (defaultLanguage :: BuildInfo -> Maybe LanguagedefaultLanguage bi :: BuildInfobi)
(++) :: [a] -> [a] -> [a]++ extensionsToFlags :: Compiler -> [Extension] -> [Flag]extensionsToFlags c :: Compilerc (usedExtensions :: BuildInfo -> [Extension]usedExtensions bi :: BuildInfobi)
where c = 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 :: PackageDB -> [[Char]]specific dbs :: [PackageDB]dbs
(GlobalPackageDB:dbs) -> "-no-user-package-conf"
(:) :: a -> [a] -> [a]: concatMap :: (a -> [b]) -> [a] -> [b]concatMap specific :: PackageDB -> [[Char]]specific dbs :: [PackageDB]dbs
_ -> ierror :: tierror
where
specific (SpecificPackageDB db) = [ "-package-conf", db :: FilePathdb ]
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 -> (FilePath,[String])
constructCcCmdLine lbi bi clbi pref filename verbosity
= 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])
ghcCcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcCcOptions lbi bi clbi odir
= ["-I" (++) :: [a] -> [a] -> [a]++ dir :: FilePathdir | dir <- 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 :: [ProgArg]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 copy src dst n = do
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue dst :: FilePathdst
installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()installOrdinaryFile verbosity :: Verbosityverbosity (src :: FilePathsrc (</>) :: FilePath -> FilePath -> FilePath</> n :: FilePathn) (dst :: FilePathdst (</>) :: FilePath -> FilePath -> FilePath</> n :: FilePathn)
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"
hcrFiles <- findModuleFiles ::
[FilePath] -> [String] -> [ModuleName] -> IO [(FilePath, FilePath)]findModuleFiles (builtDir :: FilePathbuiltDir (:) :: a -> [a] -> [a]: hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs (libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib)) ["hcr"] (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)
flip :: (a -> b -> c) -> b -> a -> cflip mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ hcrFiles :: [(FilePath, FilePath)]hcrFiles ($) :: (a -> b) -> a -> b$ \(srcBase, srcFile) -> runLhc :: [ProgArg] -> IO ()runLhc ["--install-library", srcBase :: FilePathsrcBase (</>) :: FilePath -> FilePath -> FilePath</> srcFile :: FilePathsrcFile]
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$ copy :: FilePath -> FilePath -> FilePath -> IO ()copy 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)
runLhc = rawSystemProgramConf ::
Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity lhcProgram :: ProgramlhcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
updateLibArchive :: Verbosity -> LocalBuildInfo -> FilePath -> IO ()
updateLibArchive verbosity lbi path =
case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram ranlibProgram :: ProgramranlibProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) of
Just ranlib -> rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity ranlib :: ConfiguredProgramranlib [path :: FilePathpath]
Nothing -> case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram arProgram :: ProgramarProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) of
Just ar -> rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity ar :: ConfiguredProgramar ["-s", path :: FilePathpath]
Nothing -> warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$
"Unable to generate a symbol index for the static "
(++) :: [a] -> [a] -> [a]++ "library '" (++) :: [a] -> [a] -> [a]++ path :: FilePathpath
(++) :: [a] -> [a] -> [a]++ "' (missing the 'ranlib' and 'ar' programs)"
registerPackage
:: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDBStack
-> IO ()
registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
let Just lhcPkg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram lhcPkgProgram :: ProgramlhcPkgProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
reregister ::
Verbosity
-> ConfiguredProgram
-> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> IO ()HcPkg.reregister verbosity :: Verbosityverbosity lhcPkg :: ConfiguredProgramlhcPkg packageDbs :: PackageDBStackpackageDbs (Right :: b -> Either a bRight installedPkgInfo :: InstalledPackageInfoinstalledPkgInfo)