{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
module Distribution.Simple.GHC (
getGhcInfo,
configure,
getInstalledPackages,
getInstalledPackagesMonitorFiles,
getPackageDBContents,
buildLib, buildFLib, buildExe,
replLib, replFLib, replExe,
startInterpreter,
installLib, installFLib, installExe,
libAbiHash,
hcPkgInfo,
registerPackage,
componentGhcOptions,
componentCcGhcOptions,
getLibDir,
isDynamic,
getGlobalPackageDB,
pkgRoot,
Internal.GhcEnvironmentFileEntry(..),
Internal.simpleGhcEnvironmentFile,
Internal.writeGhcEnvironmentFile,
getImplInfo,
GhcImplInfo(..)
) where
import Prelude ()
import Distribution.Compat.Prelude
import qualified Distribution.Simple.GHC.IPI642 as IPI642
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.Simple.GHC.ImplInfo
import Distribution.PackageDescription.Utils (cabalBug)
import Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ComponentLocalBuildInfo
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.Simple.Program
import Distribution.Simple.Program.Builtin (runghcProgram)
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 qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Version
import Distribution.System
import Distribution.Verbosity
import Distribution.Text
import Distribution.Types.ForeignLib
import Distribution.Types.ForeignLibType
import Distribution.Types.ForeignLibOption
import Distribution.Types.UnqualComponentName
import Distribution.Utils.NubList
import Language.Haskell.Extension
import Control.Monad (msum)
import Data.Char (isLower)
import qualified Data.Map as Map
import System.Directory
( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing
, canonicalizePath, removeFile, renameFile )
import System.FilePath ( (</>), (<.>), takeExtension
, takeDirectory, replaceExtension
,isRelative )
import qualified System.Info
#ifndef mingw32_HOST_OS
import System.Posix (createSymbolicLink)
#endif /* mingw32_HOST_OS */
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure verbosity hcPath hcPkgPath conf0 = do
(ghcProg, ghcVersion, progdb1) <-
requireProgramVersion verbosity ghcProgram
(orLaterVersion (mkVersion [6,11]))
(userMaybeSpecifyPath "ghc" hcPath conf0)
let implInfo = ghcVersionImplInfo ghcVersion
(ghcPkgProg, ghcPkgVersion, progdb2) <-
requireProgramVersion verbosity ghcPkgProgram {
programFindLocation = guessGhcPkgFromGhcPath ghcProg
}
anyVersion (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1)
when (ghcVersion /= ghcPkgVersion) $ die' verbosity $
"Version mismatch between ghc and ghc-pkg: "
++ programPath ghcProg ++ " is version " ++ display ghcVersion ++ " "
++ programPath ghcPkgProg ++ " is version " ++ display ghcPkgVersion
let hsc2hsProgram' = hsc2hsProgram {
programFindLocation = guessHsc2hsFromGhcPath ghcProg
}
haddockProgram' = haddockProgram {
programFindLocation = guessHaddockFromGhcPath ghcProg
}
hpcProgram' = hpcProgram {
programFindLocation = guessHpcFromGhcPath ghcProg
}
runghcProgram' = runghcProgram {
programFindLocation = guessRunghcFromGhcPath ghcProg
}
progdb3 = addKnownProgram haddockProgram' $
addKnownProgram hsc2hsProgram' $
addKnownProgram hpcProgram' $
addKnownProgram runghcProgram' progdb2
languages <- Internal.getLanguages verbosity implInfo ghcProg
extensions0 <- Internal.getExtensions verbosity implInfo ghcProg
ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg
let ghcInfoMap = Map.fromList ghcInfo
extensions =
filterExt JavaScriptFFI $
filterExtTH $ extensions0
filterExtTH | ghcVersion < mkVersion [8]
, Just "NO" <- Map.lookup "Have interpreter" ghcInfoMap
= filterExt TemplateHaskell
| otherwise = id
filterExt ext = filter ((/= EnableExtension ext) . fst)
let comp = Compiler {
compilerId = CompilerId GHC ghcVersion,
compilerAbiTag = NoAbiTag,
compilerCompat = [],
compilerLanguages = languages,
compilerExtensions = extensions,
compilerProperties = ghcInfoMap
}
compPlatform = Internal.targetPlatform ghcInfo
progdb4 = Internal.configureToolchain implInfo ghcProg ghcInfoMap progdb3
return (comp, compPlatform, progdb4)
guessToolFromGhcPath :: Program -> ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath tool ghcProg verbosity searchpath
= do let toolname = programName tool
given_path = programPath ghcProg
given_dir = takeDirectory given_path
real_path <- canonicalizePath given_path
let real_dir = takeDirectory real_path
versionSuffix path = takeVersionSuffix (dropExeExtension path)
given_suf = versionSuffix given_path
real_suf = versionSuffix real_path
guessNormal dir = dir </> toolname <.> exeExtension
guessGhcVersioned dir suf = dir </> (toolname ++ "-ghc" ++ suf)
<.> exeExtension
guessVersioned dir suf = dir </> (toolname ++ suf)
<.> exeExtension
mkGuesses dir suf | null suf = [guessNormal dir]
| otherwise = [guessGhcVersioned dir suf,
guessVersioned dir suf,
guessNormal dir]
guesses = mkGuesses given_dir given_suf ++
if real_path == given_path
then []
else mkGuesses real_dir real_suf
info verbosity $ "looking for tool " ++ toolname
++ " near compiler in " ++ given_dir
debug verbosity $ "candidate locations: " ++ show guesses
exists <- traverse doesFileExist guesses
case [ file | (file, True) <- zip guesses exists ] of
[] -> programFindLocation tool verbosity searchpath
(fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
let lookedAt = map fst
. takeWhile (\(_file, exist) -> not exist)
$ zip guesses exists
return (Just (fp, lookedAt))
where takeVersionSuffix :: FilePath -> String
takeVersionSuffix = takeWhileEndLE isSuffixChar
isSuffixChar :: Char -> Bool
isSuffixChar c = isDigit c || c == '.' || c == '-'
guessGhcPkgFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
guessHsc2hsFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
guessHaddockFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcPath = guessToolFromGhcPath haddockProgram
guessHpcFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcPath = guessToolFromGhcPath hpcProgram
guessRunghcFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessRunghcFromGhcPath = guessToolFromGhcPath runghcProgram
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
where
Just version = programVersion ghcProg
implInfo = ghcVersionImplInfo version
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb
-> IO InstalledPackageIndex
getPackageDBContents verbosity packagedb progdb = do
pkgss <- getInstalledPackages' verbosity [packagedb] progdb
toPackageIndex verbosity pkgss progdb
getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages verbosity comp packagedbs progdb = do
checkPackageDbEnvVar verbosity
checkPackageDbStack verbosity comp packagedbs
pkgss <- getInstalledPackages' verbosity packagedbs progdb
index <- toPackageIndex verbosity pkgss progdb
return $! hackRtsPackage index
where
hackRtsPackage index =
case PackageIndex.lookupPackageName index (mkPackageName "rts") of
[(_,[rts])]
-> PackageIndex.insert (removeMingwIncludeDir rts) index
_ -> index
toPackageIndex :: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex verbosity pkgss progdb = do
topDir <- getLibDir' verbosity ghcProg
let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
| (_, pkgs) <- pkgss ]
return $! mconcat indices
where
Just ghcProg = lookupProgram ghcProgram progdb
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir verbosity lbi =
dropWhileEndLE isSpace `fmap`
getDbProgramOutput verbosity ghcProgram
(withPrograms lbi) ["--print-libdir"]
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' verbosity ghcProg =
dropWhileEndLE isSpace `fmap`
getProgramOutput verbosity ghcProg ["--print-libdir"]
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB verbosity ghcProg =
dropWhileEndLE isSpace `fmap`
getProgramOutput verbosity ghcProg ["--print-global-package-db"]
getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> NoCallStackIO FilePath
getUserPackageDB _verbosity ghcProg platform = do
appdir <- getAppUserDataDirectory "ghc"
return (appdir </> platformAndVersion </> packageConfFileName)
where
platformAndVersion = Internal.ghcPlatformAndVersionString
platform ghcVersion
packageConfFileName
| ghcVersion >= mkVersion [6,12] = "package.conf.d"
| otherwise = "package.conf"
Just ghcVersion = programVersion ghcProg
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar verbosity =
Internal.checkPackageDbEnvVar verbosity "GHC" "GHC_PACKAGE_PATH"
checkPackageDbStack :: Verbosity -> Compiler -> PackageDBStack -> IO ()
checkPackageDbStack verbosity comp =
if flagPackageConf implInfo
then checkPackageDbStackPre76 verbosity
else checkPackageDbStackPost76 verbosity
where implInfo = ghcVersionImplInfo (compilerVersion comp)
checkPackageDbStackPost76 :: Verbosity -> PackageDBStack -> IO ()
checkPackageDbStackPost76 _ (GlobalPackageDB:rest)
| GlobalPackageDB `notElem` rest = return ()
checkPackageDbStackPost76 verbosity rest
| GlobalPackageDB `elem` rest =
die' verbosity $ "If the global package db is specified, it must be "
++ "specified first and cannot be specified multiple times"
checkPackageDbStackPost76 _ _ = return ()
checkPackageDbStackPre76 :: Verbosity -> PackageDBStack -> IO ()
checkPackageDbStackPre76 _ (GlobalPackageDB:rest)
| GlobalPackageDB `notElem` rest = return ()
checkPackageDbStackPre76 verbosity rest
| GlobalPackageDB `notElem` rest =
die' verbosity $ "With current ghc versions the global package db is always used "
++ "and must be listed first. This ghc limitation is lifted in GHC 7.6,"
++ "see http://hackage.haskell.org/trac/ghc/ticket/5977"
checkPackageDbStackPre76 verbosity _ =
die' verbosity $ "If the global package db is specified, it must be "
++ "specified first and cannot be specified multiple times"
removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
removeMingwIncludeDir pkg =
let ids = InstalledPackageInfo.includeDirs pkg
ids' = filter (not . ("mingw" `isSuffixOf`)) ids
in pkg { InstalledPackageInfo.includeDirs = ids' }
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs progdb
| ghcVersion >= mkVersion [6,9] =
sequenceA
[ do pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb
return (packagedb, pkgs)
| packagedb <- packagedbs ]
where
Just ghcProg = lookupProgram ghcProgram progdb
Just ghcVersion = programVersion ghcProg
getInstalledPackages' verbosity packagedbs progdb = do
str <- getDbProgramOutput verbosity ghcPkgProgram progdb ["list"]
let pkgFiles = [ init line | line <- lines str, last line == ':' ]
dbFile packagedb = case (packagedb, pkgFiles) of
(GlobalPackageDB, global:_) -> return $ Just global
(UserPackageDB, _global:user:_) -> return $ Just user
(UserPackageDB, _global:_) -> return $ Nothing
(SpecificPackageDB specific, _) -> return $ Just specific
_ -> die' verbosity "cannot read ghc-pkg package listing"
pkgFiles' <- traverse dbFile packagedbs
sequenceA [ withFileContents file $ \content -> do
pkgs <- readPackages file content
return (db, pkgs)
| (db , Just file) <- zip packagedbs pkgFiles' ]
where
readPackages
| ghcVersion >= mkVersion [6,4,2]
= \file content -> case reads content of
[(pkgs, _)] -> return (map IPI642.toCurrent pkgs)
_ -> failToRead file
| otherwise
= \file _ -> failToRead file
Just ghcProg = lookupProgram ghcProgram progdb
Just ghcVersion = programVersion ghcProg
failToRead file = die' verbosity $ "cannot read ghc package database " ++ file
getInstalledPackagesMonitorFiles :: Verbosity -> Platform
-> ProgramDb
-> [PackageDB]
-> IO [FilePath]
getInstalledPackagesMonitorFiles verbosity platform progdb =
traverse getPackageDBPath
where
getPackageDBPath :: PackageDB -> IO FilePath
getPackageDBPath GlobalPackageDB =
selectMonitorFile =<< getGlobalPackageDB verbosity ghcProg
getPackageDBPath UserPackageDB =
selectMonitorFile =<< getUserPackageDB verbosity ghcProg platform
getPackageDBPath (SpecificPackageDB path) = selectMonitorFile path
selectMonitorFile path = do
isFileStyle <- doesFileExist path
if isFileStyle then return path
else return (path </> "package.cache")
Just ghcProg = lookupProgram ghcProgram progdb
buildLib, replLib :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib = buildOrReplLib False
replLib = buildOrReplLib True
buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
let uid = componentUnitId clbi
libTargetDir = componentBuildDir lbi clbi
whenVanillaLib forceVanilla =
when (forceVanilla || withVanillaLib lbi)
whenProfLib = when (withProfLib lbi)
whenSharedLib forceShared =
when (forceShared || withSharedLib lbi)
whenGHCiLib = when (withGHCiLib lbi && withVanillaLib lbi)
ifReplLib = when forRepl
comp = compiler lbi
ghcVersion = compilerVersion comp
implInfo = getImplInfo comp
platform@(Platform _hostArch hostOS) = hostPlatform lbi
has_code = not (componentIsIndefinite clbi)
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let runGhcProg = runGHC verbosity ghcProg comp platform
libBi <- hackThreadedFlag verbosity
comp (withProfLib lbi) (libBuildInfo lib)
let isGhcDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
forceVanillaLib = doingTH && not isGhcDynamic
forceSharedLib = doingTH && isGhcDynamic
let isCoverageEnabled = libCoverage lbi
pkg_name = display (PD.package pkg_descr)
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| forRepl = mempty
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
| otherwise = mempty
createDirectoryIfMissingVerbose verbosity True libTargetDir
let cObjs = map (`replaceExtension` objExtension) (cSources libBi)
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
vanillaOpts = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptNumJobs = numJobs,
ghcOptInputModules = toNubListR $ allLibModules lib clbi,
ghcOptHPCDir = hpcdir Hpc.Vanilla
}
profOpts = vanillaOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptProfilingAuto = Internal.profDetailLevelFlag True
(withProfLibDetail lbi),
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = toNubListR $ hcProfOptions GHC libBi,
ghcOptHPCDir = hpcdir Hpc.Prof
}
sharedOpts = vanillaOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptFPic = toFlag True,
ghcOptHiSuffix = toFlag "dyn_hi",
ghcOptObjSuffix = toFlag "dyn_o",
ghcOptExtra = toNubListR $ hcSharedOptions GHC libBi,
ghcOptHPCDir = hpcdir Hpc.Dyn
}
linkerOpts = mempty {
ghcOptLinkOptions = toNubListR $ PD.ldOptions libBi,
ghcOptLinkLibs = toNubListR $ extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
ghcOptLinkFrameworks = toNubListR $
PD.frameworks libBi,
ghcOptLinkFrameworkDirs = toNubListR $
PD.extraFrameworkDirs libBi,
ghcOptInputFiles = toNubListR
[libTargetDir </> x | x <- cObjs]
}
replOpts = vanillaOpts {
ghcOptExtra = overNubListR
Internal.filterGhciFlags $
ghcOptExtra vanillaOpts,
ghcOptNumJobs = mempty
}
`mappend` linkerOpts
`mappend` mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptOptimisation = toFlag GhcNoOptimisation
}
vanillaSharedOpts = vanillaOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticAndDynamic,
ghcOptDynHiSuffix = toFlag "dyn_hi",
ghcOptDynObjSuffix = toFlag "dyn_o",
ghcOptHPCDir = hpcdir Hpc.Dyn
}
unless (forRepl || null (allLibModules lib clbi)) $
do let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts)
shared = whenSharedLib forceSharedLib (runGhcProg sharedOpts)
useDynToo = dynamicTooSupported &&
(forceVanillaLib || withVanillaLib lbi) &&
(forceSharedLib || withSharedLib lbi) &&
null (hcSharedOptions GHC libBi)
if not has_code
then vanilla
else
if useDynToo
then do
runGhcProg vanillaSharedOpts
case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of
(Cabal.Flag dynDir, Cabal.Flag vanillaDir) ->
copyDirectoryRecursive verbosity dynDir vanillaDir
_ -> return ()
else if isGhcDynamic
then do shared; vanilla
else do vanilla; shared
when has_code $ whenProfLib (runGhcProg profOpts)
unless (not has_code || null (cSources libBi)) $ do
info verbosity "Building C Sources..."
sequence_
[ do let baseCcOpts = Internal.componentCcGhcOptions verbosity implInfo
lbi libBi clbi libTargetDir filename
vanillaCcOpts = if isGhcDynamic
then baseCcOpts { ghcOptFPic = toFlag True }
else baseCcOpts
profCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptObjSuffix = toFlag "p_o"
}
sharedCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptFPic = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptObjSuffix = toFlag "dyn_o"
}
odir = fromFlag (ghcOptObjDir vanillaCcOpts)
createDirectoryIfMissingVerbose verbosity True odir
let runGhcProgIfNeeded ccOpts = do
needsRecomp <- checkNeedsRecompilation filename ccOpts
when needsRecomp $ runGhcProg ccOpts
runGhcProgIfNeeded vanillaCcOpts
unless forRepl $
whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCcOpts)
unless forRepl $ whenProfLib (runGhcProgIfNeeded profCcOpts)
| filename <- cSources libBi]
when has_code . ifReplLib $ do
when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules"
ifReplLib (runGhcProg replOpts)
when has_code . unless forRepl $ do
info verbosity "Linking..."
let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension))
(cSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
(cSources libBi)
compiler_id = compilerId (compiler lbi)
vanillaLibFilePath = libTargetDir </> mkLibName uid
profileLibFilePath = libTargetDir </> mkProfLibName uid
sharedLibFilePath = libTargetDir </> mkSharedLibName compiler_id uid
ghciLibFilePath = libTargetDir </> Internal.mkGHCiLibName uid
libInstallPath = libdir $ absoluteComponentInstallDirs pkg_descr lbi uid NoCopyDest
sharedLibInstallPath = libInstallPath </> mkSharedLibName compiler_id uid
stubObjs <- catMaybes <$> sequenceA
[ findFileWithExtension [objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < mkVersion [7,2]
, x <- allLibModules lib clbi ]
stubProfObjs <- catMaybes <$> sequenceA
[ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < mkVersion [7,2]
, x <- allLibModules lib clbi ]
stubSharedObjs <- catMaybes <$> sequenceA
[ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < mkVersion [7,2]
, x <- allLibModules lib clbi ]
hObjs <- Internal.getHaskellObjects implInfo lib lbi clbi
libTargetDir objExtension True
hProfObjs <-
if withProfLib lbi
then Internal.getHaskellObjects implInfo lib lbi clbi
libTargetDir ("p_" ++ objExtension) True
else return []
hSharedObjs <-
if withSharedLib lbi
then Internal.getHaskellObjects implInfo lib lbi clbi
libTargetDir ("dyn_" ++ objExtension) False
else return []
unless (null hObjs && null cObjs && null stubObjs) $ do
rpaths <- getRPaths lbi clbi
let staticObjectFiles =
hObjs
++ map (libTargetDir </>) cObjs
++ stubObjs
profObjectFiles =
hProfObjs
++ map (libTargetDir </>) cProfObjs
++ stubProfObjs
ghciObjFiles =
hObjs
++ map (libTargetDir </>) cObjs
++ stubObjs
dynamicObjectFiles =
hSharedObjs
++ map (libTargetDir </>) cSharedObjs
++ stubSharedObjs
ghcSharedLinkArgs =
mempty {
ghcOptShared = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptInputFiles = toNubListR dynamicObjectFiles,
ghcOptOutputFile = toFlag sharedLibFilePath,
ghcOptExtra = toNubListR $
hcSharedOptions GHC libBi,
ghcOptDylibName = if hostOS == OSX
&& ghcVersion < mkVersion [7,8]
then toFlag sharedLibInstallPath
else mempty,
ghcOptHideAllPackages = toFlag True,
ghcOptNoAutoLinkPackages = toFlag True,
ghcOptPackageDBs = withPackageDB lbi,
ghcOptThisUnitId = case clbi of
LibComponentLocalBuildInfo { componentCompatPackageKey = pk }
-> toFlag pk
_ -> mempty,
ghcOptThisComponentId = case clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith = insts } ->
if null insts
then mempty
else toFlag (componentComponentId clbi)
_ -> mempty,
ghcOptInstantiatedWith = case clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith = insts }
-> insts
_ -> [],
ghcOptPackages = toNubListR $
Internal.mkGhcOptPackages clbi ,
ghcOptLinkLibs = toNubListR $ extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
ghcOptLinkFrameworkDirs =
toNubListR $ PD.extraFrameworkDirs libBi,
ghcOptRPaths = rpaths
}
info verbosity (show (ghcOptPackages ghcSharedLinkArgs))
whenVanillaLib False $
Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
whenProfLib $
Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
whenGHCiLib $ do
(ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
Ld.combineObjectFiles verbosity ldProg
ghciLibFilePath ghciObjFiles
whenSharedLib False $
runGhcProg ghcSharedLinkArgs
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform
-> PackageDBStack -> IO ()
startInterpreter verbosity progdb comp platform packageDBs = do
let replOpts = mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptPackageDBs = packageDBs
}
checkPackageDbStack verbosity comp packageDBs
(ghcProg, _) <- requireProgram verbosity ghcProgram progdb
runGHC verbosity ghcProg comp platform replOpts
buildFLib, replFLib
:: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> ForeignLib -> ComponentLocalBuildInfo -> IO ()
buildFLib v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildFLib
replFLib v njobs pkg lbi = gbuild v njobs pkg lbi . GReplFLib
buildExe, replExe
:: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildExe
replExe v njobs pkg lbi = gbuild v njobs pkg lbi . GReplExe
data GBuildMode =
GBuildExe Executable
| GReplExe Executable
| GBuildFLib ForeignLib
| GReplFLib ForeignLib
gbuildInfo :: GBuildMode -> BuildInfo
gbuildInfo (GBuildExe exe) = buildInfo exe
gbuildInfo (GReplExe exe) = buildInfo exe
gbuildInfo (GBuildFLib flib) = foreignLibBuildInfo flib
gbuildInfo (GReplFLib flib) = foreignLibBuildInfo flib
gbuildName :: GBuildMode -> String
gbuildName (GBuildExe exe) = unUnqualComponentName $ exeName exe
gbuildName (GReplExe exe) = unUnqualComponentName $ exeName exe
gbuildName (GBuildFLib flib) = unUnqualComponentName $ foreignLibName flib
gbuildName (GReplFLib flib) = unUnqualComponentName $ foreignLibName flib
gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String
gbuildTargetName _lbi (GBuildExe exe) = exeTargetName exe
gbuildTargetName _lbi (GReplExe exe) = exeTargetName exe
gbuildTargetName lbi (GBuildFLib flib) = flibTargetName lbi flib
gbuildTargetName lbi (GReplFLib flib) = flibTargetName lbi flib
exeTargetName :: Executable -> String
exeTargetName exe = unUnqualComponentName (exeName exe) `withExt` exeExtension
flibTargetName :: LocalBuildInfo -> ForeignLib -> String
flibTargetName lbi flib =
case (os, foreignLibType flib) of
(Windows, ForeignLibNativeShared) -> nm <.> "dll"
(Windows, ForeignLibNativeStatic) -> nm <.> "lib"
(Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt
(_other, ForeignLibNativeShared) -> "lib" ++ nm <.> dllExtension
(_other, ForeignLibNativeStatic) -> "lib" ++ nm <.> staticLibExtension
(_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type"
where
nm :: String
nm = unUnqualComponentName $ foreignLibName flib
os :: OS
os = let (Platform _ os') = hostPlatform lbi
in os'
versionedExt :: String
versionedExt =
let nums = foreignLibVersion flib os
in foldl (<.>) "so" (map show nums)
flibBuildName :: LocalBuildInfo -> ForeignLib -> String
flibBuildName lbi flib
| (os, foreignLibType flib) ==
(Linux, ForeignLibNativeShared)
= let nums = foreignLibVersion flib os
in "lib" ++ nm <.> foldl (<.>) "so" (map show (take 1 nums))
| otherwise = flibTargetName lbi flib
where
os :: OS
os = let (Platform _ os') = hostPlatform lbi
in os'
nm :: String
nm = unUnqualComponentName $ foreignLibName flib
gbuildIsRepl :: GBuildMode -> Bool
gbuildIsRepl (GBuildExe _) = False
gbuildIsRepl (GReplExe _) = True
gbuildIsRepl (GBuildFLib _) = False
gbuildIsRepl (GReplFLib _) = True
gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool
gbuildNeedDynamic lbi bm =
case bm of
GBuildExe _ -> withDynExe lbi
GReplExe _ -> withDynExe lbi
GBuildFLib flib -> withDynFLib flib
GReplFLib flib -> withDynFLib flib
where
withDynFLib flib =
case foreignLibType flib of
ForeignLibNativeShared ->
ForeignLibStandalone `notElem` foreignLibOptions flib
ForeignLibNativeStatic ->
False
ForeignLibTypeUnknown ->
cabalBug "unknown foreign lib type"
gbuildModDefFiles :: GBuildMode -> [FilePath]
gbuildModDefFiles (GBuildExe _) = []
gbuildModDefFiles (GReplExe _) = []
gbuildModDefFiles (GBuildFLib flib) = foreignLibModDefFile flib
gbuildModDefFiles (GReplFLib flib) = foreignLibModDefFile flib
exeMainModuleName :: Executable -> Maybe ModuleName
exeMainModuleName Executable{buildInfo = bnfo} =
msum $ reverse $ map decodeMainIsArg $ findIsMainArgs ghcopts
where
ghcopts = hcOptions GHC bnfo
findIsMainArgs [] = []
findIsMainArgs ("-main-is":arg:rest) = arg : findIsMainArgs rest
findIsMainArgs (_:rest) = findIsMainArgs rest
decodeMainIsArg :: String -> Maybe ModuleName
decodeMainIsArg arg
| not (null main_fn) && isLower (head main_fn)
= Just (ModuleName.fromString main_mod)
| isUpper (head arg)
= Just (ModuleName.fromString arg)
| otherwise
= Nothing
where
(main_mod, main_fn) = splitLongestPrefix arg (== '.')
splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
splitLongestPrefix str pred'
| null r_pre = (str, [])
| otherwise = (reverse (tail r_pre), reverse r_suf)
where (r_suf, r_pre) = break pred' (reverse str)
gbuildSources :: Verbosity
-> Version
-> FilePath
-> GBuildMode
-> IO ([FilePath], [FilePath], [ModuleName])
gbuildSources verbosity specVer tmpDir bm =
case bm of
GBuildExe exe -> exeSources exe
GReplExe exe -> exeSources exe
GBuildFLib flib -> return $ flibSources flib
GReplFLib flib -> return $ flibSources flib
where
exeSources :: Executable -> IO ([FilePath], [FilePath], [ModuleName])
exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do
main <- findFile (tmpDir : hsSourceDirs bnfo) modPath
let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe
otherModNames = exeModules exe
if isHaskell main
then
if specVer < mkVersion [2] && (mainModName `elem` otherModNames)
then do
warn verbosity $ "Enabling workaround for Main module '"
++ display mainModName
++ "' listed in 'other-modules' illegaly!"
return (cSources bnfo, [main],
filter (/= mainModName) (exeModules exe))
else return (cSources bnfo, [main], exeModules exe)
else return (main : cSources bnfo, [], exeModules exe)
flibSources :: ForeignLib -> ([FilePath], [FilePath], [ModuleName])
flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} =
(cSources bnfo, [], foreignLibModules flib)
isHaskell :: FilePath -> Bool
isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"]
gbuild :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> GBuildMode -> ComponentLocalBuildInfo -> IO ()
gbuild verbosity numJobs pkg_descr lbi bm clbi = do
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let comp = compiler lbi
platform = hostPlatform lbi
implInfo = getImplInfo comp
runGhcProg = runGHC verbosity ghcProg comp platform
bnfo <- hackThreadedFlag verbosity
comp (withProfExe lbi) (gbuildInfo bm)
let targetName = gbuildTargetName lbi bm
let targetDir = buildDir lbi </> (gbuildName bm)
let tmpDir = targetDir </> (gbuildName bm ++ "-tmp")
createDirectoryIfMissingVerbose verbosity True targetDir
createDirectoryIfMissingVerbose verbosity True tmpDir
let isCoverageEnabled = exeCoverage lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| gbuildIsRepl bm = mempty
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm)
| otherwise = mempty
rpaths <- getRPaths lbi clbi
(cSrcs, inputFiles, inputModules) <- gbuildSources verbosity
(specVersion pkg_descr) tmpDir bm
let isGhcDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
cObjs = map (`replaceExtension` objExtension) cSrcs
needDynamic = gbuildNeedDynamic lbi bm
needProfiling = withProfExe lbi
baseOpts = (componentGhcOptions verbosity lbi bnfo clbi tmpDir)
`mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptInputFiles = toNubListR inputFiles,
ghcOptInputModules = toNubListR inputModules
}
staticOpts = baseOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticOnly,
ghcOptHPCDir = hpcdir Hpc.Vanilla
}
profOpts = baseOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptProfilingAuto = Internal.profDetailLevelFlag False
(withProfExeDetail lbi),
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = toNubListR
(hcProfOptions GHC bnfo),
ghcOptHPCDir = hpcdir Hpc.Prof
}
dynOpts = baseOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptFPic = toFlag True,
ghcOptHiSuffix = toFlag "dyn_hi",
ghcOptObjSuffix = toFlag "dyn_o",
ghcOptExtra = toNubListR $
hcSharedOptions GHC bnfo,
ghcOptHPCDir = hpcdir Hpc.Dyn
}
dynTooOpts = staticOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticAndDynamic,
ghcOptDynHiSuffix = toFlag "dyn_hi",
ghcOptDynObjSuffix = toFlag "dyn_o",
ghcOptHPCDir = hpcdir Hpc.Dyn
}
linkerOpts = mempty {
ghcOptLinkOptions = toNubListR $ PD.ldOptions bnfo,
ghcOptLinkLibs = toNubListR $ extraLibs bnfo,
ghcOptLinkLibPath = toNubListR $ extraLibDirs bnfo,
ghcOptLinkFrameworks = toNubListR $
PD.frameworks bnfo,
ghcOptLinkFrameworkDirs = toNubListR $
PD.extraFrameworkDirs bnfo,
ghcOptInputFiles = toNubListR
[tmpDir </> x | x <- cObjs]
}
dynLinkerOpts = mempty {
ghcOptRPaths = rpaths
}
replOpts = baseOpts {
ghcOptExtra = overNubListR
Internal.filterGhciFlags
(ghcOptExtra baseOpts)
}
`mappend` linkerOpts
`mappend` mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptOptimisation = toFlag GhcNoOptimisation
}
commonOpts | needProfiling = profOpts
| needDynamic = dynOpts
| otherwise = staticOpts
compileOpts | useDynToo = dynTooOpts
| otherwise = commonOpts
withStaticExe = not needProfiling && not needDynamic
doingTH = EnableExtension TemplateHaskell `elem` allExtensions bnfo
useDynToo = dynamicTooSupported && isGhcDynamic
&& doingTH && withStaticExe
&& null (hcSharedOptions GHC bnfo)
compileTHOpts | isGhcDynamic = dynOpts
| otherwise = staticOpts
compileForTH
| gbuildIsRepl bm = False
| useDynToo = False
| isGhcDynamic = doingTH && (needProfiling || withStaticExe)
| otherwise = doingTH && (needProfiling || needDynamic)
when compileForTH $
runGhcProg compileTHOpts { ghcOptNoLink = toFlag True
, ghcOptNumJobs = numJobs }
unless (gbuildIsRepl bm) $
runGhcProg compileOpts { ghcOptNoLink = toFlag True
, ghcOptNumJobs = numJobs }
unless (null cSrcs) $ do
info verbosity "Building C Sources..."
sequence_
[ do let baseCcOpts = Internal.componentCcGhcOptions verbosity implInfo
lbi bnfo clbi tmpDir filename
vanillaCcOpts = if isGhcDynamic
then baseCcOpts { ghcOptFPic = toFlag True }
else baseCcOpts
profCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True
}
sharedCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptFPic = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly
}
opts | needProfiling = profCcOpts
| needDynamic = sharedCcOpts
| otherwise = vanillaCcOpts
odir = fromFlag (ghcOptObjDir opts)
createDirectoryIfMissingVerbose verbosity True odir
needsRecomp <- checkNeedsRecompilation filename opts
when needsRecomp $
runGhcProg opts
| filename <- cSrcs ]
case bm of
GReplExe _ -> runGhcProg replOpts
GReplFLib _ -> runGhcProg replOpts
GBuildExe _ -> do
let linkOpts = commonOpts
`mappend` linkerOpts
`mappend` mempty {
ghcOptLinkNoHsMain = toFlag (null inputFiles)
}
`mappend` (if withDynExe lbi then dynLinkerOpts else mempty)
info verbosity "Linking..."
let target = targetDir </> targetName
when (compilerVersion comp < mkVersion [7,7]) $ do
e <- doesFileExist target
when e (removeFile target)
runGhcProg linkOpts { ghcOptOutputFile = toFlag target }
GBuildFLib flib -> do
let rtsInfo = extractRtsInfo lbi
linkOpts = case foreignLibType flib of
ForeignLibNativeShared ->
commonOpts
`mappend` linkerOpts
`mappend` dynLinkerOpts
`mappend` mempty {
ghcOptLinkNoHsMain = toFlag True,
ghcOptShared = toFlag True,
ghcOptLinkLibs = toNubListR [
if needDynamic
then rtsDynamicLib rtsInfo
else rtsStaticLib rtsInfo
],
ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo,
ghcOptFPic = toFlag True,
ghcOptLinkModDefFiles = toNubListR $ gbuildModDefFiles bm
}
`mappend` ifNeedsRPathWorkaround lbi mempty {
ghcOptLinkOptions = toNubListR ["-Wl,--no-as-needed"]
, ghcOptLinkLibs = toNubListR ["ffi"]
}
ForeignLibNativeStatic ->
cabalBug "static libraries not yet implemented"
ForeignLibTypeUnknown ->
cabalBug "unknown foreign lib type"
info verbosity "Linking..."
let buildName = flibBuildName lbi flib
runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir </> buildName) }
renameFile (targetDir </> buildName) (targetDir </> targetName)
ifNeedsRPathWorkaround :: Monoid a => LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround lbi a =
case hostPlatform lbi of
Platform _ Linux -> a
_otherwise -> mempty
data RtsInfo = RtsInfo {
rtsDynamicLib :: FilePath
, rtsStaticLib :: FilePath
, rtsLibPaths :: [FilePath]
}
extractRtsInfo :: LocalBuildInfo -> RtsInfo
extractRtsInfo lbi =
case PackageIndex.lookupPackageName (installedPkgs lbi) (mkPackageName "rts") of
[(_, [rts])] -> aux rts
_otherwise -> error "No (or multiple) ghc rts package is registered"
where
aux :: InstalledPackageInfo -> RtsInfo
aux rts = RtsInfo {
rtsDynamicLib = "HSrts-ghc" ++ display ghcVersion
, rtsStaticLib = "HSrts"
, rtsLibPaths = InstalledPackageInfo.libraryDirs rts
}
ghcVersion :: Version
ghcVersion = compilerVersion (compiler lbi)
checkNeedsRecompilation :: FilePath -> GhcOptions -> NoCallStackIO Bool
checkNeedsRecompilation filename opts = filename `moreRecentFile` oname
where oname = getObjectFileName filename opts
getObjectFileName :: FilePath -> GhcOptions -> FilePath
getObjectFileName filename opts = oname
where odir = fromFlag (ghcOptObjDir opts)
oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts)
oname = odir </> replaceExtension filename oext
getRPaths :: LocalBuildInfo
-> ComponentLocalBuildInfo
-> NoCallStackIO (NubListR FilePath)
getRPaths lbi clbi | supportRPaths hostOS = do
libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi
let hostPref = case hostOS of
OSX -> "@loader_path"
_ -> "$ORIGIN"
relPath p = if isRelative p then hostPref </> p else p
rpaths = toNubListR (map relPath libraryPaths)
return rpaths
where
(Platform _ hostOS) = hostPlatform lbi
supportRPaths Linux = True
supportRPaths Windows = False
supportRPaths OSX = True
supportRPaths FreeBSD = False
supportRPaths OpenBSD = False
supportRPaths NetBSD = False
supportRPaths DragonFly = False
supportRPaths Solaris = False
supportRPaths AIX = False
supportRPaths HPUX = False
supportRPaths IRIX = False
supportRPaths HaLVM = False
supportRPaths IOS = False
supportRPaths Android = False
supportRPaths Ghcjs = False
supportRPaths Hurd = False
supportRPaths (OtherOS _) = False
getRPaths _ _ = return mempty
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 < mkVersion [6, 10]
&& "-threaded" `elem` hcOptions GHC bi
filterHcOptions p hcoptss =
[ (hc, if hc == GHC then filter p opts else opts)
| (hc, opts) <- hcoptss ]
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash verbosity _pkg_descr lbi lib clbi = do
libBi <- hackThreadedFlag verbosity
(compiler lbi) (withProfLib lbi) (libBuildInfo lib)
let
comp = compiler lbi
platform = hostPlatform lbi
vanillaArgs0 =
(componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
`mappend` mempty {
ghcOptMode = toFlag GhcModeAbiHash,
ghcOptInputModules = toNubListR $ exposedModules lib
}
vanillaArgs =
vanillaArgs0 { ghcOptPackageDBs = [GlobalPackageDB]
, ghcOptPackages = mempty }
sharedArgs = vanillaArgs `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptFPic = toFlag True,
ghcOptHiSuffix = toFlag "dyn_hi",
ghcOptObjSuffix = toFlag "dyn_o",
ghcOptExtra = toNubListR $ hcSharedOptions GHC libBi
}
profArgs = vanillaArgs `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptProfilingAuto = Internal.profDetailLevelFlag True
(withProfLibDetail lbi),
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = toNubListR $ hcProfOptions GHC libBi
}
ghcArgs
| withVanillaLib lbi = vanillaArgs
| withSharedLib lbi = sharedArgs
| withProfLib lbi = profArgs
| otherwise = error "libAbiHash: Can't find an enabled library way"
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
hash <- getProgramInvocationOutput verbosity
(ghcInvocation ghcProg comp platform ghcArgs)
return (takeWhile (not . isSpace) hash)
componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
-> GhcOptions
componentGhcOptions verbosity lbi =
Internal.componentGhcOptions verbosity implInfo lbi
where
comp = compiler lbi
implInfo = getImplInfo comp
componentCcGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath
-> GhcOptions
componentCcGhcOptions verbosity lbi =
Internal.componentCcGhcOptions verbosity implInfo lbi
where
comp = compiler lbi
implInfo = getImplInfo comp
installExe :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> (FilePath, FilePath)
-> PackageDescription
-> Executable
-> IO ()
installExe verbosity lbi binDir buildPref
(progprefix, progsuffix) _pkg exe = do
createDirectoryIfMissingVerbose verbosity True binDir
let exeName' = unUnqualComponentName $ exeName exe
exeFileName = exeTargetName exe
fixedExeBaseName = progprefix ++ exeName' ++ progsuffix
installBinary dest = do
installExecutableFile verbosity
(buildPref </> exeName' </> exeFileName)
(dest <.> exeExtension)
when (stripExes lbi) $
Strip.stripExe verbosity (hostPlatform lbi) (withPrograms lbi)
(dest <.> exeExtension)
installBinary (binDir </> fixedExeBaseName)
installFLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> PackageDescription
-> ForeignLib
-> IO ()
installFLib verbosity lbi targetDir builtDir _pkg flib =
install (foreignLibIsShared flib)
builtDir
targetDir
(flibTargetName lbi flib)
where
install isShared srcDir dstDir name = do
let src = srcDir </> name
dst = dstDir </> name
createDirectoryIfMissingVerbose verbosity True targetDir
if isShared
then installExecutableFile verbosity src dst
else installOrdinaryFile verbosity src dst
let (Platform _ os) = hostPlatform lbi
when (not (null (foreignLibVersion flib os))) $ do
when (os /= Linux) $ die' verbosity
"Can't install foreign-library symlink on non-Linux OS"
#ifndef mingw32_HOST_OS
withTempDirectory verbosity dstDir nm $ \tmpDir -> do
let link1 = flibBuildName lbi flib
link2 = "lib" ++ nm <.> "so"
createSymbolicLink name (tmpDir </> link1)
renameFile (tmpDir </> link1) (dstDir </> link1)
createSymbolicLink name (tmpDir </> link2)
renameFile (tmpDir </> link2) (dstDir </> link2)
where
nm :: String
nm = unUnqualComponentName $ foreignLibName flib
#endif /* mingw32_HOST_OS */
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib verbosity lbi targetDir dynlibTargetDir _builtDir _pkg lib clbi = do
whenVanilla $ copyModuleFiles "hi"
whenProf $ copyModuleFiles "p_hi"
whenShared $ copyModuleFiles "dyn_hi"
whenHasCode $ do
whenVanilla $ installOrdinary builtDir targetDir vanillaLibName
whenProf $ installOrdinary builtDir targetDir profileLibName
whenGHCi $ installOrdinary builtDir targetDir ghciLibName
whenShared $ installShared builtDir dynlibTargetDir sharedLibName
where
builtDir = componentBuildDir lbi clbi
install isShared srcDir dstDir name = do
let src = srcDir </> name
dst = dstDir </> name
createDirectoryIfMissingVerbose verbosity True dstDir
if isShared
then installExecutableFile verbosity src dst
else installOrdinaryFile verbosity src dst
when (stripLibs lbi) $ Strip.stripLib verbosity
(hostPlatform lbi) (withPrograms lbi) dst
installOrdinary = install False
installShared = install True
copyModuleFiles ext =
findModuleFiles [builtDir] [ext] (allLibModules lib clbi)
>>= installOrdinaryFiles verbosity targetDir
compiler_id = compilerId (compiler lbi)
uid = componentUnitId clbi
vanillaLibName = mkLibName uid
profileLibName = mkProfLibName uid
ghciLibName = Internal.mkGHCiLibName uid
sharedLibName = (mkSharedLibName compiler_id) uid
hasLib = not $ null (allLibModules lib clbi)
&& null (cSources (libBuildInfo lib))
has_code = not (componentIsIndefinite clbi)
whenHasCode = when has_code
whenVanilla = when (hasLib && withVanillaLib lbi)
whenProf = when (hasLib && withProfLib lbi && has_code)
whenGHCi = when (hasLib && withGHCiLib lbi && has_code)
whenShared = when (hasLib && withSharedLib lbi && has_code)
hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
hcPkgInfo progdb = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcPkgProg
, HcPkg.noPkgDbStack = v < [6,9]
, HcPkg.noVerboseFlag = v < [6,11]
, HcPkg.flagPackageConf = v < [7,5]
, HcPkg.supportsDirDbs = v >= [6,8]
, HcPkg.requiresDirDbs = v >= [7,10]
, HcPkg.nativeMultiInstance = v >= [7,10]
, HcPkg.recacheMultiInstance = v >= [6,12]
, HcPkg.suppressFilesCheck = v >= [6,6]
}
where
v = versionNumbers ver
Just ghcPkgProg = lookupProgram ghcPkgProgram progdb
Just ver = programVersion ghcPkgProg
registerPackage
:: Verbosity
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
HcPkg.register (hcPkgInfo progdb) verbosity packageDbs
installedPkgInfo registerOptions
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
pkgRoot verbosity lbi = pkgRoot'
where
pkgRoot' GlobalPackageDB =
let Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
in fmap takeDirectory (getGlobalPackageDB verbosity ghcProg)
pkgRoot' UserPackageDB = do
appDir <- getAppUserDataDirectory "ghc"
let ver = compilerVersion (compiler lbi)
subdir = System.Info.arch ++ '-':System.Info.os
++ '-':display ver
rootDir = appDir </> subdir
createDirectoryIfMissing True rootDir
return rootDir
pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp)
isDynamic :: Compiler -> Bool
isDynamic = Internal.ghcLookupProperty "GHC Dynamic"
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"
withExt :: FilePath -> String -> FilePath
withExt fp ext = fp <.> if takeExtension fp /= ('.':ext) then ext else ""