    {-# LANGUAGE LambdaCase #-}

    module Distribution.Simple.GHC.Build.Link where

    import Distribution.Compat.Prelude
    import Prelude ()

    import Control.Exception (assert)
    import Control.Monad (forM_)
    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.Repl
    import Distribution.Simple.Utils
    import Distribution.System
    import Distribution.Types.ComponentLocalBuildInfo
    import Distribution.Utils.NubList
    import Distribution.Verbosity
    import Distribution.Version
    import System.Directory
    import System.FilePath

    -- | 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
      -> [FilePath]
      -- ^ The full list of extra build sources (all C, C++, Js,
      -- Asm, and Cmm sources), which were compiled to object
      -- files.
      -> (FilePath, FilePath)
      -- ^ The build target dir, and the target dir.
      -- See Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build
      -> (Set.Set 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
    -> [String]
    -> (String, String)
    -> (Set BuildWay, BuildWay -> GhcOptions)
    -> PreBuildComponentInputs
    -> IO ()
    linkOrLoadComponent ConfiguredProgram
    ghcProg PackageDescription
    pkg_descr [String]
    extraSources (String
    buildTargetDir, String
    targetDir) (Set BuildWay
    wantedWays, 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

      -- ensure extra lib dirs exist before passing to ghc
      cleanedExtraLibDirs <- IO [String] -> IO [String]
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [String] -> IO [String]) -> IO [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> IO Bool) -> [String] -> IO [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> IO Bool
    doesDirectoryExist (BuildInfo -> [String]
    extraLibDirs BuildInfo
    bi)
      cleanedExtraLibDirsStatic <- liftIO $ filterM doesDirectoryExist (extraLibDirsStatic bi)

      let
        extraSourcesObjs = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> String
    `replaceExtension` String
    objExtension) [String]
    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 String
    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 $ PD.frameworks bi
            , ghcOptLinkFrameworkDirs = toNubListR $ PD.extraFrameworkDirs bi
            , ghcOptInputFiles = toNubListR [buildTargetDir </> x | x <- 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)
                , ghcOptInputModules = replNoLoad (replReplOptions replFlags) (ghcOptInputModules staticOpts)
                , ghcOptInputFiles = replNoLoad (replReplOptions replFlags) (ghcOptInputFiles staticOpts)
                }
                -- 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 String -> GhcOptions
    linkerOpts NubListR String
    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
                  }

          -- 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 -> String -> IO ()
    warn Verbosity
    verbosity String
    "No exposed modules"
          ConfiguredProgram
    -> LocalBuildInfo
    -> ReplFlags
    -> GhcOptions
    -> PackageName
    -> TargetInfo
    -> IO ()
    runReplOrWriteFlags ConfiguredProgram
    ghcProg LocalBuildInfo
    lbi ReplFlags
    replFlags GhcOptions
    replOpts (PackageIdentifier -> PackageName
    pkgName (PackageDescription -> PackageIdentifier
    PD.package PackageDescription
    pkg_descr)) TargetInfo
    target
        BuildingWhat
    _otherwise ->
          let
            runGhcProg :: GhcOptions -> IO ()
    runGhcProg = Verbosity
    -> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
    runGHC Verbosity
    verbosity ConfiguredProgram
    ghcProg Compiler
    comp Platform
    platform
            platform :: Platform
    platform = LocalBuildInfo -> Platform
    hostPlatform LocalBuildInfo
    lbi
            comp :: Compiler
    comp = LocalBuildInfo -> Compiler
    compiler LocalBuildInfo
    lbi
           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.
              rpaths <- if BuildWay
    DynWay BuildWay -> Set BuildWay -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set BuildWay
    wantedWays then PreBuildComponentInputs -> IO (NubListR String)
    getRPaths PreBuildComponentInputs
    pbci else NubListR String -> IO (NubListR String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> NubListR String
    forall a. Ord a => [a] -> NubListR a
    toNubListR [])
              liftIO $ do
                info verbosity "Linking..."
                let linkExeLike UnqualComponentName
    name = GhcOptions
    -> (Set BuildWay, BuildWay -> GhcOptions)
    -> String
    -> UnqualComponentName
    -> (GhcOptions -> IO ())
    -> LocalBuildInfo
    -> IO ()
    linkExecutable (NubListR String -> GhcOptions
    linkerOpts NubListR String
    rpaths) (Set BuildWay
    wantedWays, BuildWay -> GhcOptions
    buildOpts) String
    targetDir UnqualComponentName
    name GhcOptions -> IO ()
    runGhcProg LocalBuildInfo
    lbi
                case component of
                  CLib Library
    lib -> String
    -> [String]
    -> PackageDescription
    -> Verbosity
    -> (GhcOptions -> IO ())
    -> Library
    -> LocalBuildInfo
    -> ComponentLocalBuildInfo
    -> [String]
    -> NubListR String
    -> Set BuildWay
    -> IO ()
    linkLibrary String
    buildTargetDir [String]
    cleanedExtraLibDirs PackageDescription
    pkg_descr Verbosity
    verbosity GhcOptions -> IO ()
    runGhcProg Library
    lib LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi [String]
    extraSources NubListR String
    rpaths Set BuildWay
    wantedWays
                  CFLib ForeignLib
    flib -> ForeignLib
    -> BuildInfo
    -> LocalBuildInfo
    -> GhcOptions
    -> (Set BuildWay, BuildWay -> GhcOptions)
    -> String
    -> (GhcOptions -> IO ())
    -> IO ()
    linkFLib ForeignLib
    flib BuildInfo
    bi LocalBuildInfo
    lbi (NubListR String -> GhcOptions
    linkerOpts NubListR String
    rpaths) (Set BuildWay
    wantedWays, BuildWay -> GhcOptions
    buildOpts) String
    targetDir GhcOptions -> IO ()
    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
      :: FilePath
      -- ^ The library target build directory
      -> [FilePath]
      -- ^ 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
      -> [FilePath]
      -- ^ Extra build sources (that were compiled to objects)
      -> NubListR FilePath
      -- ^ A list with the runtime-paths (rpaths), or empty if not linking dynamically
      -> Set.Set BuildWay
      -- ^ Wanted build ways and corresponding build options
      -> IO ()
    linkLibrary :: String
    -> [String]
    -> PackageDescription
    -> Verbosity
    -> (GhcOptions -> IO ())
    -> Library
    -> LocalBuildInfo
    -> ComponentLocalBuildInfo
    -> [String]
    -> NubListR String
    -> Set BuildWay
    -> IO ()
    linkLibrary String
    buildTargetDir [String]
    cleanedExtraLibDirs PackageDescription
    pkg_descr Verbosity
    verbosity GhcOptions -> IO ()
    runGhcProg Library
    lib LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi [String]
    extraSources NubListR String
    rpaths Set BuildWay
    wantedWays = do
      let
        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 :: String
    vanillaLibFilePath = String
    buildTargetDir String -> String -> String
    </> UnitId -> String
    mkLibName UnitId
    uid
        profileLibFilePath :: String
    profileLibFilePath = String
    buildTargetDir String -> String -> String
    </> UnitId -> String
    mkProfLibName UnitId
    uid
        sharedLibFilePath :: String
    sharedLibFilePath =
          String
    buildTargetDir
            String -> String -> String
    </> Platform -> CompilerId -> UnitId -> String
    mkSharedLibName (LocalBuildInfo -> Platform
    hostPlatform LocalBuildInfo
    lbi) CompilerId
    compiler_id UnitId
    uid
        staticLibFilePath :: String
    staticLibFilePath =
          String
    buildTargetDir
            String -> String -> String
    </> Platform -> CompilerId -> UnitId -> String
    mkStaticLibName (LocalBuildInfo -> Platform
    hostPlatform LocalBuildInfo
    lbi) CompilerId
    compiler_id UnitId
    uid
        ghciLibFilePath :: String
    ghciLibFilePath = String
    buildTargetDir String -> String -> String
    </> UnitId -> String
    Internal.mkGHCiLibName UnitId
    uid
        ghciProfLibFilePath :: String
    ghciProfLibFilePath = String
    buildTargetDir String -> String -> String
    </> UnitId -> String
    Internal.mkGHCiProfLibName UnitId
    uid
        libInstallPath :: String
    libInstallPath =
          InstallDirs String -> String
    forall dir. InstallDirs dir -> dir
    libdir (InstallDirs String -> String) -> InstallDirs String -> String
    forall a b. (a -> b) -> a -> b
    $
            PackageDescription
    -> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
    absoluteComponentInstallDirs
              PackageDescription
    pkg_descr
              LocalBuildInfo
    lbi
              UnitId
    uid
              CopyDest
    NoCopyDest
        sharedLibInstallPath :: String
    sharedLibInstallPath =
          String
    libInstallPath
            String -> String -> String
    </> Platform -> CompilerId -> UnitId -> String
    mkSharedLibName (LocalBuildInfo -> Platform
    hostPlatform LocalBuildInfo
    lbi) CompilerId
    compiler_id UnitId
    uid

        getObjFiles :: BuildWay -> IO [String]
    getObjFiles BuildWay
    way =
          [IO [String]] -> IO [String]
    forall a. Monoid a => [a] -> a
    mconcat
            [ GhcImplInfo
    -> Library
    -> LocalBuildInfo
    -> ComponentLocalBuildInfo
    -> String
    -> String
    -> Bool
    -> IO [String]
    Internal.getHaskellObjects
                GhcImplInfo
    implInfo
                Library
    lib
                LocalBuildInfo
    lbi
                ComponentLocalBuildInfo
    clbi
                String
    buildTargetDir
                (BuildWay -> String
    buildWayPrefix BuildWay
    way String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    objExtension)
                Bool
    True
            , [String] -> IO [String]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $
                (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    buildTargetDir String -> String -> String
    </>) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $
                  (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> String -> String
    `replaceExtension` (BuildWay -> String
    buildWayPrefix BuildWay
    way String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    objExtension))) [String]
    extraSources
            , [Maybe String] -> [String]
    forall a. [Maybe a] -> [a]
    catMaybes
                ([Maybe String] -> [String]) -> IO [Maybe String] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [IO (Maybe String)] -> IO [Maybe String]
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
    sequenceA
                  [ [Suffix] -> [String] -> String -> IO (Maybe String)
    findFileWithExtension
                    [String -> Suffix
    Suffix (String -> Suffix) -> String -> Suffix
    forall a b. (a -> b) -> a -> b
    $ BuildWay -> String
    buildWayPrefix BuildWay
    way String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    objExtension]
                    [String
    buildTargetDir]
                    (ModuleName -> String
    ModuleName.toFilePath ModuleName
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_stub")
                  | 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
                  ]
            ]

        -- 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 -> String
    componentCompatPackageKey = String
    pk} ->
                  String -> Flag String
    forall a. a -> Flag a
    toFlag String
    pk
                ComponentLocalBuildInfo
    _ -> Flag String
    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 :: [String] -> GhcOptions
    ghcSharedLinkArgs [String]
    dynObjectFiles =
          GhcOptions
    ghcBaseLinkArgs
            { ghcOptShared = toFlag True
            , ghcOptDynLinkMode = toFlag GhcDynamicOnly
            , ghcOptInputFiles = toNubListR 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 $ PD.frameworks libBi
            , ghcOptLinkFrameworkDirs =
                toNubListR $ PD.extraFrameworkDirs libBi
            , ghcOptRPaths = rpaths
            }
        ghcStaticLinkArgs :: [String] -> GhcOptions
    ghcStaticLinkArgs [String]
    staticObjectFiles =
          GhcOptions
    ghcBaseLinkArgs
            { ghcOptStaticLib = toFlag True
            , ghcOptInputFiles = toNubListR staticObjectFiles
            , ghcOptOutputFile = toFlag staticLibFilePath
            , ghcOptLinkLibs = extraLibs libBi
            , -- TODO: Shouldn't this use cleanedExtraLibDirsStatic instead?
              ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
            }

      staticObjectFiles <- BuildWay -> IO [String]
    getObjFiles BuildWay
    StaticWay
      profObjectFiles <- getObjFiles ProfWay
      dynamicObjectFiles <- getObjFiles DynWay

      let
        linkWay = \case
          BuildWay
    ProfWay -> do
            Verbosity -> LocalBuildInfo -> String -> [String] -> IO ()
    Ar.createArLibArchive Verbosity
    verbosity LocalBuildInfo
    lbi String
    profileLibFilePath [String]
    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
    DynWay -> do
            GhcOptions -> IO ()
    runGhcProg (GhcOptions -> IO ()) -> GhcOptions -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> GhcOptions
    ghcSharedLinkArgs [String]
    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 -> String -> [String] -> IO ()
    Ar.createArLibArchive Verbosity
    verbosity LocalBuildInfo
    lbi String
    vanillaLibFilePath [String]
    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
    $ [String] -> GhcOptions
    ghcStaticLinkArgs [String]
    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
      -> (Set.Set BuildWay, BuildWay -> GhcOptions)
      -- ^ The wanted build ways and corresponding GhcOptions that were
      -- used to compile the modules in that way.
      -> FilePath
      -- ^ 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
    -> (Set BuildWay, BuildWay -> GhcOptions)
    -> String
    -> UnqualComponentName
    -> (GhcOptions -> IO ())
    -> LocalBuildInfo
    -> IO ()
    linkExecutable GhcOptions
    linkerOpts (Set BuildWay
    wantedWays, BuildWay -> GhcOptions
    buildOpts) String
    targetDir UnqualComponentName
    targetName GhcOptions -> IO ()
    runGhcProg LocalBuildInfo
    lbi = do
      -- When building an executable, we should only "want" one build way.
      Bool -> IO () -> IO ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Set BuildWay -> Int
    forall a. Set a -> Int
    Set.size Set BuildWay
    wantedWays Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Set BuildWay -> (BuildWay -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Set BuildWay
    wantedWays ((BuildWay -> IO ()) -> IO ()) -> (BuildWay -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \BuildWay
    way -> 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 :: String
    target = String
    targetDir String -> String -> String
    </> Platform -> UnqualComponentName -> String
    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
            e <- String -> IO Bool
    doesFileExist String
    target
            when e (removeFile target)
          GhcOptions -> IO ()
    runGhcProg GhcOptions
    linkOpts{ghcOptOutputFile = toFlag target}

    -- | Link a foreign library component
    linkFLib
      :: ForeignLib
      -> BuildInfo
      -> LocalBuildInfo
      -> (GhcOptions)
      -- ^ The linker-specific GHC options
      -> (Set.Set BuildWay, BuildWay -> GhcOptions)
      -- ^ The wanted build ways and corresponding GhcOptions that were
      -- used to compile the modules in that way.
      -> FilePath
      -- ^ 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
    -> (Set BuildWay, BuildWay -> GhcOptions)
    -> String
    -> (GhcOptions -> IO ())
    -> IO ()
    linkFLib ForeignLib
    flib BuildInfo
    bi LocalBuildInfo
    lbi GhcOptions
    linkerOpts (Set BuildWay
    wantedWays, BuildWay -> GhcOptions
    buildOpts) String
    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 $ 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 :: [String]
    rtsOptLinkLibs =
              [ if ForeignLib -> Bool
    withDynFLib ForeignLib
    flib
                  then
                    if Bool
    threaded
                      then DynamicRtsInfo -> String
    dynRtsThreadedLib (RtsInfo -> DynamicRtsInfo
    rtsDynamicInfo RtsInfo
    rtsInfo)
                      else DynamicRtsInfo -> String
    dynRtsVanillaLib (RtsInfo -> DynamicRtsInfo
    rtsDynamicInfo RtsInfo
    rtsInfo)
                  else
                    if Bool
    threaded
                      then StaticRtsInfo -> String
    statRtsThreadedLib (RtsInfo -> StaticRtsInfo
    rtsStaticInfo RtsInfo
    rtsInfo)
                      else StaticRtsInfo -> String
    statRtsVanillaLib (RtsInfo -> StaticRtsInfo
    rtsStaticInfo RtsInfo
    rtsInfo)
              ]

        linkOpts :: BuildWay -> GhcOptions
        linkOpts :: BuildWay -> GhcOptions
    linkOpts BuildWay
    way = 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 $ 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)
            String -> GhcOptions
    forall a. String -> a
    cabalBug String
    "static libraries not yet implemented"
          ForeignLibType
    ForeignLibTypeUnknown ->
            String -> GhcOptions
    forall a. String -> a
    cabalBug String
    "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 :: String
    buildName = LocalBuildInfo -> ForeignLib -> String
    flibBuildName LocalBuildInfo
    lbi ForeignLib
    flib
      -- There should not be more than one wanted way when building an flib
      Bool -> IO () -> IO ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Set BuildWay -> Int
    forall a. Set a -> Int
    Set.size Set BuildWay
    wantedWays Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Set BuildWay -> (BuildWay -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Set BuildWay
    wantedWays ((BuildWay -> IO ()) -> IO ()) -> (BuildWay -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \BuildWay
    way -> do
          GhcOptions -> IO ()
    runGhcProg (BuildWay -> GhcOptions
    linkOpts BuildWay
    way){ghcOptOutputFile = toFlag (targetDir </> buildName)}
          String -> String -> IO ()
    renameFile (String
    targetDir String -> String -> String
    </> String
    buildName) (String
    targetDir String -> String -> String
    </> LocalBuildInfo -> ForeignLib -> String
    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 String)
    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 String
    _) = 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 [String] -> IO [String]
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [String] -> IO [String]) -> IO [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [String]
    depLibraryPaths Bool
    False (LocalBuildInfo -> Bool
    relocatable LocalBuildInfo
    lbi) LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi
          let hostPref = case OS
    hostOS of
                OS
    OSX -> String
    "@loader_path"
                OS
    _ -> String
    "$ORIGIN"
              relPath String
    p = if String -> Bool
    isRelative String
    p then String
    hostPref String -> String -> String
    </> String
    p else String
    p
              rpaths = [String] -> NubListR String
    forall a. Ord a => [a] -> NubListR a
    toNubListR ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    relPath [String]
    libraryPaths) NubListR String -> NubListR String -> NubListR String
    forall a. Semigroup a => a -> a -> a
    <> [String] -> NubListR String
    forall a. Ord a => [a] -> NubListR a
    toNubListR (BuildInfo -> [String]
    extraLibDirs BuildInfo
    bi)
          return rpaths
        else NubListR String -> IO (NubListR String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return NubListR String
    forall a. Monoid a => a
    mempty

    data DynamicRtsInfo = DynamicRtsInfo
      { DynamicRtsInfo -> String
    dynRtsVanillaLib :: FilePath
      , DynamicRtsInfo -> String
    dynRtsThreadedLib :: FilePath
      , DynamicRtsInfo -> String
    dynRtsDebugLib :: FilePath
      , DynamicRtsInfo -> String
    dynRtsEventlogLib :: FilePath
      , DynamicRtsInfo -> String
    dynRtsThreadedDebugLib :: FilePath
      , DynamicRtsInfo -> String
    dynRtsThreadedEventlogLib :: FilePath
      }

    data StaticRtsInfo = StaticRtsInfo
      { StaticRtsInfo -> String
    statRtsVanillaLib :: FilePath
      , StaticRtsInfo -> String
    statRtsThreadedLib :: FilePath
      , StaticRtsInfo -> String
    statRtsDebugLib :: FilePath
      , StaticRtsInfo -> String
    statRtsEventlogLib :: FilePath
      , StaticRtsInfo -> String
    statRtsThreadedDebugLib :: FilePath
      , StaticRtsInfo -> String
    statRtsThreadedEventlogLib :: FilePath
      , StaticRtsInfo -> String
    statRtsProfilingLib :: FilePath
      , StaticRtsInfo -> String
    statRtsThreadedProfilingLib :: FilePath
      }

    data RtsInfo = RtsInfo
      { RtsInfo -> DynamicRtsInfo
    rtsDynamicInfo :: DynamicRtsInfo
      , RtsInfo -> StaticRtsInfo
    rtsStaticInfo :: StaticRtsInfo
      , RtsInfo -> [String]
    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)
        (String -> PackageName
    mkPackageName String
    "rts") of
        [(Version
    _, [InstalledPackageInfo
    rts])] -> InstalledPackageInfo -> RtsInfo
    aux InstalledPackageInfo
    rts
        [(Version, [InstalledPackageInfo])]
    _otherwise -> String -> RtsInfo
    forall a. HasCallStack => String -> a
    error String
    "No (or multiple) ghc rts package is registered"
      where
        aux :: InstalledPackageInfo -> RtsInfo
        aux :: InstalledPackageInfo -> RtsInfo
    aux InstalledPackageInfo
    rts =
          RtsInfo
            { rtsDynamicInfo :: DynamicRtsInfo
    rtsDynamicInfo =
                DynamicRtsInfo
                  { dynRtsVanillaLib :: String
    dynRtsVanillaLib = String -> String
    withGhcVersion String
    "HSrts"
                  , dynRtsThreadedLib :: String
    dynRtsThreadedLib = String -> String
    withGhcVersion String
    "HSrts_thr"
                  , dynRtsDebugLib :: String
    dynRtsDebugLib = String -> String
    withGhcVersion String
    "HSrts_debug"
                  , dynRtsEventlogLib :: String
    dynRtsEventlogLib = String -> String
    withGhcVersion String
    "HSrts_l"
                  , dynRtsThreadedDebugLib :: String
    dynRtsThreadedDebugLib = String -> String
    withGhcVersion String
    "HSrts_thr_debug"
                  , dynRtsThreadedEventlogLib :: String
    dynRtsThreadedEventlogLib = String -> String
    withGhcVersion String
    "HSrts_thr_l"
                  }
            , rtsStaticInfo :: StaticRtsInfo
    rtsStaticInfo =
                StaticRtsInfo
                  { statRtsVanillaLib :: String
    statRtsVanillaLib = String
    "HSrts"
                  , statRtsThreadedLib :: String
    statRtsThreadedLib = String
    "HSrts_thr"
                  , statRtsDebugLib :: String
    statRtsDebugLib = String
    "HSrts_debug"
                  , statRtsEventlogLib :: String
    statRtsEventlogLib = String
    "HSrts_l"
                  , statRtsThreadedDebugLib :: String
    statRtsThreadedDebugLib = String
    "HSrts_thr_debug"
                  , statRtsThreadedEventlogLib :: String
    statRtsThreadedEventlogLib = String
    "HSrts_thr_l"
                  , statRtsProfilingLib :: String
    statRtsProfilingLib = String
    "HSrts_p"
                  , statRtsThreadedProfilingLib :: String
    statRtsThreadedProfilingLib = String
    "HSrts_thr_p"
                  }
            , rtsLibPaths :: [String]
    rtsLibPaths = InstalledPackageInfo -> [String]
    InstalledPackageInfo.libraryDirs InstalledPackageInfo
    rts
            }
        withGhcVersion :: String -> String
    withGhcVersion = (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (String
    "-ghc" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Version -> String
    forall a. Pretty a => a -> String
    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 = String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem String
    "-threaded" [String]
    ghc
      where
        PerCompilerFlavor [String]
    ghc [String]
    _ = BuildInfo -> PerCompilerFlavor [String]
    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
       in case ReplOptions -> Flag String
    replOptionsFlagOutput (ReplFlags -> ReplOptions
    replReplOptions ReplFlags
    rflags) of
            Flag String
    NoFlag -> Verbosity
    -> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
    runGHC (Flag Verbosity -> Verbosity
    forall a. WithCallStack (Flag a -> a)
    fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
    forall a b. (a -> b) -> a -> b
    $ ReplFlags -> Flag Verbosity
    replVerbosity ReplFlags
    rflags) ConfiguredProgram
    ghcProg Compiler
    comp Platform
    platform GhcOptions
    ghcOpts
            Flag String
    out_dir -> do
              src_dir <- IO String
    getCurrentDirectory
              let uid = ComponentLocalBuildInfo -> UnitId
    componentUnitId ComponentLocalBuildInfo
    clbi
                  this_unit = UnitId -> String
    forall a. Pretty a => a -> String
    prettyShow UnitId
    uid
                  reexported_modules = [ModuleName
    mn | LibComponentLocalBuildInfo{} <- [ComponentLocalBuildInfo
    clbi], IPI.ExposedModule ModuleName
    mn (Just{}) <- ComponentLocalBuildInfo -> [ExposedModule]
    componentExposedModules ComponentLocalBuildInfo
    clbi]
                  hidden_modules = BuildInfo -> [ModuleName]
    otherModules BuildInfo
    bi
                  extra_opts =
                    [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [String]) -> [[String]] -> [String]
    forall a b. (a -> b) -> a -> b
    $
                      [ [String
    "-this-package-name", PackageName -> String
    forall a. Pretty a => a -> String
    prettyShow PackageName
    pkg_name]
                      , [String
    "-working-dir", String
    src_dir]
                      ]
                        [[String]] -> [[String]] -> [[String]]
    forall a. [a] -> [a] -> [a]
    ++ [ [String
    "-reexported-module", ModuleName -> String
    forall a. Pretty a => a -> String
    prettyShow ModuleName
    m] | ModuleName
    m <- [ModuleName]
    reexported_modules
                           ]
                        [[String]] -> [[String]] -> [[String]]
    forall a. [a] -> [a] -> [a]
    ++ [ [String
    "-hidden-module", ModuleName -> String
    forall a. Pretty a => a -> String
    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.
              createDirectoryIfMissing False (out_dir </> "paths")
              -- Write out the PATH information into `paths` subdirectory.
              writeFileAtomic (out_dir </> "paths" </> this_unit) (encode ghcProg)
              -- Write out options for this component into a file ready for loading into
              -- the multi-repl
              writeFileAtomic (out_dir </> this_unit) $
                BS.pack $
                  escapeArgs $
                    extra_opts ++ renderGhcOptions comp platform (ghcOpts{ghcOptMode = NoFlag})

    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