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(..) )
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 lhcProgram
(orLaterVersion (Version [0,7] []))
(userMaybeSpecifyPath "lhc" hcPath conf)
(lhcPkgProg, lhcPkgVersion, conf'') <-
requireProgramVersion verbosity lhcPkgProgram
(orLaterVersion (Version [0,7] []))
(userMaybeSpecifyPath "lhc-pkg" hcPkgPath conf')
when (lhcVersion /= lhcPkgVersion) $ die $
"Version mismatch between lhc and lhc-pkg: "
++ programPath lhcProg ++ " is version " ++ display lhcVersion ++ " "
++ programPath lhcPkgProg ++ " is version " ++ display lhcPkgVersion
languages <- getLanguages verbosity lhcProg
extensions <- getExtensions verbosity lhcProg
let comp = Compiler {
compilerId = CompilerId LHC lhcVersion,
compilerLanguages = languages,
compilerExtensions = extensions
}
conf''' = configureToolchain lhcProg conf''
return (comp, conf''')
configureToolchain :: ConfiguredProgram -> ProgramConfiguration
-> ProgramConfiguration
configureToolchain lhcProg =
addKnownProgram gccProgram {
programFindLocation = findProg gccProgram (baseDir </> "gcc.exe"),
programPostConf = configureGcc
}
. addKnownProgram ldProgram {
programFindLocation = findProg ldProgram (libDir </> "ld.exe"),
programPostConf = configureLd
}
where
compilerDir = takeDirectory (programPath lhcProg)
baseDir = takeDirectory compilerDir
libDir = baseDir </> "gcc-lib"
includeDir = baseDir </> "include" </> "mingw"
isWindows = case buildOS of Windows -> True; _ -> False
findProg :: Program -> FilePath -> Verbosity -> IO (Maybe FilePath)
findProg prog location | isWindows = \verbosity -> do
exists <- doesFileExist location
if exists then return (Just location)
else do warn verbosity ("Couldn't find " ++ programName prog ++ " where I expected it. Trying the search path.")
programFindLocation prog verbosity
| otherwise = programFindLocation prog
configureGcc :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
configureGcc
| isWindows = \_ gccProg -> case programLocation gccProg of
FoundOnSystem {} -> return ["-B" ++ libDir, "-I" ++ includeDir]
UserSpecified {} -> return []
| otherwise = \_ _ -> return []
configureLd :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
configureLd verbosity ldProg = do
tempDir <- getTemporaryDirectory
ldx <- withTempFile tempDir ".c" $ \testcfile testchnd ->
withTempFile tempDir ".o" $ \testofile testohnd -> do
hPutStrLn testchnd "int foo() {}"
hClose testchnd; hClose testohnd
rawSystemProgram verbosity lhcProg ["-c", testcfile,
"-o", testofile]
withTempFile tempDir ".o" $ \testofile' testohnd' ->
do
hClose testohnd'
_ <- rawSystemProgramStdout verbosity ldProg
["-x", "-r", testofile, "-o", testofile']
return True
`catchIO` (\_ -> return False)
`catchExit` (\_ -> return False)
if ldx
then return ["-x"]
else return []
getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Flag)]
getLanguages _ _ = return [(Haskell98, "")]
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]
getExtensions verbosity lhcProg = do
exts <- rawSystemStdout verbosity (programPath lhcProg)
["--supported-languages"]
let readExtension str = do
ext <- simpleParse ("No" ++ str)
case ext of
UnknownExtension _ -> simpleParse str
_ -> return ext
return $ [ (ext, "-X" ++ display ext)
| Just ext <- map readExtension (lines exts) ]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
getInstalledPackages verbosity packagedbs conf = do
checkPackageDbStack packagedbs
pkgss <- getInstalledPackages' verbosity packagedbs conf
let indexes = [ PackageIndex.fromList (map (substTopDir topDir) pkgs)
| (_, pkgs) <- pkgss ]
return $! (mconcat indexes)
where
Just ghcProg = lookupProgram lhcProgram conf
compilerDir = takeDirectory (programPath ghcProg)
topDir = takeDirectory compilerDir
checkPackageDbStack :: PackageDBStack -> IO ()
checkPackageDbStack (GlobalPackageDB:rest)
| GlobalPackageDB `notElem` rest = return ()
checkPackageDbStack _ =
die $ "GHC.getInstalledPackages: the global package db must be "
++ "specified first and cannot be specified multiple times"
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs conf
=
sequence
[ do str <- rawSystemProgramStdoutConf verbosity lhcPkgProgram conf
["dump", packageDbGhcPkgFlag packagedb]
`catchExit` \_ -> die $ "ghc-pkg dump failed"
case parsePackages str of
Left ok -> return (packagedb, ok)
_ -> die "failed to parse output of 'ghc-pkg dump'"
| packagedb <- packagedbs ]
where
parsePackages str =
let parsed = map parseInstalledPackageInfo (splitPkgs str)
in case [ msg | ParseFailed msg <- parsed ] of
[] -> Left [ pkg | ParseOk _ pkg <- parsed ]
msgs -> Right msgs
splitPkgs :: String -> [String]
splitPkgs = map unlines . splitWith ("---" ==) . lines
where
splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith p xs = ys : case zs of
[] -> []
_:ws -> splitWith p ws
where (ys,zs) = break p xs
packageDbGhcPkgFlag GlobalPackageDB = "--global"
packageDbGhcPkgFlag UserPackageDB = "--user"
packageDbGhcPkgFlag (SpecificPackageDB path) = "--package-conf=" ++ path
substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
substTopDir topDir ipo
= ipo {
InstalledPackageInfo.importDirs
= map f (InstalledPackageInfo.importDirs ipo),
InstalledPackageInfo.libraryDirs
= map f (InstalledPackageInfo.libraryDirs ipo),
InstalledPackageInfo.includeDirs
= map f (InstalledPackageInfo.includeDirs ipo),
InstalledPackageInfo.frameworkDirs
= map f (InstalledPackageInfo.frameworkDirs ipo),
InstalledPackageInfo.haddockInterfaces
= map f (InstalledPackageInfo.haddockInterfaces ipo),
InstalledPackageInfo.haddockHTMLs
= map f (InstalledPackageInfo.haddockHTMLs ipo)
}
where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir ++ rest
f x = x
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
let pref = buildDir lbi
pkgid = packageId pkg_descr
runGhcProg = rawSystemProgramConf verbosity lhcProgram (withPrograms lbi)
ifVanillaLib forceVanilla = when (forceVanilla || withVanillaLib lbi)
ifProfLib = when (withProfLib lbi)
ifSharedLib = when (withSharedLib lbi)
ifGHCiLib = when (withGHCiLib lbi && withVanillaLib lbi)
libBi <- hackThreadedFlag verbosity
(compiler lbi) (withProfLib lbi) (libBuildInfo lib)
let libTargetDir = pref
forceVanillaLib = TemplateHaskell `elem` allExtensions libBi
createDirectoryIfMissingVerbose verbosity True libTargetDir
let ghcArgs =
["-package-name", display pkgid ]
++ constructGHCCmdLine lbi libBi clbi libTargetDir verbosity
++ map display (libModules lib)
lhcWrap x = ["--build-library", "--ghc-opts=" ++ unwords x]
ghcArgsProf = ghcArgs
++ ["-prof",
"-hisuf", "p_hi",
"-osuf", "p_o"
]
++ ghcProfOptions libBi
ghcArgsShared = ghcArgs
++ ["-dynamic",
"-hisuf", "dyn_hi",
"-osuf", "dyn_o", "-fPIC"
]
++ ghcSharedOptions libBi
unless (null (libModules lib)) $
do ifVanillaLib forceVanillaLib (runGhcProg $ lhcWrap ghcArgs)
ifProfLib (runGhcProg $ lhcWrap ghcArgsProf)
ifSharedLib (runGhcProg $ lhcWrap ghcArgsShared)
unless (null (cSources libBi)) $ do
info verbosity "Building C Sources..."
sequence_ [do let (odir,args) = constructCcCmdLine lbi libBi clbi pref
filename verbosity
createDirectoryIfMissingVerbose verbosity True odir
runGhcProg args
ifSharedLib (runGhcProg (args ++ ["-fPIC", "-osuf dyn_o"]))
| filename <- cSources libBi]
info verbosity "Linking..."
let cObjs = map (`replaceExtension` objExtension) (cSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) (cSources libBi)
vanillaLibFilePath = libTargetDir </> mkLibName pkgid
profileLibFilePath = libTargetDir </> mkProfLibName pkgid
sharedLibFilePath = libTargetDir </> mkSharedLibName pkgid
(compilerId (compiler lbi))
ghciLibFilePath = libTargetDir </> mkGHCiLibName pkgid
stubObjs <- fmap catMaybes $ sequence
[ findFileWithExtension [objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| x <- libModules lib ]
stubProfObjs <- fmap catMaybes $ sequence
[ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| x <- libModules lib ]
stubSharedObjs <- fmap catMaybes $ sequence
[ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| x <- libModules lib ]
hObjs <- getHaskellObjects lib lbi
pref objExtension True
hProfObjs <-
if (withProfLib lbi)
then getHaskellObjects lib lbi
pref ("p_" ++ objExtension) True
else return []
hSharedObjs <-
if (withSharedLib lbi)
then getHaskellObjects lib lbi
pref ("dyn_" ++ objExtension) False
else return []
unless (null hObjs && null cObjs && null stubObjs) $ do
sequence_
[ removeFile libFilePath `catchIO` \_ -> return ()
| libFilePath <- [vanillaLibFilePath, profileLibFilePath
,sharedLibFilePath, ghciLibFilePath] ]
let arVerbosity | verbosity >= deafening = "v"
| verbosity >= normal = ""
| otherwise = "c"
arArgs = ["q"++ arVerbosity]
++ [vanillaLibFilePath]
arObjArgs =
hObjs
++ map (pref </>) cObjs
++ stubObjs
arProfArgs = ["q"++ arVerbosity]
++ [profileLibFilePath]
arProfObjArgs =
hProfObjs
++ map (pref </>) cObjs
++ stubProfObjs
ldArgs = ["-r"]
++ ["-o", ghciLibFilePath <.> "tmp"]
ldObjArgs =
hObjs
++ map (pref </>) cObjs
++ stubObjs
ghcSharedObjArgs =
hSharedObjs
++ map (pref </>) cSharedObjs
++ stubSharedObjs
ghcSharedLinkArgs =
[ "-no-auto-link-packages",
"-shared",
"-dynamic",
"-o", sharedLibFilePath ]
++ ghcSharedObjArgs
++ ["-package-name", display pkgid ]
++ ghcPackageFlags lbi clbi
++ ["-l"++extraLib | extraLib <- extraLibs libBi]
++ ["-L"++extraLibDir | extraLibDir <- extraLibDirs libBi]
runLd ldLibName args = do
exists <- doesFileExist ldLibName
rawSystemProgramConf verbosity ldProgram (withPrograms lbi)
(args ++ if exists then [ldLibName] else [])
renameFile (ldLibName <.> "tmp") ldLibName
runAr = rawSystemProgramConf verbosity arProgram (withPrograms lbi)
maxCommandLineSize = 30 * 1024
ifVanillaLib False $ xargs maxCommandLineSize
runAr arArgs arObjArgs
ifProfLib $ xargs maxCommandLineSize
runAr arProfArgs arProfObjArgs
ifGHCiLib $ xargs maxCommandLineSize
(runLd ghciLibFilePath) ldArgs ldObjArgs
ifSharedLib $ runGhcProg ghcSharedLinkArgs
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe verbosity _pkg_descr lbi
exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
let pref = buildDir lbi
runGhcProg = rawSystemProgramConf verbosity lhcProgram (withPrograms lbi)
exeBi <- hackThreadedFlag verbosity
(compiler lbi) (withProfExe lbi) (buildInfo exe)
let exeNameReal = exeName' <.>
(if null $ takeExtension exeName' then exeExtension else "")
let targetDir = pref </> exeName'
let exeDir = targetDir </> (exeName' ++ "-tmp")
createDirectoryIfMissingVerbose verbosity True targetDir
createDirectoryIfMissingVerbose verbosity True exeDir
unless (null (cSources exeBi)) $ do
info verbosity "Building C Sources."
sequence_ [do let (odir,args) = constructCcCmdLine lbi exeBi clbi
exeDir filename verbosity
createDirectoryIfMissingVerbose verbosity True odir
runGhcProg args
| filename <- cSources exeBi]
srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
let cObjs = map (`replaceExtension` objExtension) (cSources exeBi)
let lhcWrap x = ("--ghc-opts\"":x) ++ ["\""]
let binArgs linkExe profExe =
(if linkExe
then ["-o", targetDir </> exeNameReal]
else ["-c"])
++ constructGHCCmdLine lbi exeBi clbi exeDir verbosity
++ [exeDir </> x | x <- cObjs]
++ [srcMainFile]
++ ["-optl" ++ opt | opt <- PD.ldOptions exeBi]
++ ["-l"++lib | lib <- extraLibs exeBi]
++ ["-L"++libDir | libDir <- extraLibDirs exeBi]
++ concat [["-framework", f] | f <- PD.frameworks exeBi]
++ if profExe
then ["-prof",
"-hisuf", "p_hi",
"-osuf", "p_o"
] ++ ghcProfOptions exeBi
else []
when (withProfExe lbi && TemplateHaskell `elem` allExtensions exeBi)
(runGhcProg $ lhcWrap (binArgs False False))
runGhcProg (binArgs True (withProfExe lbi))
hackThreadedFlag :: Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfo
hackThreadedFlag verbosity comp prof bi
| not mustFilterThreaded = return bi
| otherwise = do
warn verbosity $ "The ghc flag '-threaded' is not compatible with "
++ "profiling in ghc-6.8 and older. It will be disabled."
return bi { options = filterHcOptions (/= "-threaded") (options bi) }
where
mustFilterThreaded = prof && compilerVersion comp < Version [6, 10] []
&& "-threaded" `elem` hcOptions GHC bi
filterHcOptions p hcoptss =
[ (hc, if hc == GHC then filter p opts else opts)
| (hc, opts) <- hcoptss ]
getHaskellObjects :: Library -> LocalBuildInfo
-> FilePath -> String -> Bool -> IO [FilePath]
getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs
| splitObjs lbi && allow_split_objs = do
let dirs = [ pref </> (ModuleName.toFilePath x ++ "_split")
| x <- libModules lib ]
objss <- mapM getDirectoryContents dirs
let objs = [ dir </> obj
| (objs',dir) <- zip objss dirs, obj <- objs',
let obj_ext = takeExtension obj,
'.':wanted_obj_ext == obj_ext ]
return objs
| otherwise =
return [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext
| x <- libModules lib ]
constructGHCCmdLine
:: LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [String]
constructGHCCmdLine lbi bi clbi odir verbosity =
["--make"]
++ ghcVerbosityOptions verbosity
++ ghcOptions lbi bi clbi odir
ghcVerbosityOptions :: Verbosity -> [String]
ghcVerbosityOptions verbosity
| verbosity >= deafening = ["-v"]
| verbosity >= normal = []
| otherwise = ["-w", "-v0"]
ghcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcOptions lbi bi clbi odir
= ["-hide-all-packages"]
++ ghcPackageDbOptions (withPackageDB lbi)
++ (if splitObjs lbi then ["-split-objs"] else [])
++ ["-i"]
++ ["-i" ++ odir]
++ ["-i" ++ l | l <- nub (hsSourceDirs bi)]
++ ["-i" ++ autogenModulesDir lbi]
++ ["-I" ++ autogenModulesDir lbi]
++ ["-I" ++ odir]
++ ["-I" ++ dir | dir <- PD.includeDirs bi]
++ ["-optP" ++ opt | opt <- cppOptions bi]
++ [ "-optP-include", "-optP"++ (autogenModulesDir lbi </> cppHeaderName) ]
++ [ "-#include \"" ++ inc ++ "\"" | inc <- PD.includes bi ]
++ [ "-odir", odir, "-hidir", odir ]
++ (if compilerVersion c >= Version [6,8] []
then ["-stubdir", odir] else [])
++ ghcPackageFlags lbi clbi
++ (case withOptimization lbi of
NoOptimisation -> []
NormalOptimisation -> ["-O"]
MaximumOptimisation -> ["-O2"])
++ hcOptions GHC bi
++ languageToFlags c (defaultLanguage bi)
++ extensionsToFlags c (usedExtensions bi)
where c = compiler lbi
ghcPackageFlags :: LocalBuildInfo -> ComponentLocalBuildInfo -> [String]
ghcPackageFlags lbi clbi
| ghcVer >= Version [6,11] []
= concat [ ["-package-id", display ipkgid]
| (ipkgid, _) <- componentPackageDeps clbi ]
| otherwise = concat [ ["-package", display pkgid]
| (_, pkgid) <- componentPackageDeps clbi ]
where
ghcVer = compilerVersion (compiler lbi)
ghcPackageDbOptions :: PackageDBStack -> [String]
ghcPackageDbOptions dbstack = case dbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
(GlobalPackageDB:dbs) -> "-no-user-package-conf"
: concatMap specific dbs
_ -> ierror
where
specific (SpecificPackageDB db) = [ "-package-conf", db ]
specific _ = ierror
ierror = error ("internal error: unexpected package db stack: " ++ show dbstack)
constructCcCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath -> Verbosity -> (FilePath,[String])
constructCcCmdLine lbi bi clbi pref filename verbosity
= let odir | compilerVersion (compiler lbi) >= Version [6,4,1] [] = pref
| otherwise = pref </> takeDirectory filename
in
(odir,
ghcCcOptions lbi bi clbi odir
++ (if verbosity >= deafening then ["-v"] else [])
++ ["-c",filename])
ghcCcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcCcOptions lbi bi clbi odir
= ["-I" ++ dir | dir <- PD.includeDirs bi]
++ ghcPackageDbOptions (withPackageDB lbi)
++ ghcPackageFlags lbi clbi
++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
++ (case withOptimization lbi of
NoOptimisation -> []
_ -> ["-optc-O2"])
++ ["-odir", odir]
mkGHCiLibName :: PackageIdentifier -> String
mkGHCiLibName lib = "HS" ++ display lib <.> "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
createDirectoryIfMissingVerbose verbosity True binDir
let exeFileName = exeName exe <.> exeExtension
fixedExeBaseName = progprefix ++ exeName exe ++ progsuffix
installBinary dest = do
installExecutableFile verbosity
(buildPref </> exeName exe </> exeFileName)
(dest <.> exeExtension)
stripExe verbosity lbi exeFileName (dest <.> exeExtension)
installBinary (binDir </> fixedExeBaseName)
stripExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
stripExe verbosity lbi name path = when (stripExes lbi) $
case lookupProgram stripProgram (withPrograms lbi) of
Just strip -> rawSystemProgram verbosity strip args
Nothing -> unless (buildOS == Windows) $
warn verbosity $ "Unable to strip executable '" ++ name
++ "' (missing the 'strip' program)"
where
args = path : case buildOS of
OSX -> ["-x"]
_ -> []
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 True dst
installOrdinaryFile verbosity (src </> n) (dst </> n)
copyModuleFiles ext =
findModuleFiles [builtDir] [ext] (libModules lib)
>>= installOrdinaryFiles verbosity targetDir
ifVanilla $ copyModuleFiles "hi"
ifProf $ copyModuleFiles "p_hi"
hcrFiles <- findModuleFiles (builtDir : hsSourceDirs (libBuildInfo lib)) ["hcr"] (libModules lib)
flip mapM_ hcrFiles $ \(srcBase, srcFile) -> runLhc ["--install-library", srcBase </> srcFile]
ifVanilla $ copy builtDir targetDir vanillaLibName
ifProf $ copy builtDir targetDir profileLibName
ifGHCi $ copy builtDir targetDir ghciLibName
ifShared $ copy builtDir dynlibTargetDir sharedLibName
ifVanilla $ updateLibArchive verbosity lbi
(targetDir </> vanillaLibName)
ifProf $ updateLibArchive verbosity lbi
(targetDir </> profileLibName)
where
vanillaLibName = mkLibName pkgid
profileLibName = mkProfLibName pkgid
ghciLibName = mkGHCiLibName pkgid
sharedLibName = mkSharedLibName pkgid (compilerId (compiler lbi))
pkgid = packageId pkg
hasLib = not $ null (libModules lib)
&& null (cSources (libBuildInfo lib))
ifVanilla = when (hasLib && withVanillaLib lbi)
ifProf = when (hasLib && withProfLib lbi)
ifGHCi = when (hasLib && withGHCiLib lbi)
ifShared = when (hasLib && withSharedLib lbi)
runLhc = rawSystemProgramConf verbosity lhcProgram (withPrograms lbi)
updateLibArchive :: Verbosity -> LocalBuildInfo -> FilePath -> IO ()
updateLibArchive verbosity lbi path =
case lookupProgram ranlibProgram (withPrograms lbi) of
Just ranlib -> rawSystemProgram verbosity ranlib [path]
Nothing -> case lookupProgram arProgram (withPrograms lbi) of
Just ar -> rawSystemProgram verbosity ar ["-s", path]
Nothing -> warn verbosity $
"Unable to generate a symbol index for the static "
++ "library '" ++ path
++ "' (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 lhcPkgProgram (withPrograms lbi)
HcPkg.reregister verbosity lhcPkg packageDbs (Right installedPkgInfo)