{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
module Distribution.Simple.GHC.Build.Link where
import Distribution.Compat.Prelude
import Prelude ()
import Control.Monad.IO.Class
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.Set as Set
import Distribution.Compat.Binary (encode)
import Distribution.Compat.ResponseFile
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as IPI
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import qualified Distribution.ModuleName as ModuleName
import Distribution.Package
import Distribution.PackageDescription as PD
import Distribution.PackageDescription.Utils (cabalBug)
import Distribution.Pretty
import Distribution.Simple.Build.Inputs
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.GHC.Build.Modules
import Distribution.Simple.GHC.Build.Utils (exeTargetName, flibBuildName, flibTargetName, withDynFLib)
import Distribution.Simple.GHC.ImplInfo
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.Simple.LocalBuildInfo
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PreProcess.Types
import Distribution.Simple.Program
import qualified Distribution.Simple.Program.Ar as Ar
import Distribution.Simple.Program.GHC
import qualified Distribution.Simple.Program.Ld as Ld
import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Repl
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Utils.NubList
import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
import System.Directory
( createDirectoryIfMissing
, doesDirectoryExist
, doesFileExist
, removeFile
, renameFile
)
import System.FilePath
( isRelative
, replaceExtension
)
linkOrLoadComponent
:: ConfiguredProgram
-> PackageDescription
-> [SymbolicPath Pkg File]
-> (SymbolicPath Pkg (Dir Artifacts), SymbolicPath Pkg (Dir Build))
-> ((Bool -> [BuildWay], Bool -> BuildWay, BuildWay), BuildWay -> GhcOptions)
-> PreBuildComponentInputs
-> IO ()
linkOrLoadComponent :: ConfiguredProgram
-> PackageDescription
-> [SymbolicPath Pkg 'File]
-> (SymbolicPath Pkg ('Dir Artifacts),
SymbolicPath Pkg ('Dir Build))
-> ((Bool -> [BuildWay], Bool -> BuildWay, BuildWay),
BuildWay -> GhcOptions)
-> PreBuildComponentInputs
-> IO ()
linkOrLoadComponent
ConfiguredProgram
ghcProg
PackageDescription
pkg_descr
[SymbolicPath Pkg 'File]
extraSources
(SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir, SymbolicPath Pkg ('Dir Build)
targetDir)
((Bool -> [BuildWay]
wantedLibWays, Bool -> BuildWay
wantedFLibWay, BuildWay
wantedExeWay), BuildWay -> GhcOptions
buildOpts)
PreBuildComponentInputs
pbci = do
let
verbosity :: Verbosity
verbosity = PreBuildComponentInputs -> Verbosity
buildVerbosity PreBuildComponentInputs
pbci
target :: TargetInfo
target = PreBuildComponentInputs -> TargetInfo
targetInfo PreBuildComponentInputs
pbci
component :: Component
component = PreBuildComponentInputs -> Component
buildComponent PreBuildComponentInputs
pbci
what :: BuildingWhat
what = PreBuildComponentInputs -> BuildingWhat
buildingWhat PreBuildComponentInputs
pbci
lbi :: LocalBuildInfo
lbi = PreBuildComponentInputs -> LocalBuildInfo
localBuildInfo PreBuildComponentInputs
pbci
bi :: BuildInfo
bi = PreBuildComponentInputs -> BuildInfo
buildBI PreBuildComponentInputs
pbci
clbi :: ComponentLocalBuildInfo
clbi = PreBuildComponentInputs -> ComponentLocalBuildInfo
buildCLBI PreBuildComponentInputs
pbci
isIndef :: Bool
isIndef = ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
i :: SymbolicPathX allowAbsolute Pkg to -> FilePath
i = LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
interpretSymbolicPathLBI LocalBuildInfo
lbi
cleanedExtraLibDirs <- IO [SymbolicPath Pkg ('Dir Lib)]
-> IO [SymbolicPath Pkg ('Dir Lib)]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SymbolicPath Pkg ('Dir Lib)]
-> IO [SymbolicPath Pkg ('Dir Lib)])
-> IO [SymbolicPath Pkg ('Dir Lib)]
-> IO [SymbolicPath Pkg ('Dir Lib)]
forall a b. (a -> b) -> a -> b
$ (SymbolicPath Pkg ('Dir Lib) -> IO Bool)
-> [SymbolicPath Pkg ('Dir Lib)]
-> IO [SymbolicPath Pkg ('Dir Lib)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool)
-> (SymbolicPath Pkg ('Dir Lib) -> FilePath)
-> SymbolicPath Pkg ('Dir Lib)
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPath Pkg ('Dir Lib) -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i) (BuildInfo -> [SymbolicPath Pkg ('Dir Lib)]
extraLibDirs BuildInfo
bi)
cleanedExtraLibDirsStatic <- liftIO $ filterM (doesDirectoryExist . i) (extraLibDirsStatic bi)
let
extraSourcesObjs :: [RelativePath Artifacts File]
extraSourcesObjs =
[ FilePath -> RelativePath Artifacts 'File
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (FilePath -> RelativePath Artifacts 'File)
-> FilePath -> RelativePath Artifacts 'File
forall a b. (a -> b) -> a -> b
$ SymbolicPath Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath SymbolicPath Pkg 'File
src FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension
| SymbolicPath Pkg 'File
src <- [SymbolicPath Pkg 'File]
extraSources
]
linkerOpts NubListR FilePath
rpaths =
GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptLinkOptions =
PD.ldOptions bi
++ [ "-static"
| withFullyStaticExe lbi
]
++ maybe
[]
programOverrideArgs
(lookupProgram ldProgram (withPrograms lbi))
, ghcOptLinkLibs =
if withFullyStaticExe lbi
then extraLibsStatic bi
else extraLibs bi
, ghcOptLinkLibPath =
toNubListR $
if withFullyStaticExe lbi
then cleanedExtraLibDirsStatic
else cleanedExtraLibDirs
, ghcOptLinkFrameworks = toNubListR $ map getSymbolicPath $ PD.frameworks bi
, ghcOptLinkFrameworkDirs = toNubListR $ PD.extraFrameworkDirs bi
, ghcOptInputFiles =
toNubListR
[ coerceSymbolicPath $ buildTargetDir </> obj
| obj <- extraSourcesObjs
]
, ghcOptNoLink = Flag False
, ghcOptRPaths = rpaths
}
case what of
BuildRepl ReplFlags
replFlags -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let
staticOpts :: GhcOptions
staticOpts = BuildWay -> GhcOptions
buildOpts BuildWay
StaticWay
replOpts :: GhcOptions
replOpts =
GhcOptions
staticOpts
{
ghcOptDynLinkMode = NoFlag
, ghcOptExtra =
Internal.filterGhciFlags
(ghcOptExtra staticOpts)
<> replOptionsFlags (replReplOptions replFlags)
}
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` NubListR FilePath -> GhcOptions
linkerOpts NubListR FilePath
forall a. Monoid a => a
mempty
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptMode = toFlag GhcModeInteractive
, ghcOptOptimisation = toFlag GhcNoOptimisation
}
replOpts_final :: GhcOptions
replOpts_final =
GhcOptions
replOpts
{ ghcOptInputModules = replNoLoad (replReplOptions replFlags) (ghcOptInputModules replOpts)
, ghcOptInputFiles = replNoLoad (replReplOptions replFlags) (ghcOptInputFiles replOpts)
}
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (case Component
component of CLib Library
lib -> [ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi); Component
_ -> Bool
False) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"No exposed modules"
ConfiguredProgram
-> LocalBuildInfo
-> ReplFlags
-> GhcOptions
-> PackageName
-> TargetInfo
-> IO ()
runReplOrWriteFlags ConfiguredProgram
ghcProg LocalBuildInfo
lbi ReplFlags
replFlags GhcOptions
replOpts_final (PackageIdentifier -> PackageName
pkgName (PackageDescription -> PackageIdentifier
PD.package PackageDescription
pkg_descr)) TargetInfo
target
BuildingWhat
_otherwise ->
let
runGhcProg :: GhcOptions -> IO ()
runGhcProg = Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> GhcOptions
-> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
platform :: Platform
platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
get_rpaths :: Set BuildWay -> IO (NubListR FilePath)
get_rpaths Set BuildWay
ways =
if BuildWay
DynWay BuildWay -> Set BuildWay -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set BuildWay
ways then PreBuildComponentInputs -> IO (NubListR FilePath)
getRPaths PreBuildComponentInputs
pbci else NubListR FilePath -> IO (NubListR FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR [])
in
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Linking..."
let linkExeLike :: UnqualComponentName -> IO ()
linkExeLike UnqualComponentName
name = do
rpaths <- Set BuildWay -> IO (NubListR FilePath)
get_rpaths (BuildWay -> Set BuildWay
forall a. a -> Set a
Set.singleton BuildWay
wantedExeWay)
linkExecutable (linkerOpts rpaths) (wantedExeWay, buildOpts) targetDir name runGhcProg lbi
case Component
component of
CLib Library
lib -> do
let libWays :: [BuildWay]
libWays = Bool -> [BuildWay]
wantedLibWays Bool
isIndef
rpaths <- Set BuildWay -> IO (NubListR FilePath)
get_rpaths ([BuildWay] -> Set BuildWay
forall a. Ord a => [a] -> Set a
Set.fromList [BuildWay]
libWays)
linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg lib lbi clbi extraSources rpaths libWays
CFLib ForeignLib
flib -> do
let flib_way :: BuildWay
flib_way = Bool -> BuildWay
wantedFLibWay (ForeignLib -> Bool
withDynFLib ForeignLib
flib)
rpaths <- Set BuildWay -> IO (NubListR FilePath)
get_rpaths (BuildWay -> Set BuildWay
forall a. a -> Set a
Set.singleton BuildWay
flib_way)
linkFLib flib bi lbi (linkerOpts rpaths) (flib_way, buildOpts) targetDir runGhcProg
CExe Executable
exe -> UnqualComponentName -> IO ()
linkExeLike (Executable -> UnqualComponentName
exeName Executable
exe)
CTest TestSuite
test -> UnqualComponentName -> IO ()
linkExeLike (TestSuite -> UnqualComponentName
testName TestSuite
test)
CBench Benchmark
bench -> UnqualComponentName -> IO ()
linkExeLike (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bench)
linkLibrary
:: SymbolicPath Pkg (Dir Artifacts)
-> [SymbolicPath Pkg (Dir Lib)]
-> PackageDescription
-> Verbosity
-> (GhcOptions -> IO ())
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> [SymbolicPath Pkg File]
-> NubListR FilePath
-> [BuildWay]
-> IO ()
linkLibrary :: SymbolicPath Pkg ('Dir Artifacts)
-> [SymbolicPath Pkg ('Dir Lib)]
-> PackageDescription
-> Verbosity
-> (GhcOptions -> IO ())
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> [SymbolicPath Pkg 'File]
-> NubListR FilePath
-> [BuildWay]
-> IO ()
linkLibrary SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir [SymbolicPath Pkg ('Dir Lib)]
cleanedExtraLibDirs PackageDescription
pkg_descr Verbosity
verbosity GhcOptions -> IO ()
runGhcProg Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi [SymbolicPath Pkg 'File]
extraSources NubListR FilePath
rpaths [BuildWay]
wantedWays = do
let
common :: CommonSetupFlags
common = ConfigFlags -> CommonSetupFlags
configCommonFlags (ConfigFlags -> CommonSetupFlags)
-> ConfigFlags -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
setupWorkingDir CommonSetupFlags
common
compiler_id :: CompilerId
compiler_id = Compiler -> CompilerId
compilerId Compiler
comp
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
ghcVersion :: Version
ghcVersion = Compiler -> Version
compilerVersion Compiler
comp
implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
libBi :: BuildInfo
libBi = Library -> BuildInfo
libBuildInfo Library
lib
Platform Arch
_hostArch OS
hostOS = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
vanillaLibFilePath :: SymbolicPathX 'AllowAbsolute Pkg c3
vanillaLibFilePath = SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir SymbolicPath Pkg ('Dir Artifacts)
-> RelativePath Artifacts c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Artifacts c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (UnitId -> FilePath
mkLibName UnitId
uid)
profileLibFilePath :: SymbolicPathX 'AllowAbsolute Pkg c3
profileLibFilePath = SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir SymbolicPath Pkg ('Dir Artifacts)
-> RelativePath Artifacts c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Artifacts c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (UnitId -> FilePath
mkProfLibName UnitId
uid)
sharedLibFilePath :: SymbolicPathX 'AllowAbsolute Pkg c3
sharedLibFilePath =
SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir
SymbolicPath Pkg ('Dir Artifacts)
-> RelativePath Artifacts c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Artifacts c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (Platform -> CompilerId -> UnitId -> FilePath
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid)
profSharedLibFilePath :: SymbolicPathX 'AllowAbsolute Pkg c3
profSharedLibFilePath =
SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir
SymbolicPath Pkg ('Dir Artifacts)
-> RelativePath Artifacts c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Artifacts c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (Platform -> CompilerId -> UnitId -> FilePath
mkProfSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid)
staticLibFilePath :: SymbolicPathX 'AllowAbsolute Pkg c3
staticLibFilePath =
SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir
SymbolicPath Pkg ('Dir Artifacts)
-> RelativePath Artifacts c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Artifacts c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (Platform -> CompilerId -> UnitId -> FilePath
mkStaticLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid)
ghciLibFilePath :: SymbolicPathX 'AllowAbsolute Pkg c3
ghciLibFilePath = SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir SymbolicPath Pkg ('Dir Artifacts)
-> RelativePath Artifacts c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Artifacts c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (UnitId -> FilePath
Internal.mkGHCiLibName UnitId
uid)
ghciProfLibFilePath :: SymbolicPathX 'AllowAbsolute Pkg c3
ghciProfLibFilePath = SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir SymbolicPath Pkg ('Dir Artifacts)
-> RelativePath Artifacts c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Artifacts c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (UnitId -> FilePath
Internal.mkGHCiProfLibName UnitId
uid)
libInstallPath :: FilePath
libInstallPath =
InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
libdir (InstallDirs FilePath -> FilePath)
-> InstallDirs FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs FilePath
absoluteComponentInstallDirs
PackageDescription
pkg_descr
LocalBuildInfo
lbi
UnitId
uid
CopyDest
NoCopyDest
sharedLibInstallPath :: FilePath
sharedLibInstallPath =
FilePath
libInstallPath
FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> Platform -> CompilerId -> UnitId -> FilePath
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
profSharedLibInstallPath :: FilePath
profSharedLibInstallPath =
FilePath
libInstallPath
FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> Platform -> CompilerId -> UnitId -> FilePath
mkProfSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
getObjFiles :: BuildWay -> IO [SymbolicPath Pkg File]
getObjFiles :: BuildWay -> IO [SymbolicPath Pkg 'File]
getObjFiles BuildWay
way =
[IO [SymbolicPath Pkg 'File]] -> IO [SymbolicPath Pkg 'File]
forall a. Monoid a => [a] -> a
mconcat
[ GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> FilePath
-> Bool
-> IO [SymbolicPath Pkg 'File]
Internal.getHaskellObjects
GhcImplInfo
implInfo
Library
lib
LocalBuildInfo
lbi
ComponentLocalBuildInfo
clbi
SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir
(BuildWay -> FilePath
buildWayPrefix BuildWay
way FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension)
Bool
True
, [SymbolicPath Pkg 'File] -> IO [SymbolicPath Pkg 'File]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SymbolicPath Pkg 'File] -> IO [SymbolicPath Pkg 'File])
-> [SymbolicPath Pkg 'File] -> IO [SymbolicPath Pkg 'File]
forall a b. (a -> b) -> a -> b
$ (SymbolicPath Pkg 'File -> SymbolicPath Pkg 'File)
-> [SymbolicPath Pkg 'File] -> [SymbolicPath Pkg 'File]
forall a b. (a -> b) -> [a] -> [b]
map (BuildWay -> SymbolicPath Pkg 'File -> SymbolicPath Pkg 'File
srcObjPath BuildWay
way) [SymbolicPath Pkg 'File]
extraSources
, [Maybe (SymbolicPath Pkg 'File)] -> [SymbolicPath Pkg 'File]
forall a. [Maybe a] -> [a]
catMaybes
([Maybe (SymbolicPath Pkg 'File)] -> [SymbolicPath Pkg 'File])
-> IO [Maybe (SymbolicPath Pkg 'File)]
-> IO [SymbolicPath Pkg 'File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO (Maybe (SymbolicPath Pkg 'File))]
-> IO [Maybe (SymbolicPath Pkg 'File)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
[ Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPath Pkg ('Dir Artifacts)]
-> RelativePath Artifacts 'File
-> IO (Maybe (SymbolicPath Pkg 'File))
forall searchDir (allowAbsolute :: AllowAbsolute).
Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX allowAbsolute Pkg ('Dir searchDir)]
-> RelativePath searchDir 'File
-> IO (Maybe (SymbolicPathX allowAbsolute Pkg 'File))
findFileCwdWithExtension
Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
[FilePath -> Suffix
Suffix (FilePath -> Suffix) -> FilePath -> Suffix
forall a b. (a -> b) -> a -> b
$ BuildWay -> FilePath
buildWayPrefix BuildWay
way FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension]
[SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir]
RelativePath Artifacts 'File
xPath
| Version
ghcVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7, Int
2]
, ModuleName
x <- Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi
, let xPath :: RelativePath Artifacts File
xPath :: RelativePath Artifacts 'File
xPath = FilePath -> RelativePath Artifacts 'File
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (FilePath -> RelativePath Artifacts 'File)
-> FilePath -> RelativePath Artifacts 'File
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
ModuleName.toFilePath ModuleName
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_stub"
]
]
srcObjPath :: BuildWay -> SymbolicPath Pkg File -> SymbolicPath Pkg File
srcObjPath :: BuildWay -> SymbolicPath Pkg 'File -> SymbolicPath Pkg 'File
srcObjPath BuildWay
way SymbolicPath Pkg 'File
srcPath =
case SymbolicPath Pkg 'File -> Maybe (RelativePath Pkg 'File)
forall from (to :: FileOrDir).
SymbolicPath from to -> Maybe (RelativePath from to)
symbolicPathRelative_maybe SymbolicPath Pkg 'File
objPath of
Maybe (RelativePath Pkg 'File)
Nothing -> SymbolicPath Pkg 'File
objPath
Just RelativePath Pkg 'File
objRelPath -> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Pkg)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
(to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir SymbolicPathX 'AllowAbsolute Pkg ('Dir Pkg)
-> RelativePath Pkg 'File -> SymbolicPath Pkg 'File
forall p q r. PathLike p q r => p -> q -> r
</> RelativePath Pkg 'File
objRelPath
where
objPath :: SymbolicPath Pkg 'File
objPath = SymbolicPath Pkg 'File
srcPath SymbolicPath Pkg 'File -> FilePath -> SymbolicPath Pkg 'File
forall (allowAbsolute :: AllowAbsolute) from.
SymbolicPathX allowAbsolute from 'File
-> FilePath -> SymbolicPathX allowAbsolute from 'File
`replaceExtensionSymbolicPath` (BuildWay -> FilePath
buildWayPrefix BuildWay
way FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension)
ghcBaseLinkArgs :: GhcOptions
ghcBaseLinkArgs =
GhcOptions
forall a. Monoid a => a
mempty
{
ghcOptExtra = hcStaticOptions GHC libBi
, ghcOptHideAllPackages = toFlag True
, ghcOptNoAutoLinkPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
, ghcOptThisUnitId = case clbi of
LibComponentLocalBuildInfo{componentCompatPackageKey :: ComponentLocalBuildInfo -> FilePath
componentCompatPackageKey = FilePath
pk} ->
FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
pk
ComponentLocalBuildInfo
_ -> Flag FilePath
forall a. Monoid a => a
mempty
, ghcOptThisComponentId = case clbi of
LibComponentLocalBuildInfo
{ componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts
} ->
if [(ModuleName, OpenModule)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, OpenModule)]
insts
then Flag ComponentId
forall a. Monoid a => a
mempty
else ComponentId -> Flag ComponentId
forall a. a -> Flag a
toFlag (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
ComponentLocalBuildInfo
_ -> Flag ComponentId
forall a. Monoid a => a
mempty
, ghcOptInstantiatedWith = case clbi of
LibComponentLocalBuildInfo
{ componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts
} ->
[(ModuleName, OpenModule)]
insts
ComponentLocalBuildInfo
_ -> []
, ghcOptPackages =
toNubListR $
Internal.mkGhcOptPackages mempty clbi
}
ghcSharedLinkArgs :: [SymbolicPath Pkg File] -> GhcOptions
ghcSharedLinkArgs :: [SymbolicPath Pkg 'File] -> GhcOptions
ghcSharedLinkArgs [SymbolicPath Pkg 'File]
dynObjectFiles =
GhcOptions
ghcBaseLinkArgs
{ ghcOptShared = toFlag True
, ghcOptDynLinkMode = toFlag GhcDynamicOnly
, ghcOptInputFiles = toNubListR $ map coerceSymbolicPath dynObjectFiles
, ghcOptOutputFile = toFlag sharedLibFilePath
,
ghcOptDylibName =
if hostOS == OSX
&& ghcVersion < mkVersion [7, 8]
then toFlag sharedLibInstallPath
else mempty
, ghcOptLinkLibs = extraLibs libBi
, ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
, ghcOptLinkFrameworks = toNubListR $ map getSymbolicPath $ PD.frameworks libBi
, ghcOptLinkFrameworkDirs =
toNubListR $ PD.extraFrameworkDirs libBi
, ghcOptRPaths = rpaths
}
ghcProfSharedLinkArgs :: [SymbolicPath Pkg 'File] -> GhcOptions
ghcProfSharedLinkArgs [SymbolicPath Pkg 'File]
pdynObjectFiles =
GhcOptions
ghcBaseLinkArgs
{ ghcOptShared = toFlag True
, ghcOptProfilingMode = toFlag True
, ghcOptProfilingAuto =
Internal.profDetailLevelFlag
True
(withProfLibDetail lbi)
, ghcOptDynLinkMode = toFlag GhcDynamicOnly
, ghcOptInputFiles = toNubListR pdynObjectFiles
, ghcOptOutputFile = toFlag profSharedLibFilePath
,
ghcOptDylibName =
if hostOS == OSX
&& ghcVersion < mkVersion [7, 8]
then toFlag profSharedLibInstallPath
else mempty
, ghcOptLinkLibs = extraLibs libBi
, ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
, ghcOptLinkFrameworks = toNubListR $ map getSymbolicPath $ PD.frameworks libBi
, ghcOptLinkFrameworkDirs =
toNubListR $ PD.extraFrameworkDirs libBi
, ghcOptRPaths = rpaths
}
ghcStaticLinkArgs :: [SymbolicPathX 'AllowAbsolute Pkg to1] -> GhcOptions
ghcStaticLinkArgs [SymbolicPathX 'AllowAbsolute Pkg to1]
staticObjectFiles =
GhcOptions
ghcBaseLinkArgs
{ ghcOptStaticLib = toFlag True
, ghcOptInputFiles = toNubListR $ map coerceSymbolicPath staticObjectFiles
, ghcOptOutputFile = toFlag staticLibFilePath
, ghcOptLinkLibs = extraLibs libBi
,
ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
}
staticObjectFiles <- BuildWay -> IO [SymbolicPath Pkg 'File]
getObjFiles BuildWay
StaticWay
profObjectFiles <- getObjFiles ProfWay
dynamicObjectFiles <- getObjFiles DynWay
profDynamicObjectFiles <- getObjFiles ProfDynWay
let
linkWay = \case
BuildWay
ProfWay -> do
Verbosity
-> LocalBuildInfo
-> SymbolicPath Pkg 'File
-> [SymbolicPath Pkg 'File]
-> IO ()
Ar.createArLibArchive Verbosity
verbosity LocalBuildInfo
lbi SymbolicPath Pkg 'File
forall {c3 :: FileOrDir}. SymbolicPathX 'AllowAbsolute Pkg c3
profileLibFilePath [SymbolicPath Pkg 'File]
profObjectFiles
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
withGHCiLib LocalBuildInfo
lbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(ldProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ldProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
Ld.combineObjectFiles
verbosity
lbi
ldProg
ghciProfLibFilePath
profObjectFiles
BuildWay
ProfDynWay -> do
GhcOptions -> IO ()
runGhcProg (GhcOptions -> IO ()) -> GhcOptions -> IO ()
forall a b. (a -> b) -> a -> b
$ [SymbolicPath Pkg 'File] -> GhcOptions
ghcProfSharedLinkArgs [SymbolicPath Pkg 'File]
profDynamicObjectFiles
BuildWay
DynWay -> do
GhcOptions -> IO ()
runGhcProg (GhcOptions -> IO ()) -> GhcOptions -> IO ()
forall a b. (a -> b) -> a -> b
$ [SymbolicPath Pkg 'File] -> GhcOptions
ghcSharedLinkArgs [SymbolicPath Pkg 'File]
dynamicObjectFiles
BuildWay
StaticWay -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity
-> LocalBuildInfo
-> SymbolicPath Pkg 'File
-> [SymbolicPath Pkg 'File]
-> IO ()
Ar.createArLibArchive Verbosity
verbosity LocalBuildInfo
lbi SymbolicPath Pkg 'File
forall {c3 :: FileOrDir}. SymbolicPathX 'AllowAbsolute Pkg c3
vanillaLibFilePath [SymbolicPath Pkg 'File]
staticObjectFiles
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
withGHCiLib LocalBuildInfo
lbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(ldProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ldProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
Ld.combineObjectFiles
verbosity
lbi
ldProg
ghciLibFilePath
staticObjectFiles
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
withStaticLib LocalBuildInfo
lbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
GhcOptions -> IO ()
runGhcProg (GhcOptions -> IO ()) -> GhcOptions -> IO ()
forall a b. (a -> b) -> a -> b
$ [SymbolicPath Pkg 'File] -> GhcOptions
forall {to1 :: FileOrDir}.
[SymbolicPathX 'AllowAbsolute Pkg to1] -> GhcOptions
ghcStaticLinkArgs [SymbolicPath Pkg 'File]
staticObjectFiles
unless (null staticObjectFiles) $ do
info verbosity (show (ghcOptPackages (Internal.componentGhcOptions verbosity lbi libBi clbi buildTargetDir)))
traverse_ linkWay wantedWays
linkExecutable
:: (GhcOptions)
-> (BuildWay, BuildWay -> GhcOptions)
-> SymbolicPath Pkg (Dir Build)
-> UnqualComponentName
-> (GhcOptions -> IO ())
-> LocalBuildInfo
-> IO ()
linkExecutable :: GhcOptions
-> (BuildWay, BuildWay -> GhcOptions)
-> SymbolicPath Pkg ('Dir Build)
-> UnqualComponentName
-> (GhcOptions -> IO ())
-> LocalBuildInfo
-> IO ()
linkExecutable GhcOptions
linkerOpts (BuildWay
way, BuildWay -> GhcOptions
buildOpts) SymbolicPath Pkg ('Dir Build)
targetDir UnqualComponentName
targetName GhcOptions -> IO ()
runGhcProg LocalBuildInfo
lbi = do
let baseOpts :: GhcOptions
baseOpts = BuildWay -> GhcOptions
buildOpts BuildWay
way
linkOpts :: GhcOptions
linkOpts =
GhcOptions
baseOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{
ghcOptLinkNoHsMain = toFlag (ghcOptInputFiles baseOpts == mempty && ghcOptInputScripts baseOpts == mempty)
}
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
let target :: SymbolicPathX 'AllowAbsolute Pkg c3
target =
SymbolicPath Pkg ('Dir Build)
targetDir SymbolicPath Pkg ('Dir Build)
-> RelativePath Build c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Build c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (Platform -> UnqualComponentName -> FilePath
exeTargetName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) UnqualComponentName
targetName)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Compiler -> Version
compilerVersion Compiler
comp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7, Int
7]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let targetPath :: FilePath
targetPath = LocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 1) -> FilePath
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
interpretSymbolicPathLBI LocalBuildInfo
lbi SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 1)
forall {c3 :: FileOrDir}. SymbolicPathX 'AllowAbsolute Pkg c3
target
e <- FilePath -> IO Bool
doesFileExist FilePath
targetPath
when e (removeFile targetPath)
GhcOptions -> IO ()
runGhcProg GhcOptions
linkOpts{ghcOptOutputFile = toFlag target}
linkFLib
:: ForeignLib
-> BuildInfo
-> LocalBuildInfo
-> (GhcOptions)
-> (BuildWay, BuildWay -> GhcOptions)
-> SymbolicPath Pkg (Dir Build)
-> (GhcOptions -> IO ())
-> IO ()
linkFLib :: ForeignLib
-> BuildInfo
-> LocalBuildInfo
-> GhcOptions
-> (BuildWay, BuildWay -> GhcOptions)
-> SymbolicPath Pkg ('Dir Build)
-> (GhcOptions -> IO ())
-> IO ()
linkFLib ForeignLib
flib BuildInfo
bi LocalBuildInfo
lbi GhcOptions
linkerOpts (BuildWay
way, BuildWay -> GhcOptions
buildOpts) SymbolicPath Pkg ('Dir Build)
targetDir GhcOptions -> IO ()
runGhcProg = do
let
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
rtsLinkOpts :: GhcOptions
rtsLinkOpts :: GhcOptions
rtsLinkOpts
| Bool
supportsFLinkRts =
GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptLinkRts = toFlag True
}
| Bool
otherwise =
GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptLinkLibs = rtsOptLinkLibs
, ghcOptLinkLibPath = toNubListR $ map makeSymbolicPath $ rtsLibPaths rtsInfo
}
where
threaded :: Bool
threaded = BuildInfo -> Bool
hasThreaded BuildInfo
bi
supportsFLinkRts :: Bool
supportsFLinkRts = Compiler -> Version
compilerVersion Compiler
comp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9, Int
0]
rtsInfo :: RtsInfo
rtsInfo = LocalBuildInfo -> RtsInfo
extractRtsInfo LocalBuildInfo
lbi
rtsOptLinkLibs :: [FilePath]
rtsOptLinkLibs =
[ if ForeignLib -> Bool
withDynFLib ForeignLib
flib
then
if Bool
threaded
then DynamicRtsInfo -> FilePath
dynRtsThreadedLib (RtsInfo -> DynamicRtsInfo
rtsDynamicInfo RtsInfo
rtsInfo)
else DynamicRtsInfo -> FilePath
dynRtsVanillaLib (RtsInfo -> DynamicRtsInfo
rtsDynamicInfo RtsInfo
rtsInfo)
else
if Bool
threaded
then StaticRtsInfo -> FilePath
statRtsThreadedLib (RtsInfo -> StaticRtsInfo
rtsStaticInfo RtsInfo
rtsInfo)
else StaticRtsInfo -> FilePath
statRtsVanillaLib (RtsInfo -> StaticRtsInfo
rtsStaticInfo RtsInfo
rtsInfo)
]
linkOpts :: GhcOptions
linkOpts :: GhcOptions
linkOpts = case ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib of
ForeignLibType
ForeignLibNativeShared ->
(BuildWay -> GhcOptions
buildOpts BuildWay
way)
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
rtsLinkOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptLinkNoHsMain = toFlag True
, ghcOptShared = toFlag True
, ghcOptFPic = toFlag True
, ghcOptLinkModDefFiles = toNubListR $ fmap getSymbolicPath $ foreignLibModDefFile flib
}
ForeignLibType
ForeignLibNativeStatic ->
FilePath -> GhcOptions
forall a. FilePath -> a
cabalBug FilePath
"static libraries not yet implemented"
ForeignLibType
ForeignLibTypeUnknown ->
FilePath -> GhcOptions
forall a. FilePath -> a
cabalBug FilePath
"unknown foreign lib type"
let buildName :: FilePath
buildName = LocalBuildInfo -> ForeignLib -> FilePath
flibBuildName LocalBuildInfo
lbi ForeignLib
flib
let outFile :: SymbolicPathX 'AllowAbsolute Pkg c3
outFile = SymbolicPath Pkg ('Dir Build)
targetDir SymbolicPath Pkg ('Dir Build)
-> RelativePath Build c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Build c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx FilePath
buildName
GhcOptions -> IO ()
runGhcProg GhcOptions
linkOpts{ghcOptOutputFile = toFlag outFile}
let i :: SymbolicPathX allowAbsolute Pkg to -> FilePath
i = LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
interpretSymbolicPathLBI LocalBuildInfo
lbi
FilePath -> FilePath -> IO ()
renameFile (SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 0) -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 0)
forall {c3 :: FileOrDir}. SymbolicPathX 'AllowAbsolute Pkg c3
outFile) (SymbolicPath Pkg ('Dir Build) -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i SymbolicPath Pkg ('Dir Build)
targetDir FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib)
getRPaths
:: PreBuildComponentInputs
-> IO (NubListR FilePath)
getRPaths :: PreBuildComponentInputs -> IO (NubListR FilePath)
getRPaths PreBuildComponentInputs
pbci = do
let
lbi :: LocalBuildInfo
lbi = PreBuildComponentInputs -> LocalBuildInfo
localBuildInfo PreBuildComponentInputs
pbci
bi :: BuildInfo
bi = PreBuildComponentInputs -> BuildInfo
buildBI PreBuildComponentInputs
pbci
clbi :: ComponentLocalBuildInfo
clbi = PreBuildComponentInputs -> ComponentLocalBuildInfo
buildCLBI PreBuildComponentInputs
pbci
(Platform Arch
_ OS
hostOS) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
compid :: CompilerId
compid = Compiler -> CompilerId
compilerId (Compiler -> CompilerId)
-> (LocalBuildInfo -> Compiler) -> LocalBuildInfo -> CompilerId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> Compiler
compiler (LocalBuildInfo -> CompilerId) -> LocalBuildInfo -> CompilerId
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
lbi
supportRPaths :: OS -> Bool
supportRPaths OS
Linux = Bool
True
supportRPaths OS
Windows = Bool
False
supportRPaths OS
OSX = Bool
True
supportRPaths OS
FreeBSD =
case CompilerId
compid of
CompilerId CompilerFlavor
GHC Version
ver | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
7, Int
10, Int
2] -> Bool
True
CompilerId
_ -> Bool
False
supportRPaths OS
OpenBSD = Bool
False
supportRPaths OS
NetBSD = Bool
False
supportRPaths OS
DragonFly = Bool
False
supportRPaths OS
Solaris = Bool
False
supportRPaths OS
AIX = Bool
False
supportRPaths OS
HPUX = Bool
False
supportRPaths OS
IRIX = Bool
False
supportRPaths OS
HaLVM = Bool
False
supportRPaths OS
IOS = Bool
False
supportRPaths OS
Android = Bool
False
supportRPaths OS
Ghcjs = Bool
False
supportRPaths OS
Wasi = Bool
False
supportRPaths OS
Hurd = Bool
True
supportRPaths OS
Haiku = Bool
False
supportRPaths (OtherOS FilePath
_) = Bool
False
if OS -> Bool
supportRPaths OS
hostOS
then do
libraryPaths <- IO [FilePath] -> IO [FilePath]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO [FilePath]
depLibraryPaths Bool
False (LocalBuildInfo -> Bool
relocatable LocalBuildInfo
lbi) LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
let hostPref = case OS
hostOS of
OS
OSX -> FilePath
"@loader_path"
OS
_ -> FilePath
"$ORIGIN"
relPath FilePath
p = if FilePath -> Bool
isRelative FilePath
p then FilePath
hostPref FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> FilePath
p else FilePath
p
rpaths =
[FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
relPath [FilePath]
libraryPaths)
NubListR FilePath -> NubListR FilePath -> NubListR FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ((SymbolicPath Pkg ('Dir Lib) -> FilePath)
-> [SymbolicPath Pkg ('Dir Lib)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath Pkg ('Dir Lib) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath ([SymbolicPath Pkg ('Dir Lib)] -> [FilePath])
-> [SymbolicPath Pkg ('Dir Lib)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath Pkg ('Dir Lib)]
extraLibDirs BuildInfo
bi)
return rpaths
else NubListR FilePath -> IO (NubListR FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NubListR FilePath
forall a. Monoid a => a
mempty
data DynamicRtsInfo = DynamicRtsInfo
{ DynamicRtsInfo -> FilePath
dynRtsVanillaLib :: FilePath
, DynamicRtsInfo -> FilePath
dynRtsThreadedLib :: FilePath
, DynamicRtsInfo -> FilePath
dynRtsDebugLib :: FilePath
, DynamicRtsInfo -> FilePath
dynRtsEventlogLib :: FilePath
, DynamicRtsInfo -> FilePath
dynRtsThreadedDebugLib :: FilePath
, DynamicRtsInfo -> FilePath
dynRtsThreadedEventlogLib :: FilePath
}
data StaticRtsInfo = StaticRtsInfo
{ StaticRtsInfo -> FilePath
statRtsVanillaLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsThreadedLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsDebugLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsEventlogLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsThreadedDebugLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsThreadedEventlogLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsProfilingLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsThreadedProfilingLib :: FilePath
}
data RtsInfo = RtsInfo
{ RtsInfo -> DynamicRtsInfo
rtsDynamicInfo :: DynamicRtsInfo
, RtsInfo -> StaticRtsInfo
rtsStaticInfo :: StaticRtsInfo
, RtsInfo -> [FilePath]
rtsLibPaths :: [FilePath]
}
extractRtsInfo :: LocalBuildInfo -> RtsInfo
LocalBuildInfo
lbi =
case PackageIndex InstalledPackageInfo
-> PackageName -> [(Version, [InstalledPackageInfo])]
forall a. PackageIndex a -> PackageName -> [(Version, [a])]
PackageIndex.lookupPackageName
(LocalBuildInfo -> PackageIndex InstalledPackageInfo
installedPkgs LocalBuildInfo
lbi)
(FilePath -> PackageName
mkPackageName FilePath
"rts") of
[(Version
_, [InstalledPackageInfo
rts])] -> InstalledPackageInfo -> RtsInfo
aux InstalledPackageInfo
rts
[(Version, [InstalledPackageInfo])]
_otherwise -> FilePath -> RtsInfo
forall a. HasCallStack => FilePath -> a
error FilePath
"No (or multiple) ghc rts package is registered"
where
aux :: InstalledPackageInfo -> RtsInfo
aux :: InstalledPackageInfo -> RtsInfo
aux InstalledPackageInfo
rts =
RtsInfo
{ rtsDynamicInfo :: DynamicRtsInfo
rtsDynamicInfo =
DynamicRtsInfo
{ dynRtsVanillaLib :: FilePath
dynRtsVanillaLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts"
, dynRtsThreadedLib :: FilePath
dynRtsThreadedLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_thr"
, dynRtsDebugLib :: FilePath
dynRtsDebugLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_debug"
, dynRtsEventlogLib :: FilePath
dynRtsEventlogLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_l"
, dynRtsThreadedDebugLib :: FilePath
dynRtsThreadedDebugLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_thr_debug"
, dynRtsThreadedEventlogLib :: FilePath
dynRtsThreadedEventlogLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_thr_l"
}
, rtsStaticInfo :: StaticRtsInfo
rtsStaticInfo =
StaticRtsInfo
{ statRtsVanillaLib :: FilePath
statRtsVanillaLib = FilePath
"HSrts"
, statRtsThreadedLib :: FilePath
statRtsThreadedLib = FilePath
"HSrts_thr"
, statRtsDebugLib :: FilePath
statRtsDebugLib = FilePath
"HSrts_debug"
, statRtsEventlogLib :: FilePath
statRtsEventlogLib = FilePath
"HSrts_l"
, statRtsThreadedDebugLib :: FilePath
statRtsThreadedDebugLib = FilePath
"HSrts_thr_debug"
, statRtsThreadedEventlogLib :: FilePath
statRtsThreadedEventlogLib = FilePath
"HSrts_thr_l"
, statRtsProfilingLib :: FilePath
statRtsProfilingLib = FilePath
"HSrts_p"
, statRtsThreadedProfilingLib :: FilePath
statRtsThreadedProfilingLib = FilePath
"HSrts_thr_p"
}
, rtsLibPaths :: [FilePath]
rtsLibPaths = InstalledPackageInfo -> [FilePath]
InstalledPackageInfo.libraryDirs InstalledPackageInfo
rts
}
withGhcVersion :: FilePath -> FilePath
withGhcVersion = (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath
"-ghc" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (Compiler -> Version
compilerVersion (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi))))
hasThreaded :: BuildInfo -> Bool
hasThreaded :: BuildInfo -> Bool
hasThreaded BuildInfo
bi = FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
"-threaded" [FilePath]
ghc
where
PerCompilerFlavor [FilePath]
ghc [FilePath]
_ = BuildInfo -> PerCompilerFlavor [FilePath]
options BuildInfo
bi
runReplOrWriteFlags
:: ConfiguredProgram
-> LocalBuildInfo
-> ReplFlags
-> GhcOptions
-> PackageName
-> TargetInfo
-> IO ()
runReplOrWriteFlags :: ConfiguredProgram
-> LocalBuildInfo
-> ReplFlags
-> GhcOptions
-> PackageName
-> TargetInfo
-> IO ()
runReplOrWriteFlags ConfiguredProgram
ghcProg LocalBuildInfo
lbi ReplFlags
rflags GhcOptions
ghcOpts PackageName
pkg_name TargetInfo
target =
let bi :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo (Component -> BuildInfo) -> Component -> BuildInfo
forall a b. (a -> b) -> a -> b
$ TargetInfo -> Component
targetComponent TargetInfo
target
clbi :: ComponentLocalBuildInfo
clbi = TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
platform :: Platform
platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
common :: CommonSetupFlags
common = ConfigFlags -> CommonSetupFlags
configCommonFlags (ConfigFlags -> CommonSetupFlags)
-> ConfigFlags -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common
in case ReplOptions -> Flag FilePath
replOptionsFlagOutput (ReplFlags -> ReplOptions
replReplOptions ReplFlags
rflags) of
Flag FilePath
NoFlag -> Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> GhcOptions
-> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir GhcOptions
ghcOpts
Flag FilePath
out_dir -> do
let uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
this_unit :: FilePath
this_unit = UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnitId
uid
reexported_modules :: [ModuleName]
reexported_modules =
[ ModuleName
mn | LibComponentLocalBuildInfo{componentExposedModules :: ComponentLocalBuildInfo -> [ExposedModule]
componentExposedModules = [ExposedModule]
exposed_mods} <- [ComponentLocalBuildInfo
clbi], IPI.ExposedModule ModuleName
mn (Just{}) <- [ExposedModule]
exposed_mods
]
hidden_modules :: [ModuleName]
hidden_modules = BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
extra_opts :: [FilePath]
extra_opts =
[[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
[ [FilePath
"-this-package-name", PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageName
pkg_name]
, case Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir of
Maybe (SymbolicPath CWD ('Dir Pkg))
Nothing -> []
Just SymbolicPath CWD ('Dir Pkg)
wd -> [FilePath
"-working-dir", SymbolicPath CWD ('Dir Pkg) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath SymbolicPath CWD ('Dir Pkg)
wd]
]
[[FilePath]] -> [[FilePath]] -> [[FilePath]]
forall a. [a] -> [a] -> [a]
++ [ [FilePath
"-reexported-module", ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m] | ModuleName
m <- [ModuleName]
reexported_modules
]
[[FilePath]] -> [[FilePath]] -> [[FilePath]]
forall a. [a] -> [a] -> [a]
++ [ [FilePath
"-hidden-module", ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m] | ModuleName
m <- [ModuleName]
hidden_modules
]
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False (FilePath
out_dir FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> FilePath
"paths")
FilePath -> ByteString -> IO ()
writeFileAtomic (FilePath
out_dir FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> FilePath
"paths" FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> FilePath
this_unit) (ConfiguredProgram -> ByteString
forall a. Binary a => a -> ByteString
encode ConfiguredProgram
ghcProg)
FilePath -> ByteString -> IO ()
writeFileAtomic (FilePath
out_dir FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> FilePath
this_unit) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$
[FilePath] -> FilePath
escapeArgs ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
[FilePath]
extra_opts
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ Compiler -> Platform -> GhcOptions -> [FilePath]
renderGhcOptions Compiler
comp Platform
platform (GhcOptions
ghcOpts{ghcOptMode = NoFlag})
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [FilePath]
programOverrideArgs ConfiguredProgram
ghcProg
replNoLoad :: Ord a => ReplOptions -> NubListR a -> NubListR a
replNoLoad :: forall a. Ord a => ReplOptions -> NubListR a -> NubListR a
replNoLoad ReplOptions
replFlags NubListR a
l
| ReplOptions -> Flag Bool
replOptionsNoLoad ReplOptions
replFlags Flag Bool -> Flag Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
True = NubListR a
forall a. Monoid a => a
mempty
| Bool
otherwise = NubListR a
l