{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Build
-- Copyright   :  Isaac Jones 2003-2005,
--                Ross Paterson 2006,
--                Duncan Coutts 2007-2008, 2012
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This is the entry point to actually building the modules in a package. It
-- doesn't actually do much itself, most of the work is delegated to
-- compiler-specific actions. It does do some non-compiler specific bits like
-- running pre-processors.
module Distribution.Simple.Build
  ( -- * Build
    build
  , build_setupHooks

    -- * Repl
  , repl
  , repl_setupHooks
  , startInterpreter

    -- * Build preparation
  , preBuildComponent
  , AutogenFile (..)
  , AutogenFileContents
  , writeBuiltinAutogenFiles
  , writeAutogenFiles

    -- ** Legacy functions
  , componentInitialBuildSteps
  , initialBuildSteps

    -- * Internal package database creation
  , createInternalPackageDB

    -- * Handling of internal build tools
  , addInternalBuildTools
  ) where

import Distribution.Compat.Prelude
import Distribution.Utils.Generic
import Prelude ()

import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.Dependency
import Distribution.Types.ExecutableScope
import Distribution.Types.ForeignLib
import Distribution.Types.LibraryVisibility
import Distribution.Types.LocalBuildInfo
import Distribution.Types.ModuleRenaming
import Distribution.Types.MungedPackageId
import Distribution.Types.MungedPackageName
import Distribution.Types.ParStrat
import Distribution.Types.TargetInfo
import Distribution.Utils.Path

import Distribution.Backpack
import Distribution.Backpack.DescribeUnitId
import Distribution.Package
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import qualified Distribution.Simple.PackageIndex as Index
import qualified Distribution.Simple.UHC as UHC

import Distribution.Simple.Build.Macros (generateCabalMacrosHeader)
import Distribution.Simple.Build.PackageInfoModule (generatePackageInfoModule)
import Distribution.Simple.Build.PathsModule (generatePathsModule, pkgPathEnvVar)
import qualified Distribution.Simple.Program.HcPkg as HcPkg

import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription
import Distribution.Simple.Compiler

import Distribution.Simple.BuildPaths
import Distribution.Simple.BuildTarget
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.Configure
import Distribution.Simple.Flag
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess
import Distribution.Simple.Program
import Distribution.Simple.Program.Builtin (haskellSuiteProgram)
import Distribution.Simple.Program.Db
import qualified Distribution.Simple.Program.GHC as GHC
import Distribution.Simple.Program.Types
import Distribution.Simple.Register
import Distribution.Simple.Setup.Build
import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Repl
import Distribution.Simple.SetupHooks.Internal
  ( BuildHooks (..)
  , BuildingWhat (..)
  , noBuildHooks
  )
import qualified Distribution.Simple.SetupHooks.Internal as SetupHooks
import qualified Distribution.Simple.SetupHooks.Rule as SetupHooks
import Distribution.Simple.ShowBuildInfo
import Distribution.Simple.Test.LibV09
import Distribution.Simple.Utils
import Distribution.Utils.Json
import Distribution.Utils.ShortText (ShortText, fromShortText, toShortText)

import Distribution.Pretty
import Distribution.System
import Distribution.Verbosity
import Distribution.Version (thisVersion)

import Distribution.Compat.Graph (IsNode (..))

import Control.Monad
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
import Distribution.Simple.Errors
import System.Directory (doesFileExist, removeFile)
import System.FilePath (takeDirectory)

-- -----------------------------------------------------------------------------

-- | Build the libraries and executables in this package.
build
  :: PackageDescription
  -- ^ Mostly information from the .cabal file
  -> LocalBuildInfo
  -- ^ Configuration information
  -> BuildFlags
  -- ^ Flags that the user passed to build
  -> [PPSuffixHandler]
  -- ^ preprocessors to run before compiling
  -> IO ()
build :: PackageDescription
-> LocalBuildInfo -> BuildFlags -> [PPSuffixHandler] -> IO ()
build = BuildHooks
-> PackageDescription
-> LocalBuildInfo
-> BuildFlags
-> [PPSuffixHandler]
-> IO ()
build_setupHooks BuildHooks
noBuildHooks

build_setupHooks
  :: BuildHooks
  -> PackageDescription
  -- ^ Mostly information from the .cabal file
  -> LocalBuildInfo
  -- ^ Configuration information
  -> BuildFlags
  -- ^ Flags that the user passed to build
  -> [PPSuffixHandler]
  -- ^ preprocessors to run before compiling
  -> IO ()
build_setupHooks :: BuildHooks
-> PackageDescription
-> LocalBuildInfo
-> BuildFlags
-> [PPSuffixHandler]
-> IO ()
build_setupHooks
  (BuildHooks{preBuildComponentRules :: BuildHooks -> Maybe PreBuildComponentRules
preBuildComponentRules = Maybe PreBuildComponentRules
mbPbcRules, postBuildComponentHook :: BuildHooks -> Maybe PostBuildComponentHook
postBuildComponentHook = Maybe PostBuildComponentHook
mbPostBuild})
  PackageDescription
pkg_descr
  LocalBuildInfo
lbi
  BuildFlags
flags
  [PPSuffixHandler]
suffixHandlers = do
    Verbosity -> Compiler -> BuildFlags -> IO ()
checkSemaphoreSupport Verbosity
verbosity (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) BuildFlags
flags
    targets <- Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [String]
-> IO [TargetInfo]
readTargetInfos Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi (BuildFlags -> [String]
buildTargets BuildFlags
flags)
    let componentsToBuild = PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi ((TargetInfo -> UnitId) -> [TargetInfo] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map TargetInfo -> Key TargetInfo
TargetInfo -> UnitId
forall a. IsNode a => a -> Key a
nodeKey [TargetInfo]
targets)
    info verbosity $
      "Component build order: "
        ++ intercalate
          ", "
          ( map
              (showComponentName . componentLocalName . targetCLBI)
              componentsToBuild
          )

    when (null targets) $
      -- Only bother with this message if we're building the whole package
      setupMessage verbosity "Building" (packageId pkg_descr)

    internalPackageDB <- createInternalPackageDB verbosity lbi distPref

    -- Before the actual building, dump out build-information.
    -- This way, if the actual compilation failed, the options have still been
    -- dumped.
    dumpBuildInfo verbosity distPref (configDumpBuildInfo (configFlags lbi)) pkg_descr lbi flags

    -- Now do the actual building
    (\InstalledPackageIndex -> TargetInfo -> IO InstalledPackageIndex
f -> (InstalledPackageIndex -> TargetInfo -> IO InstalledPackageIndex)
-> InstalledPackageIndex -> [TargetInfo] -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ InstalledPackageIndex -> TargetInfo -> IO InstalledPackageIndex
f (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi) [TargetInfo]
componentsToBuild) $ \InstalledPackageIndex
index TargetInfo
target -> do
      let comp :: Component
comp = TargetInfo -> Component
targetComponent TargetInfo
target
          clbi :: ComponentLocalBuildInfo
clbi = TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target
          bi :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo Component
comp
          -- Include any build-tool-depends on build tools internal to the current package.
          progs' :: ProgramDb
progs' = PackageDescription
-> LocalBuildInfo -> BuildInfo -> ProgramDb -> ProgramDb
addInternalBuildTools PackageDescription
pkg_descr LocalBuildInfo
lbi BuildInfo
bi (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
          lbi' :: LocalBuildInfo
lbi' =
            LocalBuildInfo
lbi
              { withPrograms = progs'
              , withPackageDB = withPackageDB lbi ++ [internalPackageDB]
              , installedPkgs = index
              }
          runPreBuildHooks :: LocalBuildInfo -> TargetInfo -> IO ()
          runPreBuildHooks :: LocalBuildInfo -> TargetInfo -> IO ()
runPreBuildHooks LocalBuildInfo
lbi2 TargetInfo
tgt =
            let inputs :: PreBuildComponentInputs
inputs =
                  SetupHooks.PreBuildComponentInputs
                    { buildingWhat :: BuildingWhat
SetupHooks.buildingWhat = BuildFlags -> BuildingWhat
BuildNormal BuildFlags
flags
                    , localBuildInfo :: LocalBuildInfo
SetupHooks.localBuildInfo = LocalBuildInfo
lbi2
                    , targetInfo :: TargetInfo
SetupHooks.targetInfo = TargetInfo
tgt
                    }
             in Maybe PreBuildComponentRules
-> (PreBuildComponentRules -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe PreBuildComponentRules
mbPbcRules ((PreBuildComponentRules -> IO ()) -> IO ())
-> (PreBuildComponentRules -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PreBuildComponentRules
pbcRules -> do
                  (ruleFromId, _mons) <- Verbosity
-> PreBuildComponentInputs
-> PreBuildComponentRules
-> IO (Map RuleId Rule, [MonitorFilePath])
forall env.
Verbosity
-> env -> Rules env -> IO (Map RuleId Rule, [MonitorFilePath])
SetupHooks.computeRules Verbosity
verbosity PreBuildComponentInputs
inputs PreBuildComponentRules
pbcRules
                  SetupHooks.executeRules verbosity lbi2 tgt ruleFromId
      (LocalBuildInfo -> TargetInfo -> IO ())
-> Verbosity -> LocalBuildInfo -> TargetInfo -> IO ()
preBuildComponent LocalBuildInfo -> TargetInfo -> IO ()
runPreBuildHooks Verbosity
verbosity LocalBuildInfo
lbi' TargetInfo
target
      let numJobs :: Flag (Maybe Int)
numJobs = BuildFlags -> Flag (Maybe Int)
buildNumJobs BuildFlags
flags
      par_strat <-
        ParStratX String -> Flag (ParStratX String)
forall a. a -> Flag a
toFlag (ParStratX String -> Flag (ParStratX String))
-> IO (ParStratX String) -> IO (Flag (ParStratX String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case BuildFlags -> Flag String
buildUseSemaphore BuildFlags
flags of
          Flag String
sem_name -> case Flag (Maybe Int)
numJobs of
            Flag{} -> do
              Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Ignoring -j due to --semaphore"
              ParStratX String -> IO (ParStratX String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParStratX String -> IO (ParStratX String))
-> ParStratX String -> IO (ParStratX String)
forall a b. (a -> b) -> a -> b
$ String -> ParStratX String
forall sem. sem -> ParStratX sem
UseSem String
sem_name
            Flag (Maybe Int)
NoFlag -> ParStratX String -> IO (ParStratX String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParStratX String -> IO (ParStratX String))
-> ParStratX String -> IO (ParStratX String)
forall a b. (a -> b) -> a -> b
$ String -> ParStratX String
forall sem. sem -> ParStratX sem
UseSem String
sem_name
          Flag String
NoFlag -> ParStratX String -> IO (ParStratX String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParStratX String -> IO (ParStratX String))
-> ParStratX String -> IO (ParStratX String)
forall a b. (a -> b) -> a -> b
$ case Flag (Maybe Int)
numJobs of
            Flag Maybe Int
n -> Maybe Int -> ParStratX String
forall sem. Maybe Int -> ParStratX sem
NumJobs Maybe Int
n
            Flag (Maybe Int)
NoFlag -> ParStratX String
forall sem. ParStratX sem
Serial
      mb_ipi <-
        buildComponent
          flags
          par_strat
          pkg_descr
          lbi'
          suffixHandlers
          comp
          clbi
          distPref
      let postBuildInputs =
            SetupHooks.PostBuildComponentInputs
              { buildFlags :: BuildFlags
SetupHooks.buildFlags = BuildFlags
flags
              , localBuildInfo :: LocalBuildInfo
SetupHooks.localBuildInfo = LocalBuildInfo
lbi'
              , targetInfo :: TargetInfo
SetupHooks.targetInfo = TargetInfo
target
              }
      for_ mbPostBuild ($ postBuildInputs)
      return (maybe index (Index.insert `flip` index) mb_ipi)

    return ()
    where
      distPref :: SymbolicPath Pkg ('Dir Dist)
distPref = Flag (SymbolicPath Pkg ('Dir Dist)) -> SymbolicPath Pkg ('Dir Dist)
forall a. WithCallStack (Flag a -> a)
fromFlag (BuildFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
buildDistPref BuildFlags
flags)
      verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags)

-- | Check for conditions that would prevent the build from succeeding.
checkSemaphoreSupport
  :: Verbosity -> Compiler -> BuildFlags -> IO ()
checkSemaphoreSupport :: Verbosity -> Compiler -> BuildFlags -> IO ()
checkSemaphoreSupport Verbosity
verbosity Compiler
comp BuildFlags
flags = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Compiler -> Bool
jsemSupported Compiler
comp Bool -> Bool -> Bool
|| (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe (BuildFlags -> Flag String
buildUseSemaphore BuildFlags
flags)))) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
CheckSemaphoreSupport

-- | Write available build information for 'LocalBuildInfo' to disk.
--
-- Dumps detailed build information 'build-info.json' to the given directory.
-- Build information contains basics such as compiler details, but also
-- lists what modules a component contains and how to compile the component, assuming
-- lib:Cabal made sure that dependencies are up-to-date.
dumpBuildInfo
  :: Verbosity
  -> SymbolicPath Pkg (Dir Dist)
  -- ^ To which directory should the build-info be dumped?
  -> Flag DumpBuildInfo
  -- ^ Should we dump detailed build information for this component?
  -> PackageDescription
  -- ^ Mostly information from the .cabal file
  -> LocalBuildInfo
  -- ^ Configuration information
  -> BuildFlags
  -- ^ Flags that the user passed to build
  -> IO ()
dumpBuildInfo :: Verbosity
-> SymbolicPath Pkg ('Dir Dist)
-> Flag DumpBuildInfo
-> PackageDescription
-> LocalBuildInfo
-> BuildFlags
-> IO ()
dumpBuildInfo Verbosity
verbosity SymbolicPath Pkg ('Dir Dist)
distPref Flag DumpBuildInfo
dumpBuildInfoFlag PackageDescription
pkg_descr LocalBuildInfo
lbi BuildFlags
flags = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldDumpBuildInfo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    -- Changing this line might break consumers of the dumped build info.
    -- Announce changes on mailing lists!
    let activeTargets :: [TargetInfo]
activeTargets = PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi
    Verbosity -> String -> IO ()
info Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      String
"Dump build information for: "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
          String
", "
          ( (TargetInfo -> String) -> [TargetInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
              (ComponentName -> String
showComponentName (ComponentName -> String)
-> (TargetInfo -> ComponentName) -> TargetInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentLocalBuildInfo -> ComponentName
componentLocalName (ComponentLocalBuildInfo -> ComponentName)
-> (TargetInfo -> ComponentLocalBuildInfo)
-> TargetInfo
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetInfo -> ComponentLocalBuildInfo
targetCLBI)
              [TargetInfo]
activeTargets
          )

    (compilerProg, _) <- case CompilerFlavor -> Maybe Program
flavorToProgram (Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)) of
      Maybe Program
Nothing ->
        Verbosity -> CabalException -> IO (ConfiguredProgram, ProgramDb)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO (ConfiguredProgram, ProgramDb))
-> CabalException -> IO (ConfiguredProgram, ProgramDb)
forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> CabalException
UnknownCompilerFlavor (Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi))
      Just Program
program -> Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
program (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)

    wdir <- absoluteWorkingDirLBI lbi
    let (warns, json) = mkBuildInfo wdir pkg_descr lbi flags (compilerProg, compiler lbi) activeTargets
        buildInfoText = Json -> ByteString
renderJson Json
json
    unless (null warns) $
      warn verbosity $
        "Encountered warnings while dumping build-info:\n"
          ++ unlines warns
    LBS.writeFile buildInfoFile buildInfoText

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
shouldDumpBuildInfo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    -- Remove existing build-info.json as it might be outdated now.
    exists <- String -> IO Bool
doesFileExist String
buildInfoFile
    when exists $ removeFile buildInfoFile
  where
    buildInfoFile :: String
buildInfoFile = LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg 'File -> String
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPathLBI LocalBuildInfo
lbi (SymbolicPathX 'AllowAbsolute Pkg 'File -> String)
-> SymbolicPathX 'AllowAbsolute Pkg 'File -> String
forall a b. (a -> b) -> a -> b
$ SymbolicPath Pkg ('Dir Dist)
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall root.
SymbolicPath root ('Dir Dist) -> SymbolicPath root 'File
buildInfoPref SymbolicPath Pkg ('Dir Dist)
distPref
    shouldDumpBuildInfo :: Bool
shouldDumpBuildInfo = DumpBuildInfo -> Flag DumpBuildInfo -> DumpBuildInfo
forall a. a -> Flag a -> a
fromFlagOrDefault DumpBuildInfo
NoDumpBuildInfo Flag DumpBuildInfo
dumpBuildInfoFlag DumpBuildInfo -> DumpBuildInfo -> Bool
forall a. Eq a => a -> a -> Bool
== DumpBuildInfo
DumpBuildInfo

    -- \| Given the flavor of the compiler, try to find out
    -- which program we need.
    flavorToProgram :: CompilerFlavor -> Maybe Program
    flavorToProgram :: CompilerFlavor -> Maybe Program
flavorToProgram CompilerFlavor
GHC = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
ghcProgram
    flavorToProgram CompilerFlavor
GHCJS = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
ghcjsProgram
    flavorToProgram CompilerFlavor
UHC = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
uhcProgram
    flavorToProgram CompilerFlavor
JHC = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
jhcProgram
    flavorToProgram HaskellSuite{} = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
haskellSuiteProgram
    flavorToProgram CompilerFlavor
_ = Maybe Program
forall a. Maybe a
Nothing

repl
  :: PackageDescription
  -- ^ Mostly information from the .cabal file
  -> LocalBuildInfo
  -- ^ Configuration information
  -> ReplFlags
  -- ^ Flags that the user passed to build
  -> [PPSuffixHandler]
  -- ^ preprocessors to run before compiling
  -> [String]
  -> IO ()
repl :: PackageDescription
-> LocalBuildInfo
-> ReplFlags
-> [PPSuffixHandler]
-> [String]
-> IO ()
repl = BuildHooks
-> PackageDescription
-> LocalBuildInfo
-> ReplFlags
-> [PPSuffixHandler]
-> [String]
-> IO ()
repl_setupHooks BuildHooks
noBuildHooks

repl_setupHooks
  :: BuildHooks
  -- ^ build hook
  -> PackageDescription
  -- ^ Mostly information from the .cabal file
  -> LocalBuildInfo
  -- ^ Configuration information
  -> ReplFlags
  -- ^ Flags that the user passed to build
  -> [PPSuffixHandler]
  -- ^ preprocessors to run before compiling
  -> [String]
  -> IO ()
repl_setupHooks :: BuildHooks
-> PackageDescription
-> LocalBuildInfo
-> ReplFlags
-> [PPSuffixHandler]
-> [String]
-> IO ()
repl_setupHooks
  (BuildHooks{preBuildComponentRules :: BuildHooks -> Maybe PreBuildComponentRules
preBuildComponentRules = Maybe PreBuildComponentRules
mbPbcRules})
  PackageDescription
pkg_descr
  LocalBuildInfo
lbi
  ReplFlags
flags
  [PPSuffixHandler]
suffixHandlers
  [String]
args = do
    let distPref :: SymbolicPath Pkg ('Dir Dist)
distPref = Flag (SymbolicPath Pkg ('Dir Dist)) -> SymbolicPath Pkg ('Dir Dist)
forall a. WithCallStack (Flag a -> a)
fromFlag (ReplFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
replDistPref ReplFlags
flags)
        verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (ReplFlags -> Flag Verbosity
replVerbosity ReplFlags
flags)

    target <-
      Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [String]
-> IO [TargetInfo]
readTargetInfos Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi [String]
args IO [TargetInfo] -> ([TargetInfo] -> IO TargetInfo) -> IO TargetInfo
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[TargetInfo]
r -> case [TargetInfo]
r of
        -- This seems DEEPLY questionable.
        [] -> case PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi of
          (TargetInfo
target : [TargetInfo]
_) -> TargetInfo -> IO TargetInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TargetInfo
target
          [] -> Verbosity -> CabalException -> IO TargetInfo
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO TargetInfo)
-> CabalException -> IO TargetInfo
forall a b. (a -> b) -> a -> b
$ CabalException
FailedToDetermineTarget
        [TargetInfo
target] -> TargetInfo -> IO TargetInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TargetInfo
target
        [TargetInfo]
_ -> Verbosity -> CabalException -> IO TargetInfo
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO TargetInfo)
-> CabalException -> IO TargetInfo
forall a b. (a -> b) -> a -> b
$ CabalException
NoMultipleTargets
    let componentsToBuild = PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi [TargetInfo -> Key TargetInfo
forall a. IsNode a => a -> Key a
nodeKey TargetInfo
target]
    debug verbosity $
      "Component build order: "
        ++ intercalate
          ", "
          ( map
              (showComponentName . componentLocalName . targetCLBI)
              componentsToBuild
          )

    internalPackageDB <- createInternalPackageDB verbosity lbi distPref

    let lbiForComponent Component
comp LocalBuildInfo
lbi' =
          LocalBuildInfo
lbi'
            { withPackageDB = withPackageDB lbi ++ [internalPackageDB]
            , withPrograms =
                -- Include any build-tool-depends on build tools internal to the current package.
                addInternalBuildTools
                  pkg_descr
                  lbi'
                  (componentBuildInfo comp)
                  (withPrograms lbi')
            }
        runPreBuildHooks :: LocalBuildInfo -> TargetInfo -> IO ()
        runPreBuildHooks LocalBuildInfo
lbi2 TargetInfo
tgt =
          let inputs :: PreBuildComponentInputs
inputs =
                SetupHooks.PreBuildComponentInputs
                  { buildingWhat :: BuildingWhat
SetupHooks.buildingWhat = ReplFlags -> BuildingWhat
BuildRepl ReplFlags
flags
                  , localBuildInfo :: LocalBuildInfo
SetupHooks.localBuildInfo = LocalBuildInfo
lbi2
                  , targetInfo :: TargetInfo
SetupHooks.targetInfo = TargetInfo
tgt
                  }
           in Maybe PreBuildComponentRules
-> (PreBuildComponentRules -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe PreBuildComponentRules
mbPbcRules ((PreBuildComponentRules -> IO ()) -> IO ())
-> (PreBuildComponentRules -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PreBuildComponentRules
pbcRules -> do
                (ruleFromId, _mons) <- Verbosity
-> PreBuildComponentInputs
-> PreBuildComponentRules
-> IO (Map RuleId Rule, [MonitorFilePath])
forall env.
Verbosity
-> env -> Rules env -> IO (Map RuleId Rule, [MonitorFilePath])
SetupHooks.computeRules Verbosity
verbosity PreBuildComponentInputs
inputs PreBuildComponentRules
pbcRules
                SetupHooks.executeRules verbosity lbi2 tgt ruleFromId

    -- build any dependent components
    sequence_
      [ do
        let clbi = TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
subtarget
            comp = TargetInfo -> Component
targetComponent TargetInfo
subtarget
            lbi' = Component -> LocalBuildInfo -> LocalBuildInfo
lbiForComponent Component
comp LocalBuildInfo
lbi
        preBuildComponent runPreBuildHooks verbosity lbi' subtarget
        buildComponent
          (mempty{buildCommonFlags = mempty{setupVerbosity = toFlag verbosity}})
          NoFlag
          pkg_descr
          lbi'
          suffixHandlers
          comp
          clbi
          distPref
      | subtarget <- safeInit componentsToBuild
      ]

    -- REPL for target components
    let clbi = TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target
        comp = TargetInfo -> Component
targetComponent TargetInfo
target
        lbi' = Component -> LocalBuildInfo -> LocalBuildInfo
lbiForComponent Component
comp LocalBuildInfo
lbi
    preBuildComponent runPreBuildHooks verbosity lbi' target
    replComponent flags verbosity pkg_descr lbi' suffixHandlers comp clbi distPref

-- | Start an interpreter without loading any package files.
startInterpreter
  :: Verbosity
  -> ProgramDb
  -> Compiler
  -> Platform
  -> PackageDBStack
  -> IO ()
startInterpreter :: Verbosity
-> ProgramDb -> Compiler -> Platform -> PackageDBStack -> IO ()
startInterpreter Verbosity
verbosity ProgramDb
programDb Compiler
comp Platform
platform PackageDBStack
packageDBs =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC -> Verbosity
-> ProgramDb -> Compiler -> Platform -> PackageDBStack -> IO ()
GHC.startInterpreter Verbosity
verbosity ProgramDb
programDb Compiler
comp Platform
platform PackageDBStack
packageDBs
    CompilerFlavor
GHCJS -> Verbosity
-> ProgramDb -> Compiler -> Platform -> PackageDBStack -> IO ()
GHCJS.startInterpreter Verbosity
verbosity ProgramDb
programDb Compiler
comp Platform
platform PackageDBStack
packageDBs
    CompilerFlavor
_ -> Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
REPLNotSupported

buildComponent
  :: BuildFlags
  -> Flag ParStrat
  -> PackageDescription
  -> LocalBuildInfo
  -> [PPSuffixHandler]
  -> Component
  -> ComponentLocalBuildInfo
  -> SymbolicPath Pkg (Dir Dist)
  -> IO (Maybe InstalledPackageInfo)
buildComponent :: BuildFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> Component
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Dist)
-> IO (Maybe InstalledPackageInfo)
buildComponent BuildFlags
flags Flag (ParStratX String)
_ PackageDescription
_ LocalBuildInfo
_ [PPSuffixHandler]
_ (CTest TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteUnsupported TestType
tt}) ComponentLocalBuildInfo
_ SymbolicPath Pkg ('Dir Dist)
_ =
  Verbosity -> CabalException -> IO (Maybe InstalledPackageInfo)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags) (CabalException -> IO (Maybe InstalledPackageInfo))
-> CabalException -> IO (Maybe InstalledPackageInfo)
forall a b. (a -> b) -> a -> b
$
    TestType -> CabalException
NoSupportBuildingTestSuite TestType
tt
buildComponent BuildFlags
flags Flag (ParStratX String)
_ PackageDescription
_ LocalBuildInfo
_ [PPSuffixHandler]
_ (CBench Benchmark{benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkInterface = BenchmarkUnsupported BenchmarkType
tt}) ComponentLocalBuildInfo
_ SymbolicPath Pkg ('Dir Dist)
_ =
  Verbosity -> CabalException -> IO (Maybe InstalledPackageInfo)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags) (CabalException -> IO (Maybe InstalledPackageInfo))
-> CabalException -> IO (Maybe InstalledPackageInfo)
forall a b. (a -> b) -> a -> b
$
    BenchmarkType -> CabalException
NoSupportBuildingBenchMark BenchmarkType
tt
buildComponent
  BuildFlags
flags
  Flag (ParStratX String)
numJobs
  PackageDescription
pkg_descr
  LocalBuildInfo
lbi0
  [PPSuffixHandler]
suffixHandlers
  comp :: Component
comp@( CTest
          test :: TestSuite
test@TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteLibV09{}}
        )
  ComponentLocalBuildInfo
clbi -- This ComponentLocalBuildInfo corresponds to a detailed
  -- test suite and not a real component. It should not
  -- be used, except to construct the CLBIs for the
  -- library and stub executable that will actually be
  -- built.
  SymbolicPath Pkg ('Dir Dist)
distPref =
    do
      inplaceDir <- LocalBuildInfo -> IO (AbsolutePath ('Dir Pkg))
absoluteWorkingDirLBI LocalBuildInfo
lbi0
      let verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags
      let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) =
            testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 inplaceDir distPref
      preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers
      extras <- preprocessExtras verbosity comp lbi -- TODO find cpphs processed files
      (genDir, generatedExtras) <- generateCode (testCodeGenerators test) (testName test) pkg_descr (testBuildInfo test) lbi clbi verbosity
      setupMessage'
        verbosity
        "Building"
        (packageId pkg_descr)
        (componentLocalName clbi)
        (maybeComponentInstantiatedWith clbi)
      let libbi = Library -> BuildInfo
libBuildInfo Library
lib
          lib' = Library
lib{libBuildInfo = addSrcDir (addExtraOtherModules libbi generatedExtras) genDir}
      buildLib flags numJobs pkg lbi lib' libClbi
      -- NB: need to enable multiple instances here, because on 7.10+
      -- the package name is the same as the library, and we still
      -- want the registration to go through.
      registerPackage
        verbosity
        (compiler lbi)
        (withPrograms lbi)
        (mbWorkDirLBI lbi)
        (withPackageDB lbi)
        ipi
        HcPkg.defaultRegisterOptions
          { HcPkg.registerMultiInstance = True
          }
      let ebi = Executable -> BuildInfo
buildInfo Executable
exe
          -- NB: The stub executable is linked against the test-library
          --     which already contains all `other-modules`, so we need
          --     to remove those from the stub-exe's build-info
          exe' = Executable
exe{buildInfo = (addExtraCSources ebi extras){otherModules = []}}
      buildExe verbosity numJobs pkg_descr lbi exe' exeClbi
      return Nothing -- Can't depend on test suite
buildComponent
  BuildFlags
flags
  Flag (ParStratX String)
numJobs
  PackageDescription
pkg_descr
  LocalBuildInfo
lbi
  [PPSuffixHandler]
suffixHandlers
  Component
comp
  ComponentLocalBuildInfo
clbi
  SymbolicPath Pkg ('Dir Dist)
distPref =
    do
      let 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
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags
      PackageDescription
-> Component
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessComponent PackageDescription
pkg_descr Component
comp LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Bool
False Verbosity
verbosity [PPSuffixHandler]
suffixHandlers
      extras <- Verbosity
-> Component
-> LocalBuildInfo
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
preprocessExtras Verbosity
verbosity Component
comp LocalBuildInfo
lbi
      setupMessage'
        verbosity
        "Building"
        (packageId pkg_descr)
        (componentLocalName clbi)
        (maybeComponentInstantiatedWith clbi)
      case comp of
        CLib Library
lib -> do
          let libbi :: BuildInfo
libbi = Library -> BuildInfo
libBuildInfo Library
lib
              lib' :: Library
lib' =
                Library
lib
                  { libBuildInfo =
                      flip addExtraAsmSources extras $
                        flip addExtraCmmSources extras $
                          flip addExtraCxxSources extras $
                            flip addExtraCSources extras $
                              flip addExtraJsSources extras $
                                libbi
                  }

          BuildFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib BuildFlags
flags Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib' ComponentLocalBuildInfo
clbi

          let oneComponentRequested :: ComponentRequestedSpec -> Bool
oneComponentRequested (OneComponentRequestedSpec ComponentName
_) = Bool
True
              oneComponentRequested ComponentRequestedSpec
_ = Bool
False
          -- Don't register inplace if we're only building a single component;
          -- it's not necessary because there won't be any subsequent builds
          -- that need to tag us
          if (Bool -> Bool
not (ComponentRequestedSpec -> Bool
oneComponentRequested (LocalBuildInfo -> ComponentRequestedSpec
componentEnabledSpec LocalBuildInfo
lbi)))
            then do
              -- Register the library in-place, so exes can depend
              -- on internally defined libraries.
              inplaceDir <- LocalBuildInfo -> IO (AbsolutePath ('Dir Pkg))
absoluteWorkingDirLBI LocalBuildInfo
lbi
              let
                -- The in place registration uses the "-inplace" suffix, not an ABI hash
                installedPkgInfo =
                  AbsolutePath ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstalledPackageInfo
inplaceInstalledPackageInfo
                    AbsolutePath ('Dir Pkg)
inplaceDir
                    SymbolicPath Pkg ('Dir Dist)
distPref
                    PackageDescription
pkg_descr
                    -- NB: Use a fake ABI hash to avoid
                    -- needing to recompute it every build.
                    (String -> AbiHash
mkAbiHash String
"inplace")
                    Library
lib'
                    LocalBuildInfo
lbi
                    ComponentLocalBuildInfo
clbi
              debug verbosity $ "Registering inplace:\n" ++ (IPI.showInstalledPackageInfo installedPkgInfo)
              registerPackage
                verbosity
                (compiler lbi)
                (withPrograms lbi)
                (flagToMaybe $ buildWorkingDir flags)
                (withPackageDB lbi)
                installedPkgInfo
                HcPkg.defaultRegisterOptions
                  { HcPkg.registerMultiInstance = True
                  }
              return (Just installedPkgInfo)
            else Maybe InstalledPackageInfo -> IO (Maybe InstalledPackageInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InstalledPackageInfo
forall a. Maybe a
Nothing
        CFLib ForeignLib
flib -> do
          Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
buildFLib Verbosity
verbosity Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi ForeignLib
flib ComponentLocalBuildInfo
clbi
          Maybe InstalledPackageInfo -> IO (Maybe InstalledPackageInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InstalledPackageInfo
forall a. Maybe a
Nothing
        CExe Executable
exe -> do
          let ebi :: BuildInfo
ebi = Executable -> BuildInfo
buildInfo Executable
exe
              exe' :: Executable
exe' = Executable
exe{buildInfo = addExtraCSources ebi extras}
          Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe Verbosity
verbosity Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe' ComponentLocalBuildInfo
clbi
          Maybe InstalledPackageInfo -> IO (Maybe InstalledPackageInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InstalledPackageInfo
forall a. Maybe a
Nothing
        CTest test :: TestSuite
test@TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteExeV10{}} -> do
          let exe :: Executable
exe = TestSuite -> Executable
testSuiteExeV10AsExe TestSuite
test
          (genDir, generatedExtras) <- [String]
-> UnqualComponentName
-> PackageDescription
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Verbosity
-> IO (SymbolicPath Pkg ('Dir Source), [ModuleName])
generateCode (TestSuite -> [String]
testCodeGenerators TestSuite
test) (TestSuite -> UnqualComponentName
testName TestSuite
test) PackageDescription
pkg_descr (TestSuite -> BuildInfo
testBuildInfo TestSuite
test) LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Verbosity
verbosity
          let ebi = Executable -> BuildInfo
buildInfo Executable
exe
              exe' = Executable
exe{buildInfo = addSrcDir (addExtraOtherModules (addExtraCSources ebi extras) generatedExtras) genDir} -- todo extend hssrcdirs
          buildExe verbosity numJobs pkg_descr lbi exe' clbi
          return Nothing
        CBench bm :: Benchmark
bm@Benchmark{benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkInterface = BenchmarkExeV10{}} -> do
          let exe :: Executable
exe = Benchmark -> Executable
benchmarkExeV10asExe Benchmark
bm
          let ebi :: BuildInfo
ebi = Executable -> BuildInfo
buildInfo Executable
exe
              exe' :: Executable
exe' = Executable
exe{buildInfo = addExtraCSources ebi extras}
          Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe Verbosity
verbosity Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe' ComponentLocalBuildInfo
clbi
          Maybe InstalledPackageInfo -> IO (Maybe InstalledPackageInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InstalledPackageInfo
forall a. Maybe a
Nothing
#if __GLASGOW_HASKELL__ < 811
-- silence pattern-match warnings prior to GHC 9.0
        _ -> error "impossible"
#endif

generateCode
  :: [String]
  -> UnqualComponentName
  -> PackageDescription
  -> BuildInfo
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> Verbosity
  -> IO (SymbolicPath Pkg (Dir Source), [ModuleName.ModuleName])
generateCode :: [String]
-> UnqualComponentName
-> PackageDescription
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Verbosity
-> IO (SymbolicPath Pkg ('Dir Source), [ModuleName])
generateCode [String]
codeGens UnqualComponentName
nm PackageDescription
pdesc BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Verbosity
verbosity = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
codeGens) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 4) -> String
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> String
i SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 4)
forall {c3 :: FileOrDir}. SymbolicPathX 'AllowAbsolute Pkg c3
tgtDir
  (\[ModuleName]
x -> (SymbolicPath Pkg ('Dir Source)
forall {c3 :: FileOrDir}. SymbolicPathX 'AllowAbsolute Pkg c3
tgtDir, [ModuleName]
x)) ([ModuleName] -> (SymbolicPath Pkg ('Dir Source), [ModuleName]))
-> ([[ModuleName]] -> [ModuleName])
-> [[ModuleName]]
-> (SymbolicPath Pkg ('Dir Source), [ModuleName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ModuleName]] -> [ModuleName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ModuleName]] -> (SymbolicPath Pkg ('Dir Source), [ModuleName]))
-> IO [[ModuleName]]
-> IO (SymbolicPath Pkg ('Dir Source), [ModuleName])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [ModuleName]) -> [String] -> IO [[ModuleName]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO [ModuleName]
go [String]
codeGens
  where
    allLibs :: [Library]
allLibs = (([Library] -> [Library])
-> (Library -> [Library] -> [Library])
-> Maybe Library
-> [Library]
-> [Library]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Library] -> [Library]
forall a. a -> a
id (:) (Maybe Library -> [Library] -> [Library])
-> Maybe Library -> [Library] -> [Library]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Maybe Library
library PackageDescription
pdesc) (PackageDescription -> [Library]
subLibraries PackageDescription
pdesc)
    dependencyLibs :: [Library]
dependencyLibs = (Library -> Bool) -> [Library] -> [Library]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Library -> Bool
forall a b. a -> b -> a
const Bool
True) [Library]
allLibs -- intersect with componentPackageDeps of clbi
    srcDirs :: [SymbolicPath Pkg ('Dir Source)]
srcDirs = (Library -> [SymbolicPath Pkg ('Dir Source)])
-> [Library] -> [SymbolicPath Pkg ('Dir Source)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [SymbolicPath Pkg ('Dir Source)]
hsSourceDirs (BuildInfo -> [SymbolicPath Pkg ('Dir Source)])
-> (Library -> BuildInfo)
-> Library
-> [SymbolicPath Pkg ('Dir Source)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo) [Library]
dependencyLibs
    nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    i :: SymbolicPathX allowAbsolute Pkg to -> String
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> String
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> String
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
    tgtDir :: SymbolicPathX 'AllowAbsolute Pkg c3
tgtDir = LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
-> RelativePath Build c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> String -> RelativePath Build c3
forall from (to :: FileOrDir).
HasCallStack =>
String -> RelativePath from to
makeRelativePathEx (String
nm' String -> String -> String
forall p q r. PathLike p q r => p -> q -> r
</> String
nm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-gen")
    go :: String -> IO [ModuleName.ModuleName]
    go :: String -> IO [ModuleName]
go String
codeGenProg =
      (String -> ModuleName) -> [String] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ModuleName
forall a. IsString a => String -> a
fromString ([String] -> [ModuleName])
-> (String -> [String]) -> String -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
        (String -> [ModuleName]) -> IO String -> IO [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> Program
-> ProgramDb
-> [String]
-> IO String
forall to.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir to))
-> Program
-> ProgramDb
-> [String]
-> IO String
getDbProgramOutputCwd
          Verbosity
verbosity
          Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
          (String -> Program
simpleProgram String
codeGenProg)
          (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
          ( (SymbolicPath Pkg ('Dir Source) -> String)
-> [SymbolicPath Pkg ('Dir Source)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath Pkg ('Dir Source) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
interpretSymbolicPathCWD (SymbolicPath Pkg ('Dir Source)
forall {c3 :: FileOrDir}. SymbolicPathX 'AllowAbsolute Pkg c3
tgtDir SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: [SymbolicPath Pkg ('Dir Source)]
srcDirs)
              [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ( String
"--"
                    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Compiler -> Platform -> GhcOptions -> [String]
GHC.renderGhcOptions (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) (Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir (ZonkAny 3))
-> GhcOptions
forall build.
Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir build)
-> GhcOptions
GHC.componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi SymbolicPath Pkg ('Dir (ZonkAny 3))
forall {c3 :: FileOrDir}. SymbolicPathX 'AllowAbsolute Pkg c3
tgtDir)
                 )
          )

-- | Add extra C sources generated by preprocessing to build
-- information.
addExtraCSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCSources :: BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> BuildInfo
addExtraCSources BuildInfo
bi [SymbolicPathX 'AllowAbsolute Pkg 'File]
extras = BuildInfo
bi{cSources = new}
  where
    new :: [SymbolicPathX 'AllowAbsolute Pkg 'File]
new = [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. Ord a => [a] -> [a]
ordNub ([SymbolicPathX 'AllowAbsolute Pkg 'File]
extras [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
cSources BuildInfo
bi)

-- | Add extra C++ sources generated by preprocessing to build
-- information.
addExtraCxxSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCxxSources :: BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> BuildInfo
addExtraCxxSources BuildInfo
bi [SymbolicPathX 'AllowAbsolute Pkg 'File]
extras = BuildInfo
bi{cxxSources = new}
  where
    new :: [SymbolicPathX 'AllowAbsolute Pkg 'File]
new = [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. Ord a => [a] -> [a]
ordNub ([SymbolicPathX 'AllowAbsolute Pkg 'File]
extras [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
cxxSources BuildInfo
bi)

-- | Add extra C-- sources generated by preprocessing to build
-- information.
addExtraCmmSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCmmSources :: BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> BuildInfo
addExtraCmmSources BuildInfo
bi [SymbolicPathX 'AllowAbsolute Pkg 'File]
extras = BuildInfo
bi{cmmSources = new}
  where
    new :: [SymbolicPathX 'AllowAbsolute Pkg 'File]
new = [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. Ord a => [a] -> [a]
ordNub ([SymbolicPathX 'AllowAbsolute Pkg 'File]
extras [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
cmmSources BuildInfo
bi)

-- | Add extra ASM sources generated by preprocessing to build
-- information.
addExtraAsmSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraAsmSources :: BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> BuildInfo
addExtraAsmSources BuildInfo
bi [SymbolicPathX 'AllowAbsolute Pkg 'File]
extras = BuildInfo
bi{asmSources = new}
  where
    new :: [SymbolicPathX 'AllowAbsolute Pkg 'File]
new = [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. Ord a => [a] -> [a]
ordNub ([SymbolicPathX 'AllowAbsolute Pkg 'File]
extras [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
asmSources BuildInfo
bi)

-- | Add extra JS sources generated by preprocessing to build
-- information.
addExtraJsSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraJsSources :: BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> BuildInfo
addExtraJsSources BuildInfo
bi [SymbolicPathX 'AllowAbsolute Pkg 'File]
extras = BuildInfo
bi{jsSources = new}
  where
    new :: [SymbolicPathX 'AllowAbsolute Pkg 'File]
new = [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. Ord a => [a] -> [a]
ordNub ([SymbolicPathX 'AllowAbsolute Pkg 'File]
extras [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
jsSources BuildInfo
bi)

-- | Add extra HS modules generated by preprocessing to build
-- information.
addExtraOtherModules :: BuildInfo -> [ModuleName.ModuleName] -> BuildInfo
addExtraOtherModules :: BuildInfo -> [ModuleName] -> BuildInfo
addExtraOtherModules BuildInfo
bi [ModuleName]
extras = BuildInfo
bi{otherModules = new}
  where
    new :: [ModuleName]
new = [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
ordNub ([ModuleName]
extras [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi)

-- | Add extra source dir for generated modules.
addSrcDir :: BuildInfo -> SymbolicPath Pkg (Dir Source) -> BuildInfo
addSrcDir :: BuildInfo -> SymbolicPath Pkg ('Dir Source) -> BuildInfo
addSrcDir BuildInfo
bi SymbolicPath Pkg ('Dir Source)
extra = BuildInfo
bi{hsSourceDirs = new}
  where
    new :: [SymbolicPath Pkg ('Dir Source)]
new = [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. Ord a => [a] -> [a]
ordNub (SymbolicPath Pkg ('Dir Source)
extra SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPath Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi)

replComponent
  :: ReplFlags
  -> Verbosity
  -> PackageDescription
  -> LocalBuildInfo
  -> [PPSuffixHandler]
  -> Component
  -> ComponentLocalBuildInfo
  -> SymbolicPath Pkg (Dir Dist)
  -> IO ()
replComponent :: ReplFlags
-> Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> Component
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Dist)
-> IO ()
replComponent ReplFlags
_ Verbosity
verbosity PackageDescription
_ LocalBuildInfo
_ [PPSuffixHandler]
_ (CTest TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteUnsupported TestType
tt}) ComponentLocalBuildInfo
_ SymbolicPath Pkg ('Dir Dist)
_ =
  Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$ TestType -> CabalException
NoSupportBuildingTestSuite TestType
tt
replComponent ReplFlags
_ Verbosity
verbosity PackageDescription
_ LocalBuildInfo
_ [PPSuffixHandler]
_ (CBench Benchmark{benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkInterface = BenchmarkUnsupported BenchmarkType
tt}) ComponentLocalBuildInfo
_ SymbolicPath Pkg ('Dir Dist)
_ =
  Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$ BenchmarkType -> CabalException
NoSupportBuildingBenchMark BenchmarkType
tt
replComponent
  ReplFlags
replFlags
  Verbosity
verbosity
  PackageDescription
pkg_descr
  LocalBuildInfo
lbi0
  [PPSuffixHandler]
suffixHandlers
  comp :: Component
comp@( CTest
          test :: TestSuite
test@TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteLibV09{}}
        )
  ComponentLocalBuildInfo
clbi
  SymbolicPath Pkg ('Dir Dist)
distPref = do
    inplaceDir <- LocalBuildInfo -> IO (AbsolutePath ('Dir Pkg))
absoluteWorkingDirLBI LocalBuildInfo
lbi0
    let (pkg, lib, libClbi, lbi, _, _, _) =
          testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 inplaceDir distPref
    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers
    extras <- preprocessExtras verbosity comp lbi
    let libbi = Library -> BuildInfo
libBuildInfo Library
lib
        lib' = Library
lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}
    replLib replFlags pkg lbi lib' libClbi
replComponent
  ReplFlags
replFlags
  Verbosity
verbosity
  PackageDescription
pkg_descr
  LocalBuildInfo
lbi
  [PPSuffixHandler]
suffixHandlers
  Component
comp
  ComponentLocalBuildInfo
clbi
  SymbolicPath Pkg ('Dir Dist)
_ =
    do
      PackageDescription
-> Component
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessComponent PackageDescription
pkg_descr Component
comp LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Bool
False Verbosity
verbosity [PPSuffixHandler]
suffixHandlers
      extras <- Verbosity
-> Component
-> LocalBuildInfo
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
preprocessExtras Verbosity
verbosity Component
comp LocalBuildInfo
lbi
      case comp of
        CLib Library
lib -> do
          let libbi :: BuildInfo
libbi = Library -> BuildInfo
libBuildInfo Library
lib
              lib' :: Library
lib' = Library
lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}
          ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
replLib ReplFlags
replFlags PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib' ComponentLocalBuildInfo
clbi
        CFLib ForeignLib
flib ->
          ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
replFLib ReplFlags
replFlags PackageDescription
pkg_descr LocalBuildInfo
lbi ForeignLib
flib ComponentLocalBuildInfo
clbi
        CExe Executable
exe -> do
          let ebi :: BuildInfo
ebi = Executable -> BuildInfo
buildInfo Executable
exe
              exe' :: Executable
exe' = Executable
exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
          ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe ReplFlags
replFlags PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe' ComponentLocalBuildInfo
clbi
        CTest test :: TestSuite
test@TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteExeV10{}} -> do
          let exe :: Executable
exe = TestSuite -> Executable
testSuiteExeV10AsExe TestSuite
test
          let ebi :: BuildInfo
ebi = Executable -> BuildInfo
buildInfo Executable
exe
              exe' :: Executable
exe' = Executable
exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
          ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe ReplFlags
replFlags PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe' ComponentLocalBuildInfo
clbi
        CBench bm :: Benchmark
bm@Benchmark{benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkInterface = BenchmarkExeV10{}} -> do
          let exe :: Executable
exe = Benchmark -> Executable
benchmarkExeV10asExe Benchmark
bm
          let ebi :: BuildInfo
ebi = Executable -> BuildInfo
buildInfo Executable
exe
              exe' :: Executable
exe' = Executable
exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
          ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe ReplFlags
replFlags PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe' ComponentLocalBuildInfo
clbi
#if __GLASGOW_HASKELL__ < 811
-- silence pattern-match warnings prior to GHC 9.0
        _ -> error "impossible"
#endif

----------------------------------------------------
-- Shared code for buildComponent and replComponent
--

-- | Translate a exe-style 'TestSuite' component into an exe for building
testSuiteExeV10AsExe :: TestSuite -> Executable
testSuiteExeV10AsExe :: TestSuite -> Executable
testSuiteExeV10AsExe test :: TestSuite
test@TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteExeV10 Version
_ RelativePath Source 'File
mainFile} =
  Executable
    { exeName :: UnqualComponentName
exeName = TestSuite -> UnqualComponentName
testName TestSuite
test
    , modulePath :: RelativePath Source 'File
modulePath = RelativePath Source 'File
mainFile
    , exeScope :: ExecutableScope
exeScope = ExecutableScope
ExecutablePublic
    , buildInfo :: BuildInfo
buildInfo = TestSuite -> BuildInfo
testBuildInfo TestSuite
test
    }
testSuiteExeV10AsExe TestSuite{} = String -> Executable
forall a. HasCallStack => String -> a
error String
"testSuiteExeV10AsExe: wrong kind"

-- | Translate a exe-style 'Benchmark' component into an exe for building
benchmarkExeV10asExe :: Benchmark -> Executable
benchmarkExeV10asExe :: Benchmark -> Executable
benchmarkExeV10asExe bm :: Benchmark
bm@Benchmark{benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkInterface = BenchmarkExeV10 Version
_ RelativePath Source 'File
mainFile} =
  Executable
    { exeName :: UnqualComponentName
exeName = Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm
    , modulePath :: RelativePath Source 'File
modulePath = RelativePath Source 'File
mainFile
    , exeScope :: ExecutableScope
exeScope = ExecutableScope
ExecutablePublic
    , buildInfo :: BuildInfo
buildInfo = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bm
    }
benchmarkExeV10asExe Benchmark{} = String -> Executable
forall a. HasCallStack => String -> a
error String
"benchmarkExeV10asExe: wrong kind"

-- | Translate a lib-style 'TestSuite' component into a lib + exe for building
testSuiteLibV09AsLibAndExe
  :: PackageDescription
  -> TestSuite
  -> ComponentLocalBuildInfo
  -> LocalBuildInfo
  -> AbsolutePath (Dir Pkg)
  -- ^ absolute inplace dir
  -> SymbolicPath Pkg (Dir Dist)
  -> ( PackageDescription
     , Library
     , ComponentLocalBuildInfo
     , LocalBuildInfo
     , IPI.InstalledPackageInfo
     , Executable
     , ComponentLocalBuildInfo
     )
testSuiteLibV09AsLibAndExe :: PackageDescription
-> TestSuite
-> ComponentLocalBuildInfo
-> LocalBuildInfo
-> AbsolutePath ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> (PackageDescription, Library, ComponentLocalBuildInfo,
    LocalBuildInfo, InstalledPackageInfo, Executable,
    ComponentLocalBuildInfo)
testSuiteLibV09AsLibAndExe
  PackageDescription
pkg_descr
  test :: TestSuite
test@TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteLibV09 Version
_ ModuleName
m}
  ComponentLocalBuildInfo
clbi
  LocalBuildInfo
lbi
  AbsolutePath ('Dir Pkg)
inplaceDir
  SymbolicPath Pkg ('Dir Dist)
distPref =
    (PackageDescription
pkg, Library
lib, ComponentLocalBuildInfo
libClbi, LocalBuildInfo
lbi, InstalledPackageInfo
ipi, Executable
exe, ComponentLocalBuildInfo
exeClbi)
    where
      bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
test
      lib :: Library
lib =
        Library
          { libName :: LibraryName
libName = LibraryName
LMainLibName
          , exposedModules :: [ModuleName]
exposedModules = [ModuleName
m]
          , reexportedModules :: [ModuleReexport]
reexportedModules = []
          , signatures :: [ModuleName]
signatures = []
          , libExposed :: Bool
libExposed = Bool
True
          , libVisibility :: LibraryVisibility
libVisibility = LibraryVisibility
LibraryVisibilityPrivate
          , libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo
bi
          }
      -- This is, like, the one place where we use a CTestName for a library.
      -- Should NOT use library name, since that could conflict!
      PackageIdentifier PackageName
pkg_name Version
pkg_ver = PackageDescription -> PackageIdentifier
package PackageDescription
pkg_descr
      -- Note: we do make internal library from the test!
      compat_name :: MungedPackageName
compat_name = PackageName -> LibraryName -> MungedPackageName
MungedPackageName PackageName
pkg_name (UnqualComponentName -> LibraryName
LSubLibName (TestSuite -> UnqualComponentName
testName TestSuite
test))
      compat_key :: String
compat_key = Compiler -> MungedPackageName -> Version -> UnitId -> String
computeCompatPackageKey (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) MungedPackageName
compat_name Version
pkg_ver (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi)
      libClbi :: ComponentLocalBuildInfo
libClbi =
        LibComponentLocalBuildInfo
          { componentPackageDeps :: [(UnitId, MungedPackageId)]
componentPackageDeps = ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi
          , componentInternalDeps :: [UnitId]
componentInternalDeps = ComponentLocalBuildInfo -> [UnitId]
componentInternalDeps ComponentLocalBuildInfo
clbi
          , componentIsIndefinite_ :: Bool
componentIsIndefinite_ = Bool
False
          , componentExeDeps :: [UnitId]
componentExeDeps = ComponentLocalBuildInfo -> [UnitId]
componentExeDeps ComponentLocalBuildInfo
clbi
          , componentLocalName :: ComponentName
componentLocalName = LibraryName -> ComponentName
CLibName (LibraryName -> ComponentName) -> LibraryName -> ComponentName
forall a b. (a -> b) -> a -> b
$ UnqualComponentName -> LibraryName
LSubLibName (UnqualComponentName -> LibraryName)
-> UnqualComponentName -> LibraryName
forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
testName TestSuite
test
          , componentIsPublic :: Bool
componentIsPublic = Bool
False
          , componentIncludes :: [(OpenUnitId, ModuleRenaming)]
componentIncludes = ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
componentIncludes ComponentLocalBuildInfo
clbi
          , componentUnitId :: UnitId
componentUnitId = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
          , componentComponentId :: ComponentId
componentComponentId = ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi
          , componentInstantiatedWith :: [(ModuleName, OpenModule)]
componentInstantiatedWith = []
          , componentCompatPackageName :: MungedPackageName
componentCompatPackageName = MungedPackageName
compat_name
          , componentCompatPackageKey :: String
componentCompatPackageKey = String
compat_key
          , componentExposedModules :: [ExposedModule]
componentExposedModules = [ModuleName -> Maybe OpenModule -> ExposedModule
IPI.ExposedModule ModuleName
m Maybe OpenModule
forall a. Maybe a
Nothing]
          }
      pkgName' :: PackageName
pkgName' = String -> PackageName
mkPackageName (String -> PackageName) -> String -> PackageName
forall a b. (a -> b) -> a -> b
$ MungedPackageName -> String
forall a. Pretty a => a -> String
prettyShow MungedPackageName
compat_name
      pkg :: PackageDescription
pkg =
        PackageDescription
pkg_descr
          { package = (package pkg_descr){pkgName = pkgName'}
          , executables = []
          , testSuites = []
          , subLibraries = [lib]
          }
      ipi :: InstalledPackageInfo
ipi = AbsolutePath ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstalledPackageInfo
inplaceInstalledPackageInfo AbsolutePath ('Dir Pkg)
inplaceDir SymbolicPath Pkg ('Dir Dist)
distPref PackageDescription
pkg (String -> AbiHash
mkAbiHash String
"") Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
libClbi
      testLibDep :: Dependency
testLibDep =
        PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency
          PackageName
pkgName'
          (Version -> VersionRange
thisVersion (Version -> VersionRange) -> Version -> VersionRange
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> Version
pkgVersion (PackageIdentifier -> Version) -> PackageIdentifier -> Version
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
package PackageDescription
pkg_descr)
          NonEmptySet LibraryName
mainLibSet
      exe :: Executable
exe =
        Executable
          { exeName :: UnqualComponentName
exeName = String -> UnqualComponentName
mkUnqualComponentName (String -> UnqualComponentName) -> String -> UnqualComponentName
forall a b. (a -> b) -> a -> b
$ TestSuite -> String
stubName TestSuite
test
          , modulePath :: RelativePath Source 'File
modulePath = String -> RelativePath Source 'File
forall from (to :: FileOrDir).
HasCallStack =>
String -> RelativePath from to
makeRelativePathEx (String -> RelativePath Source 'File)
-> String -> RelativePath Source 'File
forall a b. (a -> b) -> a -> b
$ TestSuite -> String
stubFilePath TestSuite
test
          , exeScope :: ExecutableScope
exeScope = ExecutableScope
ExecutablePublic
          , buildInfo :: BuildInfo
buildInfo =
              (TestSuite -> BuildInfo
testBuildInfo TestSuite
test)
                { hsSourceDirs = [coerceSymbolicPath $ testBuildDir lbi test]
                , targetBuildDepends =
                    testLibDep
                      : targetBuildDepends (testBuildInfo test)
                }
          }
      -- \| The stub executable needs a new 'ComponentLocalBuildInfo'
      -- that exposes the relevant test suite library.
      deps :: [(UnitId, MungedPackageId)]
deps =
        (InstalledPackageInfo -> UnitId
IPI.installedUnitId InstalledPackageInfo
ipi, InstalledPackageInfo -> MungedPackageId
forall pkg. HasMungedPackageId pkg => pkg -> MungedPackageId
mungedId InstalledPackageInfo
ipi)
          (UnitId, MungedPackageId)
-> [(UnitId, MungedPackageId)] -> [(UnitId, MungedPackageId)]
forall a. a -> [a] -> [a]
: ( ((UnitId, MungedPackageId) -> Bool)
-> [(UnitId, MungedPackageId)] -> [(UnitId, MungedPackageId)]
forall a. (a -> Bool) -> [a] -> [a]
filter
                ( \(UnitId
_, MungedPackageId
x) ->
                    let name :: String
name = MungedPackageName -> String
forall a. Pretty a => a -> String
prettyShow (MungedPackageName -> String) -> MungedPackageName -> String
forall a b. (a -> b) -> a -> b
$ MungedPackageId -> MungedPackageName
mungedName MungedPackageId
x
                     in String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Cabal" Bool -> Bool -> Bool
|| String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"base"
                )
                (ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi)
            )
      exeClbi :: ComponentLocalBuildInfo
exeClbi =
        ExeComponentLocalBuildInfo
          { -- TODO: this is a hack, but as long as this is unique
            -- (doesn't clobber something) we won't run into trouble
            componentUnitId :: UnitId
componentUnitId = String -> UnitId
mkUnitId (TestSuite -> String
stubName TestSuite
test)
          , componentComponentId :: ComponentId
componentComponentId = String -> ComponentId
mkComponentId (TestSuite -> String
stubName TestSuite
test)
          , componentInternalDeps :: [UnitId]
componentInternalDeps = [ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi]
          , componentExeDeps :: [UnitId]
componentExeDeps = []
          , componentLocalName :: ComponentName
componentLocalName = UnqualComponentName -> ComponentName
CExeName (UnqualComponentName -> ComponentName)
-> UnqualComponentName -> ComponentName
forall a b. (a -> b) -> a -> b
$ String -> UnqualComponentName
mkUnqualComponentName (String -> UnqualComponentName) -> String -> UnqualComponentName
forall a b. (a -> b) -> a -> b
$ TestSuite -> String
stubName TestSuite
test
          , componentPackageDeps :: [(UnitId, MungedPackageId)]
componentPackageDeps = [(UnitId, MungedPackageId)]
deps
          , -- Assert DefUnitId invariant!
            -- Executable can't be indefinite, so dependencies must
            -- be definite packages.
            componentIncludes :: [(OpenUnitId, ModuleRenaming)]
componentIncludes =
              ((UnitId, MungedPackageId) -> (OpenUnitId, ModuleRenaming))
-> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)]
forall a b. (a -> b) -> [a] -> [b]
map ((,ModuleRenaming
defaultRenaming) (OpenUnitId -> (OpenUnitId, ModuleRenaming))
-> ((UnitId, MungedPackageId) -> OpenUnitId)
-> (UnitId, MungedPackageId)
-> (OpenUnitId, ModuleRenaming)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefUnitId -> OpenUnitId
DefiniteUnitId (DefUnitId -> OpenUnitId)
-> ((UnitId, MungedPackageId) -> DefUnitId)
-> (UnitId, MungedPackageId)
-> OpenUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> DefUnitId
unsafeMkDefUnitId (UnitId -> DefUnitId)
-> ((UnitId, MungedPackageId) -> UnitId)
-> (UnitId, MungedPackageId)
-> DefUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitId, MungedPackageId) -> UnitId
forall a b. (a, b) -> a
fst) [(UnitId, MungedPackageId)]
deps
          }
testSuiteLibV09AsLibAndExe PackageDescription
_ TestSuite{} ComponentLocalBuildInfo
_ LocalBuildInfo
_ AbsolutePath ('Dir Pkg)
_ SymbolicPath Pkg ('Dir Dist)
_ = String
-> (PackageDescription, Library, ComponentLocalBuildInfo,
    LocalBuildInfo, InstalledPackageInfo, Executable,
    ComponentLocalBuildInfo)
forall a. HasCallStack => String -> a
error String
"testSuiteLibV09AsLibAndExe: wrong kind"

-- | Initialize a new package db file for libraries defined
-- internally to the package.
createInternalPackageDB
  :: Verbosity
  -> LocalBuildInfo
  -> SymbolicPath Pkg (Dir Dist)
  -> IO PackageDB
createInternalPackageDB :: Verbosity
-> LocalBuildInfo -> SymbolicPath Pkg ('Dir Dist) -> IO PackageDB
createInternalPackageDB Verbosity
verbosity LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Dist)
distPref = do
  existsAlready <- String -> IO Bool
doesPackageDBExist String
dbPath
  when existsAlready $ deletePackageDB dbPath
  createPackageDB verbosity (compiler lbi) (withPrograms lbi) False dbPath
  return (SpecificPackageDB dbRelPath)
  where
    dbRelPath :: SymbolicPath Pkg ('Dir PkgDB)
dbRelPath = LocalBuildInfo
-> SymbolicPath Pkg ('Dir Dist) -> SymbolicPath Pkg ('Dir PkgDB)
internalPackageDBPath LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Dist)
distPref
    dbPath :: String
dbPath = LocalBuildInfo -> SymbolicPath Pkg ('Dir PkgDB) -> String
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPathLBI LocalBuildInfo
lbi SymbolicPath Pkg ('Dir PkgDB)
dbRelPath

-- | Update the program database to include any build-tool-depends specified
-- in the given 'BuildInfo' on build tools internal to the current package.
--
-- This function:
--
--  - adds these internal build tools to the 'ProgramDb', including
--    paths to their respective data directories,
--  - adds their paths to the current 'progSearchPath', and adds the data
--    directory environment variable for the current package to the current
--    'progOverrideEnv', so that any programs configured from now on will be
--    able to invoke these build tools.
addInternalBuildTools
  :: PackageDescription
  -> LocalBuildInfo
  -> BuildInfo
  -> ProgramDb
  -> ProgramDb
addInternalBuildTools :: PackageDescription
-> LocalBuildInfo -> BuildInfo -> ProgramDb -> ProgramDb
addInternalBuildTools PackageDescription
pkg LocalBuildInfo
lbi BuildInfo
bi ProgramDb
progs =
  [String] -> [(String, Maybe String)] -> ProgramDb -> ProgramDb
prependProgramSearchPathNoLogging
    [String]
internalToolPaths
    [(String, Maybe String)
pkgDataDirVar]
    (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$ (ConfiguredProgram -> ProgramDb -> ProgramDb)
-> ProgramDb -> [ConfiguredProgram] -> ProgramDb
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ConfiguredProgram -> ProgramDb -> ProgramDb
updateProgram ProgramDb
progs [ConfiguredProgram]
internalBuildTools
  where
    internalToolPaths :: [String]
internalToolPaths = (ConfiguredProgram -> String) -> [ConfiguredProgram] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
takeDirectory (String -> String)
-> (ConfiguredProgram -> String) -> ConfiguredProgram -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredProgram -> String
programPath) [ConfiguredProgram]
internalBuildTools
    pkgDataDirVar :: (String, Maybe String)
pkgDataDirVar = (PackageDescription -> String -> String
pkgPathEnvVar PackageDescription
pkg String
"datadir", String -> Maybe String
forall a. a -> Maybe a
Just String
dataDirPath)
    internalBuildTools :: [ConfiguredProgram]
internalBuildTools =
      [ (String -> ProgramLocation -> ConfiguredProgram
simpleConfiguredProgram String
toolName' (String -> ProgramLocation
FoundOnSystem String
toolLocation))
        { programOverrideEnv = [pkgDataDirVar]
        }
      | UnqualComponentName
toolName <- PackageDescription -> BuildInfo -> [UnqualComponentName]
getAllInternalToolDependencies PackageDescription
pkg BuildInfo
bi
      , let toolName' :: String
toolName' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
toolName
      , let toolLocation :: String
toolLocation =
              LocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 2) -> String
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPathLBI LocalBuildInfo
lbi (SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 2) -> String)
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 2) -> String
forall a b. (a -> b) -> a -> b
$
                LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi
                  SymbolicPath Pkg ('Dir Build)
-> RelativePath Build (ZonkAny 2)
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 2)
forall p q r. PathLike p q r => p -> q -> r
</> String -> RelativePath Build (ZonkAny 2)
forall from (to :: FileOrDir).
HasCallStack =>
String -> RelativePath from to
makeRelativePathEx (String
toolName' String -> String -> String
forall p q r. PathLike p q r => p -> q -> r
</> String
toolName' String -> String -> String
forall p. FileLike p => p -> String -> p
<.> Platform -> String
exeExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi))
      ]
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    rawDataDir :: SymbolicPath Pkg ('Dir DataDir)
rawDataDir = PackageDescription -> SymbolicPath Pkg ('Dir DataDir)
dataDir PackageDescription
pkg
    dataDirPath :: String
dataDirPath
      | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ SymbolicPath Pkg ('Dir DataDir) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath SymbolicPath Pkg ('Dir DataDir)
rawDataDir =
          Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX (ZonkAny 1) Pkg ('Dir (ZonkAny 0)) -> String
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> String
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX (ZonkAny 1) Pkg ('Dir (ZonkAny 0))
forall (allowAbsolute :: AllowAbsolute) from to.
SymbolicPathX allowAbsolute from ('Dir to)
sameDirectory
      | Bool
otherwise =
          Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir DataDir) -> String
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> String
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg ('Dir DataDir)
rawDataDir

-- TODO: build separate libs in separate dirs so that we can build
-- multiple libs, e.g. for 'LibTest' library-style test suites
buildLib
  :: BuildFlags
  -> Flag ParStrat
  -> PackageDescription
  -> LocalBuildInfo
  -> Library
  -> ComponentLocalBuildInfo
  -> IO ()
buildLib :: BuildFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib BuildFlags
flags Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi =
  let 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
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags
   in case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
        CompilerFlavor
GHC -> BuildFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
GHC.buildLib BuildFlags
flags Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi
        CompilerFlavor
GHCJS -> Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
GHCJS.buildLib Verbosity
verbosity Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi
        CompilerFlavor
UHC -> Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
UHC.buildLib Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi
        HaskellSuite{} -> Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
HaskellSuite.buildLib Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi
        CompilerFlavor
_ -> Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
BuildingNotSupportedWithCompiler

-- | Build a foreign library
--
-- NOTE: We assume that we already checked that we can actually build the
-- foreign library in configure.
buildFLib
  :: Verbosity
  -> Flag ParStrat
  -> PackageDescription
  -> LocalBuildInfo
  -> ForeignLib
  -> ComponentLocalBuildInfo
  -> IO ()
buildFLib :: Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
buildFLib Verbosity
verbosity Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi ForeignLib
flib ComponentLocalBuildInfo
clbi =
  case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
    CompilerFlavor
GHC -> Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
GHC.buildFLib Verbosity
verbosity Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi ForeignLib
flib ComponentLocalBuildInfo
clbi
    CompilerFlavor
_ -> Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
BuildingNotSupportedWithCompiler

buildExe
  :: Verbosity
  -> Flag ParStrat
  -> PackageDescription
  -> LocalBuildInfo
  -> Executable
  -> ComponentLocalBuildInfo
  -> IO ()
buildExe :: Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe Verbosity
verbosity Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe ComponentLocalBuildInfo
clbi =
  case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
    CompilerFlavor
GHC -> Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
GHC.buildExe Verbosity
verbosity Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe ComponentLocalBuildInfo
clbi
    CompilerFlavor
GHCJS -> Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
GHCJS.buildExe Verbosity
verbosity Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe ComponentLocalBuildInfo
clbi
    CompilerFlavor
UHC -> Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
UHC.buildExe Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe ComponentLocalBuildInfo
clbi
    CompilerFlavor
_ -> Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
BuildingNotSupportedWithCompiler

replLib
  :: ReplFlags
  -> PackageDescription
  -> LocalBuildInfo
  -> Library
  -> ComponentLocalBuildInfo
  -> IO ()
replLib :: ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
replLib ReplFlags
replFlags PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi =
  let 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
$ ReplFlags -> Flag Verbosity
replVerbosity ReplFlags
replFlags
      opts :: ReplOptions
opts = ReplFlags -> ReplOptions
replReplOptions ReplFlags
replFlags
   in case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
        -- 'cabal repl' doesn't need to support 'ghc --make -j', so we just pass
        -- NoFlag as the numJobs parameter.
        CompilerFlavor
GHC -> ReplFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
GHC.replLib ReplFlags
replFlags Flag (ParStratX String)
forall a. Flag a
NoFlag PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi
        CompilerFlavor
GHCJS -> [String]
-> Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
GHCJS.replLib (ReplOptions -> [String]
replOptionsFlags ReplOptions
opts) Verbosity
verbosity Flag (ParStratX String)
forall a. Flag a
NoFlag PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi
        CompilerFlavor
_ -> Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
REPLNotSupported

replExe
  :: ReplFlags
  -> PackageDescription
  -> LocalBuildInfo
  -> Executable
  -> ComponentLocalBuildInfo
  -> IO ()
replExe :: ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe ReplFlags
flags PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe ComponentLocalBuildInfo
clbi =
  let 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
$ ReplFlags -> Flag Verbosity
replVerbosity ReplFlags
flags
   in case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
        CompilerFlavor
GHC -> ReplFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
GHC.replExe ReplFlags
flags Flag (ParStratX String)
forall a. Flag a
NoFlag PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe ComponentLocalBuildInfo
clbi
        CompilerFlavor
GHCJS ->
          [String]
-> Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
GHCJS.replExe
            (ReplOptions -> [String]
replOptionsFlags (ReplOptions -> [String]) -> ReplOptions -> [String]
forall a b. (a -> b) -> a -> b
$ ReplFlags -> ReplOptions
replReplOptions ReplFlags
flags)
            Verbosity
verbosity
            Flag (ParStratX String)
forall a. Flag a
NoFlag
            PackageDescription
pkg_descr
            LocalBuildInfo
lbi
            Executable
exe
            ComponentLocalBuildInfo
clbi
        CompilerFlavor
_ -> Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
REPLNotSupported

replFLib
  :: ReplFlags
  -> PackageDescription
  -> LocalBuildInfo
  -> ForeignLib
  -> ComponentLocalBuildInfo
  -> IO ()
replFLib :: ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
replFLib ReplFlags
flags PackageDescription
pkg_descr LocalBuildInfo
lbi ForeignLib
exe ComponentLocalBuildInfo
clbi =
  let 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
$ ReplFlags -> Flag Verbosity
replVerbosity ReplFlags
flags
   in case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
        CompilerFlavor
GHC -> ReplFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
GHC.replFLib ReplFlags
flags Flag (ParStratX String)
forall a. Flag a
NoFlag PackageDescription
pkg_descr LocalBuildInfo
lbi ForeignLib
exe ComponentLocalBuildInfo
clbi
        CompilerFlavor
_ -> Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
REPLNotSupported

-- | Runs 'componentInitialBuildSteps' on every configured component.
--
-- Legacy function: does not run pre-build hooks or pre-processors. This function
-- is insufficient on its own to prepare the build for a package.
--
-- Consumers wanting to prepare the sources of a package, e.g. in order to
-- launch a REPL session, are advised to run @Setup repl --repl-multi-file=<fn>@
-- instead.
initialBuildSteps
  :: FilePath
  -- ^ "dist" prefix
  -> PackageDescription
  -- ^ mostly information from the .cabal file
  -> LocalBuildInfo
  -- ^ Configuration information
  -> Verbosity
  -- ^ The verbosity to use
  -> IO ()
initialBuildSteps :: String
-> PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
initialBuildSteps String
distPref PackageDescription
pkg_descr LocalBuildInfo
lbi Verbosity
verbosity =
  PackageDescription
-> LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withAllComponentsInBuildOrder PackageDescription
pkg_descr LocalBuildInfo
lbi ((Component -> ComponentLocalBuildInfo -> IO ()) -> IO ())
-> (Component -> ComponentLocalBuildInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Component
_comp ComponentLocalBuildInfo
clbi ->
    String
-> PackageDescription
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Verbosity
-> IO ()
componentInitialBuildSteps String
distPref PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Verbosity
verbosity
{-# DEPRECATED
  initialBuildSteps
  "This function does not prepare all source files for a package. Suggestion: use 'Setup repl --repl-multi-file=<fn>'."
  #-}

-- | Creates the autogenerated files for a particular configured component.
--
-- Legacy function: does not run pre-build hooks or pre-processors. This function
-- is insufficient on its own to prepare the build for a component.
--
-- Consumers wanting to prepare the sources of a component, e.g. in order to
-- launch a REPL session, are advised to run
-- @Setup repl <compName> --repl-multi-file=<fn>@ instead.
componentInitialBuildSteps
  :: FilePath
  -- ^ "dist" prefix
  -> PackageDescription
  -- ^ mostly information from the .cabal file
  -> LocalBuildInfo
  -- ^ Configuration information
  -> ComponentLocalBuildInfo
  -- ^ Build info about the component
  -> Verbosity
  -- ^ The verbosity to use
  -> IO ()
componentInitialBuildSteps :: String
-> PackageDescription
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Verbosity
-> IO ()
componentInitialBuildSteps String
_distPref PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Verbosity
verbosity = do
  let compBuildDir :: String
compBuildDir = LocalBuildInfo -> SymbolicPath Pkg ('Dir Build) -> String
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPathLBI LocalBuildInfo
lbi (SymbolicPath Pkg ('Dir Build) -> String)
-> SymbolicPath Pkg ('Dir Build) -> String
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
  Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
compBuildDir
  Verbosity
-> PackageDescription
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO ()
writeBuiltinAutogenFiles Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
{-# DEPRECATED
  componentInitialBuildSteps
  "This function does not prepare all source files for a component. Suggestion: use 'Setup repl <compName> --repl-multi-file=<fn>'."
  #-}

-- | Creates the autogenerated files for a particular configured component,
-- and runs the pre-build hook.
preBuildComponent
  :: (LocalBuildInfo -> TargetInfo -> IO ())
  -- ^ pre-build hook
  -> Verbosity
  -> LocalBuildInfo
  -- ^ Configuration information
  -> TargetInfo
  -> IO ()
preBuildComponent :: (LocalBuildInfo -> TargetInfo -> IO ())
-> Verbosity -> LocalBuildInfo -> TargetInfo -> IO ()
preBuildComponent LocalBuildInfo -> TargetInfo -> IO ()
preBuildHook Verbosity
verbosity LocalBuildInfo
lbi TargetInfo
tgt = do
  let pkg_descr :: PackageDescription
pkg_descr = LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi
      clbi :: ComponentLocalBuildInfo
clbi = TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
tgt
      compBuildDir :: String
compBuildDir = LocalBuildInfo -> SymbolicPath Pkg ('Dir Build) -> String
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPathLBI LocalBuildInfo
lbi (SymbolicPath Pkg ('Dir Build) -> String)
-> SymbolicPath Pkg ('Dir Build) -> String
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
  Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
compBuildDir
  Verbosity
-> PackageDescription
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO ()
writeBuiltinAutogenFiles Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
  LocalBuildInfo -> TargetInfo -> IO ()
preBuildHook LocalBuildInfo
lbi TargetInfo
tgt

-- | Generate and write to disk all built-in autogenerated files
-- for the specified component. These files will be put in the
-- autogenerated module directory for this component
-- (see 'autogenComponentsModuleDir').
--
-- This includes:
--
--  - @Paths_<pkg>.hs@,
--  - @PackageInfo_<pkg>.hs@,
--  - Backpack signature files for components that are not fully instantiated,
--  - @cabal_macros.h@.
writeBuiltinAutogenFiles
  :: Verbosity
  -> PackageDescription
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> IO ()
writeBuiltinAutogenFiles :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO ()
writeBuiltinAutogenFiles Verbosity
verbosity PackageDescription
pkg LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  Verbosity
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Map AutogenFile ByteString
-> IO ()
writeAutogenFiles Verbosity
verbosity LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi (Map AutogenFile ByteString -> IO ())
-> Map AutogenFile ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ PackageDescription
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Map AutogenFile ByteString
builtinAutogenFiles PackageDescription
pkg LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi

-- | Built-in autogenerated files and their contents. This includes:
--
--  - @Paths_<pkg>.hs@,
--  - @PackageInfo_<pkg>.hs@,
--  - Backpack signature files for components that are not fully instantiated,
--  - @cabal_macros.h@.
builtinAutogenFiles
  :: PackageDescription
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> Map AutogenFile AutogenFileContents
builtinAutogenFiles :: PackageDescription
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Map AutogenFile ByteString
builtinAutogenFiles PackageDescription
pkg LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  AutogenFile
-> ByteString
-> Map AutogenFile ByteString
-> Map AutogenFile ByteString
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AutogenFile
pathsFile ByteString
pathsContents (Map AutogenFile ByteString -> Map AutogenFile ByteString)
-> Map AutogenFile ByteString -> Map AutogenFile ByteString
forall a b. (a -> b) -> a -> b
$
    AutogenFile
-> ByteString
-> Map AutogenFile ByteString
-> Map AutogenFile ByteString
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AutogenFile
packageInfoFile ByteString
packageInfoContents (Map AutogenFile ByteString -> Map AutogenFile ByteString)
-> Map AutogenFile ByteString -> Map AutogenFile ByteString
forall a b. (a -> b) -> a -> b
$
      AutogenFile
-> ByteString
-> Map AutogenFile ByteString
-> Map AutogenFile ByteString
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AutogenFile
cppHeaderFile ByteString
cppHeaderContents (Map AutogenFile ByteString -> Map AutogenFile ByteString)
-> Map AutogenFile ByteString -> Map AutogenFile ByteString
forall a b. (a -> b) -> a -> b
$
        ComponentLocalBuildInfo -> Map AutogenFile ByteString
emptySignatureModules ComponentLocalBuildInfo
clbi
  where
    pathsFile :: AutogenFile
pathsFile = ModuleName -> Suffix -> AutogenFile
AutogenModule (PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg) (String -> Suffix
Suffix String
"hs")
    pathsContents :: ByteString
pathsContents = String -> ByteString
toUTF8LBS (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> String
generatePathsModule PackageDescription
pkg LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
    packageInfoFile :: AutogenFile
packageInfoFile = ModuleName -> Suffix -> AutogenFile
AutogenModule (PackageDescription -> ModuleName
autogenPackageInfoModuleName PackageDescription
pkg) (String -> Suffix
Suffix String
"hs")
    packageInfoContents :: ByteString
packageInfoContents = String -> ByteString
toUTF8LBS (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ PackageDescription -> LocalBuildInfo -> String
generatePackageInfoModule PackageDescription
pkg LocalBuildInfo
lbi
    cppHeaderFile :: AutogenFile
cppHeaderFile = ShortText -> AutogenFile
AutogenFile (ShortText -> AutogenFile) -> ShortText -> AutogenFile
forall a b. (a -> b) -> a -> b
$ String -> ShortText
toShortText String
cppHeaderName
    cppHeaderContents :: ByteString
cppHeaderContents = String -> ByteString
toUTF8LBS (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> String
generateCabalMacrosHeader PackageDescription
pkg LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi

-- | An empty @".hsig"@ Backpack signature module for each requirement, so that
-- GHC has a source file to look at it when it needs to typecheck
-- a signature.  It's harmless to generate these modules, even when
-- there is a real @hsig@ file written by the user, since
-- include path ordering ensures that the real @hsig@ file
-- will always be picked up before the autogenerated one.
emptySignatureModules
  :: ComponentLocalBuildInfo
  -> Map AutogenFile AutogenFileContents
emptySignatureModules :: ComponentLocalBuildInfo -> Map AutogenFile ByteString
emptySignatureModules ComponentLocalBuildInfo
clbi =
  case ComponentLocalBuildInfo
clbi of
    LibComponentLocalBuildInfo{componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts} ->
      [(AutogenFile, ByteString)] -> Map AutogenFile ByteString
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ ( ModuleName -> Suffix -> AutogenFile
AutogenModule ModuleName
modName (String -> Suffix
Suffix String
"hsig")
          , ModuleName -> ByteString
emptyHsigFile ModuleName
modName
          )
        | (ModuleName
modName, OpenModule
_) <- [(ModuleName, OpenModule)]
insts
        ]
    ComponentLocalBuildInfo
_ -> Map AutogenFile ByteString
forall k a. Map k a
Map.empty
  where
    emptyHsigFile :: ModuleName -> AutogenFileContents
    emptyHsigFile :: ModuleName -> ByteString
emptyHsigFile ModuleName
modName =
      String -> ByteString
toUTF8LBS (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
        String
"{-# OPTIONS_GHC -w #-}\n"
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{-# LANGUAGE NoImplicitPrelude #-}\n"
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"signature "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleName -> String
forall a. Pretty a => a -> String
prettyShow ModuleName
modName
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" where"

data AutogenFile
  = AutogenModule !ModuleName !Suffix
  | AutogenFile !ShortText
  deriving (Int -> AutogenFile -> String -> String
[AutogenFile] -> String -> String
AutogenFile -> String
(Int -> AutogenFile -> String -> String)
-> (AutogenFile -> String)
-> ([AutogenFile] -> String -> String)
-> Show AutogenFile
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> AutogenFile -> String -> String
showsPrec :: Int -> AutogenFile -> String -> String
$cshow :: AutogenFile -> String
show :: AutogenFile -> String
$cshowList :: [AutogenFile] -> String -> String
showList :: [AutogenFile] -> String -> String
Show, AutogenFile -> AutogenFile -> Bool
(AutogenFile -> AutogenFile -> Bool)
-> (AutogenFile -> AutogenFile -> Bool) -> Eq AutogenFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutogenFile -> AutogenFile -> Bool
== :: AutogenFile -> AutogenFile -> Bool
$c/= :: AutogenFile -> AutogenFile -> Bool
/= :: AutogenFile -> AutogenFile -> Bool
Eq, Eq AutogenFile
Eq AutogenFile =>
(AutogenFile -> AutogenFile -> Ordering)
-> (AutogenFile -> AutogenFile -> Bool)
-> (AutogenFile -> AutogenFile -> Bool)
-> (AutogenFile -> AutogenFile -> Bool)
-> (AutogenFile -> AutogenFile -> Bool)
-> (AutogenFile -> AutogenFile -> AutogenFile)
-> (AutogenFile -> AutogenFile -> AutogenFile)
-> Ord AutogenFile
AutogenFile -> AutogenFile -> Bool
AutogenFile -> AutogenFile -> Ordering
AutogenFile -> AutogenFile -> AutogenFile
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AutogenFile -> AutogenFile -> Ordering
compare :: AutogenFile -> AutogenFile -> Ordering
$c< :: AutogenFile -> AutogenFile -> Bool
< :: AutogenFile -> AutogenFile -> Bool
$c<= :: AutogenFile -> AutogenFile -> Bool
<= :: AutogenFile -> AutogenFile -> Bool
$c> :: AutogenFile -> AutogenFile -> Bool
> :: AutogenFile -> AutogenFile -> Bool
$c>= :: AutogenFile -> AutogenFile -> Bool
>= :: AutogenFile -> AutogenFile -> Bool
$cmax :: AutogenFile -> AutogenFile -> AutogenFile
max :: AutogenFile -> AutogenFile -> AutogenFile
$cmin :: AutogenFile -> AutogenFile -> AutogenFile
min :: AutogenFile -> AutogenFile -> AutogenFile
Ord)

-- | A representation of the contents of an autogenerated file.
type AutogenFileContents = LBS.ByteString

-- | Write the given autogenerated files in the autogenerated modules
-- directory for the component.
writeAutogenFiles
  :: Verbosity
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> Map AutogenFile AutogenFileContents
  -> IO ()
writeAutogenFiles :: Verbosity
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Map AutogenFile ByteString
-> IO ()
writeAutogenFiles Verbosity
verbosity LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Map AutogenFile ByteString
autogenFiles = do
  -- Ensure that the overall autogenerated files directory exists.
  Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
autogenDir
  [(AutogenFile, ByteString)]
-> ((AutogenFile, ByteString) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map AutogenFile ByteString -> [(AutogenFile, ByteString)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map AutogenFile ByteString
autogenFiles) (((AutogenFile, ByteString) -> IO ()) -> IO ())
-> ((AutogenFile, ByteString) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(AutogenFile
file, ByteString
contents) -> do
    let path :: String
path = case AutogenFile
file of
          AutogenModule ModuleName
modName (Suffix String
ext) ->
            String
autogenDir String -> String -> String
forall p q r. PathLike p q r => p -> q -> r
</> ModuleName -> String
ModuleName.toFilePath ModuleName
modName String -> String -> String
forall p. FileLike p => p -> String -> p
<.> String
ext
          AutogenFile ShortText
fileName ->
            String
autogenDir String -> String -> String
forall p q r. PathLike p q r => p -> q -> r
</> ShortText -> String
fromShortText ShortText
fileName
        dir :: String
dir = String -> String
takeDirectory String
path
    -- Ensure that the directory subtree for this autogenerated file exists.
    Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
dir
    -- Write the contents of the file.
    Verbosity -> String -> ByteString -> IO ()
rewriteFileLBS Verbosity
verbosity String
path ByteString
contents
  where
    autogenDir :: String
autogenDir = LocalBuildInfo -> SymbolicPath Pkg ('Dir Source) -> String
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPathLBI LocalBuildInfo
lbi (SymbolicPath Pkg ('Dir Source) -> String)
-> SymbolicPath Pkg ('Dir Source) -> String
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi