    {-# LANGUAGE DataKinds #-}

    module Distribution.Simple.GHC.Build where

    import Distribution.Compat.Prelude
    import Prelude ()

    import Control.Monad.IO.Class
    import Distribution.PackageDescription as PD hiding (buildInfo)
    import Distribution.Simple.Build.Inputs
    import Distribution.Simple.Flag (Flag)
    import Distribution.Simple.GHC.Build.ExtraSources
    import Distribution.Simple.GHC.Build.Link
    import Distribution.Simple.GHC.Build.Modules
    import Distribution.Simple.GHC.Build.Utils (compilerBuildWay, isHaskell, withDynFLib)
    import Distribution.Simple.LocalBuildInfo
    import Distribution.Simple.Program.Builtin (ghcProgram)
    import Distribution.Simple.Program.Db (requireProgram)
    import Distribution.Simple.Utils

    import Distribution.Types.ComponentLocalBuildInfo
    import Distribution.Types.PackageName.Magic (fakePackageId)
    import Distribution.Types.ParStrat
    import Distribution.Utils.NubList (fromNubListR)
    import Distribution.Utils.Path

    import System.FilePath (splitDirectories)

    {- Note [Build Target Dir vs Target Dir]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Where to place the build result (targetDir) and the build artifacts (buildTargetDir).

    \* For libraries, targetDir == buildTargetDir, where both the library and
    artifacts are put together.

    \* For executables or foreign libs, buildTargetDir == targetDir/<name-of-target-dir>-tmp, where
        the targetDir is the location where the target (e.g. the executable) is written to
        and buildTargetDir is where the compilation artifacts (e.g. Main.o) will live
      Arguably, this difference should not exist (#9498) (TODO)

    For instance, for a component `cabal-benchmarks`:
      targetDir == <buildDir>/cabal-benchmarks
      buildTargetDir == <buildDir>/cabal-benchmarks/cabal-benchmarks-tmp

    Or, for a library `Cabal`:
      targetDir == <buildDir>/.
      buildTargetDir == targetDir

    Furthermore, we need to account for the limit of characters in ghc
    invocations that different OSes constrain us to. Cabal invocations can
    rapidly reach this limit, in part, due to the long length of cabal v2
    prefixes. To minimize the likelihood, we use
    `tryMakeRelativeToWorkingDir` to shorten the paths used in invocations
    (see da6321bb).

    However, in executables, we don't do this. It seems that we don't need to do it
    for executable-like components because the linking step, instead of passing as
    an argument the path to each module, it simply passes the module name, the sources dir, and --make.
    RM: I believe we can use --make + module names instead of paths-to-objects
    for linking libraries too (2024-01) (TODO)
    -}

    -- | The main build phase of building a component.
    -- Includes building Haskell modules, extra build sources, and linking.
    build
      :: Flag ParStrat
      -> PackageDescription
      -> PreBuildComponentInputs
      -- ^ The context and component being built in it.
      -> IO ()
    build :: Flag ParStrat
    -> PackageDescription -> PreBuildComponentInputs -> IO ()
    build Flag ParStrat
    numJobs PackageDescription
    pkg_descr PreBuildComponentInputs
    pbci = do
      let
        verbosity :: Verbosity
    verbosity = PreBuildComponentInputs -> Verbosity
    buildVerbosity PreBuildComponentInputs
    pbci
        isLib :: Bool
    isLib = PreBuildComponentInputs -> Bool
    buildIsLib PreBuildComponentInputs
    pbci
        lbi :: LocalBuildInfo
    lbi = PreBuildComponentInputs -> LocalBuildInfo
    localBuildInfo PreBuildComponentInputs
    pbci
        bi :: BuildInfo
    bi = PreBuildComponentInputs -> BuildInfo
    buildBI PreBuildComponentInputs
    pbci
        clbi :: ComponentLocalBuildInfo
    clbi = PreBuildComponentInputs -> ComponentLocalBuildInfo
    buildCLBI PreBuildComponentInputs
    pbci
        isIndef :: Bool
    isIndef = ComponentLocalBuildInfo -> Bool
    componentIsIndefinite ComponentLocalBuildInfo
    clbi
        mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
    mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
    mbWorkDirLBI LocalBuildInfo
    lbi
        i :: SymbolicPathX allowAbsolute Pkg to -> FilePath
    i = LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
    forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
    LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
    interpretSymbolicPathLBI LocalBuildInfo
    lbi -- See Note [Symbolic paths] in Distribution.Utils.Path

      -- Create a few directories for building the component
      -- See Note [Build Target Dir vs Target Dir]
      let targetDir0 :: SymbolicPath Pkg ('Dir Build)
          targetDir0 :: SymbolicPath Pkg ('Dir Build)
    targetDir0 = LocalBuildInfo
    -> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
    componentBuildDir LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi
          buildTargetDir0 :: SymbolicPath Pkg ('Dir Artifacts)
          buildTargetDir0 :: SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
    buildTargetDir0
            -- Libraries use the target dir for building (see above)
            | Bool
    isLib = SymbolicPath Pkg ('Dir Build)
    -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
    forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
           (to2 :: FileOrDir).
    SymbolicPathX allowAbsolute from to1
    -> SymbolicPathX allowAbsolute from to2
    coerceSymbolicPath SymbolicPath Pkg ('Dir Build)
    targetDir0
            -- In other cases, use targetDir/<name-of-target-dir>-tmp
            | FilePath
    targetDirName : [FilePath]
    _ <- [FilePath] -> [FilePath]
    forall a. [a] -> [a]
    reverse ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [FilePath]
    splitDirectories (FilePath -> [FilePath]) -> FilePath -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ SymbolicPath Pkg ('Dir Build) -> FilePath
    forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
    SymbolicPathX allowAbsolute from to -> FilePath
    getSymbolicPath SymbolicPath Pkg ('Dir Build)
    targetDir0 =
                SymbolicPath Pkg ('Dir Build)
    -> SymbolicPathX 'AllowAbsolute Pkg ('Dir (ZonkAny 0))
    forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
           (to2 :: FileOrDir).
    SymbolicPathX allowAbsolute from to1
    -> SymbolicPathX allowAbsolute from to2
    coerceSymbolicPath SymbolicPath Pkg ('Dir Build)
    targetDir0 SymbolicPathX 'AllowAbsolute Pkg ('Dir (ZonkAny 0))
    -> SymbolicPathX 'OnlyRelative (ZonkAny 0) ('Dir Artifacts)
    -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
    forall p q r. PathLike p q r => p -> q -> r
    </> FilePath
    -> SymbolicPathX 'OnlyRelative (ZonkAny 0) ('Dir Artifacts)
    forall from (to :: FileOrDir).
    HasCallStack =>
    FilePath -> RelativePath from to
    makeRelativePathEx (FilePath
    targetDirName FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "-tmp")
            | Bool
    otherwise = FilePath -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "GHC.build: targetDir is empty"

      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 -> Bool -> FilePath -> IO ()
    createDirectoryIfMissingVerbose Verbosity
    verbosity Bool
    True (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ SymbolicPath Pkg ('Dir Build) -> FilePath
    forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
    SymbolicPathX allowAbsolute Pkg to -> FilePath
    i SymbolicPath Pkg ('Dir Build)
    targetDir0
        Verbosity -> Bool -> FilePath -> IO ()
    createDirectoryIfMissingVerbose Verbosity
    verbosity Bool
    True (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts) -> FilePath
    forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
    SymbolicPathX allowAbsolute Pkg to -> FilePath
    i SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
    buildTargetDir0

      -- See Note [Build Target Dir vs Target Dir] as well
      let targetDir :: SymbolicPath Pkg ('Dir Build)
    targetDir = SymbolicPath Pkg ('Dir Build)
    targetDir0 -- NB: no 'makeRelative'
      buildTargetDir <-
        if Bool
    isLib
          then -- NB: this might fail to make the buildTargetDir relative,
          -- as noted in #9776. Oh well.
            Maybe (SymbolicPath CWD ('Dir Pkg))
    -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
    -> IO (SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts))
    forall dir (to :: FileOrDir).
    Maybe (SymbolicPath CWD ('Dir dir))
    -> SymbolicPath dir to -> IO (SymbolicPath dir to)
    tryMakeRelative Maybe (SymbolicPath CWD ('Dir Pkg))
    mbWorkDir SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
    buildTargetDir0
          else SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
    -> IO (SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
    buildTargetDir0
      -- To preserve the previous behaviour, we don't use relative dirs for
      -- executables. Historically, this isn't needed to reduce the CLI limit
      -- (unlike for libraries) because we link executables with the module names
      -- instead of passing the path to object file -- that's something else we
      -- can now fix after the refactor lands.

      (ghcProg, _) <- liftIO $ requireProgram verbosity ghcProgram (withPrograms lbi)

      -- Ways which are wanted from configuration flags
      let wantedWays@(wantedLibWays, wantedFLibWay, wantedExeWay) = buildWays lbi

      -- Ways which are needed due to the compiler configuration
      let doingTH = BuildInfo -> Bool
    usesTemplateHaskellOrQQ BuildInfo
    bi
          defaultGhcWay = Compiler -> BuildWay
    compilerBuildWay (PreBuildComponentInputs -> Compiler
    buildCompiler PreBuildComponentInputs
    pbci)
          wantedModBuildWays = case PreBuildComponentInputs -> Component
    buildComponent PreBuildComponentInputs
    pbci of
            CLib Library
    _ -> Bool -> [BuildWay]
    wantedLibWays Bool
    isIndef
            CFLib ForeignLib
    fl -> [Bool -> BuildWay
    wantedFLibWay (ForeignLib -> Bool
    withDynFLib ForeignLib
    fl)]
            CExe Executable
    _ -> [BuildWay
    wantedExeWay]
            CTest TestSuite
    _ -> [BuildWay
    wantedExeWay]
            CBench Benchmark
    _ -> [BuildWay
    wantedExeWay]
          finalModBuildWays =
            [BuildWay]
    wantedModBuildWays
              [BuildWay] -> [BuildWay] -> [BuildWay]
    forall a. [a] -> [a] -> [a]
    ++ [BuildWay
    defaultGhcWay | Bool
    doingTH Bool -> Bool -> Bool
    && BuildWay
    defaultGhcWay BuildWay -> [BuildWay] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [BuildWay]
    wantedModBuildWays]
          compNameStr = ComponentName -> FilePath
    showComponentName (ComponentName -> FilePath) -> ComponentName -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Component -> ComponentName
    componentName (Component -> ComponentName) -> Component -> ComponentName
    forall a b. (a -> b) -> a -> b
    $ PreBuildComponentInputs -> Component
    buildComponent PreBuildComponentInputs
    pbci

      liftIO $ info verbosity ("Wanted module build ways(" ++ compNameStr ++ "): " ++ show wantedModBuildWays)
      liftIO $ info verbosity ("Final module build ways(" ++ compNameStr ++ "): " ++ show finalModBuildWays)
      -- We need a separate build and link phase, and C sources must be compiled
      -- after Haskell modules, because C sources may depend on stub headers
      -- generated from compiling Haskell modules (#842, #3294).
      (mbMainFile, inputModules) <- componentInputs buildTargetDir pkg_descr pbci
      let (hsMainFile, nonHsMainFile) =
            case mbMainFile of
              Just SymbolicPath Pkg 'File
    mainFile
                | PackageDescription -> PackageIdentifier
    PD.package PackageDescription
    pkg_descr PackageIdentifier -> PackageIdentifier -> Bool
    forall a. Eq a => a -> a -> Bool
    == PackageIdentifier
    fakePackageId
                    Bool -> Bool -> Bool
    || FilePath -> Bool
    isHaskell (SymbolicPath Pkg 'File -> FilePath
    forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
    SymbolicPathX allowAbsolute from to -> FilePath
    getSymbolicPath SymbolicPath Pkg 'File
    mainFile) ->
                    (SymbolicPath Pkg 'File -> Maybe (SymbolicPath Pkg 'File)
    forall a. a -> Maybe a
    Just SymbolicPath Pkg 'File
    mainFile, Maybe (SymbolicPath Pkg 'File)
    forall a. Maybe a
    Nothing)
                | Bool
    otherwise ->
                    (Maybe (SymbolicPath Pkg 'File)
    forall a. Maybe a
    Nothing, SymbolicPath Pkg 'File -> Maybe (SymbolicPath Pkg 'File)
    forall a. a -> Maybe a
    Just SymbolicPath Pkg 'File
    mainFile)
              Maybe (SymbolicPath Pkg 'File)
    Nothing -> (Maybe (SymbolicPath Pkg 'File)
    forall a. Maybe a
    Nothing, Maybe (SymbolicPath Pkg 'File)
    forall a. Maybe a
    Nothing)
      buildOpts <- buildHaskellModules numJobs ghcProg hsMainFile inputModules buildTargetDir finalModBuildWays pbci
      extraSources <- buildAllExtraSources nonHsMainFile ghcProg buildTargetDir wantedWays pbci
      linkOrLoadComponent
        ghcProg
        pkg_descr
        (fromNubListR extraSources)
        (buildTargetDir, targetDir)
        (wantedWays, buildOpts)
        pbci