    {-# 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 Distribution.Compat.Prelude
    import Prelude ()

    import Distribution.Simple.Compiler (arResponseFilesSupported)
    import Distribution.Simple.Flag
      ( fromFlagOrDefault
      )
    import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..))
    import Distribution.Simple.Program.ResponseFile
      ( withResponseFile
      )
    import Distribution.Simple.Program.Run
      ( ProgramInvocation
      , multiStageProgramInvocation
      , programInvocation
      , runProgramInvocation
      )
    import Distribution.Simple.Program.Types
      ( ConfiguredProgram (..)
      )
    import Distribution.Simple.Setup.Config
      ( 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