    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.Simple.Program.Ld
    -- Copyright   :  Duncan Coutts 2009
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    --
    -- This module provides an library interface to the @ld@ linker program.

    module Distribution.Simple.Program.Ld (
        combineObjectFiles,
      ) where

    import Prelude ()
    import Distribution.Compat.Prelude

    import Distribution.Simple.Compiler (arResponseFilesSupported)
    import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
    import Distribution.Simple.Program.ResponseFile
             ( withResponseFile )
    import Distribution.Simple.Program.Run
             ( ProgramInvocation, programInvocation, multiStageProgramInvocation
             , runProgramInvocation )
    import Distribution.Simple.Program.Types
             ( ConfiguredProgram(..) )
    import Distribution.Simple.Setup
             ( fromFlagOrDefault, configUseResponseFiles )
    import Distribution.Simple.Utils
             ( defaultTempFileOptions )
    import Distribution.Verbosity
             ( Verbosity )

    import System.Directory
             ( renameFile )
    import System.FilePath
             ( (<.>), takeDirectory )

    -- | Call @ld -r@ to link a bunch of object files together.
    --
    combineObjectFiles :: Verbosity -> LocalBuildInfo -> ConfiguredProgram
                       -> FilePath -> [FilePath] -> IO ()
    combineObjectFiles :: Verbosity
    -> LocalBuildInfo
    -> ConfiguredProgram
    -> FilePath
    -> [FilePath]
    -> IO ()
    combineObjectFiles Verbosity
    verbosity LocalBuildInfo
    lbi ConfiguredProgram
    ld FilePath
    target [FilePath]
    files = do

      -- Unlike "ar", the "ld" tool is not designed to be used with xargs. That is,
      -- if we have more object files than fit on a single command line then we
      -- have a slight problem. What we have to do is link files in batches into
      -- a temp object file and then include that one in the next batch.

      let simpleArgs :: [FilePath]
    simpleArgs  = [FilePath
    "-r", FilePath
    "-o", FilePath
    target]

          initialArgs :: [FilePath]
    initialArgs = [FilePath
    "-r", FilePath
    "-o", FilePath
    target]
          middleArgs :: [FilePath]
    middleArgs  = [FilePath
    "-r", FilePath
    "-o", FilePath
    target, FilePath
    tmpfile]
          finalArgs :: [FilePath]
    finalArgs   = [FilePath]
    middleArgs

          simple :: ProgramInvocation
    simple      = ConfiguredProgram -> [FilePath] -> ProgramInvocation
    programInvocation ConfiguredProgram
    ld [FilePath]
    simpleArgs
          initial :: ProgramInvocation
    initial     = ConfiguredProgram -> [FilePath] -> ProgramInvocation
    programInvocation ConfiguredProgram
    ld [FilePath]
    initialArgs
          middle :: ProgramInvocation
    middle      = ConfiguredProgram -> [FilePath] -> ProgramInvocation
    programInvocation ConfiguredProgram
    ld [FilePath]
    middleArgs
          final :: ProgramInvocation
    final       = ConfiguredProgram -> [FilePath] -> ProgramInvocation
    programInvocation ConfiguredProgram
    ld [FilePath]
    finalArgs

          targetDir :: FilePath
    targetDir   = FilePath -> FilePath
    takeDirectory FilePath
    target

          invokeWithResponesFile :: FilePath -> ProgramInvocation
          invokeWithResponesFile :: FilePath -> ProgramInvocation
    invokeWithResponesFile FilePath
    atFile =
            ConfiguredProgram -> [FilePath] -> ProgramInvocation
    programInvocation ConfiguredProgram
    ld ([FilePath] -> ProgramInvocation)
    -> [FilePath] -> ProgramInvocation
    forall a b. (a -> b) -> a -> b
    $ [FilePath]
    simpleArgs [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    '@' Char -> FilePath -> FilePath
    forall a. a -> [a] -> [a]
    : FilePath
    atFile]

          oldVersionManualOverride :: Bool
    oldVersionManualOverride =
            Bool -> Flag Bool -> Bool
    forall a. a -> Flag a -> a
    fromFlagOrDefault Bool
    False (Flag Bool -> Bool) -> Flag Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ConfigFlags -> Flag Bool
    configUseResponseFiles (ConfigFlags -> Flag Bool) -> ConfigFlags -> Flag Bool
    forall a b. (a -> b) -> a -> b
    $ LocalBuildInfo -> ConfigFlags
    configFlags LocalBuildInfo
    lbi
          -- Whether ghc's ar supports response files is a good proxy for
          -- whether ghc's ld supports them as well.
          responseArgumentsNotSupported :: Bool
    responseArgumentsNotSupported   =
            Bool -> Bool
    not (Compiler -> Bool
    arResponseFilesSupported (LocalBuildInfo -> Compiler
    compiler LocalBuildInfo
    lbi))

      if Bool
    oldVersionManualOverride Bool -> Bool -> Bool
    || Bool
    responseArgumentsNotSupported
        then
          [ProgramInvocation] -> IO ()
    run ([ProgramInvocation] -> IO ()) -> [ProgramInvocation] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ProgramInvocation
    -> (ProgramInvocation, ProgramInvocation, ProgramInvocation)
    -> [FilePath]
    -> [ProgramInvocation]
    multiStageProgramInvocation ProgramInvocation
    simple (ProgramInvocation
    initial, ProgramInvocation
    middle, ProgramInvocation
    final) [FilePath]
    files
        else
          Verbosity
    -> TempFileOptions
    -> FilePath
    -> FilePath
    -> Maybe TextEncoding
    -> [FilePath]
    -> (FilePath -> IO ())
    -> IO ()
    forall a.
    Verbosity
    -> TempFileOptions
    -> FilePath
    -> FilePath
    -> Maybe TextEncoding
    -> [FilePath]
    -> (FilePath -> IO a)
    -> IO a
    withResponseFile Verbosity
    verbosity TempFileOptions
    defaultTempFileOptions FilePath
    targetDir FilePath
    "ld.rsp" Maybe TextEncoding
    forall a. Maybe a
    Nothing [FilePath]
    files ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            \FilePath
    path -> Verbosity -> ProgramInvocation -> IO ()
    runProgramInvocation Verbosity
    verbosity (ProgramInvocation -> IO ()) -> ProgramInvocation -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ProgramInvocation
    invokeWithResponesFile FilePath
    path

      where
        tmpfile :: FilePath
    tmpfile        = FilePath
    target FilePath -> FilePath -> FilePath
    <.> FilePath
    "tmp" -- perhaps should use a proper temp file

        run :: [ProgramInvocation] -> IO ()
        run :: [ProgramInvocation] -> IO ()
    run []         = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        run [ProgramInvocation
    inv]      = Verbosity -> ProgramInvocation -> IO ()
    runProgramInvocation Verbosity
    verbosity ProgramInvocation
    inv
        run (ProgramInvocation
    inv:[ProgramInvocation]
    invs) = do Verbosity -> ProgramInvocation -> IO ()
    runProgramInvocation Verbosity
    verbosity ProgramInvocation
    inv
                            FilePath -> FilePath -> IO ()
    renameFile FilePath
    target FilePath
    tmpfile
                            [ProgramInvocation] -> IO ()
    run [ProgramInvocation]
    invs