{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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

    -- * Repl
  , repl
  , startInterpreter

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

    -- ** Legacy functions
  , componentInitialBuildSteps
  , initialBuildSteps

    -- * Internal package database creation
  , createInternalPackageDB
  ) 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)
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 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.Config
import Distribution.Simple.Setup.Repl
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, getCurrentDirectory, 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 PackageDescription
pkg_descr LocalBuildInfo
lbi BuildFlags
flags [PPSuffixHandler]
suffixes = do
  Verbosity -> Compiler -> BuildFlags -> IO ()
checkSemaphoreSupport Verbosity
verbosity (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) BuildFlags
flags
  [TargetInfo]
targets <- Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [String]
-> IO [TargetInfo]
readTargetInfos Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi (BuildFlags -> [String]
buildArgs BuildFlags
flags)
  let componentsToBuild :: [TargetInfo]
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)
  Verbosity -> String -> IO ()
info Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
    String
"Component build order: "
      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]
componentsToBuild
        )

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([TargetInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TargetInfo]
targets) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    -- Only bother with this message if we're building the whole package
    Verbosity -> String -> PackageIdentifier -> IO ()
setupMessage Verbosity
verbosity String
"Building" (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg_descr)

  PackageDB
internalPackageDB <- Verbosity -> LocalBuildInfo -> String -> IO PackageDB
createInternalPackageDB Verbosity
verbosity LocalBuildInfo
lbi String
distPref

  -- Before the actual building, dump out build-information.
  -- This way, if the actual compilation failed, the options have still been
  -- dumped.
  Verbosity
-> String
-> Flag DumpBuildInfo
-> PackageDescription
-> LocalBuildInfo
-> BuildFlags
-> IO ()
dumpBuildInfo Verbosity
verbosity String
distPref (ConfigFlags -> Flag DumpBuildInfo
configDumpBuildInfo (LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi)) PackageDescription
pkg_descr LocalBuildInfo
lbi BuildFlags
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 -> TargetInfo -> IO InstalledPackageIndex)
 -> IO ())
-> (InstalledPackageIndex
    -> TargetInfo -> IO InstalledPackageIndex)
-> IO ()
forall a b. (a -> b) -> a -> b
$ \InstalledPackageIndex
index TargetInfo
target -> do
    Verbosity -> LocalBuildInfo -> TargetInfo -> IO ()
preBuildComponent Verbosity
verbosity LocalBuildInfo
lbi TargetInfo
target
    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
        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
            }
    Flag (ParStratX String)
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 BuildFlags -> Flag (Maybe Int)
buildNumJobs BuildFlags
flags 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 BuildFlags -> Flag (Maybe Int)
buildNumJobs BuildFlags
flags 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
    Maybe InstalledPackageInfo
mb_ipi <-
      BuildFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> Component
-> ComponentLocalBuildInfo
-> String
-> IO (Maybe InstalledPackageInfo)
buildComponent
        BuildFlags
flags
        Flag (ParStratX String)
par_strat
        PackageDescription
pkg_descr
        LocalBuildInfo
lbi'
        [PPSuffixHandler]
suffixes
        Component
comp
        ComponentLocalBuildInfo
clbi
        String
distPref
    InstalledPackageIndex -> IO InstalledPackageIndex
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex
-> (InstalledPackageInfo -> InstalledPackageIndex)
-> Maybe InstalledPackageInfo
-> InstalledPackageIndex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstalledPackageIndex
index (InstalledPackageInfo
-> InstalledPackageIndex -> InstalledPackageIndex
Index.insert (InstalledPackageInfo
 -> InstalledPackageIndex -> InstalledPackageIndex)
-> InstalledPackageIndex
-> InstalledPackageInfo
-> InstalledPackageIndex
forall a b c. (a -> b -> c) -> b -> a -> c
`flip` InstalledPackageIndex
index) Maybe InstalledPackageInfo
mb_ipi)

  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    distPref :: String
distPref = Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (BuildFlags -> Flag String
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
  -> FilePath
  -- ^ 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
-> String
-> Flag DumpBuildInfo
-> PackageDescription
-> LocalBuildInfo
-> BuildFlags
-> IO ()
dumpBuildInfo Verbosity
verbosity String
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
          )
    String
pwd <- IO String
getCurrentDirectory

    (ConfiguredProgram
compilerProg, ProgramDb
_) <- 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)

    let ([String]
warns, Json
json) = String
-> PackageDescription
-> LocalBuildInfo
-> BuildFlags
-> (ConfiguredProgram, Compiler)
-> [TargetInfo]
-> ([String], Json)
mkBuildInfo String
pwd PackageDescription
pkg_descr LocalBuildInfo
lbi BuildFlags
flags (ConfiguredProgram
compilerProg, LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) [TargetInfo]
activeTargets
        buildInfoText :: ByteString
buildInfoText = Json -> ByteString
renderJson Json
json
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
warns) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"Encountered warnings while dumping build-info:\n"
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [String]
warns
    String -> ByteString -> IO ()
LBS.writeFile (String -> String
buildInfoPref String
distPref) ByteString
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.
    Bool
exists <- String -> IO Bool
doesFileExist (String -> String
buildInfoPref String
distPref)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFile (String -> String
buildInfoPref String
distPref)
  where
    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 PackageDescription
pkg_descr LocalBuildInfo
lbi ReplFlags
flags [PPSuffixHandler]
suffixes [String]
args = do
  let distPref :: String
distPref = Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (ReplFlags -> Flag String
replDistPref ReplFlags
flags)
      verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (ReplFlags -> Flag Verbosity
replVerbosity ReplFlags
flags)

  TargetInfo
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 :: [TargetInfo]
componentsToBuild = PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi [TargetInfo -> Key TargetInfo
forall a. IsNode a => a -> Key a
nodeKey TargetInfo
target]
  Verbosity -> String -> IO ()
debug Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
    String
"Component build order: "
      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]
componentsToBuild
        )

  PackageDB
internalPackageDB <- Verbosity -> LocalBuildInfo -> String -> IO PackageDB
createInternalPackageDB Verbosity
verbosity LocalBuildInfo
lbi String
distPref

  let lbiForComponent :: Component -> LocalBuildInfo -> LocalBuildInfo
lbiForComponent Component
comp LocalBuildInfo
lbi' =
        LocalBuildInfo
lbi'
          { withPackageDB = withPackageDB lbi ++ [internalPackageDB]
          , withPrograms =
              addInternalBuildTools
                pkg_descr
                lbi'
                (componentBuildInfo comp)
                (withPrograms lbi')
          }

  -- build any dependent components
  [IO (Maybe InstalledPackageInfo)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
    [ do
      let clbi :: ComponentLocalBuildInfo
clbi = TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
subtarget
          comp :: Component
comp = TargetInfo -> Component
targetComponent TargetInfo
subtarget
          lbi' :: LocalBuildInfo
lbi' = Component -> LocalBuildInfo -> LocalBuildInfo
lbiForComponent Component
comp LocalBuildInfo
lbi
      Verbosity -> LocalBuildInfo -> TargetInfo -> IO ()
preBuildComponent Verbosity
verbosity LocalBuildInfo
lbi TargetInfo
subtarget
      BuildFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> Component
-> ComponentLocalBuildInfo
-> String
-> IO (Maybe InstalledPackageInfo)
buildComponent
        BuildFlags
forall a. Monoid a => a
mempty{buildVerbosity = toFlag verbosity}
        Flag (ParStratX String)
forall a. Flag a
NoFlag
        PackageDescription
pkg_descr
        LocalBuildInfo
lbi'
        [PPSuffixHandler]
suffixes
        Component
comp
        ComponentLocalBuildInfo
clbi
        String
distPref
    | TargetInfo
subtarget <- [TargetInfo] -> [TargetInfo]
forall a. [a] -> [a]
safeInit [TargetInfo]
componentsToBuild
    ]

  -- REPL for target components
  let clbi :: ComponentLocalBuildInfo
clbi = TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target
      comp :: Component
comp = TargetInfo -> Component
targetComponent TargetInfo
target
      lbi' :: LocalBuildInfo
lbi' = Component -> LocalBuildInfo -> LocalBuildInfo
lbiForComponent Component
comp LocalBuildInfo
lbi
  Verbosity -> LocalBuildInfo -> TargetInfo -> IO ()
preBuildComponent Verbosity
verbosity LocalBuildInfo
lbi TargetInfo
target
  ReplFlags
-> Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> Component
-> ComponentLocalBuildInfo
-> String
-> IO ()
replComponent ReplFlags
flags Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi' [PPSuffixHandler]
suffixes Component
comp ComponentLocalBuildInfo
clbi String
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
  -> FilePath
  -> IO (Maybe InstalledPackageInfo)
buildComponent :: BuildFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> Component
-> ComponentLocalBuildInfo
-> String
-> IO (Maybe InstalledPackageInfo)
buildComponent BuildFlags
flags Flag (ParStratX String)
_ PackageDescription
_ LocalBuildInfo
_ [PPSuffixHandler]
_ (CTest TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteUnsupported TestType
tt}) ComponentLocalBuildInfo
_ String
_ =
  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
_ String
_ =
  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]
suffixes
  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.
  String
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
      String
pwd <- IO String
getCurrentDirectory
      let (PackageDescription
pkg, Library
lib, ComponentLocalBuildInfo
libClbi, LocalBuildInfo
lbi, InstalledPackageInfo
ipi, Executable
exe, ComponentLocalBuildInfo
exeClbi) =
            PackageDescription
-> TestSuite
-> ComponentLocalBuildInfo
-> LocalBuildInfo
-> String
-> String
-> (PackageDescription, Library, ComponentLocalBuildInfo,
    LocalBuildInfo, InstalledPackageInfo, Executable,
    ComponentLocalBuildInfo)
testSuiteLibV09AsLibAndExe PackageDescription
pkg_descr TestSuite
test ComponentLocalBuildInfo
clbi LocalBuildInfo
lbi0 String
distPref String
pwd
      PackageDescription
-> Component
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessComponent PackageDescription
pkg_descr Component
comp LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Bool
False Verbosity
verbosity [PPSuffixHandler]
suffixes
      [String]
extras <- Verbosity -> Component -> LocalBuildInfo -> IO [String]
preprocessExtras Verbosity
verbosity Component
comp LocalBuildInfo
lbi -- TODO find cpphs processed files
      (String
genDir, [ModuleName]
generatedExtras) <- [String]
-> UnqualComponentName
-> PackageDescription
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Verbosity
-> IO (String, [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
      Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, OpenModule)]
-> IO ()
forall a.
Pretty a =>
Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage'
        Verbosity
verbosity
        String
"Building"
        (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg_descr)
        (ComponentLocalBuildInfo -> ComponentName
componentLocalName ComponentLocalBuildInfo
clbi)
        (ComponentLocalBuildInfo -> Maybe [(ModuleName, OpenModule)]
maybeComponentInstantiatedWith ComponentLocalBuildInfo
clbi)
      let libbi :: BuildInfo
libbi = Library -> BuildInfo
libBuildInfo Library
lib
          lib' :: Library
lib' = Library
lib{libBuildInfo = addSrcDir (addExtraOtherModules libbi generatedExtras) genDir}
      BuildFlags
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib BuildFlags
flags Flag (ParStratX String)
numJobs PackageDescription
pkg LocalBuildInfo
lbi Library
lib' ComponentLocalBuildInfo
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.
      Verbosity
-> Compiler
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage
        Verbosity
verbosity
        (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
        (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
        (LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi)
        InstalledPackageInfo
ipi
        RegisterOptions
HcPkg.defaultRegisterOptions
          { HcPkg.registerMultiInstance = True
          }
      let ebi :: BuildInfo
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' = Executable
exe{buildInfo = (addExtraCSources ebi extras){otherModules = []}}
      Verbosity
-> Flag (ParStratX String)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe Verbosity
verbosity Flag (ParStratX String)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Executable
exe' ComponentLocalBuildInfo
exeClbi
      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 -- Can't depend on test suite
buildComponent
  BuildFlags
flags
  Flag (ParStratX String)
numJobs
  PackageDescription
pkg_descr
  LocalBuildInfo
lbi
  [PPSuffixHandler]
suffixes
  Component
comp
  ComponentLocalBuildInfo
clbi
  String
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]
suffixes
      [String]
extras <- Verbosity -> Component -> LocalBuildInfo -> IO [String]
preprocessExtras Verbosity
verbosity Component
comp LocalBuildInfo
lbi
      Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, OpenModule)]
-> IO ()
forall a.
Pretty a =>
Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage'
        Verbosity
verbosity
        String
"Building"
        (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg_descr)
        (ComponentLocalBuildInfo -> ComponentName
componentLocalName ComponentLocalBuildInfo
clbi)
        (ComponentLocalBuildInfo -> Maybe [(ModuleName, OpenModule)]
maybeComponentInstantiatedWith ComponentLocalBuildInfo
clbi)
      case Component
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.
              String
pwd <- IO String
getCurrentDirectory
              let
                -- The in place registration uses the "-inplace" suffix, not an ABI hash
                installedPkgInfo :: InstalledPackageInfo
installedPkgInfo =
                  String
-> String
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstalledPackageInfo
inplaceInstalledPackageInfo
                    String
pwd
                    String
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
              Verbosity -> String -> IO ()
debug Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Registering inplace:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (InstalledPackageInfo -> String
IPI.showInstalledPackageInfo InstalledPackageInfo
installedPkgInfo)
              Verbosity
-> Compiler
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage
                Verbosity
verbosity
                (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
                (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
                (LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi)
                InstalledPackageInfo
installedPkgInfo
                RegisterOptions
HcPkg.defaultRegisterOptions
                  { HcPkg.registerMultiInstance = True
                  }
              Maybe InstalledPackageInfo -> IO (Maybe InstalledPackageInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageInfo -> Maybe InstalledPackageInfo
forall a. a -> Maybe a
Just InstalledPackageInfo
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
          (String
genDir, [ModuleName]
generatedExtras) <- [String]
-> UnqualComponentName
-> PackageDescription
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Verbosity
-> IO (String, [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 :: BuildInfo
ebi = Executable -> BuildInfo
buildInfo Executable
exe
              exe' :: Executable
exe' = Executable
exe{buildInfo = addSrcDir (addExtraOtherModules (addExtraCSources ebi extras) generatedExtras) genDir} -- todo extend hssrcdirs
          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
        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 (FilePath, [ModuleName.ModuleName])
generateCode :: [String]
-> UnqualComponentName
-> PackageDescription
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Verbosity
-> IO (String, [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
tgtDir
  (\[ModuleName]
x -> (String
tgtDir, [ModuleName]
x)) ([ModuleName] -> (String, [ModuleName]))
-> ([[ModuleName]] -> [ModuleName])
-> [[ModuleName]]
-> (String, [ModuleName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ModuleName]] -> [ModuleName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ModuleName]] -> (String, [ModuleName]))
-> IO [[ModuleName]] -> IO (String, [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 PackageDir SourceDir]
srcDirs = (Library -> [SymbolicPath PackageDir SourceDir])
-> [Library] -> [SymbolicPath PackageDir SourceDir]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs (BuildInfo -> [SymbolicPath PackageDir SourceDir])
-> (Library -> BuildInfo)
-> Library
-> [SymbolicPath PackageDir SourceDir]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo) [Library]
dependencyLibs
    nm' :: String
nm' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
nm
    tgtDir :: String
tgtDir = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
nm' String -> String -> String
</> 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 -> Program -> ProgramDb -> [String] -> IO String
getDbProgramOutput
          Verbosity
verbosity
          (String -> Program
simpleProgram String
codeGenProg)
          (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
          ( (String
tgtDir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath [SymbolicPath PackageDir SourceDir]
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
-> String
-> GhcOptions
GHC.componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi String
tgtDir)
                 )
          )

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

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

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

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

-- | Add extra JS sources generated by preprocessing to build
-- information.
addExtraJsSources :: BuildInfo -> [FilePath] -> BuildInfo
addExtraJsSources :: BuildInfo -> [String] -> BuildInfo
addExtraJsSources BuildInfo
bi [String]
extras = BuildInfo
bi{jsSources = new}
  where
    new :: [String]
new = [String] -> [String]
forall a. Ord a => [a] -> [a]
ordNub ([String]
extras [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
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 -> FilePath -> BuildInfo
addSrcDir :: BuildInfo -> String -> BuildInfo
addSrcDir BuildInfo
bi String
extra = BuildInfo
bi{hsSourceDirs = new}
  where
    new :: [SymbolicPath PackageDir SourceDir]
new = [SymbolicPath PackageDir SourceDir]
-> [SymbolicPath PackageDir SourceDir]
forall a. Ord a => [a] -> [a]
ordNub (String -> SymbolicPath PackageDir SourceDir
forall from to. String -> SymbolicPath from to
unsafeMakeSymbolicPath String
extra SymbolicPath PackageDir SourceDir
-> [SymbolicPath PackageDir SourceDir]
-> [SymbolicPath PackageDir SourceDir]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)

replComponent
  :: ReplFlags
  -> Verbosity
  -> PackageDescription
  -> LocalBuildInfo
  -> [PPSuffixHandler]
  -> Component
  -> ComponentLocalBuildInfo
  -> FilePath
  -> IO ()
replComponent :: ReplFlags
-> Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> Component
-> ComponentLocalBuildInfo
-> String
-> IO ()
replComponent ReplFlags
_ Verbosity
verbosity PackageDescription
_ LocalBuildInfo
_ [PPSuffixHandler]
_ (CTest TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteUnsupported TestType
tt}) ComponentLocalBuildInfo
_ String
_ =
  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
_ String
_ =
  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]
suffixes
  comp :: Component
comp@( CTest
          test :: TestSuite
test@TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteLibV09{}}
        )
  ComponentLocalBuildInfo
clbi
  String
distPref = do
    String
pwd <- IO String
getCurrentDirectory
    let (PackageDescription
pkg, Library
lib, ComponentLocalBuildInfo
libClbi, LocalBuildInfo
lbi, InstalledPackageInfo
_, Executable
_, ComponentLocalBuildInfo
_) =
          PackageDescription
-> TestSuite
-> ComponentLocalBuildInfo
-> LocalBuildInfo
-> String
-> String
-> (PackageDescription, Library, ComponentLocalBuildInfo,
    LocalBuildInfo, InstalledPackageInfo, Executable,
    ComponentLocalBuildInfo)
testSuiteLibV09AsLibAndExe PackageDescription
pkg_descr TestSuite
test ComponentLocalBuildInfo
clbi LocalBuildInfo
lbi0 String
distPref String
pwd
    PackageDescription
-> Component
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessComponent PackageDescription
pkg_descr Component
comp LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Bool
False Verbosity
verbosity [PPSuffixHandler]
suffixes
    [String]
extras <- Verbosity -> Component -> LocalBuildInfo -> IO [String]
preprocessExtras Verbosity
verbosity Component
comp LocalBuildInfo
lbi
    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 LocalBuildInfo
lbi Library
lib' ComponentLocalBuildInfo
libClbi
replComponent
  ReplFlags
replFlags
  Verbosity
verbosity
  PackageDescription
pkg_descr
  LocalBuildInfo
lbi
  [PPSuffixHandler]
suffixes
  Component
comp
  ComponentLocalBuildInfo
clbi
  String
_ =
    do
      PackageDescription
-> Component
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessComponent PackageDescription
pkg_descr Component
comp LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Bool
False Verbosity
verbosity [PPSuffixHandler]
suffixes
      [String]
extras <- Verbosity -> Component -> LocalBuildInfo -> IO [String]
preprocessExtras Verbosity
verbosity Component
comp LocalBuildInfo
lbi
      case Component
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
_ String
mainFile} =
  Executable
    { exeName :: UnqualComponentName
exeName = TestSuite -> UnqualComponentName
testName TestSuite
test
    , modulePath :: String
modulePath = String
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
_ String
mainFile} =
  Executable
    { exeName :: UnqualComponentName
exeName = Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm
    , modulePath :: String
modulePath = String
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
  -> FilePath
  -> FilePath
  -> ( PackageDescription
     , Library
     , ComponentLocalBuildInfo
     , LocalBuildInfo
     , IPI.InstalledPackageInfo
     , Executable
     , ComponentLocalBuildInfo
     )
testSuiteLibV09AsLibAndExe :: PackageDescription
-> TestSuite
-> ComponentLocalBuildInfo
-> LocalBuildInfo
-> String
-> String
-> (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
  String
distPref
  String
pwd =
    (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 = String
-> String
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstalledPackageInfo
inplaceInstalledPackageInfo String
pwd String
distPref PackageDescription
pkg (String -> AbiHash
mkAbiHash String
"") Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
libClbi
      testDir :: String
testDir =
        LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi
          String -> String -> String
</> TestSuite -> String
stubName TestSuite
test
          String -> String -> String
</> TestSuite -> String
stubName TestSuite
test
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp"
      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 :: String
modulePath = TestSuite -> String
stubFilePath TestSuite
test
          , exeScope :: ExecutableScope
exeScope = ExecutableScope
ExecutablePublic
          , buildInfo :: BuildInfo
buildInfo =
              (TestSuite -> BuildInfo
testBuildInfo TestSuite
test)
                { hsSourceDirs = [unsafeMakeSymbolicPath testDir]
                , 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
_ String
_ String
_ = 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
  -> FilePath
  -> IO PackageDB
createInternalPackageDB :: Verbosity -> LocalBuildInfo -> String -> IO PackageDB
createInternalPackageDB Verbosity
verbosity LocalBuildInfo
lbi String
distPref = do
  Bool
existsAlready <- String -> IO Bool
doesPackageDBExist String
dbPath
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
existsAlready (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
deletePackageDB String
dbPath
  Verbosity -> Compiler -> ProgramDb -> Bool -> String -> IO ()
createPackageDB Verbosity
verbosity (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) Bool
False String
dbPath
  PackageDB -> IO PackageDB
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PackageDB
SpecificPackageDB String
dbPath)
  where
    dbPath :: String
dbPath = LocalBuildInfo -> String -> String
internalPackageDBPath LocalBuildInfo
lbi String
distPref

addInternalBuildTools
  :: PackageDescription
  -> LocalBuildInfo
  -> BuildInfo
  -> ProgramDb
  -> ProgramDb
addInternalBuildTools :: PackageDescription
-> LocalBuildInfo -> BuildInfo -> ProgramDb -> ProgramDb
addInternalBuildTools PackageDescription
pkg LocalBuildInfo
lbi BuildInfo
bi ProgramDb
progs =
  (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
    internalBuildTools :: [ConfiguredProgram]
internalBuildTools =
      [ String -> ProgramLocation -> ConfiguredProgram
simpleConfiguredProgram String
toolName' (String -> ProgramLocation
FoundOnSystem String
toolLocation)
      | UnqualComponentName
toolName <- PackageDescription -> BuildInfo -> [UnqualComponentName]
getAllInternalToolDependencies PackageDescription
pkg BuildInfo
bi
      , let toolName' :: String
toolName' = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
toolName
      , let toolLocation :: String
toolLocation = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
toolName' String -> String -> String
</> String
toolName' String -> String -> String
<.> Platform -> String
exeExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
      ]

-- 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 -> ComponentLocalBuildInfo -> String
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>'."
  #-}

-- | Pre-build steps for a component: creates the autogenerated files
-- for a particular configured component.
preBuildComponent
  :: Verbosity
  -> LocalBuildInfo
  -- ^ Configuration information
  -> TargetInfo
  -> IO ()
preBuildComponent :: Verbosity -> LocalBuildInfo -> TargetInfo -> IO ()
preBuildComponent 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 -> ComponentLocalBuildInfo -> String
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

-- | 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
</> ModuleName -> String
ModuleName.toFilePath ModuleName
modName String -> String -> String
<.> String
ext
          AutogenFile ShortText
fileName ->
            String
autogenDir String -> String -> String
</> 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 -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi