{-# 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
  )

-- | Links together the object files of the Haskell modules and extra sources
-- using the context in which the component is being built.
--
-- If the build kind is 'BuildRepl', we load the component into GHCi instead of linking.
linkOrLoadComponent
  :: ConfiguredProgram
  -- ^ The configured GHC program that will be used for linking
  -> PackageDescription
  -- ^ The package description containing the component being built
  -> [SymbolicPath Pkg File]
  -- ^ The full list of extra build sources (all C, C++, Js,
  -- Asm, and Cmm sources), which were compiled to object
  -- files.
  -> (SymbolicPath Pkg (Dir Artifacts), SymbolicPath Pkg (Dir Build))
  -- ^ The build target dir, and the target dir.
  -- See Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build
  -> ((Bool -> [BuildWay], Bool -> BuildWay, BuildWay), BuildWay -> GhcOptions)
  -- ^ The set of build ways wanted based on the user opts, and a function to
  -- convert a build way into the set of ghc options that were used to build
  -- that way.
  -> PreBuildComponentInputs
  -- ^ The context and component being built in it.
  -> 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

      -- See Note [Symbolic paths] in Distribution.Utils.Path
      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

    -- ensure extra lib dirs exist before passing to ghc
    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
        ]

      -- TODO: Shouldn't we use withStaticLib for libraries and something else
      -- for foreign libs in the three cases where we use `withFullyStaticExe` below?
      linkerOpts NubListR FilePath
rpaths =
        GhcOptions
forall a. Monoid a => a
mempty
          { ghcOptLinkOptions =
              PD.ldOptions bi
                ++ [ "-static"
                   | withFullyStaticExe lbi
                   ]
                -- Pass extra `ld-options` given
                -- through to GHC's linker.
                ++ 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
          -- For repl we use the vanilla (static) ghc options
          staticOpts :: GhcOptions
staticOpts = BuildWay -> GhcOptions
buildOpts BuildWay
StaticWay
          replOpts :: GhcOptions
replOpts =
            GhcOptions
staticOpts
              { -- Repl options use Static as the base, but doesn't need to pass -static.
                -- However, it maybe should, for uniformity.
                ghcOptDynLinkMode = NoFlag
              , ghcOptExtra =
                  Internal.filterGhciFlags
                    (ghcOptExtra staticOpts)
                    <> replOptionsFlags (replReplOptions replFlags)
              }
              -- For a normal compile we do separate invocations of ghc for
              -- compiling as for linking. But for repl we have to do just
              -- the one invocation, so that one has to include all the
              -- linker stuff too, like -l flags and any .o files from C
              -- files etc.
              --
              -- TODO: The repl doesn't use the runtime paths from linkerOpts
              -- (ghcOptRPaths), which looks like a bug. After the refactor we
              -- can fix this.
              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)
              }

        -- TODO: problem here is we need the .c files built first, so we can load them
        -- with ghci, but .c files can depend on .h files generated by ghc by ffi
        -- exports.
        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
            -- If not building dynamically, we don't pass any runtime paths.
            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)

-- | Link a library component
linkLibrary
  :: SymbolicPath Pkg (Dir Artifacts)
  -- ^ The library target build directory
  -> [SymbolicPath Pkg (Dir Lib)]
  -- ^ The list of extra lib dirs that exist (aka "cleaned")
  -> PackageDescription
  -- ^ The package description containing this library
  -> Verbosity
  -> (GhcOptions -> IO ())
  -- ^ Run the configured Ghc program
  -> Library
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> [SymbolicPath Pkg File]
  -- ^ Extra build sources (that were compiled to objects)
  -> NubListR FilePath
  -- ^ A list with the runtime-paths (rpaths), or empty if not linking dynamically
  -> [BuildWay]
  -- ^ Wanted build ways and corresponding build options
  -> 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] -- ghc-7.2+ does not make _stub.o files
              , 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"
              ]
        ]

    -- Get the @.o@ path from a source path (e.g. @.hs@),
    -- in the library target build directory.
    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
        -- Absolute path: should already be in the target build directory
        -- (e.g. a preprocessed file)
        -- TODO: assert this?
        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)

    -- I'm fairly certain that, just like the executable, we can keep just the
    -- module input list, and point to the right sources dir (as is already
    -- done), and GHC will pick up the right suffix (p_ for profile, dyn_ when
    -- -shared...). The downside to doing this is that GHC would have to
    -- reconstruct the module graph again.
    -- That would mean linking the lib would be just like the executable, and
    -- we could more easily merge the two.
    --
    -- Right now, instead, we pass the path to each object file.
    ghcBaseLinkArgs :: GhcOptions
ghcBaseLinkArgs =
      GhcOptions
forall a. Monoid a => a
mempty
        { -- TODO: This basically duplicates componentGhcOptions.
          -- I think we want to do the same as we do for executables: re-use the
          -- base options, and link by module names, not object paths.
          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
        }

    -- After the relocation lib is created we invoke ghc -shared
    -- with the dependencies spelled out as -package arguments
    -- and ghc invokes the linker with the proper library paths
    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
        , -- For dynamic libs, Mac OS/X needs to know the install location
          -- at build time. This only applies to GHC < 7.8 - see the
          -- discussion in #1660.
          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
        , -- For dynamic libs, Mac OS/X needs to know the install location
          -- at build time. This only applies to GHC < 7.8 - see the
          -- discussion in #1660.
          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
        , -- TODO: Shouldn't this use cleanedExtraLibDirsStatic instead?
          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

  -- ROMES: Why exactly branch on staticObjectFiles, rather than any other build
  -- kind that we might have wanted instead?
  -- This would be simpler by not adding every object to the invocation, and
  -- rather using module names.
  unless (null staticObjectFiles) $ do
    info verbosity (show (ghcOptPackages (Internal.componentGhcOptions verbosity lbi libBi clbi buildTargetDir)))
    traverse_ linkWay wantedWays

-- | Link the executable resulting from building this component, be it an
-- executable, test, or benchmark component.
linkExecutable
  :: (GhcOptions)
  -- ^ The linker-specific GHC options
  -> (BuildWay, BuildWay -> GhcOptions)
  -- ^ The wanted build ways and corresponding GhcOptions that were
  -- used to compile the modules in that way.
  -> SymbolicPath Pkg (Dir Build)
  -- ^ The target dir (2024-01:note: not the same as build target
  -- dir, see Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build)
  -> UnqualComponentName
  -- ^ Name of executable-like target
  -> (GhcOptions -> IO ())
  -- ^ Run the configured GHC program
  -> 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
            { -- If there are no input Haskell files we pass -no-hs-main, and
              -- assume there is a main function in another non-haskell object
              ghcOptLinkNoHsMain = toFlag (ghcOptInputFiles baseOpts == mempty && ghcOptInputScripts baseOpts == mempty)
            }
      comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi

  -- Work around old GHCs not relinking in this
  -- situation, see #3294
  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}

-- | Link a foreign library component
linkFLib
  :: ForeignLib
  -> BuildInfo
  -> LocalBuildInfo
  -> (GhcOptions)
  -- ^ The linker-specific GHC options
  -> (BuildWay, BuildWay -> GhcOptions)
  -- ^ The wanted build ways and corresponding GhcOptions that were
  -- used to compile the modules in that way.
  -> SymbolicPath Pkg (Dir Build)
  -- ^ The target dir (2024-01:note: not the same as build target
  -- dir, see Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build)
  -> (GhcOptions -> IO ())
  -- ^ Run the configured GHC program
  -> 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

    -- Instruct GHC to link against libHSrts.
    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 ->
        -- this should be caught by buildFLib
        -- (and if we do implement this, we probably don't even want to call
        -- ghc here, but rather Ar.createArLibArchive or something)
        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"
  -- We build under a (potentially) different filename to set a
  -- soname on supported platforms.  See also the note for
  -- @flibBuildName@.
  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)

-- | Calculate the RPATHs for the component we are building.
--
-- Calculates relative RPATHs when 'relocatable' is set.
getRPaths
  :: PreBuildComponentInputs
  -- ^ The context and component being built in it.
  -> 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

    -- The list of RPath-supported operating systems below reflects the
    -- platforms on which Cabal's RPATH handling is tested. It does _NOT_
    -- reflect whether the OS supports RPATH.

    -- E.g. when this comment was written, the *BSD operating systems were
    -- untested with regards to Cabal RPATH handling, and were hence set to
    -- 'False', while those operating systems themselves do support RPATH.
    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
  -- Do _not_ add a default case so that we get a warning here when a new OS
  -- is added.

  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]
  }

-- | Extract (and compute) information about the RTS library
--
-- TODO: This hardcodes the name as @HSrts-ghc<version>@. I don't know if we can
-- find this information somewhere. We can lookup the 'hsLibraries' field of
-- 'InstalledPackageInfo' but it will tell us @["HSrts", "Cffi"]@, which
-- doesn't really help.
extractRtsInfo :: LocalBuildInfo -> RtsInfo
extractRtsInfo :: LocalBuildInfo -> RtsInfo
extractRtsInfo 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))))

-- | Determine whether the given 'BuildInfo' is intended to link against the
-- threaded RTS. This is used to determine which RTS to link against when
-- building a foreign library with a GHC without support for @-flink-rts@.
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

-- | Load a target component into a repl, or write to disk a script which runs
-- GHCi with the GHC options Cabal elaborated to load the component interactively.
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{} <- [ComponentLocalBuildInfo
clbi], IPI.ExposedModule ModuleName
mn (Just{}) <- ComponentLocalBuildInfo -> [ExposedModule]
componentExposedModules ComponentLocalBuildInfo
clbi]
              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
                       ]
          -- Create "paths" subdirectory if it doesn't exist. This is where we write
          -- information about how the PATH was augmented.
          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")
          -- Write out the PATH information into `paths` subdirectory.
          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)
          -- Write out options for this component into a file ready for loading into
          -- the multi-repl
          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