{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}

-- | Planning how to build everything in a project.
--
module Distribution.Client.ProjectPlanning (
    -- * elaborated install plan types
    ElaboratedInstallPlan,
    ElaboratedConfiguredPackage(..),
    ElaboratedPlanPackage,
    ElaboratedSharedConfig(..),
    ElaboratedReadyPackage,
    BuildStyle(..),
    CabalFileText,

    -- * Producing the elaborated install plan
    rebuildProjectConfig,
    rebuildInstallPlan,

    -- * Build targets
    availableTargets,
    AvailableTarget(..),
    AvailableTargetStatus(..),
    TargetRequested(..),
    ComponentTarget(..),
    SubComponentTarget(..),
    showComponentTarget,
    nubComponentTargets,

    -- * Selecting a plan subset
    pruneInstallPlanToTargets,
    TargetAction(..),
    pruneInstallPlanToDependencies,
    CannotPruneDependencies(..),

    -- * Utils required for building
    pkgHasEphemeralBuildTargets,
    elabBuildTargetWholeComponents,
    configureCompiler,

    -- * Setup.hs CLI flags for building
    setupHsScriptOptions,
    setupHsConfigureFlags,
    setupHsConfigureArgs,
    setupHsBuildFlags,
    setupHsBuildArgs,
    setupHsReplFlags,
    setupHsReplArgs,
    setupHsTestFlags,
    setupHsTestArgs,
    setupHsBenchFlags,
    setupHsBenchArgs,
    setupHsCopyFlags,
    setupHsRegisterFlags,
    setupHsHaddockFlags,
    setupHsHaddockArgs,

    packageHashInputs,

    -- * Path construction
    binDirectoryFor,
    binDirectories,
    storePackageInstallDirs,
    storePackageInstallDirs'
  ) where

import Prelude ()
import Distribution.Client.Compat.Prelude

import           Distribution.Client.HashValue
import           Distribution.Client.HttpUtils
import           Distribution.Client.ProjectPlanning.Types as Ty
import           Distribution.Client.PackageHash
import           Distribution.Client.RebuildMonad
import           Distribution.Client.Store
import           Distribution.Client.ProjectConfig
import           Distribution.Client.ProjectConfig.Legacy
import           Distribution.Client.ProjectPlanOutput

import           Distribution.Client.Types
import qualified Distribution.Client.InstallPlan as InstallPlan
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import           Distribution.Client.Dependency
import           Distribution.Client.Dependency.Types
import qualified Distribution.Client.IndexUtils as IndexUtils
import           Distribution.Client.Utils (incVersion)
import           Distribution.Client.Targets (userToPackageConstraint)
import           Distribution.Client.DistDirLayout
import           Distribution.Client.SetupWrapper
import           Distribution.Client.JobControl
import           Distribution.Client.FetchUtils
import           Distribution.Client.Config
import qualified Hackage.Security.Client as Sec
import           Distribution.Client.Setup hiding (packageName, cabalVersion)
import           Distribution.Utils.NubList
import           Distribution.Utils.LogProgress
import           Distribution.Utils.MapAccum

import qualified Distribution.Client.BuildReports.Storage as BuildReports
         ( storeLocal, fromPlanningFailure )

import qualified Distribution.Solver.Types.ComponentDeps as CD
import           Distribution.Solver.Types.ComponentDeps (ComponentDeps)
import           Distribution.Solver.Types.ConstraintSource
import           Distribution.Solver.Types.LabeledPackageConstraint
import           Distribution.Solver.Types.OptionalStanza
import           Distribution.Solver.Types.PkgConfigDb
import           Distribution.Solver.Types.ResolverPackage
import           Distribution.Solver.Types.SolverId
import           Distribution.Solver.Types.SolverPackage
import           Distribution.Solver.Types.InstSolverPackage
import           Distribution.Solver.Types.SourcePackage
import           Distribution.Solver.Types.Settings

import           Distribution.CabalSpecVersion
import           Distribution.ModuleName
import           Distribution.Package
import           Distribution.Types.AnnotatedId
import           Distribution.Types.ComponentName
import           Distribution.Types.DumpBuildInfo
                   ( DumpBuildInfo (..) )
import           Distribution.Types.LibraryName
import           Distribution.Types.GivenComponent
  (GivenComponent(..))
import           Distribution.Types.PackageVersionConstraint
import           Distribution.Types.PkgconfigDependency
import           Distribution.Types.UnqualComponentName
import           Distribution.System
import qualified Distribution.PackageDescription as Cabal
import qualified Distribution.PackageDescription as PD
import qualified Distribution.PackageDescription.Configuration as PD
import           Distribution.Simple.PackageIndex (InstalledPackageIndex)
import           Distribution.Simple.Compiler
import qualified Distribution.Simple.GHC   as GHC   --TODO: [code cleanup] eliminate
import qualified Distribution.Simple.GHCJS as GHCJS --TODO: [code cleanup] eliminate
import           Distribution.Simple.Program
import           Distribution.Simple.Program.Db
import           Distribution.Simple.Program.Find
import qualified Distribution.Simple.Setup as Cabal
import           Distribution.Simple.Setup
  (Flag(..), toFlag, flagToMaybe, flagToList, fromFlagOrDefault)
import qualified Distribution.Simple.Configure as Cabal
import qualified Distribution.Simple.LocalBuildInfo as Cabal
import           Distribution.Simple.LocalBuildInfo
                   ( Component(..), pkgComponents, componentBuildInfo
                   , componentName )
import qualified Distribution.Simple.InstallDirs as InstallDirs
import qualified Distribution.InstalledPackageInfo as IPI

import           Distribution.Backpack.ConfiguredComponent
import           Distribution.Backpack.LinkedComponent
import           Distribution.Backpack.ComponentsGraph
import           Distribution.Backpack.ModuleShape
import           Distribution.Backpack.FullUnitId
import           Distribution.Backpack
import           Distribution.Types.ComponentInclude

import           Distribution.Simple.Utils
import           Distribution.Version

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

import           Data.Foldable (fold)
import           Text.PrettyPrint (text, hang, quotes, colon, vcat, ($$), fsep, punctuate, comma)
import qualified Text.PrettyPrint as Disp
import qualified Data.Map as Map
import qualified Data.Set as Set
import           Control.Monad (sequence, forM)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.State as State (State, execState, runState, state)
import           Control.Exception (assert)
import           Data.List (groupBy, deleteBy)
import qualified Data.List.NonEmpty as NE
import           System.FilePath

------------------------------------------------------------------------------
-- * Elaborated install plan
------------------------------------------------------------------------------

-- "Elaborated" -- worked out with great care and nicety of detail;
--                 executed with great minuteness: elaborate preparations;
--                 elaborate care.
--
-- So here's the idea:
--
-- Rather than a miscellaneous collection of 'ConfigFlags', 'InstallFlags' etc
-- all passed in as separate args and which are then further selected,
-- transformed etc during the execution of the build. Instead we construct
-- an elaborated install plan that includes everything we will need, and then
-- during the execution of the plan we do as little transformation of this
-- info as possible.
--
-- So we're trying to split the work into two phases: construction of the
-- elaborated install plan (which as far as possible should be pure) and
-- then simple execution of that plan without any smarts, just doing what the
-- plan says to do.
--
-- So that means we need a representation of this fully elaborated install
-- plan. The representation consists of two parts:
--
-- * A 'ElaboratedInstallPlan'. This is a 'GenericInstallPlan' with a
--   representation of source packages that includes a lot more detail about
--   that package's individual configuration
--
-- * A 'ElaboratedSharedConfig'. Some package configuration is the same for
--   every package in a plan. Rather than duplicate that info every entry in
--   the 'GenericInstallPlan' we keep that separately.
--
-- The division between the shared and per-package config is /not set in stone
-- for all time/. For example if we wanted to generalise the install plan to
-- describe a situation where we want to build some packages with GHC and some
-- with GHCJS then the platform and compiler would no longer be shared between
-- all packages but would have to be per-package (probably with some sanity
-- condition on the graph structure).
--

-- Refer to ProjectPlanning.Types for details of these important types:

-- type ElaboratedInstallPlan = ...
-- type ElaboratedPlanPackage = ...
-- data ElaboratedSharedConfig = ...
-- data ElaboratedConfiguredPackage = ...
-- data BuildStyle =


-- | Check that an 'ElaboratedConfiguredPackage' actually makes
-- sense under some 'ElaboratedSharedConfig'.
sanityCheckElaboratedConfiguredPackage
    :: ElaboratedSharedConfig
    -> ElaboratedConfiguredPackage
    -> a
    -> a
sanityCheckElaboratedConfiguredPackage :: forall a.
ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> a -> a
sanityCheckElaboratedConfiguredPackage ElaboratedSharedConfig
sharedConfig
                             elab :: ElaboratedConfiguredPackage
elab@ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
..} =
    (case ElaboratedPackageOrComponent
elabPkgOrComp of
        ElabPackage ElaboratedPackage
pkg -> forall a.
ElaboratedConfiguredPackage -> ElaboratedPackage -> a -> a
sanityCheckElaboratedPackage ElaboratedConfiguredPackage
elab ElaboratedPackage
pkg
        ElabComponent ElaboratedComponent
comp -> forall a.
ElaboratedConfiguredPackage -> ElaboratedComponent -> a -> a
sanityCheckElaboratedComponent ElaboratedConfiguredPackage
elab ElaboratedComponent
comp)

    -- either a package is being built inplace, or the
    -- 'installedPackageId' we assigned is consistent with
    -- the 'hashedInstalledPackageId' we would compute from
    -- the elaborated configured package
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Bool -> a -> a
assert (BuildStyle
elabBuildStyle forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly Bool -> Bool -> Bool
||
     InstalledPackageId
elabComponentId forall a. Eq a => a -> a -> Bool
== PackageHashInputs -> InstalledPackageId
hashedInstalledPackageId
                            (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> PackageHashInputs
packageHashInputs ElaboratedSharedConfig
sharedConfig ElaboratedConfiguredPackage
elab))

    -- the stanzas explicitly disabled should not be available
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Bool -> a -> a
assert (OptionalStanzaSet -> Bool
optStanzaSetNull forall a b. (a -> b) -> a -> b
$
        forall a. (a -> Bool) -> OptionalStanzaMap a -> OptionalStanzaSet
optStanzaKeysFilteredByValue (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
not) OptionalStanzaMap (Maybe Bool)
elabStanzasRequested OptionalStanzaSet -> OptionalStanzaSet -> OptionalStanzaSet
`optStanzaSetIntersection` OptionalStanzaSet
elabStanzasAvailable)

    -- either a package is built inplace, or we are not attempting to
    -- build any test suites or benchmarks (we never build these
    -- for remote packages!)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Bool -> a -> a
assert (BuildStyle
elabBuildStyle forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly Bool -> Bool -> Bool
||
     OptionalStanzaSet -> Bool
optStanzaSetNull OptionalStanzaSet
elabStanzasAvailable)

sanityCheckElaboratedComponent
    :: ElaboratedConfiguredPackage
    -> ElaboratedComponent
    -> a
    -> a
sanityCheckElaboratedComponent :: forall a.
ElaboratedConfiguredPackage -> ElaboratedComponent -> a -> a
sanityCheckElaboratedComponent ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..}
                               ElaboratedComponent{[(PkgconfigName, Maybe PkgconfigVersion)]
[(ConfiguredId, String)]
[OpenUnitId]
[UnitId]
[ConfiguredId]
Maybe ComponentName
Component
compOrderLibDependencies :: ElaboratedComponent -> [UnitId]
compExeDependencyPaths :: ElaboratedComponent -> [(ConfiguredId, String)]
compPkgConfigDependencies :: ElaboratedComponent -> [(PkgconfigName, Maybe PkgconfigVersion)]
compExeDependencies :: ElaboratedComponent -> [ConfiguredId]
compLinkedLibDependencies :: ElaboratedComponent -> [OpenUnitId]
compLibDependencies :: ElaboratedComponent -> [ConfiguredId]
compComponentName :: ElaboratedComponent -> Maybe ComponentName
compSolverName :: ElaboratedComponent -> Component
compOrderLibDependencies :: [UnitId]
compExeDependencyPaths :: [(ConfiguredId, String)]
compPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
compExeDependencies :: [ConfiguredId]
compLinkedLibDependencies :: [OpenUnitId]
compLibDependencies :: [ConfiguredId]
compComponentName :: Maybe ComponentName
compSolverName :: Component
..} =

    -- Should not be building bench or test if not inplace.
    forall a. HasCallStack => Bool -> a -> a
assert (BuildStyle
elabBuildStyle forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly Bool -> Bool -> Bool
||
     case Maybe ComponentName
compComponentName of
        Maybe ComponentName
Nothing              -> Bool
True
        Just (CLibName LibraryName
_)    -> Bool
True
        Just (CExeName UnqualComponentName
_)    -> Bool
True
        -- This is interesting: there's no way to declare a dependency
        -- on a foreign library at the moment, but you may still want
        -- to install these to the store
        Just (CFLibName UnqualComponentName
_)   -> Bool
True
        Just (CBenchName UnqualComponentName
_)  -> Bool
False
        Just (CTestName UnqualComponentName
_)   -> Bool
False)


sanityCheckElaboratedPackage
    :: ElaboratedConfiguredPackage
    -> ElaboratedPackage
    -> a
    -> a
sanityCheckElaboratedPackage :: forall a.
ElaboratedConfiguredPackage -> ElaboratedPackage -> a -> a
sanityCheckElaboratedPackage ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..}
                             ElaboratedPackage{[(PkgconfigName, Maybe PkgconfigVersion)]
InstalledPackageId
OptionalStanzaSet
ComponentDeps [()]
ComponentDeps [(ConfiguredId, String)]
ComponentDeps [ConfiguredId]
pkgStanzasEnabled :: ElaboratedPackage -> OptionalStanzaSet
pkgPkgConfigDependencies :: ElaboratedPackage -> [(PkgconfigName, Maybe PkgconfigVersion)]
pkgExeDependencyPaths :: ElaboratedPackage -> ComponentDeps [(ConfiguredId, String)]
pkgExeDependencies :: ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgDependsOnSelfLib :: ElaboratedPackage -> ComponentDeps [()]
pkgLibDependencies :: ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgInstalledId :: ElaboratedPackage -> InstalledPackageId
pkgStanzasEnabled :: OptionalStanzaSet
pkgPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
pkgExeDependencyPaths :: ComponentDeps [(ConfiguredId, String)]
pkgExeDependencies :: ComponentDeps [ConfiguredId]
pkgDependsOnSelfLib :: ComponentDeps [()]
pkgLibDependencies :: ComponentDeps [ConfiguredId]
pkgInstalledId :: InstalledPackageId
..} =
    -- we should only have enabled stanzas that actually can be built
    -- (according to the solver)
    forall a. HasCallStack => Bool -> a -> a
assert (OptionalStanzaSet
pkgStanzasEnabled OptionalStanzaSet -> OptionalStanzaSet -> Bool
`optStanzaSetIsSubset` OptionalStanzaSet
elabStanzasAvailable)

    -- the stanzas that the user explicitly requested should be
    -- enabled (by the previous test, they are also available)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Bool -> a -> a
assert (forall a. (a -> Bool) -> OptionalStanzaMap a -> OptionalStanzaSet
optStanzaKeysFilteredByValue (forall a. a -> Maybe a -> a
fromMaybe Bool
False) OptionalStanzaMap (Maybe Bool)
elabStanzasRequested
                OptionalStanzaSet -> OptionalStanzaSet -> Bool
`optStanzaSetIsSubset` OptionalStanzaSet
pkgStanzasEnabled)

------------------------------------------------------------------------------
-- * Deciding what to do: making an 'ElaboratedInstallPlan'
------------------------------------------------------------------------------

-- | Return the up-to-date project config and information about the local
-- packages within the project.
--
rebuildProjectConfig :: Verbosity
                     -> HttpTransport
                     -> DistDirLayout
                     -> ProjectConfig
                     -> IO ( ProjectConfig
                           , [PackageSpecifier UnresolvedSourcePackage] )
rebuildProjectConfig :: Verbosity
-> HttpTransport
-> DistDirLayout
-> ProjectConfig
-> IO
     (ProjectConfig,
      [PackageSpecifier (SourcePackage UnresolvedPkgLoc)])
rebuildProjectConfig Verbosity
verbosity
                     HttpTransport
httpTransport
                     distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout {
                       String
distProjectRootDirectory :: DistDirLayout -> String
distProjectRootDirectory :: String
distProjectRootDirectory,
                       String
distDirectory :: DistDirLayout -> String
distDirectory :: String
distDirectory,
                       String -> String
distProjectCacheFile :: DistDirLayout -> String -> String
distProjectCacheFile :: String -> String
distProjectCacheFile,
                       String
distProjectCacheDirectory :: DistDirLayout -> String
distProjectCacheDirectory :: String
distProjectCacheDirectory,
                       String -> String
distProjectFile :: DistDirLayout -> String -> String
distProjectFile :: String -> String
distProjectFile
                     }
                     ProjectConfig
cliConfig = do

    (String, String)
fileMonitorProjectConfigKey <- do
      String
configPath <- Flag String -> IO String
getConfigFilePath Flag String
projectConfigConfigFile
      forall (m :: * -> *) a. Monad m => a -> m a
return (String
configPath, String -> String
distProjectFile String
"")

    (ProjectConfig
projectConfig, [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages) <-
      forall a. String -> Rebuild a -> IO a
runRebuild String
distProjectRootDirectory
      forall a b. (a -> b) -> a -> b
$ forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged Verbosity
verbosity
                       FileMonitor
  (String, String)
  (ProjectConfig,
   [PackageSpecifier (SourcePackage UnresolvedPkgLoc)])
fileMonitorProjectConfig
                       (String, String)
fileMonitorProjectConfigKey -- todo check deps too?
      forall a b. (a -> b) -> a -> b
$ do
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
info Verbosity
verbosity String
"Project settings changed, reconfiguring..."
          ProjectConfigSkeleton
projectConfigSkeleton <- Rebuild ProjectConfigSkeleton
phaseReadProjectConfig
          let fetchCompiler :: Rebuild (OS, Arch, CompilerInfo)
fetchCompiler = do
                 -- have to create the cache directory before configuring the compiler
                 forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
distProjectCacheDirectory
                 (Compiler
compiler, Platform Arch
arch OS
os, ProgramDb
_) <- Verbosity
-> DistDirLayout
-> ProjectConfig
-> Rebuild (Compiler, Platform, ProgramDb)
configureCompiler Verbosity
verbosity DistDirLayout
distDirLayout ((forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
PD.ignoreConditions ProjectConfigSkeleton
projectConfigSkeleton) forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig)
                 forall (f :: * -> *) a. Applicative f => a -> f a
pure (OS
os, Arch
arch, Compiler -> CompilerInfo
compilerInfo Compiler
compiler)

          ProjectConfig
projectConfig <- forall (m :: * -> *).
Monad m =>
m (OS, Arch, CompilerInfo)
-> FlagAssignment -> ProjectConfigSkeleton -> m ProjectConfig
instantiateProjectConfigSkeletonFetchingCompiler Rebuild (OS, Arch, CompilerInfo)
fetchCompiler forall a. Monoid a => a
mempty ProjectConfigSkeleton
projectConfigSkeleton
          [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages <- ProjectConfig
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
phaseReadLocalPackages (ProjectConfig
projectConfig forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig)
          forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectConfig
projectConfig, [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages)

    Verbosity -> String -> IO ()
info Verbosity
verbosity
      forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
      forall a b. (a -> b) -> a -> b
$ (String
"this build was affected by the following (project) config files:" forall a. a -> [a] -> [a]
:)
      forall a b. (a -> b) -> a -> b
$ [ String
"- " forall a. [a] -> [a] -> [a]
++ String
path
        | Explicit String
path <- forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ ProjectConfig -> Set ProjectConfigProvenance
projectConfigProvenance ProjectConfig
projectConfig
        ]

    forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectConfig
projectConfig forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig, [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages)

  where

    ProjectConfigShared { Flag String
projectConfigConfigFile :: ProjectConfigShared -> Flag String
projectConfigConfigFile :: Flag String
projectConfigConfigFile } =
      ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig

    ProjectConfigShared { Flag Bool
projectConfigIgnoreProject :: ProjectConfigShared -> Flag Bool
projectConfigIgnoreProject :: Flag Bool
projectConfigIgnoreProject } =
      ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig

    fileMonitorProjectConfig ::
      FileMonitor
        (FilePath, FilePath)
        (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
    fileMonitorProjectConfig :: FileMonitor
  (String, String)
  (ProjectConfig,
   [PackageSpecifier (SourcePackage UnresolvedPkgLoc)])
fileMonitorProjectConfig =
      forall a b. Eq a => String -> FileMonitor a b
newFileMonitor (String -> String
distProjectCacheFile String
"config")

    -- Read the cabal.project (or implicit config) and combine it with
    -- arguments from the command line
    --
    phaseReadProjectConfig :: Rebuild ProjectConfigSkeleton
    phaseReadProjectConfig :: Rebuild ProjectConfigSkeleton
phaseReadProjectConfig = do
      Verbosity
-> HttpTransport
-> Flag Bool
-> Flag String
-> DistDirLayout
-> Rebuild ProjectConfigSkeleton
readProjectConfig Verbosity
verbosity HttpTransport
httpTransport Flag Bool
projectConfigIgnoreProject Flag String
projectConfigConfigFile DistDirLayout
distDirLayout

    -- Look for all the cabal packages in the project
    -- some of which may be local src dirs, tarballs etc
    --
    phaseReadLocalPackages :: ProjectConfig
                           -> Rebuild [PackageSpecifier UnresolvedSourcePackage]
    phaseReadLocalPackages :: ProjectConfig
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
phaseReadLocalPackages projectConfig :: ProjectConfig
projectConfig@ProjectConfig {
                               ProjectConfigShared
projectConfigShared :: ProjectConfigShared
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared,
                               ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfigBuildOnly
projectConfigBuildOnly
                             } = do

      [ProjectPackageLocation]
pkgLocations <- DistDirLayout -> ProjectConfig -> Rebuild [ProjectPackageLocation]
findProjectPackages DistDirLayout
distDirLayout ProjectConfig
projectConfig
      -- Create folder only if findProjectPackages did not throw a
      -- BadPackageLocations exception.
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
distDirectory
        Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
distProjectCacheDirectory

      Verbosity
-> DistDirLayout
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> [ProjectPackageLocation]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
fetchAndReadSourcePackages Verbosity
verbosity DistDirLayout
distDirLayout
                                 ProjectConfigShared
projectConfigShared
                                 ProjectConfigBuildOnly
projectConfigBuildOnly
                                 [ProjectPackageLocation]
pkgLocations


configureCompiler :: Verbosity ->
                     DistDirLayout ->
                     ProjectConfig ->
                     Rebuild (Compiler, Platform, ProgramDb)
configureCompiler :: Verbosity
-> DistDirLayout
-> ProjectConfig
-> Rebuild (Compiler, Platform, ProgramDb)
configureCompiler Verbosity
verbosity
                  DistDirLayout {
                     String -> String
distProjectCacheFile :: String -> String
distProjectCacheFile :: DistDirLayout -> String -> String
distProjectCacheFile
                   }
                  ProjectConfig {
                             projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared = ProjectConfigShared {
                               Flag CompilerFlavor
projectConfigHcFlavor :: ProjectConfigShared -> Flag CompilerFlavor
projectConfigHcFlavor :: Flag CompilerFlavor
projectConfigHcFlavor,
                               Flag String
projectConfigHcPath :: ProjectConfigShared -> Flag String
projectConfigHcPath :: Flag String
projectConfigHcPath,
                               Flag String
projectConfigHcPkg :: ProjectConfigShared -> Flag String
projectConfigHcPkg :: Flag String
projectConfigHcPkg
                             },
                             projectConfigLocalPackages :: ProjectConfig -> PackageConfig
projectConfigLocalPackages = PackageConfig {
                               MapLast String String
packageConfigProgramPaths :: PackageConfig -> MapLast String String
packageConfigProgramPaths :: MapLast String String
packageConfigProgramPaths,
                               NubList String
packageConfigProgramPathExtra :: PackageConfig -> NubList String
packageConfigProgramPathExtra :: NubList String
packageConfigProgramPathExtra
                             }
                           } = do
        let fileMonitorCompiler :: FileMonitor
  (Maybe CompilerFlavor, Maybe String, Maybe String, [String],
   MapLast String String, NubList String)
  b
fileMonitorCompiler       = forall a b. Eq a => String -> FileMonitor a b
newFileMonitor forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
distProjectCacheFile forall a b. (a -> b) -> a -> b
$ String
"compiler"

        [String]
progsearchpath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO [String]
getSystemSearchPath
        forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged Verbosity
verbosity forall {b}.
FileMonitor
  (Maybe CompilerFlavor, Maybe String, Maybe String, [String],
   MapLast String String, NubList String)
  b
fileMonitorCompiler
                       (Maybe CompilerFlavor
hcFlavor, Maybe String
hcPath, Maybe String
hcPkg, [String]
progsearchpath,
                        MapLast String String
packageConfigProgramPaths,
                        NubList String
packageConfigProgramPathExtra) forall a b. (a -> b) -> a -> b
$ do

          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
info Verbosity
verbosity String
"Compiler settings changed, reconfiguring..."
          result :: (Compiler, Platform, ProgramDb)
result@(Compiler
_, Platform
_, ProgramDb
progdb') <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            Maybe CompilerFlavor
-> Maybe String
-> Maybe String
-> ProgramDb
-> Verbosity
-> IO (Compiler, Platform, ProgramDb)
Cabal.configCompilerEx
              Maybe CompilerFlavor
hcFlavor Maybe String
hcPath Maybe String
hcPkg
              ProgramDb
progdb Verbosity
verbosity

        -- Note that we added the user-supplied program locations and args
        -- for /all/ programs, not just those for the compiler prog and
        -- compiler-related utils. In principle we don't know which programs
        -- the compiler will configure (and it does vary between compilers).
        -- We do know however that the compiler will only configure the
        -- programs it cares about, and those are the ones we monitor here.
          [MonitorFilePath] -> Rebuild ()
monitorFiles (ProgramDb -> [MonitorFilePath]
programsMonitorFiles ProgramDb
progdb')

          forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler, Platform, ProgramDb)
result
      where
        hcFlavor :: Maybe CompilerFlavor
hcFlavor = forall a. Flag a -> Maybe a
flagToMaybe Flag CompilerFlavor
projectConfigHcFlavor
        hcPath :: Maybe String
hcPath   = forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigHcPath
        hcPkg :: Maybe String
hcPkg    = forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigHcPkg
        progdb :: ProgramDb
progdb   =
            [(String, String)] -> ProgramDb -> ProgramDb
userSpecifyPaths (forall k a. Map k a -> [(k, a)]
Map.toList (forall k v. MapLast k v -> Map k v
getMapLast MapLast String String
packageConfigProgramPaths))
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgramSearchPath -> ProgramSearchPath) -> ProgramDb -> ProgramDb
modifyProgramSearchPath
              ([ String -> ProgramSearchPathEntry
ProgramSearchPathDir String
dir
               | String
dir <- forall a. NubList a -> [a]
fromNubList NubList String
packageConfigProgramPathExtra ] forall a. [a] -> [a] -> [a]
++)
          forall a b. (a -> b) -> a -> b
$ ProgramDb
defaultProgramDb


-- | Return an up-to-date elaborated install plan.
--
-- Two variants of the install plan are returned: with and without packages
-- from the store. That is, the \"improved\" plan where source packages are
-- replaced by pre-existing installed packages from the store (when their ids
-- match), and also the original elaborated plan which uses primarily source
-- packages.

-- The improved plan is what we use for building, but the original elaborated
-- plan is useful for reporting and configuration. For example the @freeze@
-- command needs the source package info to know about flag choices and
-- dependencies of executables and setup scripts.
--
rebuildInstallPlan :: Verbosity
                   -> DistDirLayout -> CabalDirLayout
                   -> ProjectConfig
                   -> [PackageSpecifier UnresolvedSourcePackage]
                   -> Maybe InstalledPackageIndex
                   -> IO ( ElaboratedInstallPlan  -- with store packages
                         , ElaboratedInstallPlan  -- with source packages
                         , ElaboratedSharedConfig
                         , IndexUtils.TotalIndexState
                         , IndexUtils.ActiveRepos
                         )
                      -- ^ @(improvedPlan, elaboratedPlan, _, _, _)@
rebuildInstallPlan :: Verbosity
-> DistDirLayout
-> CabalDirLayout
-> ProjectConfig
-> [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
-> Maybe InstalledPackageIndex
-> IO
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
rebuildInstallPlan Verbosity
verbosity
                   distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout {
                     String
distProjectRootDirectory :: String
distProjectRootDirectory :: DistDirLayout -> String
distProjectRootDirectory,
                     String -> String
distProjectCacheFile :: String -> String
distProjectCacheFile :: DistDirLayout -> String -> String
distProjectCacheFile
                   }
                   CabalDirLayout {
                     StoreDirLayout
cabalStoreDirLayout :: CabalDirLayout -> StoreDirLayout
cabalStoreDirLayout :: StoreDirLayout
cabalStoreDirLayout
                   } = \ProjectConfig
projectConfig [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages Maybe InstalledPackageIndex
mbInstalledPackages ->
    forall a. String -> Rebuild a -> IO a
runRebuild String
distProjectRootDirectory forall a b. (a -> b) -> a -> b
$ do
    [String]
progsearchpath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO [String]
getSystemSearchPath
    let projectConfigMonitored :: ProjectConfig
projectConfigMonitored = ProjectConfig
projectConfig { projectConfigBuildOnly :: ProjectConfigBuildOnly
projectConfigBuildOnly = forall a. Monoid a => a
mempty }

    -- The overall improved plan is cached
    forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged Verbosity
verbosity forall {b}.
FileMonitor
  (ProjectConfig,
   [PackageSpecifier (SourcePackage UnresolvedPkgLoc)], [String])
  b
fileMonitorImprovedPlan
                   -- react to changes in the project config,
                   -- the package .cabal files and the path
                   (ProjectConfig
projectConfigMonitored, [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages, [String]
progsearchpath) forall a b. (a -> b) -> a -> b
$ do

      -- And so is the elaborated plan that the improved plan based on
      (ElaboratedInstallPlan
elaboratedPlan, ElaboratedSharedConfig
elaboratedShared, TotalIndexState
totalIndexState, ActiveRepos
activeRepos) <-
        forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged Verbosity
verbosity forall {b}.
FileMonitor
  (ProjectConfig,
   [PackageSpecifier (SourcePackage UnresolvedPkgLoc)], [String])
  b
fileMonitorElaboratedPlan
                       (ProjectConfig
projectConfigMonitored, [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages,
                        [String]
progsearchpath) forall a b. (a -> b) -> a -> b
$ do

          (Compiler, Platform, ProgramDb)
compilerEtc   <- ProjectConfig -> Rebuild (Compiler, Platform, ProgramDb)
phaseConfigureCompiler ProjectConfig
projectConfig
          ()
_             <- ProjectConfig -> (Compiler, Platform, ProgramDb) -> Rebuild ()
phaseConfigurePrograms ProjectConfig
projectConfig (Compiler, Platform, ProgramDb)
compilerEtc
          (SolverInstallPlan
solverPlan, PkgConfigDb
pkgConfigDB, TotalIndexState
totalIndexState, ActiveRepos
activeRepos)
                        <- ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
-> InstalledPackageIndex
-> Rebuild
     (SolverInstallPlan, PkgConfigDb, TotalIndexState, ActiveRepos)
phaseRunSolver         ProjectConfig
projectConfig
                                                  (Compiler, Platform, ProgramDb)
compilerEtc
                                                  [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages
                                                  (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe InstalledPackageIndex
mbInstalledPackages)
          (ElaboratedInstallPlan
elaboratedPlan,
           ElaboratedSharedConfig
elaboratedShared) <- forall loc.
ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> PkgConfigDb
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig)
phaseElaboratePlan ProjectConfig
projectConfig
                                                   (Compiler, Platform, ProgramDb)
compilerEtc PkgConfigDb
pkgConfigDB
                                                   SolverInstallPlan
solverPlan
                                                   [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages

          ElaboratedInstallPlan -> ElaboratedSharedConfig -> Rebuild ()
phaseMaintainPlanOutputs ElaboratedInstallPlan
elaboratedPlan ElaboratedSharedConfig
elaboratedShared
          forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
elaboratedPlan, ElaboratedSharedConfig
elaboratedShared, TotalIndexState
totalIndexState, ActiveRepos
activeRepos)

      -- The improved plan changes each time we install something, whereas
      -- the underlying elaborated plan only changes when input config
      -- changes, so it's worth caching them separately.
      ElaboratedInstallPlan
improvedPlan <- ElaboratedInstallPlan
-> ElaboratedSharedConfig -> Rebuild ElaboratedInstallPlan
phaseImprovePlan ElaboratedInstallPlan
elaboratedPlan ElaboratedSharedConfig
elaboratedShared

      forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
improvedPlan, ElaboratedInstallPlan
elaboratedPlan, ElaboratedSharedConfig
elaboratedShared, TotalIndexState
totalIndexState, ActiveRepos
activeRepos)

  where
    fileMonitorSolverPlan :: FileMonitor
  (SolverSettings,
   [PackageSpecifier (SourcePackage UnresolvedPkgLoc)],
   Map PackageName (Map OptionalStanza Bool), Compiler, Platform,
   [ConfiguredProgram])
  b
fileMonitorSolverPlan     = forall a b. Eq a => String -> FileMonitor a b
newFileMonitorInCacheDir String
"solver-plan"
    fileMonitorSourceHashes :: FileMonitor [(PackageIdentifier, UnresolvedPkgLoc)] b
fileMonitorSourceHashes   = forall a b. Eq a => String -> FileMonitor a b
newFileMonitorInCacheDir String
"source-hashes"
    fileMonitorElaboratedPlan :: FileMonitor
  (ProjectConfig,
   [PackageSpecifier (SourcePackage UnresolvedPkgLoc)], [String])
  b
fileMonitorElaboratedPlan = forall a b. Eq a => String -> FileMonitor a b
newFileMonitorInCacheDir String
"elaborated-plan"
    fileMonitorImprovedPlan :: FileMonitor
  (ProjectConfig,
   [PackageSpecifier (SourcePackage UnresolvedPkgLoc)], [String])
  b
fileMonitorImprovedPlan   = forall a b. Eq a => String -> FileMonitor a b
newFileMonitorInCacheDir String
"improved-plan"

    newFileMonitorInCacheDir :: Eq a => FilePath -> FileMonitor a b
    newFileMonitorInCacheDir :: forall a b. Eq a => String -> FileMonitor a b
newFileMonitorInCacheDir  = forall a b. Eq a => String -> FileMonitor a b
newFileMonitor forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
distProjectCacheFile


    -- Configure the compiler we're using.
    --
    -- This is moderately expensive and doesn't change that often so we cache
    -- it independently.
    --
    phaseConfigureCompiler :: ProjectConfig
                           -> Rebuild (Compiler, Platform, ProgramDb)
    phaseConfigureCompiler :: ProjectConfig -> Rebuild (Compiler, Platform, ProgramDb)
phaseConfigureCompiler = Verbosity
-> DistDirLayout
-> ProjectConfig
-> Rebuild (Compiler, Platform, ProgramDb)
configureCompiler Verbosity
verbosity DistDirLayout
distDirLayout

    -- Configuring other programs.
    --
    -- Having configred the compiler, now we configure all the remaining
    -- programs. This is to check we can find them, and to monitor them for
    -- changes.
    --
    -- TODO: [required eventually] we don't actually do this yet.
    --
    -- We rely on the fact that the previous phase added the program config for
    -- all local packages, but that all the programs configured so far are the
    -- compiler program or related util programs.
    --
    phaseConfigurePrograms :: ProjectConfig
                           -> (Compiler, Platform, ProgramDb)
                           -> Rebuild ()
    phaseConfigurePrograms :: ProjectConfig -> (Compiler, Platform, ProgramDb) -> Rebuild ()
phaseConfigurePrograms ProjectConfig
projectConfig (Compiler
_, Platform
_, ProgramDb
compilerprogdb) = do
        -- Users are allowed to specify program locations independently for
        -- each package (e.g. to use a particular version of a pre-processor
        -- for some packages). However they cannot do this for the compiler
        -- itself as that's just not going to work. So we check for this.
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [ConfiguredProgram] -> Map PackageName PackageConfig -> IO ()
checkBadPerPackageCompilerPaths
          (ProgramDb -> [ConfiguredProgram]
configuredPrograms ProgramDb
compilerprogdb)
          (forall k v. MapMappend k v -> Map k v
getMapMappend (ProjectConfig -> MapMappend PackageName PackageConfig
projectConfigSpecificPackage ProjectConfig
projectConfig))

        --TODO: [required eventually] find/configure other programs that the
        -- user specifies.

        --TODO: [required eventually] find/configure all build-tools
        -- but note that some of them may be built as part of the plan.


    -- Run the solver to get the initial install plan.
    -- This is expensive so we cache it independently.
    --
    phaseRunSolver
        :: ProjectConfig
        -> (Compiler, Platform, ProgramDb)
        -> [PackageSpecifier UnresolvedSourcePackage]
        -> InstalledPackageIndex
        -> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
    phaseRunSolver :: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
-> InstalledPackageIndex
-> Rebuild
     (SolverInstallPlan, PkgConfigDb, TotalIndexState, ActiveRepos)
phaseRunSolver projectConfig :: ProjectConfig
projectConfig@ProjectConfig {
                     ProjectConfigShared
projectConfigShared :: ProjectConfigShared
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared,
                     ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly
                   }
                   (Compiler
compiler, Platform
platform, ProgramDb
progdb)
                   [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages
                   InstalledPackageIndex
installedPackages =
        forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged Verbosity
verbosity forall {b}.
FileMonitor
  (SolverSettings,
   [PackageSpecifier (SourcePackage UnresolvedPkgLoc)],
   Map PackageName (Map OptionalStanza Bool), Compiler, Platform,
   [ConfiguredProgram])
  b
fileMonitorSolverPlan
                       (SolverSettings
solverSettings,
                        [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages, Map PackageName (Map OptionalStanza Bool)
localPackagesEnabledStanzas,
                        Compiler
compiler, Platform
platform, ProgramDb -> [ConfiguredProgram]
programDbSignature ProgramDb
progdb) forall a b. (a -> b) -> a -> b
$ do

          InstalledPackageIndex
installedPkgIndex <- Verbosity
-> Compiler
-> ProgramDb
-> Platform
-> PackageDBStack
-> Rebuild InstalledPackageIndex
getInstalledPackages Verbosity
verbosity
                                                    Compiler
compiler ProgramDb
progdb Platform
platform
                                                    PackageDBStack
corePackageDbs
          (SourcePackageDb
sourcePkgDb, TotalIndexState
tis, ActiveRepos
ar) <- Verbosity
-> (forall a. (RepoContext -> IO a) -> IO a)
-> Maybe TotalIndexState
-> Maybe ActiveRepos
-> Rebuild (SourcePackageDb, TotalIndexState, ActiveRepos)
getSourcePackages Verbosity
verbosity forall a. (RepoContext -> IO a) -> IO a
withRepoCtx
              (SolverSettings -> Maybe TotalIndexState
solverSettingIndexState SolverSettings
solverSettings)
              (SolverSettings -> Maybe ActiveRepos
solverSettingActiveRepos SolverSettings
solverSettings)
          PkgConfigDb
pkgConfigDB       <- Verbosity -> ProgramDb -> Rebuild PkgConfigDb
getPkgConfigDb Verbosity
verbosity ProgramDb
progdb

          --TODO: [code cleanup] it'd be better if the Compiler contained the
          -- ConfiguredPrograms that it needs, rather than relying on the progdb
          -- since we don't need to depend on all the programs here, just the
          -- ones relevant for the compiler.

          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            Solver
solver <- Verbosity -> PreSolver -> CompilerInfo -> IO Solver
chooseSolver Verbosity
verbosity
                                   (SolverSettings -> PreSolver
solverSettingSolver SolverSettings
solverSettings)
                                   (Compiler -> CompilerInfo
compilerInfo Compiler
compiler)

            Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"Resolving dependencies..."
            Either String SolverInstallPlan
planOrError <- forall step a fail done.
(step -> a -> a)
-> (fail -> a) -> (done -> a) -> Progress step fail done -> a
foldProgress forall {b}. String -> IO b -> IO b
logMsg (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) forall a b. (a -> b) -> a -> b
$
              Verbosity
-> Compiler
-> Platform
-> Solver
-> SolverSettings
-> InstalledPackageIndex
-> SourcePackageDb
-> PkgConfigDb
-> [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
-> Map PackageName (Map OptionalStanza Bool)
-> Progress String String SolverInstallPlan
planPackages Verbosity
verbosity Compiler
compiler Platform
platform Solver
solver SolverSettings
solverSettings
                           (InstalledPackageIndex
installedPackages forall a. Semigroup a => a -> a -> a
<> InstalledPackageIndex
installedPkgIndex) SourcePackageDb
sourcePkgDb PkgConfigDb
pkgConfigDB
                           [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages Map PackageName (Map OptionalStanza Bool)
localPackagesEnabledStanzas
            case Either String SolverInstallPlan
planOrError of
              Left String
msg -> do ProjectConfig
-> Compiler
-> Platform
-> [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
-> IO ()
reportPlanningFailure ProjectConfig
projectConfig Compiler
compiler Platform
platform [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages
                             forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
msg
              Right SolverInstallPlan
plan -> forall (m :: * -> *) a. Monad m => a -> m a
return (SolverInstallPlan
plan, PkgConfigDb
pkgConfigDB, TotalIndexState
tis, ActiveRepos
ar)
      where
        corePackageDbs :: [PackageDB]
        corePackageDbs :: PackageDBStack
corePackageDbs = PackageDBStack -> [Maybe PackageDB] -> PackageDBStack
applyPackageDbFlags [PackageDB
GlobalPackageDB]
                                             (ProjectConfigShared -> [Maybe PackageDB]
projectConfigPackageDBs ProjectConfigShared
projectConfigShared)

        withRepoCtx :: (RepoContext -> IO a) -> IO a
withRepoCtx    = forall a.
Verbosity
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> (RepoContext -> IO a)
-> IO a
projectConfigWithSolverRepoContext Verbosity
verbosity
                           ProjectConfigShared
projectConfigShared
                           ProjectConfigBuildOnly
projectConfigBuildOnly
        solverSettings :: SolverSettings
solverSettings = ProjectConfig -> SolverSettings
resolveSolverSettings ProjectConfig
projectConfig
        logMsg :: String -> IO b -> IO b
logMsg String
message IO b
rest = Verbosity -> String -> IO ()
debugNoWrap Verbosity
verbosity String
message forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
rest

        localPackagesEnabledStanzas :: Map PackageName (Map OptionalStanza Bool)
localPackagesEnabledStanzas =
          forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (PackageName
pkgname, Map OptionalStanza Bool
stanzas)
            | PackageSpecifier (SourcePackage UnresolvedPkgLoc)
pkg <- [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages
              -- TODO: misnomer: we should separate
              -- builtin/global/inplace/local packages
              -- and packages explicitly mentioned in the project
              --
            , let pkgname :: PackageName
pkgname            = forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget PackageSpecifier (SourcePackage UnresolvedPkgLoc)
pkg
                  testsEnabled :: Flag Bool
testsEnabled       = forall a.
(Semigroup a, Monoid a) =>
(PackageConfig -> a) -> ProjectConfig -> PackageName -> a
lookupLocalPackageConfig
                                         PackageConfig -> Flag Bool
packageConfigTests
                                         ProjectConfig
projectConfig PackageName
pkgname
                  benchmarksEnabled :: Flag Bool
benchmarksEnabled  = forall a.
(Semigroup a, Monoid a) =>
(PackageConfig -> a) -> ProjectConfig -> PackageName -> a
lookupLocalPackageConfig
                                         PackageConfig -> Flag Bool
packageConfigBenchmarks
                                         ProjectConfig
projectConfig PackageName
pkgname
                  isLocal :: Bool
isLocal = forall a. Maybe a -> Bool
isJust (forall loc.
PackageSpecifier (SourcePackage (PackageLocation loc))
-> Maybe PackageIdentifier
shouldBeLocal PackageSpecifier (SourcePackage UnresolvedPkgLoc)
pkg)
                  stanzas :: Map OptionalStanza Bool
stanzas
                    | Bool
isLocal = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
                      [ (OptionalStanza
TestStanzas, Bool
enabled)
                      | Bool
enabled <- forall a. Flag a -> [a]
flagToList Flag Bool
testsEnabled ] forall a. [a] -> [a] -> [a]
++
                      [ (OptionalStanza
BenchStanzas , Bool
enabled)
                      | Bool
enabled <- forall a. Flag a -> [a]
flagToList Flag Bool
benchmarksEnabled ]
                    | Bool
otherwise = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(OptionalStanza
TestStanzas, Bool
False), (OptionalStanza
BenchStanzas, Bool
False) ]
            ]

    -- Elaborate the solver's install plan to get a fully detailed plan. This
    -- version of the plan has the final nix-style hashed ids.
    --
    phaseElaboratePlan :: ProjectConfig
                       -> (Compiler, Platform, ProgramDb)
                       -> PkgConfigDb
                       -> SolverInstallPlan
                       -> [PackageSpecifier (SourcePackage (PackageLocation loc))]
                       -> Rebuild ( ElaboratedInstallPlan
                                  , ElaboratedSharedConfig )
    phaseElaboratePlan :: forall loc.
ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> PkgConfigDb
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig)
phaseElaboratePlan ProjectConfig {
                         ProjectConfigShared
projectConfigShared :: ProjectConfigShared
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared,
                         PackageConfig
projectConfigAllPackages :: ProjectConfig -> PackageConfig
projectConfigAllPackages :: PackageConfig
projectConfigAllPackages,
                         PackageConfig
projectConfigLocalPackages :: PackageConfig
projectConfigLocalPackages :: ProjectConfig -> PackageConfig
projectConfigLocalPackages,
                         MapMappend PackageName PackageConfig
projectConfigSpecificPackage :: MapMappend PackageName PackageConfig
projectConfigSpecificPackage :: ProjectConfig -> MapMappend PackageName PackageConfig
projectConfigSpecificPackage,
                         ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly
                       }
                       (Compiler
compiler, Platform
platform, ProgramDb
progdb) PkgConfigDb
pkgConfigDB
                       SolverInstallPlan
solverPlan [PackageSpecifier (SourcePackage (PackageLocation loc))]
localPackages = do

        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
debug Verbosity
verbosity String
"Elaborating the install plan..."

        Map PackageIdentifier PackageSourceHash
sourcePackageHashes <-
          forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged Verbosity
verbosity forall {b}. FileMonitor [(PackageIdentifier, UnresolvedPkgLoc)] b
fileMonitorSourceHashes
                         (SolverInstallPlan -> [(PackageIdentifier, UnresolvedPkgLoc)]
packageLocationsSignature SolverInstallPlan
solverPlan) forall a b. (a -> b) -> a -> b
$
            Verbosity
-> (forall a. (RepoContext -> IO a) -> IO a)
-> SolverInstallPlan
-> Rebuild (Map PackageIdentifier PackageSourceHash)
getPackageSourceHashes Verbosity
verbosity forall a. (RepoContext -> IO a) -> IO a
withRepoCtx SolverInstallPlan
solverPlan

        InstallDirTemplates
defaultInstallDirs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Compiler -> IO InstallDirTemplates
userInstallDirTemplates Compiler
compiler
        let installDirs :: InstallDirTemplates
installDirs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. WithCallStack (Flag a -> a)
Cabal.fromFlag forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Flag a
Flag InstallDirTemplates
defaultInstallDirs) forall a. Semigroup a => a -> a -> a
<> (ProjectConfigShared -> InstallDirs (Flag PathTemplate)
projectConfigInstallDirs ProjectConfigShared
projectConfigShared)
        (ElaboratedInstallPlan
elaboratedPlan, ElaboratedSharedConfig
elaboratedShared)
          <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Verbosity -> LogProgress a -> IO a
runLogProgress Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
              forall loc.
Verbosity
-> Platform
-> Compiler
-> ProgramDb
-> PkgConfigDb
-> DistDirLayout
-> StoreDirLayout
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> Map PackageIdentifier PackageSourceHash
-> InstallDirTemplates
-> ProjectConfigShared
-> PackageConfig
-> PackageConfig
-> Map PackageName PackageConfig
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
elaborateInstallPlan
                Verbosity
verbosity
                Platform
platform Compiler
compiler ProgramDb
progdb PkgConfigDb
pkgConfigDB
                DistDirLayout
distDirLayout
                StoreDirLayout
cabalStoreDirLayout
                SolverInstallPlan
solverPlan
                [PackageSpecifier (SourcePackage (PackageLocation loc))]
localPackages
                Map PackageIdentifier PackageSourceHash
sourcePackageHashes
                InstallDirTemplates
installDirs
                ProjectConfigShared
projectConfigShared
                PackageConfig
projectConfigAllPackages
                PackageConfig
projectConfigLocalPackages
                (forall k v. MapMappend k v -> Map k v
getMapMappend MapMappend PackageName PackageConfig
projectConfigSpecificPackage)
        let instantiatedPlan :: ElaboratedInstallPlan
instantiatedPlan
              = StoreDirLayout
-> InstallDirTemplates
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedInstallPlan
instantiateInstallPlan
                  StoreDirLayout
cabalStoreDirLayout
                  InstallDirTemplates
installDirs
                  ElaboratedSharedConfig
elaboratedShared
                  ElaboratedInstallPlan
elaboratedPlan
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
debugNoWrap Verbosity
verbosity (forall ipkg srcpkg.
(Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg -> String
InstallPlan.showInstallPlan ElaboratedInstallPlan
instantiatedPlan)
        forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
instantiatedPlan, ElaboratedSharedConfig
elaboratedShared)
      where
        withRepoCtx :: (RepoContext -> IO a) -> IO a
withRepoCtx = forall a.
Verbosity
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> (RepoContext -> IO a)
-> IO a
projectConfigWithSolverRepoContext Verbosity
verbosity
                        ProjectConfigShared
projectConfigShared
                        ProjectConfigBuildOnly
projectConfigBuildOnly

    -- Update the files we maintain that reflect our current build environment.
    -- In particular we maintain a JSON representation of the elaborated
    -- install plan (but not the improved plan since that reflects the state
    -- of the build rather than just the input environment).
    --
    phaseMaintainPlanOutputs :: ElaboratedInstallPlan
                             -> ElaboratedSharedConfig
                             -> Rebuild ()
    phaseMaintainPlanOutputs :: ElaboratedInstallPlan -> ElaboratedSharedConfig -> Rebuild ()
phaseMaintainPlanOutputs ElaboratedInstallPlan
elaboratedPlan ElaboratedSharedConfig
elaboratedShared = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        Verbosity -> String -> IO ()
debug Verbosity
verbosity String
"Updating plan.json"
        DistDirLayout
-> ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO ()
writePlanExternalRepresentation
          DistDirLayout
distDirLayout
          ElaboratedInstallPlan
elaboratedPlan
          ElaboratedSharedConfig
elaboratedShared


    -- Improve the elaborated install plan. The elaborated plan consists
    -- mostly of source packages (with full nix-style hashed ids). Where
    -- corresponding installed packages already exist in the store, replace
    -- them in the plan.
    --
    -- Note that we do monitor the store's package db here, so we will redo
    -- this improvement phase when the db changes -- including as a result of
    -- executing a plan and installing things.
    --
    phaseImprovePlan :: ElaboratedInstallPlan
                     -> ElaboratedSharedConfig
                     -> Rebuild ElaboratedInstallPlan
    phaseImprovePlan :: ElaboratedInstallPlan
-> ElaboratedSharedConfig -> Rebuild ElaboratedInstallPlan
phaseImprovePlan ElaboratedInstallPlan
elaboratedPlan ElaboratedSharedConfig
elaboratedShared = do

        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
debug Verbosity
verbosity String
"Improving the install plan..."
        Set UnitId
storePkgIdSet <- StoreDirLayout -> CompilerId -> Rebuild (Set UnitId)
getStoreEntries StoreDirLayout
cabalStoreDirLayout CompilerId
compid
        let improvedPlan :: ElaboratedInstallPlan
improvedPlan = Set UnitId -> ElaboratedInstallPlan -> ElaboratedInstallPlan
improveInstallPlanWithInstalledPackages
                             Set UnitId
storePkgIdSet
                             ElaboratedInstallPlan
elaboratedPlan
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
debugNoWrap Verbosity
verbosity (forall ipkg srcpkg.
(Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg -> String
InstallPlan.showInstallPlan ElaboratedInstallPlan
improvedPlan)
        -- TODO: [nice to have] having checked which packages from the store
        -- we're using, it may be sensible to sanity check those packages
        -- by loading up the compiler package db and checking everything
        -- matches up as expected, e.g. no dangling deps, files deleted.
        forall (m :: * -> *) a. Monad m => a -> m a
return ElaboratedInstallPlan
improvedPlan
      where
        compid :: CompilerId
compid = Compiler -> CompilerId
compilerId (ElaboratedSharedConfig -> Compiler
pkgConfigCompiler ElaboratedSharedConfig
elaboratedShared)


-- | If a 'PackageSpecifier' refers to a single package, return Just that
-- package.


reportPlanningFailure :: ProjectConfig -> Compiler -> Platform -> [PackageSpecifier UnresolvedSourcePackage] -> IO ()
reportPlanningFailure :: ProjectConfig
-> Compiler
-> Platform
-> [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
-> IO ()
reportPlanningFailure ProjectConfig
projectConfig Compiler
comp Platform
platform [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
pkgSpecifiers = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
reportFailure forall a b. (a -> b) -> a -> b
$

    CompilerInfo
-> [PathTemplate]
-> [(BuildReport, Maybe Repo)]
-> Platform
-> IO ()
BuildReports.storeLocal (Compiler -> CompilerInfo
compilerInfo Compiler
comp)
                            (forall a. NubList a -> [a]
fromNubList forall a b. (a -> b) -> a -> b
$ ProjectConfigBuildOnly -> NubList PathTemplate
projectConfigSummaryFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly forall a b. (a -> b) -> a -> b
$ ProjectConfig
projectConfig)
                            [(BuildReport, Maybe Repo)]
buildReports Platform
platform

    -- TODO may want to handle the projectConfigLogFile paramenter here, or just remove it entirely?
  where
    reportFailure :: Bool
reportFailure = forall a. WithCallStack (Flag a -> a)
Cabal.fromFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfigBuildOnly -> Flag Bool
projectConfigReportPlanningFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly forall a b. (a -> b) -> a -> b
$ ProjectConfig
projectConfig
    pkgids :: [PackageIdentifier]
pkgids = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall pkg.
Package pkg =>
PackageSpecifier pkg -> Maybe PackageIdentifier
theSpecifiedPackage [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
pkgSpecifiers
    buildReports :: [(BuildReport, Maybe Repo)]
buildReports = Platform
-> CompilerId
-> [PackageIdentifier]
-> FlagAssignment
-> [(BuildReport, Maybe Repo)]
BuildReports.fromPlanningFailure Platform
platform
                       (Compiler -> CompilerId
compilerId Compiler
comp) [PackageIdentifier]
pkgids
                       -- TODO we may want to get more flag assignments and merge them here?
                       (PackageConfig -> FlagAssignment
packageConfigFlagAssignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfig -> PackageConfig
projectConfigAllPackages forall a b. (a -> b) -> a -> b
$ ProjectConfig
projectConfig)

    theSpecifiedPackage :: Package pkg => PackageSpecifier pkg -> Maybe PackageId
    theSpecifiedPackage :: forall pkg.
Package pkg =>
PackageSpecifier pkg -> Maybe PackageIdentifier
theSpecifiedPackage PackageSpecifier pkg
pkgSpec =
       case PackageSpecifier pkg
pkgSpec of
          NamedPackage PackageName
name [PackagePropertyVersion VersionRange
version]
            -> PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VersionRange -> Maybe Version
trivialRange VersionRange
version
          NamedPackage PackageName
_ [PackageProperty]
_ -> forall a. Maybe a
Nothing
          SpecificSourcePackage pkg
pkg -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall pkg. Package pkg => pkg -> PackageIdentifier
packageId pkg
pkg
    -- | If a range includes only a single version, return Just that version.
    trivialRange :: VersionRange -> Maybe Version
    trivialRange :: VersionRange -> Maybe Version
trivialRange = forall a.
a
-> (Version -> a)
-> (Version -> a)
-> (Version -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> VersionRange
-> a
foldVersionRange
        forall a. Maybe a
Nothing
        forall a. a -> Maybe a
Just     -- "== v"
        (\Version
_ -> forall a. Maybe a
Nothing)
        (\Version
_ -> forall a. Maybe a
Nothing)
        (\Maybe Version
_ Maybe Version
_ -> forall a. Maybe a
Nothing)
        (\Maybe Version
_ Maybe Version
_ -> forall a. Maybe a
Nothing)


programsMonitorFiles :: ProgramDb -> [MonitorFilePath]
programsMonitorFiles :: ProgramDb -> [MonitorFilePath]
programsMonitorFiles ProgramDb
progdb =
    [ MonitorFilePath
monitor
    | ConfiguredProgram
prog    <- ProgramDb -> [ConfiguredProgram]
configuredPrograms ProgramDb
progdb
    , MonitorFilePath
monitor <- [String] -> String -> [MonitorFilePath]
monitorFileSearchPath (ConfiguredProgram -> [String]
programMonitorFiles ConfiguredProgram
prog)
                                       (ConfiguredProgram -> String
programPath ConfiguredProgram
prog)
    ]

-- | Select the bits of a 'ProgramDb' to monitor for value changes.
-- Use 'programsMonitorFiles' for the files to monitor.
--
programDbSignature :: ProgramDb -> [ConfiguredProgram]
programDbSignature :: ProgramDb -> [ConfiguredProgram]
programDbSignature ProgramDb
progdb =
    [ ConfiguredProgram
prog { programMonitorFiles :: [String]
programMonitorFiles = []
           , programOverrideEnv :: [(String, Maybe String)]
programOverrideEnv  = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=String
"PATH") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
                                          (ConfiguredProgram -> [(String, Maybe String)]
programOverrideEnv ConfiguredProgram
prog) }
    | ConfiguredProgram
prog <- ProgramDb -> [ConfiguredProgram]
configuredPrograms ProgramDb
progdb ]

getInstalledPackages :: Verbosity
                     -> Compiler -> ProgramDb -> Platform
                     -> PackageDBStack
                     -> Rebuild InstalledPackageIndex
getInstalledPackages :: Verbosity
-> Compiler
-> ProgramDb
-> Platform
-> PackageDBStack
-> Rebuild InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
compiler ProgramDb
progdb Platform
platform PackageDBStack
packagedbs = do
    [MonitorFilePath] -> Rebuild ()
monitorFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> MonitorFilePath
monitorFileOrDirectory
      forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> Platform
-> IO [String]
IndexUtils.getInstalledPackagesMonitorFiles
                    Verbosity
verbosity Compiler
compiler
                    PackageDBStack
packagedbs ProgramDb
progdb Platform
platform)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
IndexUtils.getInstalledPackages
               Verbosity
verbosity Compiler
compiler
               PackageDBStack
packagedbs ProgramDb
progdb

{-
--TODO: [nice to have] use this but for sanity / consistency checking
getPackageDBContents :: Verbosity
                     -> Compiler -> ProgramDb -> Platform
                     -> PackageDB
                     -> Rebuild InstalledPackageIndex
getPackageDBContents verbosity compiler progdb platform packagedb = do
    monitorFiles . map monitorFileOrDirectory
      =<< liftIO (IndexUtils.getInstalledPackagesMonitorFiles
                    verbosity compiler
                    [packagedb] progdb platform)
    liftIO $ do
      createPackageDBIfMissing verbosity compiler progdb packagedb
      Cabal.getPackageDBContents verbosity compiler
                                 packagedb progdb
-}

getSourcePackages
    :: Verbosity
    -> (forall a. (RepoContext -> IO a) -> IO a)
    -> Maybe IndexUtils.TotalIndexState
    -> Maybe IndexUtils.ActiveRepos
    -> Rebuild (SourcePackageDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
getSourcePackages :: Verbosity
-> (forall a. (RepoContext -> IO a) -> IO a)
-> Maybe TotalIndexState
-> Maybe ActiveRepos
-> Rebuild (SourcePackageDb, TotalIndexState, ActiveRepos)
getSourcePackages Verbosity
verbosity forall a. (RepoContext -> IO a) -> IO a
withRepoCtx Maybe TotalIndexState
idxState Maybe ActiveRepos
activeRepos = do
    ((SourcePackageDb, TotalIndexState, ActiveRepos)
sourcePkgDbWithTIS, [Repo]
repos) <-
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
        forall a. (RepoContext -> IO a) -> IO a
withRepoCtx forall a b. (a -> b) -> a -> b
$ \RepoContext
repoctx -> do
          (SourcePackageDb, TotalIndexState, ActiveRepos)
sourcePkgDbWithTIS <- Verbosity
-> RepoContext
-> Maybe TotalIndexState
-> Maybe ActiveRepos
-> IO (SourcePackageDb, TotalIndexState, ActiveRepos)
IndexUtils.getSourcePackagesAtIndexState Verbosity
verbosity RepoContext
repoctx Maybe TotalIndexState
idxState Maybe ActiveRepos
activeRepos
          forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePackageDb, TotalIndexState, ActiveRepos)
sourcePkgDbWithTIS, RepoContext -> [Repo]
repoContextRepos RepoContext
repoctx)

    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> Rebuild ()
needIfExists
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Repo] -> [String]
IndexUtils.getSourcePackagesMonitorFiles
        forall a b. (a -> b) -> a -> b
$ [Repo]
repos
    forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePackageDb, TotalIndexState, ActiveRepos)
sourcePkgDbWithTIS


getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild PkgConfigDb
getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild PkgConfigDb
getPkgConfigDb Verbosity
verbosity ProgramDb
progdb = do
    [String]
dirs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> ProgramDb -> IO [String]
getPkgConfigDbDirs Verbosity
verbosity ProgramDb
progdb
    -- Just monitor the dirs so we'll notice new .pc files.
    -- Alternatively we could monitor all the .pc files too.
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> Rebuild Bool
monitorDirectoryStatus [String]
dirs
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> ProgramDb -> IO PkgConfigDb
readPkgConfigDb Verbosity
verbosity ProgramDb
progdb


-- | Select the config values to monitor for changes package source hashes.
packageLocationsSignature :: SolverInstallPlan
                          -> [(PackageId, PackageLocation (Maybe FilePath))]
packageLocationsSignature :: SolverInstallPlan -> [(PackageIdentifier, UnresolvedPkgLoc)]
packageLocationsSignature SolverInstallPlan
solverPlan =
    [ (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SourcePackage UnresolvedPkgLoc
pkg, forall loc. SourcePackage loc -> loc
srcpkgSource SourcePackage UnresolvedPkgLoc
pkg)
    | SolverInstallPlan.Configured (SolverPackage { solverPkgSource :: forall loc. SolverPackage loc -> SourcePackage loc
solverPkgSource = SourcePackage UnresolvedPkgLoc
pkg})
        <- SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
SolverInstallPlan.toList SolverInstallPlan
solverPlan
    ]


-- | Get the 'HashValue' for all the source packages where we use hashes,
-- and download any packages required to do so.
--
-- Note that we don't get hashes for local unpacked packages.
--
getPackageSourceHashes :: Verbosity
                       -> (forall a. (RepoContext -> IO a) -> IO a)
                       -> SolverInstallPlan
                       -> Rebuild (Map PackageId PackageSourceHash)
getPackageSourceHashes :: Verbosity
-> (forall a. (RepoContext -> IO a) -> IO a)
-> SolverInstallPlan
-> Rebuild (Map PackageIdentifier PackageSourceHash)
getPackageSourceHashes Verbosity
verbosity forall a. (RepoContext -> IO a) -> IO a
withRepoCtx SolverInstallPlan
solverPlan = do

    -- Determine if and where to get the package's source hash from.
    --
    let allPkgLocations :: [(PackageId, PackageLocation (Maybe FilePath))]
        allPkgLocations :: [(PackageIdentifier, UnresolvedPkgLoc)]
allPkgLocations =
          [ (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SourcePackage UnresolvedPkgLoc
pkg, forall loc. SourcePackage loc -> loc
srcpkgSource SourcePackage UnresolvedPkgLoc
pkg)
          | SolverInstallPlan.Configured (SolverPackage { solverPkgSource :: forall loc. SolverPackage loc -> SourcePackage loc
solverPkgSource = SourcePackage UnresolvedPkgLoc
pkg})
              <- SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
SolverInstallPlan.toList SolverInstallPlan
solverPlan ]

        -- Tarballs that were local in the first place.
        -- We'll hash these tarball files directly.
        localTarballPkgs :: [(PackageId, FilePath)]
        localTarballPkgs :: [(PackageIdentifier, String)]
localTarballPkgs =
          [ (PackageIdentifier
pkgid, String
tarball)
          | (PackageIdentifier
pkgid, LocalTarballPackage String
tarball) <- [(PackageIdentifier, UnresolvedPkgLoc)]
allPkgLocations ]

        -- Tarballs from remote URLs. We must have downloaded these already
        -- (since we extracted the .cabal file earlier)
        remoteTarballPkgs :: [(PackageIdentifier, String)]
remoteTarballPkgs =
          [ (PackageIdentifier
pkgid, String
tarball)
          | (PackageIdentifier
pkgid, RemoteTarballPackage URI
_ (Just String
tarball)) <- [(PackageIdentifier, UnresolvedPkgLoc)]
allPkgLocations ]

        -- tarballs from source-repository-package stanzas
        sourceRepoTarballPkgs :: [(PackageIdentifier, String)]
sourceRepoTarballPkgs =
          [ (PackageIdentifier
pkgid, String
tarball)
          | (PackageIdentifier
pkgid, RemoteSourceRepoPackage SourceRepoMaybe
_ (Just String
tarball)) <- [(PackageIdentifier, UnresolvedPkgLoc)]
allPkgLocations ]

        -- Tarballs from repositories, either where the repository provides
        -- hashes as part of the repo metadata, or where we will have to
        -- download and hash the tarball.
        repoTarballPkgsWithMetadataUnvalidated    :: [(PackageId, Repo)]
        repoTarballPkgsWithoutMetadata :: [(PackageId, Repo)]
        ([(PackageIdentifier, Repo)]
repoTarballPkgsWithMetadataUnvalidated,
         [(PackageIdentifier, Repo)]
repoTarballPkgsWithoutMetadata) =
          forall a b. [Either a b] -> ([a], [b])
partitionEithers
          [ case Repo
repo of
              RepoSecure{} -> forall a b. a -> Either a b
Left  (PackageIdentifier
pkgid, Repo
repo)
              Repo
_            -> forall a b. b -> Either a b
Right (PackageIdentifier
pkgid, Repo
repo)
          | (PackageIdentifier
pkgid, RepoTarballPackage Repo
repo PackageIdentifier
_ Maybe String
_) <- [(PackageIdentifier, UnresolvedPkgLoc)]
allPkgLocations ]

    ([(PackageIdentifier, Repo)]
repoTarballPkgsWithMetadata, [(PackageIdentifier, Repo)]
repoTarballPkgsToDownloadWithMeta) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (RepoContext -> IO a) -> IO a
withRepoCtx forall a b. (a -> b) -> a -> b
$ \RepoContext
repoctx -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(PackageIdentifier, Repo)]
repoTarballPkgsWithMetadataUnvalidated forall a b. (a -> b) -> a -> b
$
        \x :: (PackageIdentifier, Repo)
x@(PackageIdentifier
pkg, Repo
repo) -> Verbosity -> RepoContext -> Repo -> PackageIdentifier -> IO Bool
verifyFetchedTarball Verbosity
verbosity RepoContext
repoctx Repo
repo PackageIdentifier
pkg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> case Bool
b of
                          Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (PackageIdentifier, Repo)
x
                          Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (PackageIdentifier, Repo)
x

    -- For tarballs from repos that do not have hashes available we now have
    -- to check if the packages were downloaded already.
    --
    ([(PackageIdentifier, Repo)]
repoTarballPkgsToDownloadWithNoMeta,
     [(PackageIdentifier, String)]
repoTarballPkgsDownloaded)
      <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$
         forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
           [ do Maybe String
mtarball <- Repo -> PackageIdentifier -> IO (Maybe String)
checkRepoTarballFetched Repo
repo PackageIdentifier
pkgid
                case Maybe String
mtarball of
                  Maybe String
Nothing      -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left  (PackageIdentifier
pkgid, Repo
repo))
                  Just String
tarball -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (PackageIdentifier
pkgid, String
tarball))
           | (PackageIdentifier
pkgid, Repo
repo) <- [(PackageIdentifier, Repo)]
repoTarballPkgsWithoutMetadata ]

    let repoTarballPkgsToDownload :: [(PackageIdentifier, Repo)]
repoTarballPkgsToDownload = [(PackageIdentifier, Repo)]
repoTarballPkgsToDownloadWithMeta forall a. [a] -> [a] -> [a]
++ [(PackageIdentifier, Repo)]
repoTarballPkgsToDownloadWithNoMeta
    (Map PackageIdentifier PackageSourceHash
hashesFromRepoMetadata,
     [(PackageIdentifier, String)]
repoTarballPkgsNewlyDownloaded) <-
      -- Avoid having to initialise the repository (ie 'withRepoCtx') if we
      -- don't have to. (The main cost is configuring the http client.)
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageIdentifier, Repo)]
repoTarballPkgsToDownload Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageIdentifier, Repo)]
repoTarballPkgsWithMetadata
      then forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Map k a
Map.empty, [])
      else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (RepoContext -> IO a) -> IO a
withRepoCtx forall a b. (a -> b) -> a -> b
$ \RepoContext
repoctx -> do

      -- For tarballs from repos that do have hashes available as part of the
      -- repo metadata we now load up the index for each repo and retrieve
      -- the hashes for the packages
      --
      Map PackageIdentifier PackageSourceHash
hashesFromRepoMetadata <-
        forall a.
((Throws VerificationError, Throws SomeRemoteError,
  Throws InvalidPackageException) =>
 IO a)
-> IO a
Sec.uncheckClientErrors forall a b. (a -> b) -> a -> b
$ --TODO: [code cleanup] wrap in our own exceptions
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
          -- Reading the repo index is expensive so we group the packages by repo
          [ RepoContext
-> forall a.
   Repo -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
repoContextWithSecureRepo RepoContext
repoctx Repo
repo forall a b. (a -> b) -> a -> b
$ \Repository down
secureRepo ->
              forall (down :: * -> *) a.
Repository down -> (IndexCallbacks -> IO a) -> IO a
Sec.withIndex Repository down
secureRepo forall a b. (a -> b) -> a -> b
$ \IndexCallbacks
repoIndex ->
                forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                  [ do Hash
hash <- forall a. Trusted a -> a
Sec.trusted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> -- strip off Trusted tag
                               IndexCallbacks
-> (Throws InvalidPackageException, Throws VerificationError) =>
   PackageIdentifier -> IO (Trusted Hash)
Sec.indexLookupHash IndexCallbacks
repoIndex PackageIdentifier
pkgid
                       -- Note that hackage-security currently uses SHA256
                       -- but this API could in principle give us some other
                       -- choice in future.
                       forall (m :: * -> *) a. Monad m => a -> m a
return (PackageIdentifier
pkgid, Hash -> PackageSourceHash
hashFromTUF Hash
hash)
                  | PackageIdentifier
pkgid <- [PackageIdentifier]
pkgids ]
          | (Repo
repo, [PackageIdentifier]
pkgids) <-
                forall a b. (a -> b) -> [a] -> [b]
map (\grp :: NonEmpty (PackageIdentifier, Repo)
grp@((PackageIdentifier
_,Repo
repo):|[(PackageIdentifier, Repo)]
_) -> (Repo
repo, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (PackageIdentifier, Repo)
grp)))
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (forall a. Eq a => a -> a -> Bool
(==)    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (RemoteRepo -> RepoName
remoteRepoName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repo -> RemoteRepo
repoRemote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd))
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy  (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (RemoteRepo -> RepoName
remoteRepoName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repo -> RemoteRepo
repoRemote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd))
              forall a b. (a -> b) -> a -> b
$ [(PackageIdentifier, Repo)]
repoTarballPkgsWithMetadata
          ]

      -- For tarballs from repos that do not have hashes available, download
      -- the ones we previously determined we need.
      --
      [(PackageIdentifier, String)]
repoTarballPkgsNewlyDownloaded <-
        forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
          [ do String
tarball <- Verbosity -> RepoContext -> Repo -> PackageIdentifier -> IO String
fetchRepoTarball Verbosity
verbosity RepoContext
repoctx Repo
repo PackageIdentifier
pkgid
               forall (m :: * -> *) a. Monad m => a -> m a
return (PackageIdentifier
pkgid, String
tarball)
          | (PackageIdentifier
pkgid, Repo
repo) <- [(PackageIdentifier, Repo)]
repoTarballPkgsToDownload ]

      forall (m :: * -> *) a. Monad m => a -> m a
return (Map PackageIdentifier PackageSourceHash
hashesFromRepoMetadata,
              [(PackageIdentifier, String)]
repoTarballPkgsNewlyDownloaded)

    -- Hash tarball files for packages where we have to do that. This includes
    -- tarballs that were local in the first place, plus tarballs from repos,
    -- either previously cached or freshly downloaded.
    --
    let allTarballFilePkgs :: [(PackageId, FilePath)]
        allTarballFilePkgs :: [(PackageIdentifier, String)]
allTarballFilePkgs = [(PackageIdentifier, String)]
localTarballPkgs
                          forall a. [a] -> [a] -> [a]
++ [(PackageIdentifier, String)]
remoteTarballPkgs
                          forall a. [a] -> [a] -> [a]
++ [(PackageIdentifier, String)]
sourceRepoTarballPkgs
                          forall a. [a] -> [a] -> [a]
++ [(PackageIdentifier, String)]
repoTarballPkgsDownloaded
                          forall a. [a] -> [a] -> [a]
++ [(PackageIdentifier, String)]
repoTarballPkgsNewlyDownloaded
    Map PackageIdentifier PackageSourceHash
hashesFromTarballFiles <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
      forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ do PackageSourceHash
srchash <- String -> IO PackageSourceHash
readFileHashValue String
tarball
             forall (m :: * -> *) a. Monad m => a -> m a
return (PackageIdentifier
pkgid, PackageSourceHash
srchash)
        | (PackageIdentifier
pkgid, String
tarball) <- [(PackageIdentifier, String)]
allTarballFilePkgs
        ]
    [MonitorFilePath] -> Rebuild ()
monitorFiles [ String -> MonitorFilePath
monitorFile String
tarball
                 | (PackageIdentifier
_pkgid, String
tarball) <- [(PackageIdentifier, String)]
allTarballFilePkgs ]

    -- Return the combination
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Map PackageIdentifier PackageSourceHash
hashesFromRepoMetadata
           forall a. Semigroup a => a -> a -> a
<> Map PackageIdentifier PackageSourceHash
hashesFromTarballFiles

-- | Append the given package databases to an existing PackageDBStack.
-- A @Nothing@ entry will clear everything before it.
applyPackageDbFlags :: PackageDBStack -> [Maybe PackageDB] -> PackageDBStack
applyPackageDbFlags :: PackageDBStack -> [Maybe PackageDB] -> PackageDBStack
applyPackageDbFlags PackageDBStack
dbs' []            = PackageDBStack
dbs'
applyPackageDbFlags PackageDBStack
_    (Maybe PackageDB
Nothing:[Maybe PackageDB]
dbs) = PackageDBStack -> [Maybe PackageDB] -> PackageDBStack
applyPackageDbFlags []             [Maybe PackageDB]
dbs
applyPackageDbFlags PackageDBStack
dbs' (Just PackageDB
db:[Maybe PackageDB]
dbs) = PackageDBStack -> [Maybe PackageDB] -> PackageDBStack
applyPackageDbFlags (PackageDBStack
dbs' forall a. [a] -> [a] -> [a]
++ [PackageDB
db]) [Maybe PackageDB]
dbs

-- ------------------------------------------------------------
-- * Installation planning
-- ------------------------------------------------------------

planPackages :: Verbosity
             -> Compiler
             -> Platform
             -> Solver -> SolverSettings
             -> InstalledPackageIndex
             -> SourcePackageDb
             -> PkgConfigDb
             -> [PackageSpecifier UnresolvedSourcePackage]
             -> Map PackageName (Map OptionalStanza Bool)
             -> Progress String String SolverInstallPlan
planPackages :: Verbosity
-> Compiler
-> Platform
-> Solver
-> SolverSettings
-> InstalledPackageIndex
-> SourcePackageDb
-> PkgConfigDb
-> [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
-> Map PackageName (Map OptionalStanza Bool)
-> Progress String String SolverInstallPlan
planPackages Verbosity
verbosity Compiler
comp Platform
platform Solver
solver SolverSettings{[(UserConstraint, ConstraintSource)]
[PackageVersionConstraint]
[LocalRepo]
[RemoteRepo]
Maybe Int
Maybe Version
Maybe TotalIndexState
Maybe ActiveRepos
Map PackageName FlagAssignment
FlagAssignment
ReorderGoals
CountConflicts
FineGrainedConflicts
MinimizeConflictSet
IndependentGoals
PreferOldest
StrongFlags
AllowBootLibInstalls
OnlyConstrained
PreSolver
AllowOlder
AllowNewer
solverSettingPreferOldest :: SolverSettings -> PreferOldest
solverSettingIndependentGoals :: SolverSettings -> IndependentGoals
solverSettingOnlyConstrained :: SolverSettings -> OnlyConstrained
solverSettingAllowBootLibInstalls :: SolverSettings -> AllowBootLibInstalls
solverSettingStrongFlags :: SolverSettings -> StrongFlags
solverSettingMinimizeConflictSet :: SolverSettings -> MinimizeConflictSet
solverSettingFineGrainedConflicts :: SolverSettings -> FineGrainedConflicts
solverSettingCountConflicts :: SolverSettings -> CountConflicts
solverSettingReorderGoals :: SolverSettings -> ReorderGoals
solverSettingMaxBackjumps :: SolverSettings -> Maybe Int
solverSettingAllowNewer :: SolverSettings -> AllowNewer
solverSettingAllowOlder :: SolverSettings -> AllowOlder
solverSettingCabalVersion :: SolverSettings -> Maybe Version
solverSettingFlagAssignments :: SolverSettings -> Map PackageName FlagAssignment
solverSettingFlagAssignment :: SolverSettings -> FlagAssignment
solverSettingPreferences :: SolverSettings -> [PackageVersionConstraint]
solverSettingConstraints :: SolverSettings -> [(UserConstraint, ConstraintSource)]
solverSettingLocalNoIndexRepos :: SolverSettings -> [LocalRepo]
solverSettingRemoteRepos :: SolverSettings -> [RemoteRepo]
solverSettingPreferOldest :: PreferOldest
solverSettingIndependentGoals :: IndependentGoals
solverSettingActiveRepos :: Maybe ActiveRepos
solverSettingIndexState :: Maybe TotalIndexState
solverSettingOnlyConstrained :: OnlyConstrained
solverSettingAllowBootLibInstalls :: AllowBootLibInstalls
solverSettingStrongFlags :: StrongFlags
solverSettingMinimizeConflictSet :: MinimizeConflictSet
solverSettingFineGrainedConflicts :: FineGrainedConflicts
solverSettingCountConflicts :: CountConflicts
solverSettingReorderGoals :: ReorderGoals
solverSettingMaxBackjumps :: Maybe Int
solverSettingAllowNewer :: AllowNewer
solverSettingAllowOlder :: AllowOlder
solverSettingSolver :: PreSolver
solverSettingCabalVersion :: Maybe Version
solverSettingFlagAssignments :: Map PackageName FlagAssignment
solverSettingFlagAssignment :: FlagAssignment
solverSettingPreferences :: [PackageVersionConstraint]
solverSettingConstraints :: [(UserConstraint, ConstraintSource)]
solverSettingLocalNoIndexRepos :: [LocalRepo]
solverSettingRemoteRepos :: [RemoteRepo]
solverSettingSolver :: SolverSettings -> PreSolver
solverSettingActiveRepos :: SolverSettings -> Maybe ActiveRepos
solverSettingIndexState :: SolverSettings -> Maybe TotalIndexState
..}
             InstalledPackageIndex
installedPkgIndex SourcePackageDb
sourcePkgDb PkgConfigDb
pkgConfigDB
             [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages Map PackageName (Map OptionalStanza Bool)
pkgStanzasEnable =
    Platform
-> CompilerInfo
-> PkgConfigDb
-> Solver
-> DepResolverParams
-> Progress String String SolverInstallPlan
resolveDependencies
      Platform
platform (Compiler -> CompilerInfo
compilerInfo Compiler
comp)
      PkgConfigDb
pkgConfigDB Solver
solver
      DepResolverParams
resolverParams

  where

    --TODO: [nice to have] disable multiple instances restriction in
    -- the solver, but then make sure we can cope with that in the
    -- output.
    resolverParams :: DepResolverParams
    resolverParams :: DepResolverParams
resolverParams =

        Maybe Int -> DepResolverParams -> DepResolverParams
setMaxBackjumps Maybe Int
solverSettingMaxBackjumps

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndependentGoals -> DepResolverParams -> DepResolverParams
setIndependentGoals IndependentGoals
solverSettingIndependentGoals

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReorderGoals -> DepResolverParams -> DepResolverParams
setReorderGoals ReorderGoals
solverSettingReorderGoals

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. CountConflicts -> DepResolverParams -> DepResolverParams
setCountConflicts CountConflicts
solverSettingCountConflicts

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. FineGrainedConflicts -> DepResolverParams -> DepResolverParams
setFineGrainedConflicts FineGrainedConflicts
solverSettingFineGrainedConflicts

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinimizeConflictSet -> DepResolverParams -> DepResolverParams
setMinimizeConflictSet MinimizeConflictSet
solverSettingMinimizeConflictSet

        --TODO: [required eventually] should only be configurable for
        --custom installs
   -- . setAvoidReinstalls solverSettingAvoidReinstalls

        --TODO: [required eventually] should only be configurable for
        --custom installs
   -- . setShadowPkgs solverSettingShadowPkgs

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrongFlags -> DepResolverParams -> DepResolverParams
setStrongFlags StrongFlags
solverSettingStrongFlags

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowBootLibInstalls -> DepResolverParams -> DepResolverParams
setAllowBootLibInstalls AllowBootLibInstalls
solverSettingAllowBootLibInstalls

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnlyConstrained -> DepResolverParams -> DepResolverParams
setOnlyConstrained OnlyConstrained
solverSettingOnlyConstrained

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> DepResolverParams -> DepResolverParams
setSolverVerbosity Verbosity
verbosity

        --TODO: [required eventually] decide if we need to prefer
        -- installed for global packages, or prefer latest even for
        -- global packages. Perhaps should be configurable but with a
        -- different name than "upgrade-dependencies".
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackagesPreferenceDefault -> DepResolverParams -> DepResolverParams
setPreferenceDefault
        (if forall a. BooleanFlag a => a -> Bool
Cabal.asBool PreferOldest
solverSettingPreferOldest
          then PackagesPreferenceDefault
PreferAllOldest
          else PackagesPreferenceDefault
PreferLatestForSelected)
                           {-(if solverSettingUpgradeDeps
                                then PreferAllLatest
                                else PreferLatestForSelected)-}

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowOlder -> DepResolverParams -> DepResolverParams
removeLowerBounds AllowOlder
solverSettingAllowOlder
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowNewer -> DepResolverParams -> DepResolverParams
removeUpperBounds AllowNewer
solverSettingAllowNewer

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePackage UnresolvedPkgLoc -> Maybe [Dependency])
-> DepResolverParams -> DepResolverParams
addDefaultSetupDependencies (Compiler -> Platform -> PackageDescription -> Maybe [Dependency]
defaultSetupDeps Compiler
comp Platform
platform
                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
PD.packageDescription
                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription)

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> DepResolverParams -> DepResolverParams
addSetupCabalMinVersionConstraint Version
setupMinCabalVersionConstraint
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> DepResolverParams -> DepResolverParams
addSetupCabalMaxVersionConstraint Version
setupMaxCabalVersionConstraint

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackagePreference] -> DepResolverParams -> DepResolverParams
addPreferences
          -- preferences from the config file or command line
          [ PackageName -> VersionRange -> PackagePreference
PackageVersionPreference PackageName
name VersionRange
ver
          | PackageVersionConstraint PackageName
name VersionRange
ver <- [PackageVersionConstraint]
solverSettingPreferences ]

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
          -- version constraints from the config file or command line
            [ PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint (UserConstraint -> PackageConstraint
userToPackageConstraint UserConstraint
pc) ConstraintSource
src
            | (UserConstraint
pc, ConstraintSource
src) <- [(UserConstraint, ConstraintSource)]
solverSettingConstraints ]

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackagePreference] -> DepResolverParams -> DepResolverParams
addPreferences
          -- enable stanza preference unilaterally, regardless if the user asked
          -- accordingly or expressed no preference, to help hint the solver
          [ PackageName -> [OptionalStanza] -> PackagePreference
PackageStanzasPreference PackageName
pkgname [OptionalStanza]
stanzas
          | PackageSpecifier (SourcePackage UnresolvedPkgLoc)
pkg <- [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages
          , let pkgname :: PackageName
pkgname = forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget PackageSpecifier (SourcePackage UnresolvedPkgLoc)
pkg
                stanzaM :: Map OptionalStanza Bool
stanzaM = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall k a. Map k a
Map.empty PackageName
pkgname Map PackageName (Map OptionalStanza Bool)
pkgStanzasEnable
                stanzas :: [OptionalStanza]
stanzas = [ OptionalStanza
stanza | OptionalStanza
stanza <- [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
                          , forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup OptionalStanza
stanza Map OptionalStanza Bool
stanzaM forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
False ]
          , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptionalStanza]
stanzas)
          ]

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
          -- enable stanza constraints where the user asked to enable
          [ PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint
              (ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint (PackageName -> ConstraintScope
scopeToplevel PackageName
pkgname)
                                 ([OptionalStanza] -> PackageProperty
PackagePropertyStanzas [OptionalStanza]
stanzas))
              ConstraintSource
ConstraintSourceConfigFlagOrTarget
          | PackageSpecifier (SourcePackage UnresolvedPkgLoc)
pkg <- [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages
          , let pkgname :: PackageName
pkgname = forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget PackageSpecifier (SourcePackage UnresolvedPkgLoc)
pkg
                stanzaM :: Map OptionalStanza Bool
stanzaM = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall k a. Map k a
Map.empty PackageName
pkgname Map PackageName (Map OptionalStanza Bool)
pkgStanzasEnable
                stanzas :: [OptionalStanza]
stanzas = [ OptionalStanza
stanza | OptionalStanza
stanza <- [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
                          , forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup OptionalStanza
stanza Map OptionalStanza Bool
stanzaM forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True ]
          , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptionalStanza]
stanzas)
          ]

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
          --TODO: [nice to have] should have checked at some point that the
          -- package in question actually has these flags.
          [ PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint
              (ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint (PackageName -> ConstraintScope
scopeToplevel PackageName
pkgname)
                                 (FlagAssignment -> PackageProperty
PackagePropertyFlags FlagAssignment
flags))
              ConstraintSource
ConstraintSourceConfigFlagOrTarget
          | (PackageName
pkgname, FlagAssignment
flags) <- forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName FlagAssignment
solverSettingFlagAssignments ]

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
          --TODO: [nice to have] we have user-supplied flags for unspecified
          -- local packages (as well as specific per-package flags). For the
          -- former we just apply all these flags to all local targets which
          -- is silly. We should check if the flags are appropriate.
          [ PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint
              (ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint (PackageName -> ConstraintScope
scopeToplevel PackageName
pkgname)
                                 (FlagAssignment -> PackageProperty
PackagePropertyFlags FlagAssignment
flags))
              ConstraintSource
ConstraintSourceConfigFlagOrTarget
          | let flags :: FlagAssignment
flags = FlagAssignment
solverSettingFlagAssignment
          , Bool -> Bool
not (FlagAssignment -> Bool
PD.nullFlagAssignment FlagAssignment
flags)
          , PackageSpecifier (SourcePackage UnresolvedPkgLoc)
pkg <- [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages
          , let pkgname :: PackageName
pkgname = forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget PackageSpecifier (SourcePackage UnresolvedPkgLoc)
pkg ]

      forall a b. (a -> b) -> a -> b
$ DepResolverParams
stdResolverParams

    stdResolverParams :: DepResolverParams
    stdResolverParams :: DepResolverParams
stdResolverParams =
      -- Note: we don't use the standardInstallPolicy here, since that uses
      -- its own addDefaultSetupDependencies that is not appropriate for us.
      InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
-> DepResolverParams
basicInstallPolicy
        InstalledPackageIndex
installedPkgIndex SourcePackageDb
sourcePkgDb
        [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
localPackages

    -- While we can talk to older Cabal versions (we need to be able to
    -- do so for custom Setup scripts that require older Cabal lib
    -- versions), we have problems talking to some older versions that
    -- don't support certain features.
    --
    -- For example, Cabal-1.16 and older do not know about build targets.
    -- Even worse, 1.18 and older only supported the --constraint flag
    -- with source package ids, not --dependency with installed package
    -- ids. That is bad because we cannot reliably select the right
    -- dependencies in the presence of multiple instances (i.e. the
    -- store). See issue #3932. So we require Cabal 1.20 as a minimum.
    --
    -- Moreover, lib:Cabal generally only supports the interface of
    -- current and past compilers; in fact recent lib:Cabal versions
    -- will warn when they encounter a too new or unknown GHC compiler
    -- version (c.f. #415). To avoid running into unsupported
    -- configurations we encode the compatibility matrix as lower
    -- bounds on lib:Cabal here (effectively corresponding to the
    -- respective major Cabal version bundled with the respective GHC
    -- release).
    --
    -- etc.
    -- GHC 9.2   needs  Cabal >= 3.6
    -- GHC 9.0   needs  Cabal >= 3.4
    -- GHC 8.10  needs  Cabal >= 3.2
    -- GHC 8.8   needs  Cabal >= 3.0
    -- GHC 8.6   needs  Cabal >= 2.4
    -- GHC 8.4   needs  Cabal >= 2.2
    -- GHC 8.2   needs  Cabal >= 2.0
    -- GHC 8.0   needs  Cabal >= 1.24
    -- GHC 7.10  needs  Cabal >= 1.22
    --
    -- (NB: we don't need to consider older GHCs as Cabal >= 1.20 is
    -- the absolute lower bound)
    --
    -- TODO: long-term, this compatibility matrix should be
    --       stored as a field inside 'Distribution.Compiler.Compiler'
    setupMinCabalVersionConstraint :: Version
setupMinCabalVersionConstraint
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9,Int
6]  = [Int] -> Version
mkVersion [Int
3,Int
10]
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9,Int
4]  = [Int] -> Version
mkVersion [Int
3,Int
8]
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9,Int
2]  = [Int] -> Version
mkVersion [Int
3,Int
6]
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9,Int
0]  = [Int] -> Version
mkVersion [Int
3,Int
4]
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
10] = [Int] -> Version
mkVersion [Int
3,Int
2]
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
8]  = [Int] -> Version
mkVersion [Int
3,Int
0]
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
6]  = [Int] -> Version
mkVersion [Int
2,Int
4]
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
4]  = [Int] -> Version
mkVersion [Int
2,Int
2]
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
2]  = [Int] -> Version
mkVersion [Int
2,Int
0]
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
0]  = [Int] -> Version
mkVersion [Int
1,Int
24]
      | Bool
isGHC, Version
compVer forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
7,Int
10] = [Int] -> Version
mkVersion [Int
1,Int
22]
      | Bool
otherwise                          = [Int] -> Version
mkVersion [Int
1,Int
20]
      where
        isGHC :: Bool
isGHC    = CompilerFlavor
compFlav forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CompilerFlavor
GHC,CompilerFlavor
GHCJS]
        compFlav :: CompilerFlavor
compFlav = Compiler -> CompilerFlavor
compilerFlavor Compiler
comp
        compVer :: Version
compVer  = Compiler -> Version
compilerVersion Compiler
comp

    -- As we can't predict the future, we also place a global upper
    -- bound on the lib:Cabal version we know how to interact with:
    --
    -- The upper bound is computed by incrementing the current major
    -- version twice in order to allow for the current version, as
    -- well as the next adjacent major version (one of which will not
    -- be released, as only "even major" versions of Cabal are
    -- released to Hackage or bundled with proper GHC releases).
    --
    -- For instance, if the current version of cabal-install is an odd
    -- development version, e.g.  Cabal-2.1.0.0, then we impose an
    -- upper bound `setup.Cabal < 2.3`; if `cabal-install` is on a
    -- stable/release even version, e.g. Cabal-2.2.1.0, the upper
    -- bound is `setup.Cabal < 2.4`. This gives us enough flexibility
    -- when dealing with development snapshots of Cabal and cabal-install.
    --
    setupMaxCabalVersionConstraint :: Version
setupMaxCabalVersionConstraint =
      ([Int] -> [Int]) -> Version -> Version
alterVersion (forall a. Int -> [a] -> [a]
take Int
2) forall a b. (a -> b) -> a -> b
$ Int -> Version -> Version
incVersion Int
1 forall a b. (a -> b) -> a -> b
$ Int -> Version -> Version
incVersion Int
1 Version
cabalVersion

------------------------------------------------------------------------------
-- * Install plan post-processing
------------------------------------------------------------------------------

-- This phase goes from the InstallPlan we get from the solver and has to
-- make an elaborated install plan.
--
-- We go in two steps:
--
--  1. elaborate all the source packages that the solver has chosen.
--  2. swap source packages for pre-existing installed packages wherever
--     possible.
--
-- We do it in this order, elaborating and then replacing, because the easiest
-- way to calculate the installed package ids used for the replacement step is
-- from the elaborated configuration for each package.




------------------------------------------------------------------------------
-- * Install plan elaboration
------------------------------------------------------------------------------

-- Note [SolverId to ConfiguredId]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Dependency solving is a per package affair, so after we're done, we
-- end up with 'SolverInstallPlan' that records in 'solverPkgLibDeps'
-- and 'solverPkgExeDeps' what packages provide the libraries and executables
-- needed by each component of the package (phew!)  For example, if I have
--
--      library
--          build-depends: lib
--          build-tool-depends: pkg:exe1
--          build-tools: alex
--
-- After dependency solving, I find out that this library component has
-- library dependencies on lib-0.2, and executable dependencies on pkg-0.1
-- and alex-0.3 (other components of the package may have different
-- dependencies).  Note that I've "lost" the knowledge that I depend
-- *specifically* on the exe1 executable from pkg.
--
-- So, we have a this graph of packages, and we need to transform it into
-- a graph of components which we are actually going to build.  In particular:
--
-- NODE changes from PACKAGE (SolverPackage) to COMPONENTS (ElaboratedConfiguredPackage)
-- EDGE changes from PACKAGE DEP (SolverId) to COMPONENT DEPS (ConfiguredId)
--
-- In both cases, what was previously a single node/edge may turn into multiple
-- nodes/edges.  Multiple components, because there may be multiple components
-- in a package; multiple component deps, because we may depend upon multiple
-- executables from the same package (and maybe, some day, multiple libraries
-- from the same package.)
--
-- Let's talk about how to do this transformation. Naively, we might consider
-- just processing each package, converting it into (zero or) one or more
-- components.  But we also have to update the edges; this leads to
-- two complications:
--
--      1. We don't know what the ConfiguredId of a component is until
--      we've configured it, but we cannot configure a component unless
--      we know the ConfiguredId of all its dependencies.  Thus, we must
--      process the 'SolverInstallPlan' in topological order.
--
--      2. When we process a package, we know the SolverIds of its
--      dependencies, but we have to do some work to turn these into
--      ConfiguredIds.  For example, in the case of build-tool-depends, the
--      SolverId isn't enough to uniquely determine the ConfiguredId we should
--      elaborate to: we have to look at the executable name attached to
--      the package name in the package description to figure it out.
--      At the same time, we NEED to use the SolverId, because there might
--      be multiple versions of the same package in the build plan
--      (due to setup dependencies); we can't just look up the package name
--      from the package description.
--
-- We can adopt the following strategy:
--
--      * When a package is transformed into components, record
--        a mapping from SolverId to ALL of the components
--        which were elaborated.
--
--      * When we look up an edge, we use our knowledge of the
--        component name to *filter* the list of components into
--        the ones we actually wanted to refer to.
--
-- By the way, we can tell that SolverInstallPlan is not the "right" type
-- because a SolverId cannot adequately represent all possible dependency
-- solver states: we may need to record foo-0.1 multiple times in
-- the solver install plan with different dependencies.  This imprecision in the
-- type currently doesn't cause any problems because the dependency solver
-- continues to enforce the single instance restriction regardless of compiler
-- version.  The right way to solve this is to come up with something very much
-- like a 'ConfiguredId', in that it incorporates the version choices of its
-- dependencies, but less fine grained.


-- | Produce an elaborated install plan using the policy for local builds with
-- a nix-style shared store.
--
-- In theory should be able to make an elaborated install plan with a policy
-- matching that of the classic @cabal install --user@ or @--global@
--
elaborateInstallPlan
  :: Verbosity -> Platform -> Compiler -> ProgramDb -> PkgConfigDb
  -> DistDirLayout
  -> StoreDirLayout
  -> SolverInstallPlan
  -> [PackageSpecifier (SourcePackage (PackageLocation loc))]
  -> Map PackageId PackageSourceHash
  -> InstallDirs.InstallDirTemplates
  -> ProjectConfigShared
  -> PackageConfig
  -> PackageConfig
  -> Map PackageName PackageConfig
  -> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
elaborateInstallPlan :: forall loc.
Verbosity
-> Platform
-> Compiler
-> ProgramDb
-> PkgConfigDb
-> DistDirLayout
-> StoreDirLayout
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> Map PackageIdentifier PackageSourceHash
-> InstallDirTemplates
-> ProjectConfigShared
-> PackageConfig
-> PackageConfig
-> Map PackageName PackageConfig
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
elaborateInstallPlan Verbosity
verbosity Platform
platform Compiler
compiler ProgramDb
compilerprogdb PkgConfigDb
pkgConfigDB
                     distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{String
String -> String
PackageIdentifier -> String
CompilerId -> PackageDB
DistDirParams -> String
DistDirParams -> String -> String
distPackageDB :: DistDirLayout -> CompilerId -> PackageDB
distBinDirectory :: DistDirLayout -> String
distTempDirectory :: DistDirLayout -> String
distSdistDirectory :: DistDirLayout -> String
distSdistFile :: DistDirLayout -> PackageIdentifier -> String
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> String
distPackageCacheFile :: DistDirLayout -> DistDirParams -> String -> String
distUnpackedSrcRootDirectory :: DistDirLayout -> String
distUnpackedSrcDirectory :: DistDirLayout -> PackageIdentifier -> String
distDownloadSrcDirectory :: DistDirLayout -> String
distBuildRootDirectory :: DistDirLayout -> String
distBuildDirectory :: DistDirLayout -> DistDirParams -> String
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: String
distTempDirectory :: String
distSdistDirectory :: String
distSdistFile :: PackageIdentifier -> String
distPackageCacheDirectory :: DistDirParams -> String
distPackageCacheFile :: DistDirParams -> String -> String
distProjectCacheDirectory :: String
distProjectCacheFile :: String -> String
distUnpackedSrcRootDirectory :: String
distUnpackedSrcDirectory :: PackageIdentifier -> String
distDownloadSrcDirectory :: String
distBuildRootDirectory :: String
distBuildDirectory :: DistDirParams -> String
distDirectory :: String
distProjectFile :: String -> String
distProjectRootDirectory :: String
distProjectFile :: DistDirLayout -> String -> String
distProjectCacheDirectory :: DistDirLayout -> String
distProjectCacheFile :: DistDirLayout -> String -> String
distDirectory :: DistDirLayout -> String
distProjectRootDirectory :: DistDirLayout -> String
..}
                     storeDirLayout :: StoreDirLayout
storeDirLayout@StoreDirLayout{CompilerId -> PackageDBStack
storePackageDBStack :: StoreDirLayout -> CompilerId -> PackageDBStack
storePackageDBStack :: CompilerId -> PackageDBStack
storePackageDBStack}
                     SolverInstallPlan
solverPlan [PackageSpecifier (SourcePackage (PackageLocation loc))]
localPackages
                     Map PackageIdentifier PackageSourceHash
sourcePackageHashes
                     InstallDirTemplates
defaultInstallDirs
                     ProjectConfigShared
sharedPackageConfig
                     PackageConfig
allPackagesConfig
                     PackageConfig
localPackagesConfig
                     Map PackageName PackageConfig
perPackageConfig = do
    ElaboratedInstallPlan
x <- LogProgress ElaboratedInstallPlan
elaboratedInstallPlan
    forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
x, ElaboratedSharedConfig
elaboratedSharedConfig)
  where
    elaboratedSharedConfig :: ElaboratedSharedConfig
elaboratedSharedConfig =
      ElaboratedSharedConfig {
        pkgConfigPlatform :: Platform
pkgConfigPlatform      = Platform
platform,
        pkgConfigCompiler :: Compiler
pkgConfigCompiler      = Compiler
compiler,
        pkgConfigCompilerProgs :: ProgramDb
pkgConfigCompilerProgs = ProgramDb
compilerprogdb,
        pkgConfigReplOptions :: ReplOptions
pkgConfigReplOptions   = forall a. Monoid a => a
mempty
      }

    preexistingInstantiatedPkgs :: Map UnitId FullUnitId
    preexistingInstantiatedPkgs :: Map UnitId FullUnitId
preexistingInstantiatedPkgs =
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {loc}. ResolverPackage loc -> Maybe (UnitId, FullUnitId)
f (SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
SolverInstallPlan.toList SolverInstallPlan
solverPlan))
      where
        f :: ResolverPackage loc -> Maybe (UnitId, FullUnitId)
f (SolverInstallPlan.PreExisting InstSolverPackage
inst)
            | let ipkg :: InstalledPackageInfo
ipkg = InstSolverPackage -> InstalledPackageInfo
instSolverPkgIPI InstSolverPackage
inst
            , Bool -> Bool
not (InstalledPackageInfo -> Bool
IPI.indefinite InstalledPackageInfo
ipkg)
            = forall a. a -> Maybe a
Just (InstalledPackageInfo -> UnitId
IPI.installedUnitId InstalledPackageInfo
ipkg,
                     (InstalledPackageId -> Map ModuleName OpenModule -> FullUnitId
FullUnitId (InstalledPackageInfo -> InstalledPackageId
IPI.installedComponentId InstalledPackageInfo
ipkg)
                                 (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
IPI.instantiatedWith InstalledPackageInfo
ipkg))))
        f ResolverPackage loc
_ = forall a. Maybe a
Nothing

    elaboratedInstallPlan ::
      LogProgress (InstallPlan.GenericInstallPlan IPI.InstalledPackageInfo ElaboratedConfiguredPackage)
    elaboratedInstallPlan :: LogProgress ElaboratedInstallPlan
elaboratedInstallPlan =
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
((SolverId -> [GenericPlanPackage ipkg srcpkg])
 -> ResolverPackage UnresolvedPkgLoc
 -> LogProgress [GenericPlanPackage ipkg srcpkg])
-> SolverInstallPlan
-> LogProgress (GenericInstallPlan ipkg srcpkg)
InstallPlan.fromSolverInstallPlanWithProgress SolverInstallPlan
solverPlan forall a b. (a -> b) -> a -> b
$ \SolverId -> [ElaboratedPlanPackage]
mapDep ResolverPackage UnresolvedPkgLoc
planpkg ->
        case ResolverPackage UnresolvedPkgLoc
planpkg of
          SolverInstallPlan.PreExisting InstSolverPackage
pkg ->
            forall (m :: * -> *) a. Monad m => a -> m a
return [forall ipkg srcpkg. ipkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.PreExisting (InstSolverPackage -> InstalledPackageInfo
instSolverPkgIPI InstSolverPackage
pkg)]

          SolverInstallPlan.Configured  SolverPackage UnresolvedPkgLoc
pkg ->
            let inplace_doc :: Doc
inplace_doc | forall loc. SolverPackage loc -> Bool
shouldBuildInplaceOnly SolverPackage UnresolvedPkgLoc
pkg = String -> Doc
text String
"inplace"
                            | Bool
otherwise                  = Doc
Disp.empty
            in forall a. Doc -> LogProgress a -> LogProgress a
addProgressCtx (String -> Doc
text String
"In the" Doc -> Doc -> Doc
<+> Doc
inplace_doc Doc -> Doc -> Doc
<+> String -> Doc
text String
"package" Doc -> Doc -> Doc
<+>
                             Doc -> Doc
quotes (forall a. Pretty a => a -> Doc
pretty (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SolverPackage UnresolvedPkgLoc
pkg))) forall a b. (a -> b) -> a -> b
$
               forall a b. (a -> b) -> [a] -> [b]
map forall ipkg srcpkg. srcpkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.Configured forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SolverId -> [ElaboratedPlanPackage])
-> SolverPackage UnresolvedPkgLoc
-> LogProgress [ElaboratedConfiguredPackage]
elaborateSolverToComponents SolverId -> [ElaboratedPlanPackage]
mapDep SolverPackage UnresolvedPkgLoc
pkg

    -- NB: We don't INSTANTIATE packages at this point.  That's
    -- a post-pass.  This makes it simpler to compute dependencies.
    elaborateSolverToComponents
        :: (SolverId -> [ElaboratedPlanPackage])
        -> SolverPackage UnresolvedPkgLoc
        -> LogProgress [ElaboratedConfiguredPackage]
    elaborateSolverToComponents :: (SolverId -> [ElaboratedPlanPackage])
-> SolverPackage UnresolvedPkgLoc
-> LogProgress [ElaboratedConfiguredPackage]
elaborateSolverToComponents SolverId -> [ElaboratedPlanPackage]
mapDep spkg :: SolverPackage UnresolvedPkgLoc
spkg@(SolverPackage SourcePackage UnresolvedPkgLoc
_ FlagAssignment
_ OptionalStanzaSet
_ ComponentDeps [SolverId]
deps0 ComponentDeps [SolverId]
exe_deps0)
        = case ComponentRequestedSpec
-> PackageDescription -> Either [ComponentName] ComponentsGraph
mkComponentsGraph (ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabEnabledSpec ElaboratedConfiguredPackage
elab0) PackageDescription
pd of
           Right ComponentsGraph
g -> do
            let src_comps :: ComponentsWithDeps
src_comps = ComponentsGraph -> ComponentsWithDeps
componentsGraphToList ComponentsGraph
g
            Doc -> LogProgress ()
infoProgress forall a b. (a -> b) -> a -> b
$ Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"Component graph for" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty PackageIdentifier
pkgid Doc -> Doc -> Doc
<<>> Doc
colon)
                            Int
4 (ComponentsWithDeps -> Doc
dispComponentsWithDeps ComponentsWithDeps
src_comps)
            ((ConfiguredComponentMap, LinkedComponentMap,
 Map InstalledPackageId String)
_, [ElaboratedConfiguredPackage]
comps) <- forall (m :: * -> *) (t :: * -> *) a b c.
(Monad m, Traversable t) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumM (ConfiguredComponentMap, LinkedComponentMap,
 Map InstalledPackageId String)
-> Component
-> LogProgress
     ((ConfiguredComponentMap, LinkedComponentMap,
       Map InstalledPackageId String),
      ElaboratedConfiguredPackage)
buildComponent
                            (forall k a. Map k a
Map.empty, forall k a. Map k a
Map.empty, forall k a. Map k a
Map.empty)
                            (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst ComponentsWithDeps
src_comps)
            let not_per_component_reasons :: [Doc]
not_per_component_reasons = forall {t :: * -> *} {a}. Foldable t => t a -> [Doc]
why_not_per_component ComponentsWithDeps
src_comps
            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
not_per_component_reasons
                then forall (m :: * -> *) a. Monad m => a -> m a
return [ElaboratedConfiguredPackage]
comps
                else do forall {t :: * -> *}.
Foldable t =>
t ElaboratedConfiguredPackage -> [Doc] -> LogProgress ()
checkPerPackageOk [ElaboratedConfiguredPackage]
comps [Doc]
not_per_component_reasons
                        forall (m :: * -> *) a. Monad m => a -> m a
return [SolverPackage UnresolvedPkgLoc
-> ComponentsGraph
-> [ElaboratedConfiguredPackage]
-> ElaboratedConfiguredPackage
elaborateSolverToPackage SolverPackage UnresolvedPkgLoc
spkg ComponentsGraph
g forall a b. (a -> b) -> a -> b
$
                                [ElaboratedConfiguredPackage]
comps forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe ElaboratedConfiguredPackage
setupComponent]
           Left [ComponentName]
cns ->
            forall a. Doc -> LogProgress a
dieProgress forall a b. (a -> b) -> a -> b
$
                Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"Dependency cycle between the following components:") Int
4
                     ([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentName -> String
componentNameStanza) [ComponentName]
cns))
      where
        -- You are eligible to per-component build if this list is empty
        why_not_per_component :: t a -> [Doc]
why_not_per_component t a
g
            = [Doc]
cuz_buildtype forall a. [a] -> [a] -> [a]
++ [Doc]
cuz_spec forall a. [a] -> [a] -> [a]
++ [Doc]
cuz_length forall a. [a] -> [a] -> [a]
++ [Doc]
cuz_flag forall a. [a] -> [a] -> [a]
++ [Doc]
cuz_coverage
          where
            cuz :: String -> [Doc]
cuz String
reason = [String -> Doc
text String
reason]
            -- We have to disable per-component for now with
            -- Configure-type scripts in order to prevent parallel
            -- invocation of the same `./configure` script.
            -- See https://github.com/haskell/cabal/issues/4548
            --
            -- Moreover, at this point in time, only non-Custom setup scripts
            -- are supported.  Implementing per-component builds with
            -- Custom would require us to create a new 'ElabSetup'
            -- type, and teach all of the code paths how to handle it.
            -- Once you've implemented this, swap it for the code below.
            cuz_buildtype :: [Doc]
cuz_buildtype =
                case PackageDescription -> BuildType
PD.buildType (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab0) of
                    BuildType
PD.Configure -> String -> [Doc]
cuz String
"build-type is Configure"
                    BuildType
PD.Custom -> String -> [Doc]
cuz String
"build-type is Custom"
                    BuildType
_         -> []
            -- cabal-format versions prior to 1.8 have different build-depends semantics
            -- for now it's easier to just fallback to legacy-mode when specVersion < 1.8
            -- see, https://github.com/haskell/cabal/issues/4121
            cuz_spec :: [Doc]
cuz_spec
                | PackageDescription -> CabalSpecVersion
PD.specVersion PackageDescription
pd forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_8 = []
                | Bool
otherwise = String -> [Doc]
cuz String
"cabal-version is less than 1.8"
            -- In the odd corner case that a package has no components at all
            -- then keep it as a whole package, since otherwise it turns into
            -- 0 component graph nodes and effectively vanishes. We want to
            -- keep it around at least for error reporting purposes.
            cuz_length :: [Doc]
cuz_length
                | forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
g forall a. Ord a => a -> a -> Bool
> Int
0 = []
                | Bool
otherwise    = String -> [Doc]
cuz String
"there are no buildable components"
            -- For ease of testing, we let per-component builds be toggled
            -- at the top level
            cuz_flag :: [Doc]
cuz_flag
                | forall a. a -> Flag a -> a
fromFlagOrDefault Bool
True (ProjectConfigShared -> Flag Bool
projectConfigPerComponent ProjectConfigShared
sharedPackageConfig)
                = []
                | Bool
otherwise = String -> [Doc]
cuz String
"you passed --disable-per-component"
            -- Enabling program coverage introduces odd runtime dependencies
            -- between components.
            cuz_coverage :: [Doc]
cuz_coverage
                | forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (PackageConfig -> Flag Bool
packageConfigCoverage PackageConfig
localPackagesConfig)
                = String -> [Doc]
cuz String
"program coverage is enabled"
                | Bool
otherwise = []

        -- | Sometimes a package may make use of features which are only
        -- supported in per-package mode.  If this is the case, we should
        -- give an error when this occurs.
        checkPerPackageOk :: t ElaboratedConfiguredPackage -> [Doc] -> LogProgress ()
checkPerPackageOk t ElaboratedConfiguredPackage
comps [Doc]
reasons = do
            let is_sublib :: ComponentName -> Bool
is_sublib (CLibName (LSubLibName UnqualComponentName
_)) = Bool
True
                is_sublib ComponentName
_ = Bool
False
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ComponentName -> Bool) -> ElaboratedConfiguredPackage -> Bool
matchElabPkg ComponentName -> Bool
is_sublib) t ElaboratedConfiguredPackage
comps) forall a b. (a -> b) -> a -> b
$
                forall a. Doc -> LogProgress a
dieProgress forall a b. (a -> b) -> a -> b
$
                    String -> Doc
text String
"Internal libraries only supported with per-component builds." Doc -> Doc -> Doc
$$
                    String -> Doc
text String
"Per-component builds were disabled because" Doc -> Doc -> Doc
<+>
                        [Doc] -> Doc
fsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma [Doc]
reasons)
            -- TODO: Maybe exclude Backpack too

        elab0 :: ElaboratedConfiguredPackage
elab0 = SolverPackage UnresolvedPkgLoc -> ElaboratedConfiguredPackage
elaborateSolverToCommon SolverPackage UnresolvedPkgLoc
spkg
        pkgid :: PackageIdentifier
pkgid = ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId    ElaboratedConfiguredPackage
elab0
        pd :: PackageDescription
pd    = ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab0

        -- TODO: This is just a skeleton to get elaborateSolverToPackage
        -- working correctly
        -- TODO: When we actually support building these components, we
        -- have to add dependencies on this from all other components
        setupComponent :: Maybe ElaboratedConfiguredPackage
        setupComponent :: Maybe ElaboratedConfiguredPackage
setupComponent
            | PackageDescription -> BuildType
PD.buildType (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab0) forall a. Eq a => a -> a -> Bool
== BuildType
PD.Custom
            = forall a. a -> Maybe a
Just ElaboratedConfiguredPackage
elab0 {
                elabModuleShape :: ModuleShape
elabModuleShape = ModuleShape
emptyModuleShape,
                elabUnitId :: UnitId
elabUnitId = forall {a}. String -> a
notImpl String
"elabUnitId",
                elabComponentId :: InstalledPackageId
elabComponentId = forall {a}. String -> a
notImpl String
"elabComponentId",
                elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabLinkedInstantiatedWith = forall k a. Map k a
Map.empty,
                elabInstallDirs :: InstallDirs String
elabInstallDirs = forall {a}. String -> a
notImpl String
"elabInstallDirs",
                elabPkgOrComp :: ElaboratedPackageOrComponent
elabPkgOrComp = ElaboratedComponent -> ElaboratedPackageOrComponent
ElabComponent (ElaboratedComponent {[ConfiguredId]
Component
forall {a}. a
forall a. [a]
forall a. Maybe a
compPkgConfigDependencies :: forall a. [a]
compExeDependencyPaths :: forall a. [a]
compExeDependencies :: forall a. [a]
compOrderLibDependencies :: forall {a}. a
compLinkedLibDependencies :: forall {a}. a
compLibDependencies :: [ConfiguredId]
compComponentName :: forall a. Maybe a
compSolverName :: Component
compOrderLibDependencies :: [UnitId]
compExeDependencyPaths :: [(ConfiguredId, String)]
compPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
compExeDependencies :: [ConfiguredId]
compLinkedLibDependencies :: [OpenUnitId]
compLibDependencies :: [ConfiguredId]
compComponentName :: Maybe ComponentName
compSolverName :: Component
..})
              }
            | Bool
otherwise
            = forall a. Maybe a
Nothing
          where
            compSolverName :: Component
compSolverName      = Component
CD.ComponentSetup
            compComponentName :: Maybe a
compComponentName   = forall a. Maybe a
Nothing
            dep_pkgs :: [ElaboratedPlanPackage]
dep_pkgs = (SolverId -> [ElaboratedPlanPackage])
-> SolverId -> [ElaboratedPlanPackage]
elaborateLibSolverId SolverId -> [ElaboratedPlanPackage]
mapDep forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Monoid a => ComponentDeps a -> a
CD.setupDeps ComponentDeps [SolverId]
deps0
            compLibDependencies :: [ConfiguredId]
compLibDependencies
                = forall a b. (a -> b) -> [a] -> [b]
map forall a. HasConfiguredId a => a -> ConfiguredId
configuredId [ElaboratedPlanPackage]
dep_pkgs
            compLinkedLibDependencies :: a
compLinkedLibDependencies = forall {a}. String -> a
notImpl String
"compLinkedLibDependencies"
            compOrderLibDependencies :: a
compOrderLibDependencies = forall {a}. String -> a
notImpl String
"compOrderLibDependencies"
            -- Not supported:
            compExeDependencies :: [a]
compExeDependencies         = []
            compExeDependencyPaths :: [a]
compExeDependencyPaths      = []
            compPkgConfigDependencies :: [a]
compPkgConfigDependencies   = []

            notImpl :: String -> a
notImpl String
f =
                forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Distribution.Client.ProjectPlanning.setupComponent: " forall a. [a] -> [a] -> [a]
++
                        String
f forall a. [a] -> [a] -> [a]
++ String
" not implemented yet"


        buildComponent
            :: (ConfiguredComponentMap,
                LinkedComponentMap,
                Map ComponentId FilePath)
            -> Cabal.Component
            -> LogProgress
                ((ConfiguredComponentMap,
                  LinkedComponentMap,
                  Map ComponentId FilePath),
                ElaboratedConfiguredPackage)
        buildComponent :: (ConfiguredComponentMap, LinkedComponentMap,
 Map InstalledPackageId String)
-> Component
-> LogProgress
     ((ConfiguredComponentMap, LinkedComponentMap,
       Map InstalledPackageId String),
      ElaboratedConfiguredPackage)
buildComponent (ConfiguredComponentMap
cc_map, LinkedComponentMap
lc_map, Map InstalledPackageId String
exe_map) Component
comp =
          forall a. Doc -> LogProgress a -> LogProgress a
addProgressCtx (String -> Doc
text String
"In the stanza" Doc -> Doc -> Doc
<+>
                          Doc -> Doc
quotes (String -> Doc
text (ComponentName -> String
componentNameStanza ComponentName
cname))) forall a b. (a -> b) -> a -> b
$ do

            -- 1. Configure the component, but with a place holder ComponentId.
            ConfiguredComponent
cc0 <- PackageDescription
-> InstalledPackageId
-> ConfiguredComponentMap
-> ConfiguredComponentMap
-> Component
-> LogProgress ConfiguredComponent
toConfiguredComponent
                    PackageDescription
pd
                    (forall a. HasCallStack => String -> a
error String
"Distribution.Client.ProjectPlanning.cc_cid: filled in later")
                    (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ConfiguredComponentMap
external_lib_cc_map ConfiguredComponentMap
cc_map)
                    (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ConfiguredComponentMap
external_exe_cc_map ConfiguredComponentMap
cc_map)
                    Component
comp


            -- 2. Read out the dependencies from the ConfiguredComponent cc0
            let compLibDependencies :: [ConfiguredId]
compLibDependencies =
                    -- Nub because includes can show up multiple times
                    forall a. Ord a => [a] -> [a]
ordNub (forall a b. (a -> b) -> [a] -> [b]
map (AnnotatedId InstalledPackageId -> ConfiguredId
annotatedIdToConfiguredId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall id rn. ComponentInclude id rn -> AnnotatedId id
ci_ann_id)
                                (ConfiguredComponent
-> [ComponentInclude InstalledPackageId IncludeRenaming]
cc_includes ConfiguredComponent
cc0))
                compExeDependencies :: [ConfiguredId]
compExeDependencies =
                    forall a b. (a -> b) -> [a] -> [b]
map AnnotatedId InstalledPackageId -> ConfiguredId
annotatedIdToConfiguredId
                        (ConfiguredComponent -> [AnnotatedId InstalledPackageId]
cc_exe_deps ConfiguredComponent
cc0)
                compExeDependencyPaths :: [(ConfiguredId, String)]
compExeDependencyPaths =
                    [ (AnnotatedId InstalledPackageId -> ConfiguredId
annotatedIdToConfiguredId AnnotatedId InstalledPackageId
aid', String
path)
                    | AnnotatedId InstalledPackageId
aid' <- ConfiguredComponent -> [AnnotatedId InstalledPackageId]
cc_exe_deps ConfiguredComponent
cc0
                    , Just [String]
paths <- [forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall id. AnnotatedId id -> id
ann_id AnnotatedId InstalledPackageId
aid') Map InstalledPackageId [String]
exe_map1]
                    , String
path <- [String]
paths ]
                elab_comp :: ElaboratedComponent
elab_comp = ElaboratedComponent {[(PkgconfigName, Maybe PkgconfigVersion)]
[(ConfiguredId, String)]
[ConfiguredId]
Maybe ComponentName
Component
forall {a}. a
compPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
compSolverName :: Component
compComponentName :: Maybe ComponentName
compOrderLibDependencies :: forall {a}. a
compLinkedLibDependencies :: forall {a}. a
compExeDependencyPaths :: [(ConfiguredId, String)]
compExeDependencies :: [ConfiguredId]
compLibDependencies :: [ConfiguredId]
compOrderLibDependencies :: [UnitId]
compExeDependencyPaths :: [(ConfiguredId, String)]
compPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
compExeDependencies :: [ConfiguredId]
compLinkedLibDependencies :: [OpenUnitId]
compLibDependencies :: [ConfiguredId]
compComponentName :: Maybe ComponentName
compSolverName :: Component
..}

            -- 3. Construct a preliminary ElaboratedConfiguredPackage,
            -- and use this to compute the component ID.  Fix up cc_id
            -- correctly.
            let elab1 :: ElaboratedConfiguredPackage
elab1 = ElaboratedConfiguredPackage
elab0 {
                        elabPkgOrComp :: ElaboratedPackageOrComponent
elabPkgOrComp = ElaboratedComponent -> ElaboratedPackageOrComponent
ElabComponent forall a b. (a -> b) -> a -> b
$ ElaboratedComponent
elab_comp
                     }
                cid :: InstalledPackageId
cid = case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab0 of
                        BuildStyle
BuildInplaceOnly ->
                          String -> InstalledPackageId
mkComponentId forall a b. (a -> b) -> a -> b
$
                            forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pkgid forall a. [a] -> [a] -> [a]
++ String
"-inplace" forall a. [a] -> [a] -> [a]
++
                              (case ComponentName -> Maybe UnqualComponentName
Cabal.componentNameString ComponentName
cname of
                                  Maybe UnqualComponentName
Nothing -> String
""
                                  Just UnqualComponentName
s -> String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
s)
                        BuildStyle
BuildAndInstall ->
                          PackageHashInputs -> InstalledPackageId
hashedInstalledPackageId
                            (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> PackageHashInputs
packageHashInputs
                                ElaboratedSharedConfig
elaboratedSharedConfig
                                ElaboratedConfiguredPackage
elab1) -- knot tied
                cc :: ConfiguredComponent
cc = ConfiguredComponent
cc0 { cc_ann_id :: AnnotatedId InstalledPackageId
cc_ann_id = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const InstalledPackageId
cid) (ConfiguredComponent -> AnnotatedId InstalledPackageId
cc_ann_id ConfiguredComponent
cc0) }
            Doc -> LogProgress ()
infoProgress forall a b. (a -> b) -> a -> b
$ ConfiguredComponent -> Doc
dispConfiguredComponent ConfiguredComponent
cc

            -- 4. Perform mix-in linking
            let lookup_uid :: DefUnitId -> FullUnitId
lookup_uid DefUnitId
def_uid =
                    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DefUnitId -> UnitId
unDefUnitId DefUnitId
def_uid) Map UnitId FullUnitId
preexistingInstantiatedPkgs of
                        Just FullUnitId
full -> FullUnitId
full
                        Maybe FullUnitId
Nothing -> forall a. HasCallStack => String -> a
error (String
"lookup_uid: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow DefUnitId
def_uid)
            LinkedComponent
lc <- Verbosity
-> (DefUnitId -> FullUnitId)
-> PackageIdentifier
-> LinkedComponentMap
-> ConfiguredComponent
-> LogProgress LinkedComponent
toLinkedComponent Verbosity
verbosity DefUnitId -> FullUnitId
lookup_uid (ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId ElaboratedConfiguredPackage
elab0)
                        (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union LinkedComponentMap
external_lc_map LinkedComponentMap
lc_map) ConfiguredComponent
cc
            Doc -> LogProgress ()
infoProgress forall a b. (a -> b) -> a -> b
$ LinkedComponent -> Doc
dispLinkedComponent LinkedComponent
lc
            -- NB: elab is setup to be the correct form for an
            -- indefinite library, or a definite library with no holes.
            -- We will modify it in 'instantiateInstallPlan' to handle
            -- instantiated packages.

            -- 5. Construct the final ElaboratedConfiguredPackage
            let
                elab2 :: ElaboratedConfiguredPackage
elab2 = ElaboratedConfiguredPackage
elab1 {
                    elabModuleShape :: ModuleShape
elabModuleShape = LinkedComponent -> ModuleShape
lc_shape LinkedComponent
lc,
                    elabUnitId :: UnitId
elabUnitId      = OpenUnitId -> UnitId
abstractUnitId (LinkedComponent -> OpenUnitId
lc_uid LinkedComponent
lc),
                    elabComponentId :: InstalledPackageId
elabComponentId = LinkedComponent -> InstalledPackageId
lc_cid LinkedComponent
lc,
                    elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabLinkedInstantiatedWith = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (LinkedComponent -> [(ModuleName, OpenModule)]
lc_insts LinkedComponent
lc),
                    elabPkgOrComp :: ElaboratedPackageOrComponent
elabPkgOrComp = ElaboratedComponent -> ElaboratedPackageOrComponent
ElabComponent forall a b. (a -> b) -> a -> b
$ ElaboratedComponent
elab_comp {
                        compLinkedLibDependencies :: [OpenUnitId]
compLinkedLibDependencies = forall a. Ord a => [a] -> [a]
ordNub (forall a b. (a -> b) -> [a] -> [b]
map forall id rn. ComponentInclude id rn -> id
ci_id (LinkedComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
lc_includes LinkedComponent
lc)),
                        compOrderLibDependencies :: [UnitId]
compOrderLibDependencies =
                          forall a. Ord a => [a] -> [a]
ordNub (forall a b. (a -> b) -> [a] -> [b]
map (OpenUnitId -> UnitId
abstractUnitId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall id rn. ComponentInclude id rn -> id
ci_id)
                                      (LinkedComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
lc_includes LinkedComponent
lc forall a. [a] -> [a] -> [a]
++ LinkedComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
lc_sig_includes LinkedComponent
lc))
                      }
                   }
                elab :: ElaboratedConfiguredPackage
elab = ElaboratedConfiguredPackage
elab2 {
                    elabInstallDirs :: InstallDirs String
elabInstallDirs = StoreDirLayout
-> InstallDirTemplates
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> InstallDirs String
computeInstallDirs
                      StoreDirLayout
storeDirLayout
                      InstallDirTemplates
defaultInstallDirs
                      ElaboratedSharedConfig
elaboratedSharedConfig
                      ElaboratedConfiguredPackage
elab2
                   }

            -- 6. Construct the updated local maps
            let cc_map' :: ConfiguredComponentMap
cc_map'  = ConfiguredComponent
-> ConfiguredComponentMap -> ConfiguredComponentMap
extendConfiguredComponentMap ConfiguredComponent
cc ConfiguredComponentMap
cc_map
                lc_map' :: LinkedComponentMap
lc_map'  = LinkedComponent -> LinkedComponentMap -> LinkedComponentMap
extendLinkedComponentMap LinkedComponent
lc LinkedComponentMap
lc_map
                exe_map' :: Map InstalledPackageId String
exe_map' = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert InstalledPackageId
cid (ElaboratedConfiguredPackage -> String
inplace_bin_dir ElaboratedConfiguredPackage
elab) Map InstalledPackageId String
exe_map

            forall (m :: * -> *) a. Monad m => a -> m a
return ((ConfiguredComponentMap
cc_map', LinkedComponentMap
lc_map', Map InstalledPackageId String
exe_map'), ElaboratedConfiguredPackage
elab)
          where
            compLinkedLibDependencies :: a
compLinkedLibDependencies = forall a. HasCallStack => String -> a
error String
"buildComponent: compLinkedLibDependencies"
            compOrderLibDependencies :: a
compOrderLibDependencies = forall a. HasCallStack => String -> a
error String
"buildComponent: compOrderLibDependencies"

            cname :: ComponentName
cname = Component -> ComponentName
Cabal.componentName Component
comp
            compComponentName :: Maybe ComponentName
compComponentName = forall a. a -> Maybe a
Just ComponentName
cname
            compSolverName :: Component
compSolverName = ComponentName -> Component
CD.componentNameToComponent ComponentName
cname

            -- NB: compLinkedLibDependencies and
            -- compOrderLibDependencies are defined when we define
            -- 'elab'.
            external_lib_dep_sids :: [SolverId]
external_lib_dep_sids = forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
CD.select (forall a. Eq a => a -> a -> Bool
== Component
compSolverName) ComponentDeps [SolverId]
deps0
            external_exe_dep_sids :: [SolverId]
external_exe_dep_sids = forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
CD.select (forall a. Eq a => a -> a -> Bool
== Component
compSolverName) ComponentDeps [SolverId]
exe_deps0

            external_lib_dep_pkgs :: [ElaboratedPlanPackage]
external_lib_dep_pkgs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SolverId -> [ElaboratedPlanPackage]
mapDep [SolverId]
external_lib_dep_sids

            -- Combine library and build-tool dependencies, for backwards
            -- compatibility (See issue #5412 and the documentation for
            -- InstallPlan.fromSolverInstallPlan), but prefer the versions
            -- specified as build-tools.
            external_exe_dep_pkgs :: [ElaboratedPlanPackage]
external_exe_dep_pkgs =
                forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SolverId -> [ElaboratedPlanPackage]
mapDep forall a b. (a -> b) -> a -> b
$
                forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubBy (PackageIdentifier -> PackageName
pkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) forall a b. (a -> b) -> a -> b
$
                [SolverId]
external_exe_dep_sids forall a. [a] -> [a] -> [a]
++ [SolverId]
external_lib_dep_sids

            external_exe_map :: Map InstalledPackageId [String]
external_exe_map = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
                [ (ElaboratedPlanPackage -> InstalledPackageId
getComponentId ElaboratedPlanPackage
pkg, [String]
paths)
                | ElaboratedPlanPackage
pkg <- [ElaboratedPlanPackage]
external_exe_dep_pkgs
                , let paths :: [String]
paths = ElaboratedPlanPackage -> [String]
planPackageExePaths ElaboratedPlanPackage
pkg ]
            exe_map1 :: Map InstalledPackageId [String]
exe_map1 = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map InstalledPackageId [String]
external_exe_map forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> [String
x]) Map InstalledPackageId String
exe_map

            external_lib_cc_map :: ConfiguredComponentMap
external_lib_cc_map = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
                                forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ElaboratedPlanPackage
-> (PackageName,
    Map ComponentName (AnnotatedId InstalledPackageId))
mkCCMapping [ElaboratedPlanPackage]
external_lib_dep_pkgs
            external_exe_cc_map :: ConfiguredComponentMap
external_exe_cc_map = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
                                forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ElaboratedPlanPackage
-> (PackageName,
    Map ComponentName (AnnotatedId InstalledPackageId))
mkCCMapping [ElaboratedPlanPackage]
external_exe_dep_pkgs
            external_lc_map :: LinkedComponentMap
external_lc_map =
                forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ElaboratedPlanPackage
-> (InstalledPackageId, (OpenUnitId, ModuleShape))
mkShapeMapping forall a b. (a -> b) -> a -> b
$
                [ElaboratedPlanPackage]
external_lib_dep_pkgs forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SolverId -> [ElaboratedPlanPackage]
mapDep [SolverId]
external_exe_dep_sids

            compPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
compPkgConfigDependencies =
                [ (PkgconfigName
pn, forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"compPkgConfigDependencies: impossible! "
                                            forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow PkgconfigName
pn forall a. [a] -> [a] -> [a]
++ String
" from "
                                            forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId ElaboratedConfiguredPackage
elab0))
                                 (PkgConfigDb -> PkgconfigName -> Maybe (Maybe PkgconfigVersion)
pkgConfigDbPkgVersion PkgConfigDb
pkgConfigDB PkgconfigName
pn))
                | PkgconfigDependency PkgconfigName
pn PkgconfigVersionRange
_ <- BuildInfo -> [PkgconfigDependency]
PD.pkgconfigDepends
                                                (Component -> BuildInfo
Cabal.componentBuildInfo Component
comp) ]

            inplace_bin_dir :: ElaboratedConfiguredPackage -> String
inplace_bin_dir ElaboratedConfiguredPackage
elab =
                DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> String
-> String
binDirectoryFor
                    DistDirLayout
distDirLayout
                    ElaboratedSharedConfig
elaboratedSharedConfig
                    ElaboratedConfiguredPackage
elab forall a b. (a -> b) -> a -> b
$
                    case ComponentName -> Maybe UnqualComponentName
Cabal.componentNameString ComponentName
cname of
                             Just UnqualComponentName
n -> forall a. Pretty a => a -> String
prettyShow UnqualComponentName
n
                             Maybe UnqualComponentName
Nothing -> String
""


    -- | Given a 'SolverId' referencing a dependency on a library, return
    -- the 'ElaboratedPlanPackage' corresponding to the library.  This
    -- returns at most one result.
    elaborateLibSolverId :: (SolverId -> [ElaboratedPlanPackage])
                         -> SolverId -> [ElaboratedPlanPackage]
    elaborateLibSolverId :: (SolverId -> [ElaboratedPlanPackage])
-> SolverId -> [ElaboratedPlanPackage]
elaborateLibSolverId SolverId -> [ElaboratedPlanPackage]
mapDep = forall a. (a -> Bool) -> [a] -> [a]
filter ((ComponentName -> Bool) -> ElaboratedPlanPackage -> Bool
matchPlanPkg (forall a. Eq a => a -> a -> Bool
== (LibraryName -> ComponentName
CLibName LibraryName
LMainLibName))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolverId -> [ElaboratedPlanPackage]
mapDep

    -- | Given an 'ElaboratedPlanPackage', return the paths to where the
    -- executables that this package represents would be installed.
    -- The only case where multiple paths can be returned is the inplace
    -- monolithic package one, since there can be multiple exes and each one
    -- has its own directory.
    planPackageExePaths :: ElaboratedPlanPackage -> [FilePath]
    planPackageExePaths :: ElaboratedPlanPackage -> [String]
planPackageExePaths =
        -- Pre-existing executables are assumed to be in PATH
        -- already.  In fact, this should be impossible.
        forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage (forall a b. a -> b -> a
const []) forall a b. (a -> b) -> a -> b
$ \ElaboratedConfiguredPackage
elab ->
            let
              executables :: [FilePath]
              executables :: [String]
executables =
                case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
                    -- Monolithic mode: all exes of the package
                    ElabPackage ElaboratedPackage
_ -> UnqualComponentName -> String
unUnqualComponentName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
PD.exeName
                                 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Executable]
PD.executables (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab)
                    -- Per-component mode: just the selected exe
                    ElabComponent ElaboratedComponent
comp ->
                        case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ComponentName -> Maybe UnqualComponentName
Cabal.componentNameString
                                  (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp) of
                            Just (Just UnqualComponentName
n) -> [forall a. Pretty a => a -> String
prettyShow UnqualComponentName
n]
                            Maybe (Maybe UnqualComponentName)
_ -> [String
""]
            in
              DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> String
-> String
binDirectoryFor
                 DistDirLayout
distDirLayout
                 ElaboratedSharedConfig
elaboratedSharedConfig
                 ElaboratedConfiguredPackage
elab
                 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
executables

    elaborateSolverToPackage :: SolverPackage UnresolvedPkgLoc
                             -> ComponentsGraph
                             -> [ElaboratedConfiguredPackage]
                             -> ElaboratedConfiguredPackage
    elaborateSolverToPackage :: SolverPackage UnresolvedPkgLoc
-> ComponentsGraph
-> [ElaboratedConfiguredPackage]
-> ElaboratedConfiguredPackage
elaborateSolverToPackage
        pkg :: SolverPackage UnresolvedPkgLoc
pkg@(SolverPackage (SourcePackage PackageIdentifier
pkgid GenericPackageDescription
_gpd UnresolvedPkgLoc
_srcloc Maybe CabalFileText
_descOverride)
                           FlagAssignment
_flags OptionalStanzaSet
_stanzas ComponentDeps [SolverId]
_deps0 ComponentDeps [SolverId]
_exe_deps0)
        ComponentsGraph
compGraph [ElaboratedConfiguredPackage]
comps =
        -- Knot tying: the final elab includes the
        -- pkgInstalledId, which is calculated by hashing many
        -- of the other fields of the elaboratedPackage.
        ElaboratedConfiguredPackage
elab
      where
        elab0 :: ElaboratedConfiguredPackage
elab0@ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..} = SolverPackage UnresolvedPkgLoc -> ElaboratedConfiguredPackage
elaborateSolverToCommon SolverPackage UnresolvedPkgLoc
pkg
        elab1 :: ElaboratedConfiguredPackage
elab1 = ElaboratedConfiguredPackage
elab0 {
                elabUnitId :: UnitId
elabUnitId = InstalledPackageId -> UnitId
newSimpleUnitId InstalledPackageId
pkgInstalledId,
                elabComponentId :: InstalledPackageId
elabComponentId = InstalledPackageId
pkgInstalledId,
                elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabLinkedInstantiatedWith = forall k a. Map k a
Map.empty,
                elabPkgOrComp :: ElaboratedPackageOrComponent
elabPkgOrComp = ElaboratedPackage -> ElaboratedPackageOrComponent
ElabPackage forall a b. (a -> b) -> a -> b
$ ElaboratedPackage {[(PkgconfigName, Maybe PkgconfigVersion)]
InstalledPackageId
OptionalStanzaSet
ComponentDeps [()]
ComponentDeps [(ConfiguredId, String)]
ComponentDeps [ConfiguredId]
pkgStanzasEnabled :: OptionalStanzaSet
pkgDependsOnSelfLib :: ComponentDeps [()]
pkgPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
pkgExeDependencyPaths :: ComponentDeps [(ConfiguredId, String)]
pkgExeDependencies :: ComponentDeps [ConfiguredId]
pkgLibDependencies :: ComponentDeps [ConfiguredId]
pkgInstalledId :: InstalledPackageId
pkgStanzasEnabled :: OptionalStanzaSet
pkgPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
pkgExeDependencyPaths :: ComponentDeps [(ConfiguredId, String)]
pkgExeDependencies :: ComponentDeps [ConfiguredId]
pkgDependsOnSelfLib :: ComponentDeps [()]
pkgLibDependencies :: ComponentDeps [ConfiguredId]
pkgInstalledId :: InstalledPackageId
..},
                elabModuleShape :: ModuleShape
elabModuleShape = ModuleShape
modShape
            }
        elab :: ElaboratedConfiguredPackage
elab = ElaboratedConfiguredPackage
elab1 {
                elabInstallDirs :: InstallDirs String
elabInstallDirs =
                  StoreDirLayout
-> InstallDirTemplates
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> InstallDirs String
computeInstallDirs StoreDirLayout
storeDirLayout
                                     InstallDirTemplates
defaultInstallDirs
                                     ElaboratedSharedConfig
elaboratedSharedConfig
                                     ElaboratedConfiguredPackage
elab1
            }

        modShape :: ModuleShape
modShape = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ComponentName -> Bool) -> ElaboratedConfiguredPackage -> Bool
matchElabPkg (forall a. Eq a => a -> a -> Bool
== (LibraryName -> ComponentName
CLibName LibraryName
LMainLibName))) [ElaboratedConfiguredPackage]
comps of
                        Maybe ElaboratedConfiguredPackage
Nothing -> ModuleShape
emptyModuleShape
                        Just ElaboratedConfiguredPackage
e -> ElaboratedConfiguredPackage -> ModuleShape
Ty.elabModuleShape ElaboratedConfiguredPackage
e

        pkgInstalledId :: InstalledPackageId
pkgInstalledId
          | forall loc. SolverPackage loc -> Bool
shouldBuildInplaceOnly SolverPackage UnresolvedPkgLoc
pkg
          = String -> InstalledPackageId
mkComponentId (forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pkgid forall a. [a] -> [a] -> [a]
++ String
"-inplace")

          | Bool
otherwise
          = forall a. HasCallStack => Bool -> a -> a
assert (forall a. Maybe a -> Bool
isJust Maybe PackageSourceHash
elabPkgSourceHash) forall a b. (a -> b) -> a -> b
$
            PackageHashInputs -> InstalledPackageId
hashedInstalledPackageId
              (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> PackageHashInputs
packageHashInputs
                ElaboratedSharedConfig
elaboratedSharedConfig
                ElaboratedConfiguredPackage
elab)  -- recursive use of elab

        -- Need to filter out internal dependencies, because they don't
        -- correspond to anything real anymore.
        isExt :: ConfiguredId -> Bool
isExt ConfiguredId
confid = ConfiguredId -> PackageIdentifier
confSrcId ConfiguredId
confid forall a. Eq a => a -> a -> Bool
/= PackageIdentifier
pkgid
        filterExt :: [ConfiguredId] -> [ConfiguredId]
filterExt  = forall a. (a -> Bool) -> [a] -> [a]
filter ConfiguredId -> Bool
isExt
        filterExt' :: [(ConfiguredId, b)] -> [(ConfiguredId, b)]
filterExt' = forall a. (a -> Bool) -> [a] -> [a]
filter (ConfiguredId -> Bool
isExt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

        pkgLibDependencies :: ComponentDeps [ConfiguredId]
pkgLibDependencies
            = forall {a}.
Monoid a =>
(ElaboratedComponent -> a) -> ComponentDeps a
buildComponentDeps ([ConfiguredId] -> [ConfiguredId]
filterExt  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedComponent -> [ConfiguredId]
compLibDependencies)
        pkgExeDependencies :: ComponentDeps [ConfiguredId]
pkgExeDependencies
            = forall {a}.
Monoid a =>
(ElaboratedComponent -> a) -> ComponentDeps a
buildComponentDeps ([ConfiguredId] -> [ConfiguredId]
filterExt  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedComponent -> [ConfiguredId]
compExeDependencies)
        pkgExeDependencyPaths :: ComponentDeps [(ConfiguredId, String)]
pkgExeDependencyPaths
            = forall {a}.
Monoid a =>
(ElaboratedComponent -> a) -> ComponentDeps a
buildComponentDeps (forall {b}. [(ConfiguredId, b)] -> [(ConfiguredId, b)]
filterExt' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedComponent -> [(ConfiguredId, String)]
compExeDependencyPaths)
        -- TODO: Why is this flat?
        pkgPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
pkgPkgConfigDependencies
            = forall a. Monoid a => ComponentDeps a -> a
CD.flatDeps forall a b. (a -> b) -> a -> b
$ forall {a}.
Monoid a =>
(ElaboratedComponent -> a) -> ComponentDeps a
buildComponentDeps ElaboratedComponent -> [(PkgconfigName, Maybe PkgconfigVersion)]
compPkgConfigDependencies

        pkgDependsOnSelfLib :: ComponentDeps [()]
pkgDependsOnSelfLib
            = forall a. Monoid a => [ComponentDep a] -> ComponentDeps a
CD.fromList [ (ComponentName -> Component
CD.componentNameToComponent ComponentName
cn, [()])
                          | Graph.N Component
_ ComponentName
cn [ComponentName]
_ <- forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Node ComponentName Component]
mb_closure ]
          where
            mb_closure :: Maybe [Node ComponentName Component]
mb_closure = forall a. Graph a -> [Key a] -> Maybe [a]
Graph.revClosure ComponentsGraph
compGraph [ ComponentName
k | ComponentName
k <- forall a. Graph a -> [Key a]
Graph.keys ComponentsGraph
compGraph, ComponentName -> Bool
is_lib ComponentName
k ]
            -- NB: the sublib case should not occur, because sub-libraries
            -- are not supported without per-component builds
            is_lib :: ComponentName -> Bool
is_lib (CLibName LibraryName
_) = Bool
True
            is_lib ComponentName
_ = Bool
False

        buildComponentDeps :: (ElaboratedComponent -> a) -> ComponentDeps a
buildComponentDeps ElaboratedComponent -> a
f
            = forall a. Monoid a => [ComponentDep a] -> ComponentDeps a
CD.fromList [ (ElaboratedComponent -> Component
compSolverName ElaboratedComponent
comp, ElaboratedComponent -> a
f ElaboratedComponent
comp)
                          | ElaboratedConfiguredPackage{
                                elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabComponent ElaboratedComponent
comp
                            } <- [ElaboratedConfiguredPackage]
comps
                          ]

        -- NB: This is not the final setting of 'pkgStanzasEnabled'.
        -- See [Sticky enabled testsuites]; we may enable some extra
        -- stanzas opportunistically when it is cheap to do so.
        --
        -- However, we start off by enabling everything that was
        -- requested, so that we can maintain an invariant that
        -- pkgStanzasEnabled is a superset of elabStanzasRequested
        pkgStanzasEnabled :: OptionalStanzaSet
pkgStanzasEnabled  = forall a. (a -> Bool) -> OptionalStanzaMap a -> OptionalStanzaSet
optStanzaKeysFilteredByValue (forall a. a -> Maybe a -> a
fromMaybe Bool
False) OptionalStanzaMap (Maybe Bool)
elabStanzasRequested

    elaborateSolverToCommon :: SolverPackage UnresolvedPkgLoc
                            -> ElaboratedConfiguredPackage
    elaborateSolverToCommon :: SolverPackage UnresolvedPkgLoc -> ElaboratedConfiguredPackage
elaborateSolverToCommon
        pkg :: SolverPackage UnresolvedPkgLoc
pkg@(SolverPackage (SourcePackage PackageIdentifier
pkgid GenericPackageDescription
gdesc UnresolvedPkgLoc
srcloc Maybe CabalFileText
descOverride)
                           FlagAssignment
flags OptionalStanzaSet
stanzas ComponentDeps [SolverId]
deps0 ComponentDeps [SolverId]
_exe_deps0) =
        ElaboratedConfiguredPackage
elaboratedPackage
      where
        elaboratedPackage :: ElaboratedConfiguredPackage
elaboratedPackage = ElaboratedConfiguredPackage {Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
PackageDescription
PackageIdentifier
Map String String
Map String [String]
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
forall {a}. a
forall a. [a]
forall a. Maybe a
forall k a. Map k a
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfLibDetail :: ProfDetailLevel
elabProfExeDetail :: ProfDetailLevel
elabProfLib :: Bool
elabProfExe :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceSetupPackageDBStack :: PackageDBStack
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabBuildHaddocks :: Bool
elabHaddockTargets :: forall a. [a]
elabReplTarget :: forall a. Maybe a
elabBenchTargets :: forall a. [a]
elabTestTargets :: forall a. [a]
elabBuildTargets :: forall a. [a]
elabConfigureTargets :: forall a. [a]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabModuleShape :: forall {a}. a
elabInstallDirs :: forall {a}. a
elabPkgOrComp :: forall {a}. a
elabLinkedInstantiatedWith :: forall {a}. a
elabInstantiatedWith :: forall k a. Map k a
elabComponentId :: forall {a}. a
elabUnitId :: forall {a}. a
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
..}

        -- These get filled in later
        elabUnitId :: a
elabUnitId          = forall a. HasCallStack => String -> a
error String
"elaborateSolverToCommon: elabUnitId"
        elabComponentId :: a
elabComponentId     = forall a. HasCallStack => String -> a
error String
"elaborateSolverToCommon: elabComponentId"
        elabInstantiatedWith :: Map k a
elabInstantiatedWith = forall k a. Map k a
Map.empty
        elabLinkedInstantiatedWith :: a
elabLinkedInstantiatedWith = forall a. HasCallStack => String -> a
error String
"elaborateSolverToCommon: elabLinkedInstantiatedWith"
        elabPkgOrComp :: a
elabPkgOrComp       = forall a. HasCallStack => String -> a
error String
"elaborateSolverToCommon: elabPkgOrComp"
        elabInstallDirs :: a
elabInstallDirs     = forall a. HasCallStack => String -> a
error String
"elaborateSolverToCommon: elabInstallDirs"
        elabModuleShape :: a
elabModuleShape     = forall a. HasCallStack => String -> a
error String
"elaborateSolverToCommon: elabModuleShape"

        elabIsCanonical :: Bool
elabIsCanonical     = Bool
True
        elabPkgSourceId :: PackageIdentifier
elabPkgSourceId     = PackageIdentifier
pkgid
        elabPkgDescription :: PackageDescription
elabPkgDescription  = case FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
PD.finalizePD
                                    FlagAssignment
flags ComponentRequestedSpec
elabEnabledSpec (forall a b. a -> b -> a
const Bool
True)
                                    Platform
platform (Compiler -> CompilerInfo
compilerInfo Compiler
compiler)
                                    [] GenericPackageDescription
gdesc of
                               Right (PackageDescription
desc, FlagAssignment
_) -> PackageDescription
desc
                               Left [Dependency]
_          -> forall a. HasCallStack => String -> a
error String
"Failed to finalizePD in elaborateSolverToCommon"
        elabFlagAssignment :: FlagAssignment
elabFlagAssignment  = FlagAssignment
flags
        elabFlagDefaults :: FlagAssignment
elabFlagDefaults    = [(FlagName, Bool)] -> FlagAssignment
PD.mkFlagAssignment
                              [ (PackageFlag -> FlagName
Cabal.flagName PackageFlag
flag, PackageFlag -> Bool
Cabal.flagDefault PackageFlag
flag)
                              | PackageFlag
flag <- GenericPackageDescription -> [PackageFlag]
PD.genPackageFlags GenericPackageDescription
gdesc ]

        elabEnabledSpec :: ComponentRequestedSpec
elabEnabledSpec      = OptionalStanzaSet -> ComponentRequestedSpec
enableStanzas OptionalStanzaSet
stanzas
        elabStanzasAvailable :: OptionalStanzaSet
elabStanzasAvailable = OptionalStanzaSet
stanzas

        elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
        elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasRequested = forall a. (OptionalStanza -> a) -> OptionalStanzaMap a
optStanzaTabulate forall a b. (a -> b) -> a -> b
$ \OptionalStanza
o -> case OptionalStanza
o of
            -- NB: even if a package stanza is requested, if the package
            -- doesn't actually have any of that stanza we omit it from
            -- the request, to ensure that we don't decide that this
            -- package needs to be rebuilt.  (It needs to be done here,
            -- because the ElaboratedConfiguredPackage is where we test
            -- whether or not there have been changes.)
            OptionalStanza
TestStanzas  -> forall a. [a] -> Maybe a
listToMaybe [ Bool
v | Bool
v <- forall a. Maybe a -> [a]
maybeToList Maybe Bool
tests, TestSuite
_ <- PackageDescription -> [TestSuite]
PD.testSuites PackageDescription
elabPkgDescription ]
            OptionalStanza
BenchStanzas -> forall a. [a] -> Maybe a
listToMaybe [ Bool
v | Bool
v <- forall a. Maybe a -> [a]
maybeToList Maybe Bool
benchmarks, Benchmark
_ <- PackageDescription -> [Benchmark]
PD.benchmarks PackageDescription
elabPkgDescription ]
          where
            tests, benchmarks :: Maybe Bool
            tests :: Maybe Bool
tests      = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag Bool
packageConfigTests
            benchmarks :: Maybe Bool
benchmarks = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag Bool
packageConfigBenchmarks

        -- This is a placeholder which will get updated by 'pruneInstallPlanPass1'
        -- and 'pruneInstallPlanPass2'.  We can't populate it here
        -- because whether or not tests/benchmarks should be enabled
        -- is heuristically calculated based on whether or not the
        -- dependencies of the test suite have already been installed,
        -- but this function doesn't know what is installed (since
        -- we haven't improved the plan yet), so we do it in another pass.
        -- Check the comments of those functions for more details.
        elabConfigureTargets :: [a]
elabConfigureTargets = []
        elabBuildTargets :: [a]
elabBuildTargets    = []
        elabTestTargets :: [a]
elabTestTargets     = []
        elabBenchTargets :: [a]
elabBenchTargets    = []
        elabReplTarget :: Maybe a
elabReplTarget      = forall a. Maybe a
Nothing
        elabHaddockTargets :: [a]
elabHaddockTargets  = []

        elabBuildHaddocks :: Bool
elabBuildHaddocks   =
          forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigDocumentation

        elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgSourceLocation = UnresolvedPkgLoc
srcloc
        elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceHash   = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageIdentifier
pkgid Map PackageIdentifier PackageSourceHash
sourcePackageHashes
        elabLocalToProject :: Bool
elabLocalToProject  = forall pkg. Package pkg => pkg -> Bool
isLocalToProject SolverPackage UnresolvedPkgLoc
pkg
        elabBuildStyle :: BuildStyle
elabBuildStyle      = if forall loc. SolverPackage loc -> Bool
shouldBuildInplaceOnly SolverPackage UnresolvedPkgLoc
pkg
                                then BuildStyle
BuildInplaceOnly else BuildStyle
BuildAndInstall
        elabPackageDbs :: [Maybe PackageDB]
elabPackageDbs             = ProjectConfigShared -> [Maybe PackageDB]
projectConfigPackageDBs ProjectConfigShared
sharedPackageConfig
        elabBuildPackageDBStack :: PackageDBStack
elabBuildPackageDBStack    = PackageDBStack
buildAndRegisterDbs
        elabRegisterPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack = PackageDBStack
buildAndRegisterDbs

        elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptStyle       = PackageDescription -> SetupScriptStyle
packageSetupScriptStyle PackageDescription
elabPkgDescription
        elabSetupScriptCliVersion :: Version
elabSetupScriptCliVersion  =
          SetupScriptStyle
-> PackageDescription
-> Graph NonSetupLibDepSolverPlanPackage
-> ComponentDeps [SolverId]
-> Version
packageSetupScriptSpecVersion
          SetupScriptStyle
elabSetupScriptStyle PackageDescription
elabPkgDescription Graph NonSetupLibDepSolverPlanPackage
libDepGraph ComponentDeps [SolverId]
deps0
        elabSetupPackageDBStack :: PackageDBStack
elabSetupPackageDBStack    = PackageDBStack
buildAndRegisterDbs

        elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack = PackageDBStack
inplacePackageDbs
        elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceRegisterPackageDBStack = PackageDBStack
inplacePackageDbs
        elabInplaceSetupPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack = PackageDBStack
inplacePackageDbs

        buildAndRegisterDbs :: PackageDBStack
buildAndRegisterDbs
          | forall loc. SolverPackage loc -> Bool
shouldBuildInplaceOnly SolverPackage UnresolvedPkgLoc
pkg = PackageDBStack
inplacePackageDbs
          | Bool
otherwise                  = PackageDBStack
corePackageDbs

        elabPkgDescriptionOverride :: Maybe CabalFileText
elabPkgDescriptionOverride = Maybe CabalFileText
descOverride

        elabVanillaLib :: Bool
elabVanillaLib    = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
True PackageConfig -> Flag Bool
packageConfigVanillaLib --TODO: [required feature]: also needs to be handled recursively
        elabSharedLib :: Bool
elabSharedLib     = PackageIdentifier
pkgid forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageIdentifier
pkgsUseSharedLibrary
        elabStaticLib :: Bool
elabStaticLib     = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigStaticLib
        elabDynExe :: Bool
elabDynExe        = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigDynExe
        elabFullyStaticExe :: Bool
elabFullyStaticExe = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigFullyStaticExe
        elabGHCiLib :: Bool
elabGHCiLib       = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigGHCiLib --TODO: [required feature] needs to default to enabled on windows still

        elabProfExe :: Bool
elabProfExe       = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigProf
        elabProfLib :: Bool
elabProfLib       = PackageIdentifier
pkgid forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageIdentifier
pkgsUseProfilingLibrary

        (ProfDetailLevel
elabProfExeDetail,
         ProfDetailLevel
elabProfLibDetail) = forall {p} {b}.
Package p =>
p
-> b
-> (PackageConfig -> Flag b)
-> (PackageConfig -> Flag b)
-> (b, b)
perPkgOptionLibExeFlag PackageIdentifier
pkgid ProfDetailLevel
ProfDetailDefault
                               PackageConfig -> Flag ProfDetailLevel
packageConfigProfDetail
                               PackageConfig -> Flag ProfDetailLevel
packageConfigProfLibDetail
        elabCoverage :: Bool
elabCoverage      = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigCoverage

        elabOptimization :: OptimisationLevel
elabOptimization  = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid OptimisationLevel
NormalOptimisation PackageConfig -> Flag OptimisationLevel
packageConfigOptimization
        elabSplitObjs :: Bool
elabSplitObjs     = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigSplitObjs
        elabSplitSections :: Bool
elabSplitSections = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigSplitSections
        elabStripLibs :: Bool
elabStripLibs     = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigStripLibs
        elabStripExes :: Bool
elabStripExes     = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigStripExes
        elabDebugInfo :: DebugInfoLevel
elabDebugInfo     = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid DebugInfoLevel
NoDebugInfo PackageConfig -> Flag DebugInfoLevel
packageConfigDebugInfo
        elabDumpBuildInfo :: DumpBuildInfo
elabDumpBuildInfo = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid DumpBuildInfo
NoDumpBuildInfo PackageConfig -> Flag DumpBuildInfo
packageConfigDumpBuildInfo

        -- Combine the configured compiler prog settings with the user-supplied
        -- config. For the compiler progs any user-supplied config was taken
        -- into account earlier when configuring the compiler so its ok that
        -- our configured settings for the compiler override the user-supplied
        -- config here.
        elabProgramPaths :: Map String String
elabProgramPaths  = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                             [ (ConfiguredProgram -> String
programId ConfiguredProgram
prog, ConfiguredProgram -> String
programPath ConfiguredProgram
prog)
                             | ConfiguredProgram
prog <- ProgramDb -> [ConfiguredProgram]
configuredPrograms ProgramDb
compilerprogdb ]
                        forall a. Semigroup a => a -> a -> a
<> forall {pkg} {k} {v}.
(Package pkg, Ord k) =>
pkg -> (PackageConfig -> MapLast k v) -> Map k v
perPkgOptionMapLast PackageIdentifier
pkgid PackageConfig -> MapLast String String
packageConfigProgramPaths
        elabProgramArgs :: Map String [String]
elabProgramArgs   = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                             [ (ConfiguredProgram -> String
programId ConfiguredProgram
prog, [String]
args)
                             | ConfiguredProgram
prog <- ProgramDb -> [ConfiguredProgram]
configuredPrograms ProgramDb
compilerprogdb
                             , let args :: [String]
args = ConfiguredProgram -> [String]
programOverrideArgs ConfiguredProgram
prog
                             , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args)
                             ]
                        forall a. Semigroup a => a -> a -> a
<> forall {pkg} {v} {k}.
(Package pkg, Semigroup v, Ord k) =>
pkg -> (PackageConfig -> MapMappend k v) -> Map k v
perPkgOptionMapMappend PackageIdentifier
pkgid PackageConfig -> MapMappend String [String]
packageConfigProgramArgs
        elabProgramPathExtra :: [String]
elabProgramPathExtra    = forall {pkg} {a}.
(Package pkg, Ord a) =>
pkg -> (PackageConfig -> NubList a) -> [a]
perPkgOptionNubList PackageIdentifier
pkgid PackageConfig -> NubList String
packageConfigProgramPathExtra
        elabConfigureScriptArgs :: [String]
elabConfigureScriptArgs = forall a. PackageIdentifier -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageIdentifier
pkgid PackageConfig -> [String]
packageConfigConfigureArgs
        elabExtraLibDirs :: [String]
elabExtraLibDirs        = forall a. PackageIdentifier -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageIdentifier
pkgid PackageConfig -> [String]
packageConfigExtraLibDirs
        elabExtraLibDirsStatic :: [String]
elabExtraLibDirsStatic  = forall a. PackageIdentifier -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageIdentifier
pkgid PackageConfig -> [String]
packageConfigExtraLibDirsStatic
        elabExtraFrameworkDirs :: [String]
elabExtraFrameworkDirs  = forall a. PackageIdentifier -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageIdentifier
pkgid PackageConfig -> [String]
packageConfigExtraFrameworkDirs
        elabExtraIncludeDirs :: [String]
elabExtraIncludeDirs    = forall a. PackageIdentifier -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageIdentifier
pkgid PackageConfig -> [String]
packageConfigExtraIncludeDirs
        elabProgPrefix :: Maybe PathTemplate
elabProgPrefix          = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag PathTemplate
packageConfigProgPrefix
        elabProgSuffix :: Maybe PathTemplate
elabProgSuffix          = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag PathTemplate
packageConfigProgSuffix


        elabHaddockHoogle :: Bool
elabHaddockHoogle       = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigHaddockHoogle
        elabHaddockHtml :: Bool
elabHaddockHtml         = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigHaddockHtml
        elabHaddockHtmlLocation :: Maybe String
elabHaddockHtmlLocation = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag String
packageConfigHaddockHtmlLocation
        elabHaddockForeignLibs :: Bool
elabHaddockForeignLibs  = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigHaddockForeignLibs
        elabHaddockForHackage :: HaddockTarget
elabHaddockForHackage   = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid HaddockTarget
Cabal.ForDevelopment PackageConfig -> Flag HaddockTarget
packageConfigHaddockForHackage
        elabHaddockExecutables :: Bool
elabHaddockExecutables  = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigHaddockExecutables
        elabHaddockTestSuites :: Bool
elabHaddockTestSuites   = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigHaddockTestSuites
        elabHaddockBenchmarks :: Bool
elabHaddockBenchmarks   = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigHaddockBenchmarks
        elabHaddockInternal :: Bool
elabHaddockInternal     = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigHaddockInternal
        elabHaddockCss :: Maybe String
elabHaddockCss          = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag String
packageConfigHaddockCss
        elabHaddockLinkedSource :: Bool
elabHaddockLinkedSource = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigHaddockLinkedSource
        elabHaddockQuickJump :: Bool
elabHaddockQuickJump    = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigHaddockQuickJump
        elabHaddockHscolourCss :: Maybe String
elabHaddockHscolourCss  = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag String
packageConfigHaddockHscolourCss
        elabHaddockContents :: Maybe PathTemplate
elabHaddockContents     = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag PathTemplate
packageConfigHaddockContents
        elabHaddockIndex :: Maybe PathTemplate
elabHaddockIndex        = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag PathTemplate
packageConfigHaddockIndex
        elabHaddockBaseUrl :: Maybe String
elabHaddockBaseUrl      = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag String
packageConfigHaddockBaseUrl
        elabHaddockLib :: Maybe String
elabHaddockLib          = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag String
packageConfigHaddockLib

        elabTestMachineLog :: Maybe PathTemplate
elabTestMachineLog      = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag PathTemplate
packageConfigTestMachineLog
        elabTestHumanLog :: Maybe PathTemplate
elabTestHumanLog        = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag PathTemplate
packageConfigTestHumanLog
        elabTestShowDetails :: Maybe TestShowDetails
elabTestShowDetails     = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag TestShowDetails
packageConfigTestShowDetails
        elabTestKeepTix :: Bool
elabTestKeepTix         = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigTestKeepTix
        elabTestWrapper :: Maybe String
elabTestWrapper         = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag String
packageConfigTestWrapper
        elabTestFailWhenNoTestSuites :: Bool
elabTestFailWhenNoTestSuites = forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageIdentifier
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigTestFailWhenNoTestSuites
        elabTestTestOptions :: [PathTemplate]
elabTestTestOptions     = forall a. PackageIdentifier -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageIdentifier
pkgid PackageConfig -> [PathTemplate]
packageConfigTestTestOptions

        elabBenchmarkOptions :: [PathTemplate]
elabBenchmarkOptions    = forall a. PackageIdentifier -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageIdentifier
pkgid PackageConfig -> [PathTemplate]
packageConfigBenchmarkOptions

    perPkgOptionFlag  :: PackageId -> a ->  (PackageConfig -> Flag a) -> a
    perPkgOptionMaybe :: PackageId ->       (PackageConfig -> Flag a) -> Maybe a
    perPkgOptionList  :: PackageId ->       (PackageConfig -> [a])    -> [a]

    perPkgOptionFlag :: forall a. PackageIdentifier -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag  PackageIdentifier
pkgid a
def PackageConfig -> Flag a
f = forall a. a -> Flag a -> a
fromFlagOrDefault a
def (forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption PackageIdentifier
pkgid PackageConfig -> Flag a
f)
    perPkgOptionMaybe :: forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid     PackageConfig -> Flag a
f = forall a. Flag a -> Maybe a
flagToMaybe (forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption PackageIdentifier
pkgid PackageConfig -> Flag a
f)
    perPkgOptionList :: forall a. PackageIdentifier -> (PackageConfig -> [a]) -> [a]
perPkgOptionList  PackageIdentifier
pkgid     PackageConfig -> [a]
f = forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption PackageIdentifier
pkgid PackageConfig -> [a]
f
    perPkgOptionNubList :: pkg -> (PackageConfig -> NubList a) -> [a]
perPkgOptionNubList    pkg
pkgid PackageConfig -> NubList a
f = forall a. NubList a -> [a]
fromNubList   (forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption pkg
pkgid PackageConfig -> NubList a
f)
    perPkgOptionMapLast :: pkg -> (PackageConfig -> MapLast k v) -> Map k v
perPkgOptionMapLast    pkg
pkgid PackageConfig -> MapLast k v
f = forall k v. MapLast k v -> Map k v
getMapLast    (forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption pkg
pkgid PackageConfig -> MapLast k v
f)
    perPkgOptionMapMappend :: pkg -> (PackageConfig -> MapMappend k v) -> Map k v
perPkgOptionMapMappend pkg
pkgid PackageConfig -> MapMappend k v
f = forall k v. MapMappend k v -> Map k v
getMapMappend (forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption pkg
pkgid PackageConfig -> MapMappend k v
f)

    perPkgOptionLibExeFlag :: p
-> b
-> (PackageConfig -> Flag b)
-> (PackageConfig -> Flag b)
-> (b, b)
perPkgOptionLibExeFlag p
pkgid b
def PackageConfig -> Flag b
fboth PackageConfig -> Flag b
flib = (b
exe, b
lib)
      where
        exe :: b
exe = forall a. a -> Flag a -> a
fromFlagOrDefault b
def Flag b
bothflag
        lib :: b
lib = forall a. a -> Flag a -> a
fromFlagOrDefault b
def (Flag b
bothflag forall a. Semigroup a => a -> a -> a
<> Flag b
libflag)

        bothflag :: Flag b
bothflag = forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption p
pkgid PackageConfig -> Flag b
fboth
        libflag :: Flag b
libflag  = forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption p
pkgid PackageConfig -> Flag b
flib

    lookupPerPkgOption :: (Package pkg, Monoid m)
                       => pkg -> (PackageConfig -> m) -> m
    lookupPerPkgOption :: forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption pkg
pkg PackageConfig -> m
f =
        -- This is where we merge the options from the project config that
        -- apply to all packages, all project local packages, and to specific
        -- named packages
        m
global forall a. Monoid a => a -> a -> a
`mappend` m
local forall a. Monoid a => a -> a -> a
`mappend` m
perpkg
      where
        global :: m
global = PackageConfig -> m
f PackageConfig
allPackagesConfig
        local :: m
local  | forall pkg. Package pkg => pkg -> Bool
isLocalToProject pkg
pkg
               = PackageConfig -> m
f PackageConfig
localPackagesConfig
               | Bool
otherwise
               = forall a. Monoid a => a
mempty
        perpkg :: m
perpkg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty PackageConfig -> m
f (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall pkg. Package pkg => pkg -> PackageName
packageName pkg
pkg) Map PackageName PackageConfig
perPackageConfig)

    inplacePackageDbs :: PackageDBStack
inplacePackageDbs = PackageDBStack
corePackageDbs
                     forall a. [a] -> [a] -> [a]
++ [ CompilerId -> PackageDB
distPackageDB (Compiler -> CompilerId
compilerId Compiler
compiler) ]

    corePackageDbs :: PackageDBStack
corePackageDbs = PackageDBStack -> [Maybe PackageDB] -> PackageDBStack
applyPackageDbFlags (CompilerId -> PackageDBStack
storePackageDBStack (Compiler -> CompilerId
compilerId Compiler
compiler))
                                         (ProjectConfigShared -> [Maybe PackageDB]
projectConfigPackageDBs ProjectConfigShared
sharedPackageConfig)

    -- For this local build policy, every package that lives in a local source
    -- dir (as opposed to a tarball), or depends on such a package, will be
    -- built inplace into a shared dist dir. Tarball packages that depend on
    -- source dir packages will also get unpacked locally.
    shouldBuildInplaceOnly :: SolverPackage loc -> Bool
    shouldBuildInplaceOnly :: forall loc. SolverPackage loc -> Bool
shouldBuildInplaceOnly SolverPackage loc
pkg = forall a. Ord a => a -> Set a -> Bool
Set.member (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SolverPackage loc
pkg)
                                            Set PackageIdentifier
pkgsToBuildInplaceOnly

    pkgsToBuildInplaceOnly :: Set PackageId
    pkgsToBuildInplaceOnly :: Set PackageIdentifier
pkgsToBuildInplaceOnly =
        forall a. Ord a => [a] -> Set a
Set.fromList
      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> PackageIdentifier
packageId
      forall a b. (a -> b) -> a -> b
$ SolverInstallPlan
-> [SolverId] -> [ResolverPackage UnresolvedPkgLoc]
SolverInstallPlan.reverseDependencyClosure
          SolverInstallPlan
solverPlan
          (forall a b. (a -> b) -> [a] -> [b]
map PackageIdentifier -> SolverId
PlannedId (forall a. Set a -> [a]
Set.toList Set PackageIdentifier
pkgsLocalToProject))

    isLocalToProject :: Package pkg => pkg -> Bool
    isLocalToProject :: forall pkg. Package pkg => pkg -> Bool
isLocalToProject pkg
pkg = forall a. Ord a => a -> Set a -> Bool
Set.member (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId pkg
pkg)
                                      Set PackageIdentifier
pkgsLocalToProject

    pkgsLocalToProject :: Set PackageId
    pkgsLocalToProject :: Set PackageIdentifier
pkgsLocalToProject =
        forall a. Ord a => [a] -> Set a
Set.fromList (forall a. [Maybe a] -> [a]
catMaybes (forall a b. (a -> b) -> [a] -> [b]
map forall loc.
PackageSpecifier (SourcePackage (PackageLocation loc))
-> Maybe PackageIdentifier
shouldBeLocal [PackageSpecifier (SourcePackage (PackageLocation loc))]
localPackages))
        --TODO: localPackages is a misnomer, it's all project packages
        -- here is where we decide which ones will be local!

    pkgsUseSharedLibrary :: Set PackageId
    pkgsUseSharedLibrary :: Set PackageIdentifier
pkgsUseSharedLibrary =
        (ResolverPackage UnresolvedPkgLoc -> Bool) -> Set PackageIdentifier
packagesWithLibDepsDownwardClosedProperty forall pkg. Package pkg => pkg -> Bool
needsSharedLib
      where
        needsSharedLib :: p -> Bool
needsSharedLib p
pkg =
            forall a. a -> Maybe a -> a
fromMaybe Bool
compilerShouldUseSharedLibByDefault
                      (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(||) Maybe Bool
pkgSharedLib Maybe Bool
pkgDynExe)
          where
            pkgid :: PackageIdentifier
pkgid        = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId p
pkg
            pkgSharedLib :: Maybe Bool
pkgSharedLib = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag Bool
packageConfigSharedLib
            pkgDynExe :: Maybe Bool
pkgDynExe    = forall a. PackageIdentifier -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageIdentifier
pkgid PackageConfig -> Flag Bool
packageConfigDynExe

    --TODO: [code cleanup] move this into the Cabal lib. It's currently open
    -- coded in Distribution.Simple.Configure, but should be made a proper
    -- function of the Compiler or CompilerInfo.
    compilerShouldUseSharedLibByDefault :: Bool
compilerShouldUseSharedLibByDefault =
      case Compiler -> CompilerFlavor
compilerFlavor Compiler
compiler of
        CompilerFlavor
GHC   -> Compiler -> Bool
GHC.isDynamic Compiler
compiler
        CompilerFlavor
GHCJS -> Compiler -> Bool
GHCJS.isDynamic Compiler
compiler
        CompilerFlavor
_     -> Bool
False

    pkgsUseProfilingLibrary :: Set PackageId
    pkgsUseProfilingLibrary :: Set PackageIdentifier
pkgsUseProfilingLibrary =
        (ResolverPackage UnresolvedPkgLoc -> Bool) -> Set PackageIdentifier
packagesWithLibDepsDownwardClosedProperty forall pkg. Package pkg => pkg -> Bool
needsProfilingLib
      where
        needsProfilingLib :: p -> Bool
needsProfilingLib p
pkg =
            forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (Flag Bool
profBothFlag forall a. Semigroup a => a -> a -> a
<> Flag Bool
profLibFlag)
          where
            pkgid :: PackageIdentifier
pkgid        = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId p
pkg
            profBothFlag :: Flag Bool
profBothFlag = forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption PackageIdentifier
pkgid PackageConfig -> Flag Bool
packageConfigProf
            profLibFlag :: Flag Bool
profLibFlag  = forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption PackageIdentifier
pkgid PackageConfig -> Flag Bool
packageConfigProfLib
            --TODO: [code cleanup] unused: the old deprecated packageConfigProfExe

    libDepGraph :: Graph NonSetupLibDepSolverPlanPackage
libDepGraph = forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList forall a b. (a -> b) -> a -> b
$
                    forall a b. (a -> b) -> [a] -> [b]
map ResolverPackage UnresolvedPkgLoc -> NonSetupLibDepSolverPlanPackage
NonSetupLibDepSolverPlanPackage
                        (SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
SolverInstallPlan.toList SolverInstallPlan
solverPlan)

    packagesWithLibDepsDownwardClosedProperty :: (ResolverPackage UnresolvedPkgLoc -> Bool) -> Set PackageIdentifier
packagesWithLibDepsDownwardClosedProperty ResolverPackage UnresolvedPkgLoc -> Bool
property =
        forall a. Ord a => [a] -> Set a
Set.fromList
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> PackageIdentifier
packageId
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe []
      forall a b. (a -> b) -> a -> b
$ forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure
          Graph NonSetupLibDepSolverPlanPackage
libDepGraph
          [ forall a. IsNode a => a -> Key a
Graph.nodeKey ResolverPackage UnresolvedPkgLoc
pkg
          | ResolverPackage UnresolvedPkgLoc
pkg <- SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
SolverInstallPlan.toList SolverInstallPlan
solverPlan
          , ResolverPackage UnresolvedPkgLoc -> Bool
property ResolverPackage UnresolvedPkgLoc
pkg ] -- just the packages that satisfy the property
      --TODO: [nice to have] this does not check the config consistency,
      -- e.g. a package explicitly turning off profiling, but something
      -- depending on it that needs profiling. This really needs a separate
      -- package config validation/resolution pass.

      --TODO: [nice to have] config consistency checking:
      -- + profiling libs & exes, exe needs lib, recursive
      -- + shared libs & exes, exe needs lib, recursive
      -- + vanilla libs & exes, exe needs lib, recursive
      -- + ghci or shared lib needed by TH, recursive, ghc version dependent

-- TODO: Drop matchPlanPkg/matchElabPkg in favor of mkCCMapping

shouldBeLocal :: PackageSpecifier (SourcePackage (PackageLocation loc)) -> Maybe PackageId
shouldBeLocal :: forall loc.
PackageSpecifier (SourcePackage (PackageLocation loc))
-> Maybe PackageIdentifier
shouldBeLocal NamedPackage{}              = forall a. Maybe a
Nothing
shouldBeLocal (SpecificSourcePackage SourcePackage (PackageLocation loc)
pkg) = case forall loc. SourcePackage loc -> loc
srcpkgSource SourcePackage (PackageLocation loc)
pkg of
    LocalUnpackedPackage String
_ -> forall a. a -> Maybe a
Just (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SourcePackage (PackageLocation loc)
pkg)
    PackageLocation loc
_                      -> forall a. Maybe a
Nothing

-- | Given a 'ElaboratedPlanPackage', report if it matches a 'ComponentName'.
matchPlanPkg :: (ComponentName -> Bool) -> ElaboratedPlanPackage -> Bool
matchPlanPkg :: (ComponentName -> Bool) -> ElaboratedPlanPackage -> Bool
matchPlanPkg ComponentName -> Bool
p = forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage (ComponentName -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> ComponentName
ipiComponentName) ((ComponentName -> Bool) -> ElaboratedConfiguredPackage -> Bool
matchElabPkg ComponentName -> Bool
p)

-- | Get the appropriate 'ComponentName' which identifies an installed
-- component.
ipiComponentName :: IPI.InstalledPackageInfo -> ComponentName
ipiComponentName :: InstalledPackageInfo -> ComponentName
ipiComponentName = LibraryName -> ComponentName
CLibName forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> LibraryName
IPI.sourceLibName

-- | Given a 'ElaboratedConfiguredPackage', report if it matches a
-- 'ComponentName'.
matchElabPkg :: (ComponentName -> Bool) -> ElaboratedConfiguredPackage -> Bool
matchElabPkg :: (ComponentName -> Bool) -> ElaboratedConfiguredPackage -> Bool
matchElabPkg ComponentName -> Bool
p ElaboratedConfiguredPackage
elab =
    case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
        ElabComponent ElaboratedComponent
comp -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ComponentName -> Bool
p (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp)
        ElabPackage ElaboratedPackage
_ ->
            -- So, what should we do here?  One possibility is to
            -- unconditionally return 'True', because whatever it is
            -- that we're looking for, it better be in this package.
            -- But this is a bit dodgy if the package doesn't actually
            -- have, e.g., a library.  Fortunately, it's not possible
            -- for the build of the library/executables to be toggled
            -- by 'pkgStanzasEnabled', so the only thing we have to
            -- test is if the component in question is *buildable.*
            forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ComponentName -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component -> ComponentName
componentName)
                (PackageDescription -> [Component]
Cabal.pkgBuildableComponents (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab))

-- | Given an 'ElaboratedPlanPackage', generate the mapping from 'PackageName'
-- and 'ComponentName' to the 'ComponentId' that should be used
-- in this case.
mkCCMapping :: ElaboratedPlanPackage
            -> (PackageName, Map ComponentName (AnnotatedId ComponentId))
mkCCMapping :: ElaboratedPlanPackage
-> (PackageName,
    Map ComponentName (AnnotatedId InstalledPackageId))
mkCCMapping =
    forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage
       (\InstalledPackageInfo
ipkg -> (forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo
ipkg,
                    forall k a. k -> a -> Map k a
Map.singleton (InstalledPackageInfo -> ComponentName
ipiComponentName InstalledPackageInfo
ipkg)
                                  -- TODO: libify
                                  (AnnotatedId {
                                    ann_id :: InstalledPackageId
ann_id = InstalledPackageInfo -> InstalledPackageId
IPI.installedComponentId InstalledPackageInfo
ipkg,
                                    ann_pid :: PackageIdentifier
ann_pid = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId InstalledPackageInfo
ipkg,
                                    ann_cname :: ComponentName
ann_cname = InstalledPackageInfo -> ComponentName
IPI.sourceComponentName InstalledPackageInfo
ipkg
                                  })))
      forall a b. (a -> b) -> a -> b
$ \ElaboratedConfiguredPackage
elab ->
        let mk_aid :: ComponentName -> AnnotatedId InstalledPackageId
mk_aid ComponentName
cn = AnnotatedId {
                            ann_id :: InstalledPackageId
ann_id = ElaboratedConfiguredPackage -> InstalledPackageId
elabComponentId ElaboratedConfiguredPackage
elab,
                            ann_pid :: PackageIdentifier
ann_pid = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab,
                            ann_cname :: ComponentName
ann_cname = ComponentName
cn
                        }
        in (forall pkg. Package pkg => pkg -> PackageName
packageName ElaboratedConfiguredPackage
elab,
            case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
                ElabComponent ElaboratedComponent
comp ->
                    case ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp of
                        Maybe ComponentName
Nothing -> forall k a. Map k a
Map.empty
                        Just ComponentName
n  -> forall k a. k -> a -> Map k a
Map.singleton ComponentName
n (ComponentName -> AnnotatedId InstalledPackageId
mk_aid ComponentName
n)
                ElabPackage ElaboratedPackage
_ ->
                    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
                        forall a b. (a -> b) -> [a] -> [b]
map (\Component
comp -> let cn :: ComponentName
cn = Component -> ComponentName
Cabal.componentName Component
comp in (ComponentName
cn, ComponentName -> AnnotatedId InstalledPackageId
mk_aid ComponentName
cn))
                            (PackageDescription -> [Component]
Cabal.pkgBuildableComponents (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab)))

-- | Given an 'ElaboratedPlanPackage', generate the mapping from 'ComponentId'
-- to the shape of this package, as per mix-in linking.
mkShapeMapping :: ElaboratedPlanPackage
               -> (ComponentId, (OpenUnitId, ModuleShape))
mkShapeMapping :: ElaboratedPlanPackage
-> (InstalledPackageId, (OpenUnitId, ModuleShape))
mkShapeMapping ElaboratedPlanPackage
dpkg =
    (ElaboratedPlanPackage -> InstalledPackageId
getComponentId ElaboratedPlanPackage
dpkg, (OpenUnitId
indef_uid, ModuleShape
shape))
  where
    (InstalledPackageId
dcid, ModuleShape
shape) =
        forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage
            -- Uses Monad (->)
            (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) InstalledPackageInfo -> InstalledPackageId
IPI.installedComponentId InstalledPackageInfo -> ModuleShape
shapeInstalledPackage)
            (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) ElaboratedConfiguredPackage -> InstalledPackageId
elabComponentId ElaboratedConfiguredPackage -> ModuleShape
elabModuleShape)
            ElaboratedPlanPackage
dpkg
    indef_uid :: OpenUnitId
indef_uid =
        InstalledPackageId -> Map ModuleName OpenModule -> OpenUnitId
IndefFullUnitId InstalledPackageId
dcid
            (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (ModuleName
req, ModuleName -> OpenModule
OpenModuleVar ModuleName
req)
                          | ModuleName
req <- forall a. Set a -> [a]
Set.toList (ModuleShape -> Set ModuleName
modShapeRequires ModuleShape
shape)])

-- | Get the bin\/ directories that a package's executables should reside in.
--
-- The result may be empty if the package does not build any executables.
--
-- The result may have several entries if this is an inplace build of a package
-- with multiple executables.
binDirectories
  :: DistDirLayout
  -> ElaboratedSharedConfig
  -> ElaboratedConfiguredPackage
  -> [FilePath]
binDirectories :: DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> [String]
binDirectories DistDirLayout
layout ElaboratedSharedConfig
config ElaboratedConfiguredPackage
package = case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
package of
  -- quick sanity check: no sense returning a bin directory if we're not going
  -- to put any executables in it, that will just clog up the PATH
  BuildStyle
_ | Bool
noExecutables -> []
  BuildStyle
BuildAndInstall -> [ElaboratedConfiguredPackage -> String
installedBinDirectory ElaboratedConfiguredPackage
package]
  BuildStyle
BuildInplaceOnly -> forall a b. (a -> b) -> [a] -> [b]
map (String
rootString -> String -> String
</>) forall a b. (a -> b) -> a -> b
$ case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
package of
    ElabComponent ElaboratedComponent
comp -> case ElaboratedComponent -> Component
compSolverName ElaboratedComponent
comp of
      CD.ComponentExe UnqualComponentName
n -> [forall a. Pretty a => a -> String
prettyShow UnqualComponentName
n]
      Component
_ -> []
    ElabPackage ElaboratedPackage
_ -> forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
PD.exeName)
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Executable]
PD.executables
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription
                   forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage
package
  where
  noExecutables :: Bool
noExecutables = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Executable]
PD.executables forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage
package
  root :: String
root  =  DistDirLayout -> DistDirParams -> String
distBuildDirectory DistDirLayout
layout (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
config ElaboratedConfiguredPackage
package)
       String -> String -> String
</> String
"build"

-- | A newtype for 'SolverInstallPlan.SolverPlanPackage' for which the
-- dependency graph considers only dependencies on libraries which are
-- NOT from setup dependencies.  Used to compute the set
-- of packages needed for profiling and dynamic libraries.
newtype NonSetupLibDepSolverPlanPackage
    = NonSetupLibDepSolverPlanPackage
    { NonSetupLibDepSolverPlanPackage -> ResolverPackage UnresolvedPkgLoc
unNonSetupLibDepSolverPlanPackage :: SolverInstallPlan.SolverPlanPackage }

instance Package NonSetupLibDepSolverPlanPackage where
    packageId :: NonSetupLibDepSolverPlanPackage -> PackageIdentifier
packageId = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonSetupLibDepSolverPlanPackage -> ResolverPackage UnresolvedPkgLoc
unNonSetupLibDepSolverPlanPackage

instance IsNode NonSetupLibDepSolverPlanPackage where
    type Key NonSetupLibDepSolverPlanPackage = SolverId
    nodeKey :: NonSetupLibDepSolverPlanPackage
-> Key NonSetupLibDepSolverPlanPackage
nodeKey = forall a. IsNode a => a -> Key a
nodeKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonSetupLibDepSolverPlanPackage -> ResolverPackage UnresolvedPkgLoc
unNonSetupLibDepSolverPlanPackage
    nodeNeighbors :: NonSetupLibDepSolverPlanPackage
-> [Key NonSetupLibDepSolverPlanPackage]
nodeNeighbors (NonSetupLibDepSolverPlanPackage ResolverPackage UnresolvedPkgLoc
spkg)
        = forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps ResolverPackage UnresolvedPkgLoc
spkg)

type InstS = Map UnitId ElaboratedPlanPackage
type InstM a = State InstS a

getComponentId :: ElaboratedPlanPackage
               -> ComponentId
getComponentId :: ElaboratedPlanPackage -> InstalledPackageId
getComponentId (InstallPlan.PreExisting InstalledPackageInfo
dipkg) = InstalledPackageInfo -> InstalledPackageId
IPI.installedComponentId InstalledPackageInfo
dipkg
getComponentId (InstallPlan.Configured ElaboratedConfiguredPackage
elab) = ElaboratedConfiguredPackage -> InstalledPackageId
elabComponentId ElaboratedConfiguredPackage
elab
getComponentId (InstallPlan.Installed ElaboratedConfiguredPackage
elab) = ElaboratedConfiguredPackage -> InstalledPackageId
elabComponentId ElaboratedConfiguredPackage
elab

extractElabBuildStyle :: InstallPlan.GenericPlanPackage ipkg ElaboratedConfiguredPackage
                      -> BuildStyle
extractElabBuildStyle :: forall ipkg.
GenericPlanPackage ipkg ElaboratedConfiguredPackage -> BuildStyle
extractElabBuildStyle (InstallPlan.Configured ElaboratedConfiguredPackage
elab) = ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab
extractElabBuildStyle GenericPlanPackage ipkg ElaboratedConfiguredPackage
_ = BuildStyle
BuildAndInstall

-- instantiateInstallPlan is responsible for filling out an InstallPlan
-- with all of the extra Configured packages that would be generated by
-- recursively instantiating the dependencies of packages.
--
-- Suppose we are compiling the following packages:
--
--  unit f where
--    signature H
--
--  unit g where
--    dependency f[H=containers:Data.Map]
--
-- At entry, we have an InstallPlan with a single plan package per
-- actual source package, e.g., only (indefinite!) f and g.  The job of
-- instantiation is to turn this into three plan packages: each of the
-- packages as before, but also a new, definite package f[H=containers:Data.Map]
--
-- How do we do this?  The general strategy is to iterate over every
-- package in the existing plan and recursively create new entries for
-- each of its dependencies which is an instantiated package (e.g.,
-- f[H=p:G]).  This process must be recursive, as f itself may depend on
-- OTHER packages which it instantiated using its hole H.
--
-- Some subtleties:
--
--  * We have to keep track of whether or not we are instantiating with
--    inplace packages, because instantiating a non-inplace package with
--    an inplace packages makes it inplace (since it depends on
--    something in the inplace store)!  The rule is that if any of the
--    modules in an instantiation are inplace, then the instantiated
--    unit itself must be inplace.  There is then a bunch of faffing
--    about to keep track of BuildStyle.
--
--  * ElaboratedConfiguredPackage was never really designed for post
--    facto instantiation, so some of the steps for generating new
--    instantiations are a little fraught.  For example, the act of
--    flipping a package to be inplace involves faffing about with four
--    fields, because these fields are precomputed.  A good refactor
--    would be to reduce the amount of precomputation to simplify the
--    algorithm here.
--
--  * We use the state monad to cache already instantiated modules, so
--    we don't instantiate the same thing multiple times.
--
instantiateInstallPlan :: StoreDirLayout -> InstallDirs.InstallDirTemplates -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedInstallPlan
instantiateInstallPlan :: StoreDirLayout
-> InstallDirTemplates
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedInstallPlan
instantiateInstallPlan StoreDirLayout
storeDirLayout InstallDirTemplates
defaultInstallDirs ElaboratedSharedConfig
elaboratedShared ElaboratedInstallPlan
plan =
    forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
IndependentGoals
-> Graph (GenericPlanPackage ipkg srcpkg)
-> GenericInstallPlan ipkg srcpkg
InstallPlan.new (Bool -> IndependentGoals
IndependentGoals Bool
False)
                    (forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList (forall k a. Map k a -> [a]
Map.elems InstS
ready_map))
  where
    pkgs :: [ElaboratedPlanPackage]
pkgs = forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
plan

    cmap :: Map InstalledPackageId ElaboratedPlanPackage
cmap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (ElaboratedPlanPackage -> InstalledPackageId
getComponentId ElaboratedPlanPackage
pkg, ElaboratedPlanPackage
pkg) | ElaboratedPlanPackage
pkg <- [ElaboratedPlanPackage]
pkgs ]

    instantiateUnitId :: ComponentId -> Map ModuleName (Module, BuildStyle)
                      -> InstM (DefUnitId, BuildStyle)
    instantiateUnitId :: InstalledPackageId
-> Map ModuleName (Module, BuildStyle)
-> InstM (DefUnitId, BuildStyle)
instantiateUnitId InstalledPackageId
cid Map ModuleName (Module, BuildStyle)
insts = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall a b. (a -> b) -> a -> b
$ \InstS
s ->
        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
uid InstS
s of
            Maybe ElaboratedPlanPackage
Nothing ->
                -- Knot tied
                -- TODO: I don't think the knot tying actually does
                -- anything useful
                let (ElaboratedPlanPackage
r, InstS
s') = forall s a. State s a -> s -> (a, s)
runState (UnitId
-> InstalledPackageId
-> Map ModuleName (Module, BuildStyle)
-> InstM ElaboratedPlanPackage
instantiateComponent UnitId
uid InstalledPackageId
cid Map ModuleName (Module, BuildStyle)
insts)
                                       (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert UnitId
uid ElaboratedPlanPackage
r InstS
s)
                in ((DefUnitId
def_uid, forall ipkg.
GenericPlanPackage ipkg ElaboratedConfiguredPackage -> BuildStyle
extractElabBuildStyle ElaboratedPlanPackage
r), forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert UnitId
uid ElaboratedPlanPackage
r InstS
s')
            Just ElaboratedPlanPackage
r -> ((DefUnitId
def_uid, forall ipkg.
GenericPlanPackage ipkg ElaboratedConfiguredPackage -> BuildStyle
extractElabBuildStyle ElaboratedPlanPackage
r), InstS
s)
      where
        def_uid :: DefUnitId
def_uid = InstalledPackageId -> Map ModuleName Module -> DefUnitId
mkDefUnitId InstalledPackageId
cid (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Map ModuleName (Module, BuildStyle)
insts)
        uid :: UnitId
uid = DefUnitId -> UnitId
unDefUnitId DefUnitId
def_uid

    -- No need to InplaceT; the inplace-ness is properly computed for
    -- the ElaboratedPlanPackage, so that will implicitly pass it on
    instantiateComponent
        :: UnitId -> ComponentId -> Map ModuleName (Module, BuildStyle)
        -> InstM ElaboratedPlanPackage
    instantiateComponent :: UnitId
-> InstalledPackageId
-> Map ModuleName (Module, BuildStyle)
-> InstM ElaboratedPlanPackage
instantiateComponent UnitId
uid InstalledPackageId
cid Map ModuleName (Module, BuildStyle)
insts
      | Just ElaboratedPlanPackage
planpkg <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup InstalledPackageId
cid Map InstalledPackageId ElaboratedPlanPackage
cmap
      = case ElaboratedPlanPackage
planpkg of
          InstallPlan.Configured (elab0 :: ElaboratedConfiguredPackage
elab0@ElaboratedConfiguredPackage
                                    { elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabComponent ElaboratedComponent
comp }) -> do
            [DefUnitId]
deps <-
              forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ModuleName (Module, BuildStyle)
-> OpenUnitId -> InstM (DefUnitId, BuildStyle)
substUnitId Map ModuleName (Module, BuildStyle)
insts) (ElaboratedComponent -> [OpenUnitId]
compLinkedLibDependencies ElaboratedComponent
comp)
            let build_style :: BuildStyle
build_style = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Map ModuleName (Module, BuildStyle)
insts)
            let getDep :: Module -> [DefUnitId]
getDep (Module DefUnitId
dep_uid ModuleName
_) = [DefUnitId
dep_uid]
                elab1 :: ElaboratedConfiguredPackage
elab1 = BuildStyle
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
fixupBuildStyle BuildStyle
build_style forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage
elab0 {
                    elabUnitId :: UnitId
elabUnitId = UnitId
uid,
                    elabComponentId :: InstalledPackageId
elabComponentId = InstalledPackageId
cid,
                    elabInstantiatedWith :: Map ModuleName Module
elabInstantiatedWith = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Map ModuleName (Module, BuildStyle)
insts,
                    elabIsCanonical :: Bool
elabIsCanonical = forall k a. Map k a -> Bool
Map.null (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Map ModuleName (Module, BuildStyle)
insts),
                    elabPkgOrComp :: ElaboratedPackageOrComponent
elabPkgOrComp = ElaboratedComponent -> ElaboratedPackageOrComponent
ElabComponent ElaboratedComponent
comp {
                        compOrderLibDependencies :: [UnitId]
compOrderLibDependencies =
                            (if forall k a. Map k a -> Bool
Map.null Map ModuleName (Module, BuildStyle)
insts then [] else [InstalledPackageId -> UnitId
newSimpleUnitId InstalledPackageId
cid]) forall a. [a] -> [a] -> [a]
++
                            forall a. Ord a => [a] -> [a]
ordNub (forall a b. (a -> b) -> [a] -> [b]
map DefUnitId -> UnitId
unDefUnitId
                                ([DefUnitId]
deps forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Module -> [DefUnitId]
getDep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a. Map k a -> [a]
Map.elems Map ModuleName (Module, BuildStyle)
insts)))
                    }
                  }
                elab :: ElaboratedConfiguredPackage
elab = ElaboratedConfiguredPackage
elab1 {
                    elabInstallDirs :: InstallDirs String
elabInstallDirs = StoreDirLayout
-> InstallDirTemplates
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> InstallDirs String
computeInstallDirs StoreDirLayout
storeDirLayout
                                                         InstallDirTemplates
defaultInstallDirs
                                                         ElaboratedSharedConfig
elaboratedShared
                                                         ElaboratedConfiguredPackage
elab1
                  }
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall ipkg srcpkg. srcpkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.Configured ElaboratedConfiguredPackage
elab
          ElaboratedPlanPackage
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ElaboratedPlanPackage
planpkg
      | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"instantiateComponent: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow InstalledPackageId
cid)

    substUnitId :: Map ModuleName (Module, BuildStyle) -> OpenUnitId -> InstM (DefUnitId, BuildStyle)
    substUnitId :: Map ModuleName (Module, BuildStyle)
-> OpenUnitId -> InstM (DefUnitId, BuildStyle)
substUnitId Map ModuleName (Module, BuildStyle)
_ (DefiniteUnitId DefUnitId
uid) =
        -- This COULD actually, secretly, be an inplace package, but in
        -- that case it doesn't matter as it's already been recorded
        -- in the package that depends on this
        forall (m :: * -> *) a. Monad m => a -> m a
return (DefUnitId
uid, BuildStyle
BuildAndInstall)
    substUnitId Map ModuleName (Module, BuildStyle)
subst (IndefFullUnitId InstalledPackageId
cid Map ModuleName OpenModule
insts) = do
        Map ModuleName (Module, BuildStyle)
insts' <- Map ModuleName (Module, BuildStyle)
-> Map ModuleName OpenModule
-> InstM (Map ModuleName (Module, BuildStyle))
substSubst Map ModuleName (Module, BuildStyle)
subst Map ModuleName OpenModule
insts
        InstalledPackageId
-> Map ModuleName (Module, BuildStyle)
-> InstM (DefUnitId, BuildStyle)
instantiateUnitId InstalledPackageId
cid Map ModuleName (Module, BuildStyle)
insts'

    -- NB: NOT composition
    substSubst :: Map ModuleName (Module, BuildStyle)
               -> Map ModuleName OpenModule
               -> InstM (Map ModuleName (Module, BuildStyle))
    substSubst :: Map ModuleName (Module, BuildStyle)
-> Map ModuleName OpenModule
-> InstM (Map ModuleName (Module, BuildStyle))
substSubst Map ModuleName (Module, BuildStyle)
subst Map ModuleName OpenModule
insts = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map ModuleName (Module, BuildStyle)
-> OpenModule -> InstM (Module, BuildStyle)
substModule Map ModuleName (Module, BuildStyle)
subst) Map ModuleName OpenModule
insts

    substModule :: Map ModuleName (Module, BuildStyle) -> OpenModule -> InstM (Module, BuildStyle)
    substModule :: Map ModuleName (Module, BuildStyle)
-> OpenModule -> InstM (Module, BuildStyle)
substModule Map ModuleName (Module, BuildStyle)
subst (OpenModuleVar ModuleName
mod_name)
        | Just (Module, BuildStyle)
m <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
mod_name Map ModuleName (Module, BuildStyle)
subst = forall (m :: * -> *) a. Monad m => a -> m a
return (Module, BuildStyle)
m
        | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"substModule: non-closing substitution"
    substModule Map ModuleName (Module, BuildStyle)
subst (OpenModule OpenUnitId
uid ModuleName
mod_name) = do
        (DefUnitId
uid', BuildStyle
build_style) <- Map ModuleName (Module, BuildStyle)
-> OpenUnitId -> InstM (DefUnitId, BuildStyle)
substUnitId Map ModuleName (Module, BuildStyle)
subst OpenUnitId
uid
        forall (m :: * -> *) a. Monad m => a -> m a
return (DefUnitId -> ModuleName -> Module
Module DefUnitId
uid' ModuleName
mod_name, BuildStyle
build_style)

    indefiniteUnitId :: ComponentId -> InstM UnitId
    indefiniteUnitId :: InstalledPackageId -> InstM UnitId
indefiniteUnitId InstalledPackageId
cid = do
        let uid :: UnitId
uid = InstalledPackageId -> UnitId
newSimpleUnitId InstalledPackageId
cid
        ElaboratedPlanPackage
r <- UnitId -> InstalledPackageId -> InstM ElaboratedPlanPackage
indefiniteComponent UnitId
uid InstalledPackageId
cid
        forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall a b. (a -> b) -> a -> b
$ \InstS
s -> (UnitId
uid, forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert UnitId
uid ElaboratedPlanPackage
r InstS
s)

    indefiniteComponent :: UnitId -> ComponentId -> InstM ElaboratedPlanPackage
    indefiniteComponent :: UnitId -> InstalledPackageId -> InstM ElaboratedPlanPackage
indefiniteComponent UnitId
_uid InstalledPackageId
cid
      -- Only need Configured; this phase happens before improvement, so
      -- there shouldn't be any Installed packages here.
      | Just (InstallPlan.Configured ElaboratedConfiguredPackage
epkg) <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup InstalledPackageId
cid Map InstalledPackageId ElaboratedPlanPackage
cmap
      , ElabComponent ElaboratedComponent
elab_comp <- ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
epkg
      = do -- We need to do a little more processing of the includes: some
           -- of them are fully definite even without substitution.  We
           -- want to build those too; see #5634.
           --
           -- This code mimics similar code in Distribution.Backpack.ReadyComponent;
           -- however, unlike the conversion from LinkedComponent to
           -- ReadyComponent, this transformation is done *without*
           -- changing the type in question; and what we are simply
           -- doing is enforcing tighter invariants on the data
           -- structure in question.  The new invariant is that there
           -- is no IndefFullUnitId in compLinkedLibDependencies that actually
           -- has no holes.  We couldn't specify this invariant when
           -- we initially created the ElaboratedPlanPackage because
           -- we have no way of actually reifying the UnitId into a
           -- DefiniteUnitId (that's what substUnitId does!)
           [OpenUnitId]
new_deps <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (ElaboratedComponent -> [OpenUnitId]
compLinkedLibDependencies ElaboratedComponent
elab_comp) forall a b. (a -> b) -> a -> b
$ \OpenUnitId
uid ->
             if forall a. Set a -> Bool
Set.null (OpenUnitId -> Set ModuleName
openUnitIdFreeHoles OpenUnitId
uid)
                then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DefUnitId -> OpenUnitId
DefiniteUnitId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (Map ModuleName (Module, BuildStyle)
-> OpenUnitId -> InstM (DefUnitId, BuildStyle)
substUnitId forall k a. Map k a
Map.empty OpenUnitId
uid)
                else forall (m :: * -> *) a. Monad m => a -> m a
return OpenUnitId
uid
           -- NB: no fixupBuildStyle needed here, as if the indefinite
           -- component depends on any inplace packages, it itself must
           -- be indefinite!  There is no substitution here, we can't
           -- post facto add inplace deps
           forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ipkg srcpkg. srcpkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.Configured forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage
epkg {
            elabPkgOrComp :: ElaboratedPackageOrComponent
elabPkgOrComp = ElaboratedComponent -> ElaboratedPackageOrComponent
ElabComponent ElaboratedComponent
elab_comp {
                compLinkedLibDependencies :: [OpenUnitId]
compLinkedLibDependencies = [OpenUnitId]
new_deps,
                -- I think this is right: any new definite unit ids we
                -- minted in the phase above need to be built before us.
                -- Add 'em in.  This doesn't remove any old dependencies
                -- on the indefinite package; they're harmless.
                compOrderLibDependencies :: [UnitId]
compOrderLibDependencies =
                    forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$ ElaboratedComponent -> [UnitId]
compOrderLibDependencies ElaboratedComponent
elab_comp forall a. [a] -> [a] -> [a]
++
                             [DefUnitId -> UnitId
unDefUnitId DefUnitId
d | DefiniteUnitId DefUnitId
d <- [OpenUnitId]
new_deps]
            }
           }
      | Just ElaboratedPlanPackage
planpkg <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup InstalledPackageId
cid Map InstalledPackageId ElaboratedPlanPackage
cmap
      = forall (m :: * -> *) a. Monad m => a -> m a
return ElaboratedPlanPackage
planpkg
      | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"indefiniteComponent: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow InstalledPackageId
cid)

    fixupBuildStyle :: BuildStyle
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
fixupBuildStyle BuildStyle
BuildAndInstall ElaboratedConfiguredPackage
elab = ElaboratedConfiguredPackage
elab
    fixupBuildStyle BuildStyle
_ (elab :: ElaboratedConfiguredPackage
elab@ElaboratedConfiguredPackage { elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle = BuildStyle
BuildInplaceOnly }) = ElaboratedConfiguredPackage
elab
    fixupBuildStyle BuildStyle
BuildInplaceOnly ElaboratedConfiguredPackage
elab = ElaboratedConfiguredPackage
elab {
      elabBuildStyle :: BuildStyle
elabBuildStyle = BuildStyle
BuildInplaceOnly,
      elabBuildPackageDBStack :: PackageDBStack
elabBuildPackageDBStack = ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack ElaboratedConfiguredPackage
elab,
      elabRegisterPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack = ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceRegisterPackageDBStack ElaboratedConfiguredPackage
elab,
      elabSetupPackageDBStack :: PackageDBStack
elabSetupPackageDBStack = ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack ElaboratedConfiguredPackage
elab
    }

    ready_map :: InstS
ready_map = forall s a. State s a -> s -> s
execState StateT InstS Identity ()
work forall k a. Map k a
Map.empty

    work :: StateT InstS Identity ()
work = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ElaboratedPlanPackage]
pkgs forall a b. (a -> b) -> a -> b
$ \ElaboratedPlanPackage
pkg ->
            case ElaboratedPlanPackage
pkg of
                InstallPlan.Configured ElaboratedConfiguredPackage
elab
                    | Bool -> Bool
not (forall k a. Map k a -> Bool
Map.null (ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabLinkedInstantiatedWith ElaboratedConfiguredPackage
elab))
                    -> InstalledPackageId -> InstM UnitId
indefiniteUnitId (ElaboratedConfiguredPackage -> InstalledPackageId
elabComponentId ElaboratedConfiguredPackage
elab)
                        forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                ElaboratedPlanPackage
_ -> InstalledPackageId
-> Map ModuleName (Module, BuildStyle)
-> InstM (DefUnitId, BuildStyle)
instantiateUnitId (ElaboratedPlanPackage -> InstalledPackageId
getComponentId ElaboratedPlanPackage
pkg) forall k a. Map k a
Map.empty
                        forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

---------------------------
-- Build targets
--

-- Refer to ProjectPlanning.Types for details of these important types:

-- data ComponentTarget = ...
-- data SubComponentTarget = ...

-- One step in the build system is to translate higher level intentions like
-- "build this package", "test that package", or "repl that component" into
-- a more detailed specification of exactly which components to build (or other
-- actions like repl or build docs). This translation is somewhat different for
-- different commands. For example "test" for a package will build a different
-- set of components than "build". In addition, the translation of these
-- intentions can fail. For example "run" for a package is only unambiguous
-- when the package has a single executable.
--
-- So we need a little bit of infrastructure to make it easy for the command
-- implementations to select what component targets are meant when a user asks
-- to do something with a package or component. To do this (and to be able to
-- produce good error messages for mistakes and when targets are not available)
-- we need to gather and summarise accurate information about all the possible
-- targets, both available and unavailable. Then a command implementation can
-- decide which of the available component targets should be selected.

-- | An available target represents a component within a package that a user
-- command could plausibly refer to. In this sense, all the components defined
-- within the package are things the user could refer to, whether or not it
-- would actually be possible to build that component.
--
-- In particular the available target contains an 'AvailableTargetStatus' which
-- informs us about whether it's actually possible to select this component to
-- be built, and if not why not. This detail makes it possible for command
-- implementations (like @build@, @test@ etc) to accurately report why a target
-- cannot be used.
--
-- Note that the type parameter is used to help enforce that command
-- implementations can only select targets that can actually be built (by
-- forcing them to return the @k@ value for the selected targets).
-- In particular 'resolveTargets' makes use of this (with @k@ as
-- @('UnitId', ComponentName')@) to identify the targets thus selected.
--
data AvailableTarget k = AvailableTarget {
       forall k. AvailableTarget k -> PackageIdentifier
availableTargetPackageId      :: PackageId,
       forall k. AvailableTarget k -> ComponentName
availableTargetComponentName  :: ComponentName,
       forall k. AvailableTarget k -> AvailableTargetStatus k
availableTargetStatus         :: AvailableTargetStatus k,
       forall k. AvailableTarget k -> Bool
availableTargetLocalToProject :: Bool
     }
  deriving (AvailableTarget k -> AvailableTarget k -> Bool
forall k. Eq k => AvailableTarget k -> AvailableTarget k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AvailableTarget k -> AvailableTarget k -> Bool
$c/= :: forall k. Eq k => AvailableTarget k -> AvailableTarget k -> Bool
== :: AvailableTarget k -> AvailableTarget k -> Bool
$c== :: forall k. Eq k => AvailableTarget k -> AvailableTarget k -> Bool
Eq, Int -> AvailableTarget k -> String -> String
forall k. Show k => Int -> AvailableTarget k -> String -> String
forall k. Show k => [AvailableTarget k] -> String -> String
forall k. Show k => AvailableTarget k -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AvailableTarget k] -> String -> String
$cshowList :: forall k. Show k => [AvailableTarget k] -> String -> String
show :: AvailableTarget k -> String
$cshow :: forall k. Show k => AvailableTarget k -> String
showsPrec :: Int -> AvailableTarget k -> String -> String
$cshowsPrec :: forall k. Show k => Int -> AvailableTarget k -> String -> String
Show, forall a b. a -> AvailableTarget b -> AvailableTarget a
forall a b. (a -> b) -> AvailableTarget a -> AvailableTarget b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AvailableTarget b -> AvailableTarget a
$c<$ :: forall a b. a -> AvailableTarget b -> AvailableTarget a
fmap :: forall a b. (a -> b) -> AvailableTarget a -> AvailableTarget b
$cfmap :: forall a b. (a -> b) -> AvailableTarget a -> AvailableTarget b
Functor)

-- | The status of a an 'AvailableTarget' component. This tells us whether
-- it's actually possible to select this component to be built, and if not
-- why not.
--
data AvailableTargetStatus k =
       TargetDisabledByUser   -- ^ When the user does @tests: False@
     | TargetDisabledBySolver -- ^ When the solver could not enable tests
     | TargetNotBuildable     -- ^ When the component has @buildable: False@
     | TargetNotLocal         -- ^ When the component is non-core in a non-local package
     | TargetBuildable k TargetRequested -- ^ The target can or should be built
  deriving (AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
forall k.
Eq k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
$c/= :: forall k.
Eq k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
== :: AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
$c== :: forall k.
Eq k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
Eq, AvailableTargetStatus k -> AvailableTargetStatus k -> Ordering
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
forall {k}. Ord k => Eq (AvailableTargetStatus k)
forall k.
Ord k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
forall k.
Ord k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Ordering
forall k.
Ord k =>
AvailableTargetStatus k
-> AvailableTargetStatus k -> AvailableTargetStatus k
min :: AvailableTargetStatus k
-> AvailableTargetStatus k -> AvailableTargetStatus k
$cmin :: forall k.
Ord k =>
AvailableTargetStatus k
-> AvailableTargetStatus k -> AvailableTargetStatus k
max :: AvailableTargetStatus k
-> AvailableTargetStatus k -> AvailableTargetStatus k
$cmax :: forall k.
Ord k =>
AvailableTargetStatus k
-> AvailableTargetStatus k -> AvailableTargetStatus k
>= :: AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
$c>= :: forall k.
Ord k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
> :: AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
$c> :: forall k.
Ord k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
<= :: AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
$c<= :: forall k.
Ord k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
< :: AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
$c< :: forall k.
Ord k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
compare :: AvailableTargetStatus k -> AvailableTargetStatus k -> Ordering
$ccompare :: forall k.
Ord k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Ordering
Ord, Int -> AvailableTargetStatus k -> String -> String
forall k.
Show k =>
Int -> AvailableTargetStatus k -> String -> String
forall k. Show k => [AvailableTargetStatus k] -> String -> String
forall k. Show k => AvailableTargetStatus k -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AvailableTargetStatus k] -> String -> String
$cshowList :: forall k. Show k => [AvailableTargetStatus k] -> String -> String
show :: AvailableTargetStatus k -> String
$cshow :: forall k. Show k => AvailableTargetStatus k -> String
showsPrec :: Int -> AvailableTargetStatus k -> String -> String
$cshowsPrec :: forall k.
Show k =>
Int -> AvailableTargetStatus k -> String -> String
Show, forall a b. a -> AvailableTargetStatus b -> AvailableTargetStatus a
forall a b.
(a -> b) -> AvailableTargetStatus a -> AvailableTargetStatus b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AvailableTargetStatus b -> AvailableTargetStatus a
$c<$ :: forall a b. a -> AvailableTargetStatus b -> AvailableTargetStatus a
fmap :: forall a b.
(a -> b) -> AvailableTargetStatus a -> AvailableTargetStatus b
$cfmap :: forall a b.
(a -> b) -> AvailableTargetStatus a -> AvailableTargetStatus b
Functor)

-- | This tells us whether a target ought to be built by default, or only if
-- specifically requested. The policy is that components like libraries and
-- executables are built by default by @build@, but test suites and benchmarks
-- are not, unless this is overridden in the project configuration.
--
data TargetRequested =
       TargetRequestedByDefault    -- ^ To be built by default
     | TargetNotRequestedByDefault -- ^ Not to be built by default
  deriving (TargetRequested -> TargetRequested -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetRequested -> TargetRequested -> Bool
$c/= :: TargetRequested -> TargetRequested -> Bool
== :: TargetRequested -> TargetRequested -> Bool
$c== :: TargetRequested -> TargetRequested -> Bool
Eq, Eq TargetRequested
TargetRequested -> TargetRequested -> Bool
TargetRequested -> TargetRequested -> Ordering
TargetRequested -> TargetRequested -> TargetRequested
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
min :: TargetRequested -> TargetRequested -> TargetRequested
$cmin :: TargetRequested -> TargetRequested -> TargetRequested
max :: TargetRequested -> TargetRequested -> TargetRequested
$cmax :: TargetRequested -> TargetRequested -> TargetRequested
>= :: TargetRequested -> TargetRequested -> Bool
$c>= :: TargetRequested -> TargetRequested -> Bool
> :: TargetRequested -> TargetRequested -> Bool
$c> :: TargetRequested -> TargetRequested -> Bool
<= :: TargetRequested -> TargetRequested -> Bool
$c<= :: TargetRequested -> TargetRequested -> Bool
< :: TargetRequested -> TargetRequested -> Bool
$c< :: TargetRequested -> TargetRequested -> Bool
compare :: TargetRequested -> TargetRequested -> Ordering
$ccompare :: TargetRequested -> TargetRequested -> Ordering
Ord, Int -> TargetRequested -> String -> String
[TargetRequested] -> String -> String
TargetRequested -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TargetRequested] -> String -> String
$cshowList :: [TargetRequested] -> String -> String
show :: TargetRequested -> String
$cshow :: TargetRequested -> String
showsPrec :: Int -> TargetRequested -> String -> String
$cshowsPrec :: Int -> TargetRequested -> String -> String
Show)

-- | Given the install plan, produce the set of 'AvailableTarget's for each
-- package-component pair.
--
-- Typically there will only be one such target for each component, but for
-- example if we have a plan with both normal and profiling variants of a
-- component then we would get both as available targets, or similarly if we
-- had a plan that contained two instances of the same version of a package.
-- This approach makes it relatively easy to select all instances\/variants
-- of a component.
--
availableTargets :: ElaboratedInstallPlan
                 -> Map (PackageId, ComponentName)
                        [AvailableTarget (UnitId, ComponentName)]
availableTargets :: ElaboratedInstallPlan
-> Map
     (PackageIdentifier, ComponentName)
     [AvailableTarget (UnitId, ComponentName)]
availableTargets ElaboratedInstallPlan
installPlan =
    let rs :: [(PackageIdentifier, ComponentName, Bool,
  AvailableTarget (UnitId, ComponentName))]
rs = [ (PackageIdentifier
pkgid, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target)
             | ElaboratedPlanPackage
pkg <- forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
installPlan
             , (PackageIdentifier
pkgid, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target) <- case ElaboratedPlanPackage
pkg of
                 InstallPlan.PreExisting InstalledPackageInfo
ipkg -> InstalledPackageInfo
-> [(PackageIdentifier, ComponentName, Bool,
     AvailableTarget (UnitId, ComponentName))]
availableInstalledTargets InstalledPackageInfo
ipkg
                 InstallPlan.Installed   ElaboratedConfiguredPackage
elab -> ElaboratedConfiguredPackage
-> [(PackageIdentifier, ComponentName, Bool,
     AvailableTarget (UnitId, ComponentName))]
availableSourceTargets ElaboratedConfiguredPackage
elab
                 InstallPlan.Configured  ElaboratedConfiguredPackage
elab -> ElaboratedConfiguredPackage
-> [(PackageIdentifier, ComponentName, Bool,
     AvailableTarget (UnitId, ComponentName))]
availableSourceTargets ElaboratedConfiguredPackage
elab
             ]
     in forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
         (forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++)
            [ ((PackageIdentifier
pkgid, ComponentName
cname), [AvailableTarget (UnitId, ComponentName)
target])
            | (PackageIdentifier
pkgid, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target) <- [(PackageIdentifier, ComponentName, Bool,
  AvailableTarget (UnitId, ComponentName))]
rs, Bool -> Bool
not Bool
fake])
         (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ ((PackageIdentifier
pkgid, ComponentName
cname), [AvailableTarget (UnitId, ComponentName)
target])
            | (PackageIdentifier
pkgid, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target) <- [(PackageIdentifier, ComponentName, Bool,
  AvailableTarget (UnitId, ComponentName))]
rs, Bool
fake])
    -- The normal targets mask the fake ones. We get all instances of the
    -- normal ones and only one copy of the fake ones (as there are many
    -- duplicates of the fake ones). See 'availableSourceTargets' below for
    -- more details on this fake stuff is about.

availableInstalledTargets :: IPI.InstalledPackageInfo
                          -> [(PackageId, ComponentName, Bool,
                               AvailableTarget (UnitId, ComponentName))]
availableInstalledTargets :: InstalledPackageInfo
-> [(PackageIdentifier, ComponentName, Bool,
     AvailableTarget (UnitId, ComponentName))]
availableInstalledTargets InstalledPackageInfo
ipkg =
    let unitid :: UnitId
unitid = forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
ipkg
        cname :: ComponentName
cname  = LibraryName -> ComponentName
CLibName LibraryName
LMainLibName
        status :: AvailableTargetStatus (UnitId, ComponentName)
status = forall k. k -> TargetRequested -> AvailableTargetStatus k
TargetBuildable (UnitId
unitid, ComponentName
cname) TargetRequested
TargetRequestedByDefault
        target :: AvailableTarget (UnitId, ComponentName)
target = forall k.
PackageIdentifier
-> ComponentName
-> AvailableTargetStatus k
-> Bool
-> AvailableTarget k
AvailableTarget (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId InstalledPackageInfo
ipkg) ComponentName
cname AvailableTargetStatus (UnitId, ComponentName)
status Bool
False
        fake :: Bool
fake   = Bool
False
     in [(forall pkg. Package pkg => pkg -> PackageIdentifier
packageId InstalledPackageInfo
ipkg, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target)]

availableSourceTargets :: ElaboratedConfiguredPackage
                       -> [(PackageId, ComponentName, Bool,
                            AvailableTarget (UnitId, ComponentName))]
availableSourceTargets :: ElaboratedConfiguredPackage
-> [(PackageIdentifier, ComponentName, Bool,
     AvailableTarget (UnitId, ComponentName))]
availableSourceTargets ElaboratedConfiguredPackage
elab =
    -- We have a somewhat awkward problem here. We need to know /all/ the
    -- components from /all/ the packages because these are the things that
    -- users could refer to. Unfortunately, at this stage the elaborated install
    -- plan does /not/ contain all components: some components have already
    -- been deleted because they cannot possibly be built. This is the case
    -- for components that are marked @buildable: False@ in their .cabal files.
    -- (It's not unreasonable that the unbuildable components have been pruned
    -- as the plan invariant is considerably simpler if all nodes can be built)
    --
    -- We can recover the missing components but it's not exactly elegant. For
    -- a graph node corresponding to a component we still have the information
    -- about the package that it came from, and this includes the names of
    -- /all/ the other components in the package. So in principle this lets us
    -- find the names of all components, plus full details of the buildable
    -- components.
    --
    -- Consider for example a package with 3 exe components: foo, bar and baz
    -- where foo and bar are buildable, but baz is not. So the plan contains
    -- nodes for the components foo and bar. Now we look at each of these two
    -- nodes and look at the package they come from and the names of the
    -- components in this package. This will give us the names foo, bar and
    -- baz, twice (once for each of the two buildable components foo and bar).
    --
    -- We refer to these reconstructed missing components as fake targets.
    -- It is an invariant that they are not available to be built.
    --
    -- To produce the final set of targets we put the fake targets in a finite
    -- map (thus eliminating the duplicates) and then we overlay that map with
    -- the normal buildable targets. (This is done above in 'availableTargets'.)
    --
    [ (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target)
    | Component
component <- PackageDescription -> [Component]
pkgComponents (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab)
    , let cname :: ComponentName
cname  = Component -> ComponentName
componentName Component
component
          status :: AvailableTargetStatus (UnitId, ComponentName)
status = Component -> AvailableTargetStatus (UnitId, ComponentName)
componentAvailableTargetStatus Component
component
          target :: AvailableTarget (UnitId, ComponentName)
target = AvailableTarget {
                     availableTargetPackageId :: PackageIdentifier
availableTargetPackageId      = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab,
                     availableTargetComponentName :: ComponentName
availableTargetComponentName  = ComponentName
cname,
                     availableTargetStatus :: AvailableTargetStatus (UnitId, ComponentName)
availableTargetStatus         = AvailableTargetStatus (UnitId, ComponentName)
status,
                     availableTargetLocalToProject :: Bool
availableTargetLocalToProject = ElaboratedConfiguredPackage -> Bool
elabLocalToProject ElaboratedConfiguredPackage
elab
                   }
          fake :: Bool
fake   = ComponentName -> Bool
isFakeTarget ComponentName
cname

    -- TODO: The goal of this test is to exclude "instantiated"
    -- packages as available targets. This means that you can't
    -- ask for a particular instantiated component to be built;
    -- it will only get built by a dependency.  Perhaps the
    -- correct way to implement this is to run selection
    -- prior to instantiating packages.  If you refactor
    -- this, then you can delete this test.
    , ElaboratedConfiguredPackage -> Bool
elabIsCanonical ElaboratedConfiguredPackage
elab

      -- Filter out some bogus parts of the cross product that are never needed
    , case AvailableTargetStatus (UnitId, ComponentName)
status of
        TargetBuildable{} | Bool
fake -> Bool
False
        AvailableTargetStatus (UnitId, ComponentName)
_                        -> Bool
True
    ]
  where
    isFakeTarget :: ComponentName -> Bool
isFakeTarget ComponentName
cname =
      case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
        ElabPackage ElaboratedPackage
_               -> Bool
False
        ElabComponent ElaboratedComponent
elabComponent -> ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
elabComponent
                                       forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just ComponentName
cname

    componentAvailableTargetStatus
      :: Component -> AvailableTargetStatus (UnitId, ComponentName)
    componentAvailableTargetStatus :: Component -> AvailableTargetStatus (UnitId, ComponentName)
componentAvailableTargetStatus Component
component =
        case Component -> Maybe OptionalStanza
componentOptionalStanza forall a b. (a -> b) -> a -> b
$ ComponentName -> Component
CD.componentNameToComponent ComponentName
cname of
          -- it is not an optional stanza, so a library, exe or foreign lib
          Maybe OptionalStanza
Nothing
            | Bool -> Bool
not Bool
buildable  -> forall k. AvailableTargetStatus k
TargetNotBuildable
            | Bool
otherwise      -> forall k. k -> TargetRequested -> AvailableTargetStatus k
TargetBuildable (ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
elab, ComponentName
cname)
                                                TargetRequested
TargetRequestedByDefault

          -- it is not an optional stanza, so a testsuite or benchmark
          Just OptionalStanza
stanza ->
            case (forall a. OptionalStanza -> OptionalStanzaMap a -> a
optStanzaLookup OptionalStanza
stanza (ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasRequested ElaboratedConfiguredPackage
elab), -- TODO
                  OptionalStanza -> OptionalStanzaSet -> Bool
optStanzaSetMember OptionalStanza
stanza (ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasAvailable ElaboratedConfiguredPackage
elab)) of
              (Maybe Bool, Bool)
_ | Bool -> Bool
not Bool
withinPlan -> forall k. AvailableTargetStatus k
TargetNotLocal
              (Just Bool
False,   Bool
_)  -> forall k. AvailableTargetStatus k
TargetDisabledByUser
              (Maybe Bool
Nothing,  Bool
False)  -> forall k. AvailableTargetStatus k
TargetDisabledBySolver
              (Maybe Bool, Bool)
_ | Bool -> Bool
not Bool
buildable  -> forall k. AvailableTargetStatus k
TargetNotBuildable
              (Just Bool
True, Bool
True)  -> forall k. k -> TargetRequested -> AvailableTargetStatus k
TargetBuildable (ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
elab, ComponentName
cname)
                                                    TargetRequested
TargetRequestedByDefault
              (Maybe Bool
Nothing,   Bool
True)  -> forall k. k -> TargetRequested -> AvailableTargetStatus k
TargetBuildable (ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
elab, ComponentName
cname)
                                                    TargetRequested
TargetNotRequestedByDefault
              (Just Bool
True, Bool
False) ->
                forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"componentAvailableTargetStatus: impossible; cname=" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow ComponentName
cname
      where
        cname :: ComponentName
cname      = Component -> ComponentName
componentName Component
component
        buildable :: Bool
buildable  = BuildInfo -> Bool
PD.buildable (Component -> BuildInfo
componentBuildInfo Component
component)
        withinPlan :: Bool
withinPlan = ElaboratedConfiguredPackage -> Bool
elabLocalToProject ElaboratedConfiguredPackage
elab
                  Bool -> Bool -> Bool
|| case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
                       ElabComponent ElaboratedComponent
elabComponent ->
                         ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
elabComponent forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ComponentName
cname
                       ElabPackage ElaboratedPackage
_ ->
                         case Component -> ComponentName
componentName Component
component of
                           CLibName (LibraryName
LMainLibName) -> Bool
True
                           CExeName UnqualComponentName
_ -> Bool
True
                           --TODO: what about sub-libs and foreign libs?
                           ComponentName
_          -> Bool
False

-- | Merge component targets that overlap each other. Specially when we have
-- multiple targets for the same component and one of them refers to the whole
-- component (rather than a module or file within) then all the other targets
-- for that component are subsumed.
--
-- We also allow for information associated with each component target, and
-- whenever we targets subsume each other we aggregate their associated info.
--
nubComponentTargets :: [(ComponentTarget, a)] -> [(ComponentTarget, NonEmpty a)]
nubComponentTargets :: forall a. [(ComponentTarget, a)] -> [(ComponentTarget, NonEmpty a)]
nubComponentTargets =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. [(ComponentTarget, a)] -> [(ComponentTarget, NonEmpty a)]
wholeComponentOverrides forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==)    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy  (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\t :: (ComponentTarget, a)
t@((ComponentTarget ComponentName
cname SubComponentTarget
_, a
_)) -> (ComponentName
cname, (ComponentTarget, a)
t))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (ComponentTarget, a) -> (ComponentTarget, a)
compatSubComponentTargets
  where
    -- If we're building the whole component then that the only target all we
    -- need, otherwise we can have several targets within the component.
    wholeComponentOverrides :: [(ComponentTarget,  a )]
                            -> [(ComponentTarget, NonEmpty a)]
    wholeComponentOverrides :: forall a. [(ComponentTarget, a)] -> [(ComponentTarget, NonEmpty a)]
wholeComponentOverrides [(ComponentTarget, a)]
ts =
      case [ (ComponentTarget, a)
ta | ta :: (ComponentTarget, a)
ta@(ComponentTarget ComponentName
_ SubComponentTarget
WholeComponent, a
_) <- [(ComponentTarget, a)]
ts ] of
        ((ComponentTarget
t, a
x):[(ComponentTarget, a)]
_) ->
                let
                    -- Delete tuple (t, x) from original list to avoid duplicates.
                    -- Use 'deleteBy', to avoid additional Class constraint on 'nubComponentTargets'.
                    ts' :: [(ComponentTarget, a)]
ts' = forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy (\(ComponentTarget
t1, a
_) (ComponentTarget
t2, a
_) -> ComponentTarget
t1 forall a. Eq a => a -> a -> Bool
== ComponentTarget
t2) (ComponentTarget
t, a
x) [(ComponentTarget, a)]
ts
                in
                    [ (ComponentTarget
t, a
x forall a. a -> [a] -> NonEmpty a
:| forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(ComponentTarget, a)]
ts') ]
        []    -> [ (ComponentTarget
t, a
x forall a. a -> [a] -> NonEmpty a
:| []) | (ComponentTarget
t,a
x) <- [(ComponentTarget, a)]
ts ]

    -- Not all Cabal Setup.hs versions support sub-component targets, so switch
    -- them over to the whole component
    compatSubComponentTargets :: (ComponentTarget, a) -> (ComponentTarget, a)
    compatSubComponentTargets :: forall a. (ComponentTarget, a) -> (ComponentTarget, a)
compatSubComponentTargets target :: (ComponentTarget, a)
target@(ComponentTarget ComponentName
cname SubComponentTarget
_subtarget, a
x)
      | Bool -> Bool
not Bool
setupHsSupportsSubComponentTargets
                  = (ComponentName -> SubComponentTarget -> ComponentTarget
ComponentTarget ComponentName
cname SubComponentTarget
WholeComponent, a
x)
      | Bool
otherwise = (ComponentTarget, a)
target

    -- Actually the reality is that no current version of Cabal's Setup.hs
    -- build command actually support building specific files or modules.
    setupHsSupportsSubComponentTargets :: Bool
setupHsSupportsSubComponentTargets = Bool
False
    -- TODO: when that changes, adjust this test, e.g.
    -- | pkgSetupScriptCliVersion >= Version [x,y] []

pkgHasEphemeralBuildTargets :: ElaboratedConfiguredPackage -> Bool
pkgHasEphemeralBuildTargets :: ElaboratedConfiguredPackage -> Bool
pkgHasEphemeralBuildTargets ElaboratedConfiguredPackage
elab =
    forall a. Maybe a -> Bool
isJust (ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabReplTarget ElaboratedConfiguredPackage
elab)
 Bool -> Bool -> Bool
|| (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
elab)
 Bool -> Bool -> Bool
|| (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
elab)
 Bool -> Bool -> Bool
|| (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets ElaboratedConfiguredPackage
elab)
 Bool -> Bool -> Bool
|| (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [ () | ComponentTarget ComponentName
_ SubComponentTarget
subtarget <- ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab
                      , SubComponentTarget
subtarget forall a. Eq a => a -> a -> Bool
/= SubComponentTarget
WholeComponent ]

-- | The components that we'll build all of, meaning that after they're built
-- we can skip building them again (unlike with building just some modules or
-- other files within a component).
--
elabBuildTargetWholeComponents :: ElaboratedConfiguredPackage
                              -> Set ComponentName
elabBuildTargetWholeComponents :: ElaboratedConfiguredPackage -> Set ComponentName
elabBuildTargetWholeComponents ElaboratedConfiguredPackage
elab =
    forall a. Ord a => [a] -> Set a
Set.fromList
      [ ComponentName
cname | ComponentTarget ComponentName
cname SubComponentTarget
WholeComponent <- ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab ]



------------------------------------------------------------------------------
-- * Install plan pruning
------------------------------------------------------------------------------

-- | How 'pruneInstallPlanToTargets' should interpret the per-package
-- 'ComponentTarget's: as build, repl or haddock targets.
--
data TargetAction = TargetActionConfigure
                  | TargetActionBuild
                  | TargetActionRepl
                  | TargetActionTest
                  | TargetActionBench
                  | TargetActionHaddock

-- | Given a set of per-package\/per-component targets, take the subset of the
-- install plan needed to build those targets. Also, update the package config
-- to specify which optional stanzas to enable, and which targets within each
-- package to build.
--
-- NB: Pruning happens after improvement, which is important because we
-- will prune differently depending on what is already installed (to
-- implement "sticky" test suite enabling behavior).
--
pruneInstallPlanToTargets :: TargetAction
                          -> Map UnitId [ComponentTarget]
                          -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets :: TargetAction
-> Map UnitId [ComponentTarget]
-> ElaboratedInstallPlan
-> ElaboratedInstallPlan
pruneInstallPlanToTargets TargetAction
targetActionType Map UnitId [ComponentTarget]
perPkgTargetsMap ElaboratedInstallPlan
elaboratedPlan =
    forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
IndependentGoals
-> Graph (GenericPlanPackage ipkg srcpkg)
-> GenericInstallPlan ipkg srcpkg
InstallPlan.new (forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> IndependentGoals
InstallPlan.planIndepGoals ElaboratedInstallPlan
elaboratedPlan)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList
    -- We have to do the pruning in two passes
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
pruneInstallPlanPass2
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
pruneInstallPlanPass1
    -- Set the targets that will be the roots for pruning
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetAction
-> Map UnitId [ComponentTarget]
-> [ElaboratedPlanPackage]
-> [ElaboratedPlanPackage]
setRootTargets TargetAction
targetActionType Map UnitId [ComponentTarget]
perPkgTargetsMap
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList
  forall a b. (a -> b) -> a -> b
$ ElaboratedInstallPlan
elaboratedPlan

-- | This is a temporary data type, where we temporarily
-- override the graph dependencies of an 'ElaboratedPackage',
-- so we can take a closure over them.  We'll throw out the
-- overridden dependencies when we're done so it's strictly temporary.
--
-- For 'ElaboratedComponent', this the cached unit IDs always
-- coincide with the real thing.
data PrunedPackage = PrunedPackage ElaboratedConfiguredPackage [UnitId]

instance Package PrunedPackage where
    packageId :: PrunedPackage -> PackageIdentifier
packageId (PrunedPackage ElaboratedConfiguredPackage
elab [UnitId]
_) = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab

instance HasUnitId PrunedPackage where
    installedUnitId :: PrunedPackage -> UnitId
installedUnitId = forall a. IsNode a => a -> Key a
nodeKey

instance IsNode PrunedPackage where
    type Key PrunedPackage = UnitId
    nodeKey :: PrunedPackage -> Key PrunedPackage
nodeKey (PrunedPackage ElaboratedConfiguredPackage
elab [UnitId]
_)  = forall a. IsNode a => a -> Key a
nodeKey ElaboratedConfiguredPackage
elab
    nodeNeighbors :: PrunedPackage -> [Key PrunedPackage]
nodeNeighbors (PrunedPackage ElaboratedConfiguredPackage
_ [UnitId]
deps) = [UnitId]
deps

fromPrunedPackage :: PrunedPackage -> ElaboratedConfiguredPackage
fromPrunedPackage :: PrunedPackage -> ElaboratedConfiguredPackage
fromPrunedPackage (PrunedPackage ElaboratedConfiguredPackage
elab [UnitId]
_) = ElaboratedConfiguredPackage
elab

-- | Set the build targets based on the user targets (but not rev deps yet).
-- This is required before we can prune anything.
--
setRootTargets :: TargetAction
               -> Map UnitId [ComponentTarget]
               -> [ElaboratedPlanPackage]
               -> [ElaboratedPlanPackage]
setRootTargets :: TargetAction
-> Map UnitId [ComponentTarget]
-> [ElaboratedPlanPackage]
-> [ElaboratedPlanPackage]
setRootTargets TargetAction
targetAction Map UnitId [ComponentTarget]
perPkgTargetsMap =
    forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (forall k a. Map k a -> Bool
Map.null Map UnitId [ComponentTarget]
perPkgTargetsMap)) forall a b. (a -> b) -> a -> b
$
    forall a. HasCallStack => Bool -> a -> a
assert (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (forall k a. Map k a -> [a]
Map.elems Map UnitId [ComponentTarget]
perPkgTargetsMap)) forall a b. (a -> b) -> a -> b
$

    forall a b. (a -> b) -> [a] -> [b]
map (forall srcpkg srcpkg' ipkg.
(srcpkg -> srcpkg')
-> GenericPlanPackage ipkg srcpkg
-> GenericPlanPackage ipkg srcpkg'
mapConfiguredPackage ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
setElabBuildTargets)
  where
    -- Set the targets we'll build for this package/component. This is just
    -- based on the root targets from the user, not targets implied by reverse
    -- dependencies. Those comes in the second pass once we know the rev deps.
    --
    setElabBuildTargets :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
setElabBuildTargets ElaboratedConfiguredPackage
elab =
      case (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab) Map UnitId [ComponentTarget]
perPkgTargetsMap,
            TargetAction
targetAction) of
        (Maybe [ComponentTarget]
Nothing, TargetAction
_)                      -> ElaboratedConfiguredPackage
elab
        (Just [ComponentTarget]
tgts,  TargetAction
TargetActionConfigure) -> ElaboratedConfiguredPackage
elab { elabConfigureTargets :: [ComponentTarget]
elabConfigureTargets = [ComponentTarget]
tgts }
        (Just [ComponentTarget]
tgts,  TargetAction
TargetActionBuild)   -> ElaboratedConfiguredPackage
elab { elabBuildTargets :: [ComponentTarget]
elabBuildTargets = [ComponentTarget]
tgts }
        (Just [ComponentTarget]
tgts,  TargetAction
TargetActionTest)    -> ElaboratedConfiguredPackage
elab { elabTestTargets :: [ComponentTarget]
elabTestTargets  = [ComponentTarget]
tgts }
        (Just [ComponentTarget]
tgts,  TargetAction
TargetActionBench)   -> ElaboratedConfiguredPackage
elab { elabBenchTargets :: [ComponentTarget]
elabBenchTargets  = [ComponentTarget]
tgts }
        (Just [ComponentTarget
tgt], TargetAction
TargetActionRepl)    -> ElaboratedConfiguredPackage
elab { elabReplTarget :: Maybe ComponentTarget
elabReplTarget = forall a. a -> Maybe a
Just ComponentTarget
tgt
                                                  , elabBuildHaddocks :: Bool
elabBuildHaddocks = Bool
False }
        (Just [ComponentTarget]
tgts,  TargetAction
TargetActionHaddock) ->
          forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ComponentTarget
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
setElabHaddockTargets (ElaboratedConfiguredPackage
elab { elabHaddockTargets :: [ComponentTarget]
elabHaddockTargets = [ComponentTarget]
tgts
                                            , elabBuildHaddocks :: Bool
elabBuildHaddocks = Bool
True }) [ComponentTarget]
tgts
        (Just [ComponentTarget]
_,     TargetAction
TargetActionRepl)    ->
          forall a. HasCallStack => String -> a
error String
"pruneInstallPlanToTargets: multiple repl targets"

    setElabHaddockTargets :: ComponentTarget
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
setElabHaddockTargets ComponentTarget
tgt ElaboratedConfiguredPackage
elab
      | ComponentTarget -> Bool
isTestComponentTarget ComponentTarget
tgt       = ElaboratedConfiguredPackage
elab { elabHaddockTestSuites :: Bool
elabHaddockTestSuites  = Bool
True }
      | ComponentTarget -> Bool
isBenchComponentTarget ComponentTarget
tgt      = ElaboratedConfiguredPackage
elab { elabHaddockBenchmarks :: Bool
elabHaddockBenchmarks  = Bool
True }
      | ComponentTarget -> Bool
isForeignLibComponentTarget ComponentTarget
tgt = ElaboratedConfiguredPackage
elab { elabHaddockForeignLibs :: Bool
elabHaddockForeignLibs = Bool
True }
      | ComponentTarget -> Bool
isExeComponentTarget ComponentTarget
tgt        = ElaboratedConfiguredPackage
elab { elabHaddockExecutables :: Bool
elabHaddockExecutables = Bool
True }
      | ComponentTarget -> Bool
isSubLibComponentTarget ComponentTarget
tgt     = ElaboratedConfiguredPackage
elab { elabHaddockInternal :: Bool
elabHaddockInternal    = Bool
True }
      | Bool
otherwise                       = ElaboratedConfiguredPackage
elab

-- | Assuming we have previously set the root build targets (i.e. the user
-- targets but not rev deps yet), the first pruning pass does two things:
--
-- * A first go at determining which optional stanzas (testsuites, benchmarks)
--   are needed. We have a second go in the next pass.
-- * Take the dependency closure using pruned dependencies. We prune deps that
--   are used only by unneeded optional stanzas. These pruned deps are only
--   used for the dependency closure and are not persisted in this pass.
--
pruneInstallPlanPass1 :: [ElaboratedPlanPackage]
                      -> [ElaboratedPlanPackage]
pruneInstallPlanPass1 :: [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
pruneInstallPlanPass1 [ElaboratedPlanPackage]
pkgs =
    forall a b. (a -> b) -> [a] -> [b]
map (forall srcpkg srcpkg' ipkg.
(srcpkg -> srcpkg')
-> GenericPlanPackage ipkg srcpkg
-> GenericPlanPackage ipkg srcpkg'
mapConfiguredPackage PrunedPackage -> ElaboratedConfiguredPackage
fromPrunedPackage)
        (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure Graph (GenericPlanPackage InstalledPackageInfo PrunedPackage)
graph [UnitId]
roots)
  where
    pkgs' :: [GenericPlanPackage InstalledPackageInfo PrunedPackage]
pkgs' = forall a b. (a -> b) -> [a] -> [b]
map (forall srcpkg srcpkg' ipkg.
(srcpkg -> srcpkg')
-> GenericPlanPackage ipkg srcpkg
-> GenericPlanPackage ipkg srcpkg'
mapConfiguredPackage ElaboratedConfiguredPackage -> PrunedPackage
prune) [ElaboratedPlanPackage]
pkgs
    graph :: Graph (GenericPlanPackage InstalledPackageInfo PrunedPackage)
graph = forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList [GenericPlanPackage InstalledPackageInfo PrunedPackage]
pkgs'
    roots :: [UnitId]
roots = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {ipkg}.
GenericPlanPackage ipkg PrunedPackage -> Maybe UnitId
find_root [GenericPlanPackage InstalledPackageInfo PrunedPackage]
pkgs'

    prune :: ElaboratedConfiguredPackage -> PrunedPackage
prune ElaboratedConfiguredPackage
elab = ElaboratedConfiguredPackage -> [UnitId] -> PrunedPackage
PrunedPackage ElaboratedConfiguredPackage
elab' (ElaboratedConfiguredPackage -> [UnitId]
pruneOptionalDependencies ElaboratedConfiguredPackage
elab')
      where elab' :: ElaboratedConfiguredPackage
elab' =
                ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
setDocumentation
              forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
addOptionalStanzas ElaboratedConfiguredPackage
elab

    is_root :: PrunedPackage -> Maybe UnitId
    is_root :: PrunedPackage -> Maybe UnitId
is_root (PrunedPackage ElaboratedConfiguredPackage
elab [UnitId]
_) =
      if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets ElaboratedConfiguredPackage
elab)
                   , forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab)
                   , forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
elab)
                   , forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
elab)
                   , forall a. Maybe a -> Bool
isNothing (ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabReplTarget ElaboratedConfiguredPackage
elab)
                   , forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets ElaboratedConfiguredPackage
elab)
                   ]
          then forall a. a -> Maybe a
Just (forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab)
          else forall a. Maybe a
Nothing

    find_root :: GenericPlanPackage ipkg PrunedPackage -> Maybe UnitId
find_root (InstallPlan.Configured PrunedPackage
pkg) = PrunedPackage -> Maybe UnitId
is_root PrunedPackage
pkg
    -- When using the extra-packages stanza we need to
    -- look at installed packages as well.
    find_root (InstallPlan.Installed PrunedPackage
pkg)  = PrunedPackage -> Maybe UnitId
is_root PrunedPackage
pkg
    find_root GenericPlanPackage ipkg PrunedPackage
_ = forall a. Maybe a
Nothing

    -- Note [Sticky enabled testsuites]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- The testsuite and benchmark targets are somewhat special in that we need
    -- to configure the packages with them enabled, and we need to do that even
    -- if we only want to build one of several testsuites.
    --
    -- There are two cases in which we will enable the testsuites (or
    -- benchmarks): if one of the targets is a testsuite, or if all of the
    -- testsuite dependencies are already cached in the store. The rationale
    -- for the latter is to minimise how often we have to reconfigure due to
    -- the particular targets we choose to build. Otherwise choosing to build
    -- a testsuite target, and then later choosing to build an exe target
    -- would involve unnecessarily reconfiguring the package with testsuites
    -- disabled. Technically this introduces a little bit of stateful
    -- behaviour to make this "sticky", but it should be benign.

    -- Decide whether or not to enable testsuites and benchmarks.
    -- See [Sticky enabled testsuites]
    addOptionalStanzas :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
    addOptionalStanzas :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
addOptionalStanzas elab :: ElaboratedConfiguredPackage
elab@ElaboratedConfiguredPackage{ elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabPackage ElaboratedPackage
pkg } =
        ElaboratedConfiguredPackage
elab {
            elabPkgOrComp :: ElaboratedPackageOrComponent
elabPkgOrComp = ElaboratedPackage -> ElaboratedPackageOrComponent
ElabPackage (ElaboratedPackage
pkg { pkgStanzasEnabled :: OptionalStanzaSet
pkgStanzasEnabled = OptionalStanzaSet
stanzas })
        }
      where
        stanzas :: OptionalStanzaSet
               -- By default, we enabled all stanzas requested by the user,
               -- as per elabStanzasRequested, done in
               -- 'elaborateSolverToPackage'
        stanzas :: OptionalStanzaSet
stanzas = ElaboratedPackage -> OptionalStanzaSet
pkgStanzasEnabled ElaboratedPackage
pkg
               -- optionalStanzasRequiredByTargets has to be done at
               -- prune-time because it depends on 'elabTestTargets'
               -- et al, which is done by 'setRootTargets' at the
               -- beginning of pruning.
               forall a. Semigroup a => a -> a -> a
<> ElaboratedConfiguredPackage -> OptionalStanzaSet
optionalStanzasRequiredByTargets ElaboratedConfiguredPackage
elab
               -- optionalStanzasWithDepsAvailable has to be done at
               -- prune-time because it depends on what packages are
               -- installed, which is not known until after improvement
               -- (pruning is done after improvement)
               forall a. Semigroup a => a -> a -> a
<> Set UnitId
-> ElaboratedConfiguredPackage
-> ElaboratedPackage
-> OptionalStanzaSet
optionalStanzasWithDepsAvailable Set UnitId
availablePkgs ElaboratedConfiguredPackage
elab ElaboratedPackage
pkg
    addOptionalStanzas ElaboratedConfiguredPackage
elab = ElaboratedConfiguredPackage
elab

    setDocumentation :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
    setDocumentation :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
setDocumentation elab :: ElaboratedConfiguredPackage
elab@ElaboratedConfiguredPackage { elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabComponent ElaboratedComponent
comp } =
      ElaboratedConfiguredPackage
elab {
        elabBuildHaddocks :: Bool
elabBuildHaddocks =
            ElaboratedConfiguredPackage -> Bool
elabBuildHaddocks ElaboratedConfiguredPackage
elab Bool -> Bool -> Bool
&& Component -> ElaboratedConfiguredPackage -> Bool
documentationEnabled (ElaboratedComponent -> Component
compSolverName ElaboratedComponent
comp) ElaboratedConfiguredPackage
elab
      }

      where
        documentationEnabled :: Component -> ElaboratedConfiguredPackage -> Bool
documentationEnabled Component
c =
          case Component
c of
            Component
CD.ComponentLib      -> forall a b. a -> b -> a
const Bool
True
            CD.ComponentSubLib UnqualComponentName
_ -> ElaboratedConfiguredPackage -> Bool
elabHaddockInternal
            CD.ComponentFLib UnqualComponentName
_   -> ElaboratedConfiguredPackage -> Bool
elabHaddockForeignLibs
            CD.ComponentExe UnqualComponentName
_    -> ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables
            CD.ComponentTest UnqualComponentName
_   -> ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites
            CD.ComponentBench UnqualComponentName
_  -> ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks
            Component
CD.ComponentSetup    -> forall a b. a -> b -> a
const Bool
False

    setDocumentation ElaboratedConfiguredPackage
elab = ElaboratedConfiguredPackage
elab

    -- Calculate package dependencies but cut out those needed only by
    -- optional stanzas that we've determined we will not enable.
    -- These pruned deps are not persisted in this pass since they're based on
    -- the optional stanzas and we'll make further tweaks to the optional
    -- stanzas in the next pass.
    --
    pruneOptionalDependencies :: ElaboratedConfiguredPackage -> [UnitId]
    pruneOptionalDependencies :: ElaboratedConfiguredPackage -> [UnitId]
pruneOptionalDependencies elab :: ElaboratedConfiguredPackage
elab@ElaboratedConfiguredPackage{ elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabComponent ElaboratedComponent
_ }
        = forall a. IsUnit a => a -> [UnitId]
InstallPlan.depends ElaboratedConfiguredPackage
elab -- no pruning
    pruneOptionalDependencies ElaboratedConfiguredPackage{ elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabPackage ElaboratedPackage
pkg }
        = (forall a. Monoid a => ComponentDeps a -> a
CD.flatDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Component -> a -> Bool) -> ComponentDeps a -> ComponentDeps a
CD.filterDeps forall {p}. Component -> p -> Bool
keepNeeded) (ElaboratedPackage -> ComponentDeps [UnitId]
pkgOrderDependencies ElaboratedPackage
pkg)
      where
        keepNeeded :: Component -> p -> Bool
keepNeeded (CD.ComponentTest  UnqualComponentName
_) p
_ = OptionalStanza
TestStanzas  OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` OptionalStanzaSet
stanzas
        keepNeeded (CD.ComponentBench UnqualComponentName
_) p
_ = OptionalStanza
BenchStanzas OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` OptionalStanzaSet
stanzas
        keepNeeded Component
_                     p
_ = Bool
True
        stanzas :: OptionalStanzaSet
stanzas = ElaboratedPackage -> OptionalStanzaSet
pkgStanzasEnabled ElaboratedPackage
pkg

    optionalStanzasRequiredByTargets :: ElaboratedConfiguredPackage
                                     -> OptionalStanzaSet
    optionalStanzasRequiredByTargets :: ElaboratedConfiguredPackage -> OptionalStanzaSet
optionalStanzasRequiredByTargets ElaboratedConfiguredPackage
pkg =
      [OptionalStanza] -> OptionalStanzaSet
optStanzaSetFromList
        [ OptionalStanza
stanza
        | ComponentTarget ComponentName
cname SubComponentTarget
_ <- ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
pkg
                                  forall a. [a] -> [a] -> [a]
++ ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
pkg
                                  forall a. [a] -> [a] -> [a]
++ ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
pkg
                                  forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList (ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabReplTarget ElaboratedConfiguredPackage
pkg)
                                  forall a. [a] -> [a] -> [a]
++ ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets ElaboratedConfiguredPackage
pkg
        , OptionalStanza
stanza <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$
                    Component -> Maybe OptionalStanza
componentOptionalStanza forall a b. (a -> b) -> a -> b
$
                    ComponentName -> Component
CD.componentNameToComponent ComponentName
cname
        ]

    availablePkgs :: Set UnitId
availablePkgs =
      forall a. Ord a => [a] -> Set a
Set.fromList
        [ forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
pkg
        | InstallPlan.PreExisting InstalledPackageInfo
pkg <- [ElaboratedPlanPackage]
pkgs ]

-- | Given a set of already installed packages @availablePkgs@,
-- determine the set of available optional stanzas from @pkg@
-- which have all of their dependencies already installed.  This is used
-- to implement "sticky" testsuites, where once we have installed
-- all of the deps needed for the test suite, we go ahead and
-- enable it always.
optionalStanzasWithDepsAvailable :: Set UnitId
                                 -> ElaboratedConfiguredPackage
                                 -> ElaboratedPackage
                                 -> OptionalStanzaSet
optionalStanzasWithDepsAvailable :: Set UnitId
-> ElaboratedConfiguredPackage
-> ElaboratedPackage
-> OptionalStanzaSet
optionalStanzasWithDepsAvailable Set UnitId
availablePkgs ElaboratedConfiguredPackage
elab ElaboratedPackage
pkg =
    [OptionalStanza] -> OptionalStanzaSet
optStanzaSetFromList
      [ OptionalStanza
stanza
      | OptionalStanza
stanza <- OptionalStanzaSet -> [OptionalStanza]
optStanzaSetToList (ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasAvailable ElaboratedConfiguredPackage
elab)
      , let deps :: [UnitId]
            deps :: [UnitId]
deps = forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
CD.select (OptionalStanza -> Component -> Bool
optionalStanzaDeps OptionalStanza
stanza)
                             -- TODO: probably need to select other
                             -- dep types too eventually
                             (ElaboratedPackage -> ComponentDeps [UnitId]
pkgOrderDependencies ElaboratedPackage
pkg)
      , forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnitId
availablePkgs) [UnitId]
deps
      ]
  where
    optionalStanzaDeps :: OptionalStanza -> Component -> Bool
optionalStanzaDeps OptionalStanza
TestStanzas  (CD.ComponentTest  UnqualComponentName
_) = Bool
True
    optionalStanzaDeps OptionalStanza
BenchStanzas (CD.ComponentBench UnqualComponentName
_) = Bool
True
    optionalStanzaDeps OptionalStanza
_            Component
_                     = Bool
False


-- The second pass does three things:
--
-- * A second go at deciding which optional stanzas to enable.
-- * Prune the dependencies based on the final choice of optional stanzas.
-- * Extend the targets within each package to build, now we know the reverse
--   dependencies, ie we know which libs are needed as deps by other packages.
--
-- Achieving sticky behaviour with enabling\/disabling optional stanzas is
-- tricky. The first approximation was handled by the first pass above, but
-- it's not quite enough. That pass will enable stanzas if all of the deps
-- of the optional stanza are already installed /in the store/. That's important
-- but it does not account for dependencies that get built inplace as part of
-- the project. We cannot take those inplace build deps into account in the
-- pruning pass however because we don't yet know which ones we're going to
-- build. Once we do know, we can have another go and enable stanzas that have
-- all their deps available. Now we can consider all packages in the pruned
-- plan to be available, including ones we already decided to build from
-- source.
--
-- Deciding which targets to build depends on knowing which packages have
-- reverse dependencies (ie are needed). This requires the result of first
-- pass, which is another reason we have to split it into two passes.
--
-- Note that just because we might enable testsuites or benchmarks (in the
-- first or second pass) doesn't mean that we build all (or even any) of them.
-- That depends on which targets we picked in the first pass.
--
pruneInstallPlanPass2 :: [ElaboratedPlanPackage]
                      -> [ElaboratedPlanPackage]
pruneInstallPlanPass2 :: [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
pruneInstallPlanPass2 [ElaboratedPlanPackage]
pkgs =
    forall a b. (a -> b) -> [a] -> [b]
map (forall srcpkg srcpkg' ipkg.
(srcpkg -> srcpkg')
-> GenericPlanPackage ipkg srcpkg
-> GenericPlanPackage ipkg srcpkg'
mapConfiguredPackage ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
setStanzasDepsAndTargets) [ElaboratedPlanPackage]
pkgs
  where
    setStanzasDepsAndTargets :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
setStanzasDepsAndTargets ElaboratedConfiguredPackage
elab =
        ElaboratedConfiguredPackage
elab {
          elabBuildTargets :: [ComponentTarget]
elabBuildTargets = forall a. Ord a => [a] -> [a]
ordNub
                           forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab
                          forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
libTargetsRequiredForRevDeps
                          forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
exeTargetsRequiredForRevDeps,
          elabPkgOrComp :: ElaboratedPackageOrComponent
elabPkgOrComp =
            case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
              ElabPackage ElaboratedPackage
pkg ->
                let stanzas :: OptionalStanzaSet
stanzas = ElaboratedPackage -> OptionalStanzaSet
pkgStanzasEnabled ElaboratedPackage
pkg
                           forall a. Semigroup a => a -> a -> a
<> Set UnitId
-> ElaboratedConfiguredPackage
-> ElaboratedPackage
-> OptionalStanzaSet
optionalStanzasWithDepsAvailable Set UnitId
availablePkgs ElaboratedConfiguredPackage
elab ElaboratedPackage
pkg
                    keepNeeded :: Component -> p -> Bool
keepNeeded (CD.ComponentTest  UnqualComponentName
_) p
_ = OptionalStanza
TestStanzas  OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` OptionalStanzaSet
stanzas
                    keepNeeded (CD.ComponentBench UnqualComponentName
_) p
_ = OptionalStanza
BenchStanzas OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` OptionalStanzaSet
stanzas
                    keepNeeded Component
_                     p
_ = Bool
True
                in ElaboratedPackage -> ElaboratedPackageOrComponent
ElabPackage forall a b. (a -> b) -> a -> b
$ ElaboratedPackage
pkg {
                  pkgStanzasEnabled :: OptionalStanzaSet
pkgStanzasEnabled = OptionalStanzaSet
stanzas,
                  pkgLibDependencies :: ComponentDeps [ConfiguredId]
pkgLibDependencies   = forall a.
(Component -> a -> Bool) -> ComponentDeps a -> ComponentDeps a
CD.filterDeps forall {p}. Component -> p -> Bool
keepNeeded (ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgLibDependencies ElaboratedPackage
pkg),
                  pkgExeDependencies :: ComponentDeps [ConfiguredId]
pkgExeDependencies   = forall a.
(Component -> a -> Bool) -> ComponentDeps a -> ComponentDeps a
CD.filterDeps forall {p}. Component -> p -> Bool
keepNeeded (ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgExeDependencies ElaboratedPackage
pkg),
                  pkgExeDependencyPaths :: ComponentDeps [(ConfiguredId, String)]
pkgExeDependencyPaths = forall a.
(Component -> a -> Bool) -> ComponentDeps a -> ComponentDeps a
CD.filterDeps forall {p}. Component -> p -> Bool
keepNeeded (ElaboratedPackage -> ComponentDeps [(ConfiguredId, String)]
pkgExeDependencyPaths ElaboratedPackage
pkg)
                }
              r :: ElaboratedPackageOrComponent
r@(ElabComponent ElaboratedComponent
_) -> ElaboratedPackageOrComponent
r
        }
      where
        libTargetsRequiredForRevDeps :: [ComponentTarget]
libTargetsRequiredForRevDeps =
          [ ComponentName -> SubComponentTarget -> ComponentTarget
ComponentTarget (LibraryName -> ComponentName
CLibName LibraryName
Cabal.defaultLibName) SubComponentTarget
WholeComponent
          | forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnitId
hasReverseLibDeps
          ]
        exeTargetsRequiredForRevDeps :: [ComponentTarget]
exeTargetsRequiredForRevDeps =
          -- TODO: allow requesting executable with different name
          -- than package name
          [ ComponentName -> SubComponentTarget -> ComponentTarget
ComponentTarget (UnqualComponentName -> ComponentName
Cabal.CExeName
                             forall a b. (a -> b) -> a -> b
$ PackageName -> UnqualComponentName
packageNameToUnqualComponentName
                             forall a b. (a -> b) -> a -> b
$ forall pkg. Package pkg => pkg -> PackageName
packageName forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId ElaboratedConfiguredPackage
elab)
                            SubComponentTarget
WholeComponent
          | forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnitId
hasReverseExeDeps
          ]


    availablePkgs :: Set UnitId
    availablePkgs :: Set UnitId
availablePkgs = forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId [ElaboratedPlanPackage]
pkgs)

    hasReverseLibDeps :: Set UnitId
    hasReverseLibDeps :: Set UnitId
hasReverseLibDeps =
      forall a. Ord a => [a] -> Set a
Set.fromList [ UnitId
depid
                   | InstallPlan.Configured ElaboratedConfiguredPackage
pkg <- [ElaboratedPlanPackage]
pkgs
                   , UnitId
depid <- ElaboratedConfiguredPackage -> [UnitId]
elabOrderLibDependencies ElaboratedConfiguredPackage
pkg ]

    hasReverseExeDeps :: Set UnitId
    hasReverseExeDeps :: Set UnitId
hasReverseExeDeps =
      forall a. Ord a => [a] -> Set a
Set.fromList [ UnitId
depid
                   | InstallPlan.Configured ElaboratedConfiguredPackage
pkg <- [ElaboratedPlanPackage]
pkgs
                   , UnitId
depid <- ElaboratedConfiguredPackage -> [UnitId]
elabOrderExeDependencies ElaboratedConfiguredPackage
pkg ]

mapConfiguredPackage :: (srcpkg -> srcpkg')
                     -> InstallPlan.GenericPlanPackage ipkg srcpkg
                     -> InstallPlan.GenericPlanPackage ipkg srcpkg'
mapConfiguredPackage :: forall srcpkg srcpkg' ipkg.
(srcpkg -> srcpkg')
-> GenericPlanPackage ipkg srcpkg
-> GenericPlanPackage ipkg srcpkg'
mapConfiguredPackage srcpkg -> srcpkg'
f (InstallPlan.Configured srcpkg
pkg) =
  forall ipkg srcpkg. srcpkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.Configured (srcpkg -> srcpkg'
f srcpkg
pkg)
mapConfiguredPackage srcpkg -> srcpkg'
f (InstallPlan.Installed srcpkg
pkg) =
  forall ipkg srcpkg. srcpkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.Installed (srcpkg -> srcpkg'
f srcpkg
pkg)
mapConfiguredPackage srcpkg -> srcpkg'
_ (InstallPlan.PreExisting ipkg
pkg) =
  forall ipkg srcpkg. ipkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.PreExisting ipkg
pkg

------------------------------------
-- Support for --only-dependencies
--

-- | Try to remove the given targets from the install plan.
--
-- This is not always possible.
--
pruneInstallPlanToDependencies :: Set UnitId
                               -> ElaboratedInstallPlan
                               -> Either CannotPruneDependencies
                                         ElaboratedInstallPlan
pruneInstallPlanToDependencies :: Set UnitId
-> ElaboratedInstallPlan
-> Either CannotPruneDependencies ElaboratedInstallPlan
pruneInstallPlanToDependencies Set UnitId
pkgTargets ElaboratedInstallPlan
installPlan =
    forall a. HasCallStack => Bool -> a -> a
assert (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg
-> UnitId -> Maybe (GenericPlanPackage ipkg srcpkg)
InstallPlan.lookup ElaboratedInstallPlan
installPlan)
                (forall a. Set a -> [a]
Set.toList Set UnitId
pkgTargets)) forall a b. (a -> b) -> a -> b
$

    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
IndependentGoals
-> Graph (GenericPlanPackage ipkg srcpkg)
-> GenericInstallPlan ipkg srcpkg
InstallPlan.new (forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> IndependentGoals
InstallPlan.planIndepGoals ElaboratedInstallPlan
installPlan))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph ElaboratedPlanPackage
-> Either CannotPruneDependencies (Graph ElaboratedPlanPackage)
checkBrokenDeps
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\ElaboratedPlanPackage
pkg -> forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedPlanPackage
pkg forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set UnitId
pkgTargets)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList
  forall a b. (a -> b) -> a -> b
$ ElaboratedInstallPlan
installPlan
    where
      -- Our strategy is to remove the packages we don't want and then check
      -- if the remaining graph is broken or not, ie any packages with dangling
      -- dependencies. If there are then we cannot prune the given targets.
      checkBrokenDeps :: Graph.Graph ElaboratedPlanPackage
                      -> Either CannotPruneDependencies
                                (Graph.Graph ElaboratedPlanPackage)
      checkBrokenDeps :: Graph ElaboratedPlanPackage
-> Either CannotPruneDependencies (Graph ElaboratedPlanPackage)
checkBrokenDeps Graph ElaboratedPlanPackage
graph =
        case forall a. Graph a -> [(a, [Key a])]
Graph.broken Graph ElaboratedPlanPackage
graph of
          []             -> forall a b. b -> Either a b
Right Graph ElaboratedPlanPackage
graph
          [(ElaboratedPlanPackage, [Key ElaboratedPlanPackage])]
brokenPackages ->
            forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [(ElaboratedPlanPackage, [ElaboratedPlanPackage])]
-> CannotPruneDependencies
CannotPruneDependencies
             [ (ElaboratedPlanPackage
pkg, [ElaboratedPlanPackage]
missingDeps)
             | (ElaboratedPlanPackage
pkg, [UnitId]
missingDepIds) <- [(ElaboratedPlanPackage, [Key ElaboratedPlanPackage])]
brokenPackages
             , let missingDeps :: [ElaboratedPlanPackage]
missingDeps = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe UnitId -> Maybe ElaboratedPlanPackage
lookupDep [UnitId]
missingDepIds
             ]
            where
              -- lookup in the original unpruned graph
              lookupDep :: UnitId -> Maybe ElaboratedPlanPackage
lookupDep = forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg
-> UnitId -> Maybe (GenericPlanPackage ipkg srcpkg)
InstallPlan.lookup ElaboratedInstallPlan
installPlan

-- | It is not always possible to prune to only the dependencies of a set of
-- targets. It may be the case that removing a package leaves something else
-- that still needed the pruned package.
--
-- This lists all the packages that would be broken, and their dependencies
-- that would be missing if we did prune.
--
newtype CannotPruneDependencies =
        CannotPruneDependencies [(ElaboratedPlanPackage,
                                  [ElaboratedPlanPackage])]
  deriving (Int -> CannotPruneDependencies -> String -> String
[CannotPruneDependencies] -> String -> String
CannotPruneDependencies -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CannotPruneDependencies] -> String -> String
$cshowList :: [CannotPruneDependencies] -> String -> String
show :: CannotPruneDependencies -> String
$cshow :: CannotPruneDependencies -> String
showsPrec :: Int -> CannotPruneDependencies -> String -> String
$cshowsPrec :: Int -> CannotPruneDependencies -> String -> String
Show)


---------------------------
-- Setup.hs script policy
--

-- Handling for Setup.hs scripts is a bit tricky, part of it lives in the
-- solver phase, and part in the elaboration phase. We keep the helper
-- functions for both phases together here so at least you can see all of it
-- in one place.
--
-- There are four major cases for Setup.hs handling:
--
--  1. @build-type@ Custom with a @custom-setup@ section
--  2. @build-type@ Custom without a @custom-setup@ section
--  3. @build-type@ not Custom with @cabal-version >  $our-cabal-version@
--  4. @build-type@ not Custom with @cabal-version <= $our-cabal-version@
--
-- It's also worth noting that packages specifying @cabal-version: >= 1.23@
-- or later that have @build-type@ Custom will always have a @custom-setup@
-- section. Therefore in case 2, the specified @cabal-version@ will always be
-- less than 1.23.
--
-- In cases 1 and 2 we obviously have to build an external Setup.hs script,
-- while in case 4 we can use the internal library API.
--
-- TODO:In case 3 we should fail. We don't know how to talk to
-- newer ./Setup.hs
--
-- data SetupScriptStyle = ...  -- see ProjectPlanning.Types

-- | Work out the 'SetupScriptStyle' given the package description.
--
packageSetupScriptStyle :: PD.PackageDescription -> SetupScriptStyle
packageSetupScriptStyle :: PackageDescription -> SetupScriptStyle
packageSetupScriptStyle PackageDescription
pkg
  | BuildType
buildType forall a. Eq a => a -> a -> Bool
== BuildType
PD.Custom
  , Just SetupBuildInfo
setupbi <- PackageDescription -> Maybe SetupBuildInfo
PD.setupBuildInfo PackageDescription
pkg -- does have a custom-setup stanza
  , Bool -> Bool
not (SetupBuildInfo -> Bool
PD.defaultSetupDepends SetupBuildInfo
setupbi)  -- but not one we added internally
  = SetupScriptStyle
SetupCustomExplicitDeps

  | BuildType
buildType forall a. Eq a => a -> a -> Bool
== BuildType
PD.Custom
  , Just SetupBuildInfo
setupbi <- PackageDescription -> Maybe SetupBuildInfo
PD.setupBuildInfo PackageDescription
pkg -- we get this case post-solver as
  , SetupBuildInfo -> Bool
PD.defaultSetupDepends SetupBuildInfo
setupbi        -- the solver fills in the deps
  = SetupScriptStyle
SetupCustomImplicitDeps

  | BuildType
buildType forall a. Eq a => a -> a -> Bool
== BuildType
PD.Custom
  , Maybe SetupBuildInfo
Nothing <- PackageDescription -> Maybe SetupBuildInfo
PD.setupBuildInfo PackageDescription
pkg      -- we get this case pre-solver
  = SetupScriptStyle
SetupCustomImplicitDeps

  -- here we should fail.
  | PackageDescription -> CabalSpecVersion
PD.specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
> CabalSpecVersion
cabalSpecLatest  -- one cabal-install is built against
  = SetupScriptStyle
SetupNonCustomExternalLib

  | Bool
otherwise
  = SetupScriptStyle
SetupNonCustomInternalLib
  where
    buildType :: BuildType
buildType = PackageDescription -> BuildType
PD.buildType PackageDescription
pkg


-- | Part of our Setup.hs handling policy is implemented by getting the solver
-- to work out setup dependencies for packages. The solver already handles
-- packages that explicitly specify setup dependencies, but we can also tell
-- the solver to treat other packages as if they had setup dependencies.
-- That's what this function does, it gets called by the solver for all
-- packages that don't already have setup dependencies.
--
-- The dependencies we want to add is different for each 'SetupScriptStyle'.
--
-- Note that adding default deps means these deps are actually /added/ to the
-- packages that we get out of the solver in the 'SolverInstallPlan'. Making
-- implicit setup deps explicit is a problem in the post-solver stages because
-- we still need to distinguish the case of explicit and implicit setup deps.
-- See 'rememberImplicitSetupDeps'.
--
-- Note in addition to adding default setup deps, we also use
-- 'addSetupCabalMinVersionConstraint' (in 'planPackages') to require
-- @Cabal >= 1.20@ for Setup scripts.
--
defaultSetupDeps :: Compiler -> Platform
                 -> PD.PackageDescription
                 -> Maybe [Dependency]
defaultSetupDeps :: Compiler -> Platform -> PackageDescription -> Maybe [Dependency]
defaultSetupDeps Compiler
compiler Platform
platform PackageDescription
pkg =
    case PackageDescription -> SetupScriptStyle
packageSetupScriptStyle PackageDescription
pkg of

      -- For packages with build type custom that do not specify explicit
      -- setup dependencies, we add a dependency on Cabal and a number
      -- of other packages.
      SetupScriptStyle
SetupCustomImplicitDeps ->
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
depPkgname VersionRange
anyVersion NonEmptySet LibraryName
mainLibSet
        | PackageName
depPkgname <- Compiler -> Platform -> [PackageName]
legacyCustomSetupPkgs Compiler
compiler Platform
platform ] forall a. [a] -> [a] -> [a]
++
        [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
cabalPkgname VersionRange
cabalConstraint NonEmptySet LibraryName
mainLibSet
        | forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg forall a. Eq a => a -> a -> Bool
/= PackageName
cabalPkgname ]
        where
          -- The Cabal dep is slightly special:
          -- * We omit the dep for the Cabal lib itself, since it bootstraps.
          -- * We constrain it to be < 1.25
          --
          -- Note: we also add a global constraint to require Cabal >= 1.20
          -- for Setup scripts (see use addSetupCabalMinVersionConstraint).
          --
          cabalConstraint :: VersionRange
cabalConstraint   = Version -> VersionRange
orLaterVersion (CabalSpecVersion -> Version
csvToVersion (PackageDescription -> CabalSpecVersion
PD.specVersion PackageDescription
pkg))
                                VersionRange -> VersionRange -> VersionRange
`intersectVersionRanges`
                              Version -> VersionRange
earlierVersion Version
cabalCompatMaxVer
          -- The idea here is that at some point we will make significant
          -- breaking changes to the Cabal API that Setup.hs scripts use.
          -- So for old custom Setup scripts that do not specify explicit
          -- constraints, we constrain them to use a compatible Cabal version.
          cabalCompatMaxVer :: Version
cabalCompatMaxVer = [Int] -> Version
mkVersion [Int
1,Int
25]

      -- For other build types (like Simple) if we still need to compile an
      -- external Setup.hs, it'll be one of the simple ones that only depends
      -- on Cabal and base.
      SetupScriptStyle
SetupNonCustomExternalLib ->
        forall a. a -> Maybe a
Just [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
cabalPkgname VersionRange
cabalConstraint NonEmptySet LibraryName
mainLibSet
             , PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
basePkgname  VersionRange
anyVersion NonEmptySet LibraryName
mainLibSet]
        where
          cabalConstraint :: VersionRange
cabalConstraint = Version -> VersionRange
orLaterVersion (CabalSpecVersion -> Version
csvToVersion (PackageDescription -> CabalSpecVersion
PD.specVersion PackageDescription
pkg))

      -- The internal setup wrapper method has no deps at all.
      SetupScriptStyle
SetupNonCustomInternalLib -> forall a. a -> Maybe a
Just []

      -- This case gets ruled out by the caller, planPackages, see the note
      -- above in the SetupCustomImplicitDeps case.
      SetupScriptStyle
SetupCustomExplicitDeps ->
        forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"defaultSetupDeps: called for a package with explicit "
             forall a. [a] -> [a] -> [a]
++ String
"setup deps: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg)
  where
    -- we require one less
    --
    -- This maps e.g. CabalSpecV3_0 to mkVersion [2,5]
    csvToVersion :: CabalSpecVersion -> Version
    csvToVersion :: CabalSpecVersion -> Version
csvToVersion = [Int] -> Version
mkVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion -> [Int]
cabalSpecMinimumLibraryVersion

-- | Work out which version of the Cabal we will be using to talk to the
-- Setup.hs interface for this package.
--
-- This depends somewhat on the 'SetupScriptStyle' but most cases are a result
-- of what the solver picked for us, based on the explicit setup deps or the
-- ones added implicitly by 'defaultSetupDeps'.
--
packageSetupScriptSpecVersion :: SetupScriptStyle
                              -> PD.PackageDescription
                              -> Graph.Graph NonSetupLibDepSolverPlanPackage
                              -> ComponentDeps [SolverId]
                              -> Version

-- We're going to be using the internal Cabal library, so the spec version of
-- that is simply the version of the Cabal library that cabal-install has been
-- built with.
packageSetupScriptSpecVersion :: SetupScriptStyle
-> PackageDescription
-> Graph NonSetupLibDepSolverPlanPackage
-> ComponentDeps [SolverId]
-> Version
packageSetupScriptSpecVersion SetupScriptStyle
SetupNonCustomInternalLib PackageDescription
_ Graph NonSetupLibDepSolverPlanPackage
_ ComponentDeps [SolverId]
_ =
    Version
cabalVersion

-- If we happen to be building the Cabal lib itself then because that
-- bootstraps itself then we use the version of the lib we're building.
packageSetupScriptSpecVersion SetupScriptStyle
SetupCustomImplicitDeps PackageDescription
pkg Graph NonSetupLibDepSolverPlanPackage
_ ComponentDeps [SolverId]
_
  | forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg forall a. Eq a => a -> a -> Bool
== PackageName
cabalPkgname
  = forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg

-- In all other cases we have a look at what version of the Cabal lib the
-- solver picked. Or if it didn't depend on Cabal at all (which is very rare)
-- then we look at the .cabal file to see what spec version it declares.
packageSetupScriptSpecVersion SetupScriptStyle
_ PackageDescription
pkg Graph NonSetupLibDepSolverPlanPackage
libDepGraph ComponentDeps [SolverId]
deps =
    case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((PackageName
cabalPkgname forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName) [PackageIdentifier]
setupLibDeps of
      Just PackageIdentifier
dep -> forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
dep
      Maybe PackageIdentifier
Nothing  -> [Int] -> Version
mkVersion (CabalSpecVersion -> [Int]
cabalSpecMinimumLibraryVersion (PackageDescription -> CabalSpecVersion
PD.specVersion PackageDescription
pkg))
  where
    setupLibDeps :: [PackageIdentifier]
setupLibDeps = forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> PackageIdentifier
packageId forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$
                   forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure Graph NonSetupLibDepSolverPlanPackage
libDepGraph (forall a. Monoid a => ComponentDeps a -> a
CD.setupDeps ComponentDeps [SolverId]
deps)


cabalPkgname, basePkgname :: PackageName
cabalPkgname :: PackageName
cabalPkgname = String -> PackageName
mkPackageName String
"Cabal"
basePkgname :: PackageName
basePkgname  = String -> PackageName
mkPackageName String
"base"


legacyCustomSetupPkgs :: Compiler -> Platform -> [PackageName]
legacyCustomSetupPkgs :: Compiler -> Platform -> [PackageName]
legacyCustomSetupPkgs Compiler
compiler (Platform Arch
_ OS
os) =
    forall a b. (a -> b) -> [a] -> [b]
map String -> PackageName
mkPackageName forall a b. (a -> b) -> a -> b
$
        [ String
"array", String
"base", String
"binary", String
"bytestring", String
"containers"
        , String
"deepseq", String
"directory", String
"filepath", String
"pretty"
        , String
"process", String
"time", String
"transformers" ]
     forall a. [a] -> [a] -> [a]
++ [ String
"Win32" | OS
os forall a. Eq a => a -> a -> Bool
== OS
Windows ]
     forall a. [a] -> [a] -> [a]
++ [ String
"unix"  | OS
os forall a. Eq a => a -> a -> Bool
/= OS
Windows ]
     forall a. [a] -> [a] -> [a]
++ [ String
"ghc-prim"         | Bool
isGHC ]
     forall a. [a] -> [a] -> [a]
++ [ String
"template-haskell" | Bool
isGHC ]
     forall a. [a] -> [a] -> [a]
++ [ String
"old-time" | Bool
notGHC710 ]
  where
    isGHC :: Bool
isGHC = CompilerFlavor -> Compiler -> Bool
compilerCompatFlavor CompilerFlavor
GHC Compiler
compiler
    notGHC710 :: Bool
notGHC710 = case CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
compiler of
        Maybe Version
Nothing -> Bool
False
        Just Version
v  -> Version
v forall a. Ord a => a -> a -> Bool
<= [Int] -> Version
mkVersion [Int
7,Int
9]

-- The other aspects of our Setup.hs policy lives here where we decide on
-- the 'SetupScriptOptions'.
--
-- Our current policy for the 'SetupCustomImplicitDeps' case is that we
-- try to make the implicit deps cover everything, and we don't allow the
-- compiler to pick up other deps. This may or may not be sustainable, and
-- we might have to allow the deps to be non-exclusive, but that itself would
-- be tricky since we would have to allow the Setup access to all the packages
-- in the store and local dbs.

setupHsScriptOptions :: ElaboratedReadyPackage
                     -> ElaboratedInstallPlan
                     -> ElaboratedSharedConfig
                     -> DistDirLayout
                     -> FilePath
                     -> FilePath
                     -> Bool
                     -> Lock
                     -> SetupScriptOptions
-- TODO: Fix this so custom is a separate component.  Custom can ALWAYS
-- be a separate component!!!
setupHsScriptOptions :: ElaboratedReadyPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
-> String
-> String
-> Bool
-> Lock
-> SetupScriptOptions
setupHsScriptOptions (ReadyPackage elab :: ElaboratedConfiguredPackage
elab@ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..})
                     ElaboratedInstallPlan
plan ElaboratedSharedConfig{Platform
ReplOptions
ProgramDb
Compiler
pkgConfigReplOptions :: ReplOptions
pkgConfigCompilerProgs :: ProgramDb
pkgConfigCompiler :: Compiler
pkgConfigPlatform :: Platform
pkgConfigReplOptions :: ElaboratedSharedConfig -> ReplOptions
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
..} DistDirLayout
distdir String
srcdir String
builddir
                     Bool
isParallelBuild Lock
cacheLock =
    SetupScriptOptions {
      useCabalVersion :: VersionRange
useCabalVersion          = Version -> VersionRange
thisVersion Version
elabSetupScriptCliVersion,
      useCabalSpecVersion :: Maybe Version
useCabalSpecVersion      = forall a. a -> Maybe a
Just Version
elabSetupScriptCliVersion,
      useCompiler :: Maybe Compiler
useCompiler              = forall a. a -> Maybe a
Just Compiler
pkgConfigCompiler,
      usePlatform :: Maybe Platform
usePlatform              = forall a. a -> Maybe a
Just Platform
pkgConfigPlatform,
      usePackageDB :: PackageDBStack
usePackageDB             = PackageDBStack
elabSetupPackageDBStack,
      usePackageIndex :: Maybe InstalledPackageIndex
usePackageIndex          = forall a. Maybe a
Nothing,
      useDependencies :: [(InstalledPackageId, PackageIdentifier)]
useDependencies          = [ (InstalledPackageId
uid, PackageIdentifier
srcid)
                                 | ConfiguredId PackageIdentifier
srcid (Just (CLibName LibraryName
LMainLibName)) InstalledPackageId
uid
                                 <- ElaboratedConfiguredPackage -> [ConfiguredId]
elabSetupDependencies ElaboratedConfiguredPackage
elab ],
      useDependenciesExclusive :: Bool
useDependenciesExclusive = Bool
True,
      useVersionMacros :: Bool
useVersionMacros         = SetupScriptStyle
elabSetupScriptStyle forall a. Eq a => a -> a -> Bool
== SetupScriptStyle
SetupCustomExplicitDeps,
      useProgramDb :: ProgramDb
useProgramDb             = ProgramDb
pkgConfigCompilerProgs,
      useDistPref :: String
useDistPref              = String
builddir,
      useLoggingHandle :: Maybe Handle
useLoggingHandle         = forall a. Maybe a
Nothing, -- this gets set later
      useWorkingDir :: Maybe String
useWorkingDir            = forall a. a -> Maybe a
Just String
srcdir,
      useExtraPathEnv :: [String]
useExtraPathEnv          = ElaboratedConfiguredPackage -> [String]
elabExeDependencyPaths ElaboratedConfiguredPackage
elab,
      useExtraEnvOverrides :: [(String, Maybe String)]
useExtraEnvOverrides     = DistDirLayout -> ElaboratedInstallPlan -> [(String, Maybe String)]
dataDirsEnvironmentForPlan DistDirLayout
distdir ElaboratedInstallPlan
plan,
      useWin32CleanHack :: Bool
useWin32CleanHack        = Bool
False,   --TODO: [required eventually]
      forceExternalSetupMethod :: Bool
forceExternalSetupMethod = Bool
isParallelBuild,
      setupCacheLock :: Maybe Lock
setupCacheLock           = forall a. a -> Maybe a
Just Lock
cacheLock,
      isInteractive :: Bool
isInteractive            = Bool
False
    }


-- | To be used for the input for elaborateInstallPlan.
--
-- TODO: [code cleanup] make InstallDirs.defaultInstallDirs pure.
--
userInstallDirTemplates :: Compiler
                        -> IO InstallDirs.InstallDirTemplates
userInstallDirTemplates :: Compiler -> IO InstallDirTemplates
userInstallDirTemplates Compiler
compiler = do
    CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
InstallDirs.defaultInstallDirs
                  (Compiler -> CompilerFlavor
compilerFlavor Compiler
compiler)
                  Bool
True  -- user install
                  Bool
False -- unused

storePackageInstallDirs :: StoreDirLayout
                        -> CompilerId
                        -> InstalledPackageId
                        -> InstallDirs.InstallDirs FilePath
storePackageInstallDirs :: StoreDirLayout
-> CompilerId -> InstalledPackageId -> InstallDirs String
storePackageInstallDirs StoreDirLayout
storeDirLayout CompilerId
compid InstalledPackageId
ipkgid =
  StoreDirLayout -> CompilerId -> UnitId -> InstallDirs String
storePackageInstallDirs' StoreDirLayout
storeDirLayout CompilerId
compid forall a b. (a -> b) -> a -> b
$ InstalledPackageId -> UnitId
newSimpleUnitId InstalledPackageId
ipkgid

storePackageInstallDirs' :: StoreDirLayout
                         -> CompilerId
                         -> UnitId
                         -> InstallDirs.InstallDirs FilePath
storePackageInstallDirs' :: StoreDirLayout -> CompilerId -> UnitId -> InstallDirs String
storePackageInstallDirs' StoreDirLayout{ CompilerId -> UnitId -> String
storePackageDirectory :: StoreDirLayout -> CompilerId -> UnitId -> String
storePackageDirectory :: CompilerId -> UnitId -> String
storePackageDirectory
                                       , CompilerId -> String
storeDirectory :: StoreDirLayout -> CompilerId -> String
storeDirectory :: CompilerId -> String
storeDirectory }
                         CompilerId
compid UnitId
unitid =
    InstallDirs.InstallDirs {String
prefix :: String
bindir :: String
libdir :: String
libsubdir :: String
dynlibdir :: String
flibdir :: String
libexecdir :: String
libexecsubdir :: String
includedir :: String
datadir :: String
datasubdir :: String
docdir :: String
mandir :: String
htmldir :: String
haddockdir :: String
sysconfdir :: String
sysconfdir :: String
haddockdir :: String
htmldir :: String
mandir :: String
docdir :: String
datasubdir :: String
datadir :: String
includedir :: String
libexecsubdir :: String
libexecdir :: String
flibdir :: String
dynlibdir :: String
libsubdir :: String
libdir :: String
bindir :: String
prefix :: String
..}
  where
    store :: String
store        = CompilerId -> String
storeDirectory CompilerId
compid
    prefix :: String
prefix       = CompilerId -> UnitId -> String
storePackageDirectory CompilerId
compid UnitId
unitid
    bindir :: String
bindir       = String
prefix String -> String -> String
</> String
"bin"
    libdir :: String
libdir       = String
prefix String -> String -> String
</> String
"lib"
    libsubdir :: String
libsubdir    = String
""
    -- Note: on macOS, we place libraries into
    --       @store/lib@ to work around the load
    --       command size limit of macOSs mach-o linker.
    --       See also @PackageHash.hashedInstalledPackageIdVeryShort@
    dynlibdir :: String
dynlibdir    | OS
buildOS forall a. Eq a => a -> a -> Bool
== OS
OSX = String
store String -> String -> String
</> String
"lib"
                 | Bool
otherwise      = String
libdir
    flibdir :: String
flibdir      = String
libdir
    libexecdir :: String
libexecdir   = String
prefix String -> String -> String
</> String
"libexec"
    libexecsubdir :: String
libexecsubdir= String
""
    includedir :: String
includedir   = String
libdir String -> String -> String
</> String
"include"
    datadir :: String
datadir      = String
prefix String -> String -> String
</> String
"share"
    datasubdir :: String
datasubdir   = String
""
    docdir :: String
docdir       = String
datadir String -> String -> String
</> String
"doc"
    mandir :: String
mandir       = String
datadir String -> String -> String
</> String
"man"
    htmldir :: String
htmldir      = String
docdir  String -> String -> String
</> String
"html"
    haddockdir :: String
haddockdir   = String
htmldir
    sysconfdir :: String
sysconfdir   = String
prefix String -> String -> String
</> String
"etc"


computeInstallDirs :: StoreDirLayout
                   -> InstallDirs.InstallDirTemplates
                   -> ElaboratedSharedConfig
                   -> ElaboratedConfiguredPackage
                   -> InstallDirs.InstallDirs FilePath
computeInstallDirs :: StoreDirLayout
-> InstallDirTemplates
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> InstallDirs String
computeInstallDirs StoreDirLayout
storeDirLayout InstallDirTemplates
defaultInstallDirs ElaboratedSharedConfig
elaboratedShared ElaboratedConfiguredPackage
elab
  | ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly
  -- use the ordinary default install dirs
  = (PackageIdentifier
-> UnitId
-> CompilerInfo
-> CopyDest
-> Platform
-> InstallDirTemplates
-> InstallDirs String
InstallDirs.absoluteInstallDirs
       (ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId ElaboratedConfiguredPackage
elab)
       (ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
elab)
       (Compiler -> CompilerInfo
compilerInfo (ElaboratedSharedConfig -> Compiler
pkgConfigCompiler ElaboratedSharedConfig
elaboratedShared))
       CopyDest
InstallDirs.NoCopyDest
       (ElaboratedSharedConfig -> Platform
pkgConfigPlatform ElaboratedSharedConfig
elaboratedShared)
       InstallDirTemplates
defaultInstallDirs) {

      -- absoluteInstallDirs sets these as 'undefined' but we have
      -- to use them as "Setup.hs configure" args
      libsubdir :: String
InstallDirs.libsubdir  = String
"",
      libexecsubdir :: String
InstallDirs.libexecsubdir  = String
"",
      datasubdir :: String
InstallDirs.datasubdir = String
""
    }

  | Bool
otherwise
  -- use special simplified install dirs
  = StoreDirLayout -> CompilerId -> UnitId -> InstallDirs String
storePackageInstallDirs'
      StoreDirLayout
storeDirLayout
      (Compiler -> CompilerId
compilerId (ElaboratedSharedConfig -> Compiler
pkgConfigCompiler ElaboratedSharedConfig
elaboratedShared))
      (ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
elab)


--TODO: [code cleanup] perhaps reorder this code
-- based on the ElaboratedInstallPlan + ElaboratedSharedConfig,
-- make the various Setup.hs {configure,build,copy} flags


setupHsConfigureFlags :: ElaboratedReadyPackage
                      -> ElaboratedSharedConfig
                      -> Verbosity
                      -> FilePath
                      -> Cabal.ConfigFlags
setupHsConfigureFlags :: ElaboratedReadyPackage
-> ElaboratedSharedConfig -> Verbosity -> String -> ConfigFlags
setupHsConfigureFlags (ReadyPackage elab :: ElaboratedConfiguredPackage
elab@ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..})
                      sharedConfig :: ElaboratedSharedConfig
sharedConfig@ElaboratedSharedConfig{Platform
ReplOptions
ProgramDb
Compiler
pkgConfigReplOptions :: ReplOptions
pkgConfigCompilerProgs :: ProgramDb
pkgConfigCompiler :: Compiler
pkgConfigPlatform :: Platform
pkgConfigReplOptions :: ElaboratedSharedConfig -> ReplOptions
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
..}
                      Verbosity
verbosity String
builddir =
    forall a.
ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> a -> a
sanityCheckElaboratedConfiguredPackage ElaboratedSharedConfig
sharedConfig ElaboratedConfiguredPackage
elab
        (Cabal.ConfigFlags {[String]
[Maybe PackageDB]
[(String, String)]
[(String, [String])]
[(ModuleName, Module)]
[GivenComponent]
[PackageVersionConstraint]
NubList String
InstallDirs (Flag PathTemplate)
Flag Bool
Flag String
Flag CompilerFlavor
Flag InstalledPackageId
Flag OptimisationLevel
Flag DebugInfoLevel
Flag ProfDetailLevel
Flag Verbosity
Flag DumpBuildInfo
Flag PathTemplate
FlagAssignment
Option' (Last' ProgramDb)
configArgs :: [String]
configPrograms_ :: Option' (Last' ProgramDb)
configProgramPaths :: [(String, String)]
configProgramArgs :: [(String, [String])]
configProgramPathExtra :: NubList String
configHcFlavor :: Flag CompilerFlavor
configHcPath :: Flag String
configHcPkg :: Flag String
configVanillaLib :: Flag Bool
configProfLib :: Flag Bool
configSharedLib :: Flag Bool
configStaticLib :: Flag Bool
configDynExe :: Flag Bool
configFullyStaticExe :: Flag Bool
configProfExe :: Flag Bool
configProf :: Flag Bool
configProfDetail :: Flag ProfDetailLevel
configProfLibDetail :: Flag ProfDetailLevel
configConfigureArgs :: [String]
configOptimization :: Flag OptimisationLevel
configProgPrefix :: Flag PathTemplate
configProgSuffix :: Flag PathTemplate
configInstallDirs :: InstallDirs (Flag PathTemplate)
configScratchDir :: Flag String
configExtraLibDirs :: [String]
configExtraLibDirsStatic :: [String]
configExtraFrameworkDirs :: [String]
configExtraIncludeDirs :: [String]
configIPID :: Flag String
configCID :: Flag InstalledPackageId
configDeterministic :: Flag Bool
configDistPref :: Flag String
configCabalFilePath :: Flag String
configVerbosity :: Flag Verbosity
configUserInstall :: Flag Bool
configPackageDBs :: [Maybe PackageDB]
configGHCiLib :: Flag Bool
configSplitSections :: Flag Bool
configSplitObjs :: Flag Bool
configStripExes :: Flag Bool
configStripLibs :: Flag Bool
configConstraints :: [PackageVersionConstraint]
configDependencies :: [GivenComponent]
configInstantiateWith :: [(ModuleName, Module)]
configConfigurationsFlags :: FlagAssignment
configTests :: Flag Bool
configBenchmarks :: Flag Bool
configCoverage :: Flag Bool
configLibCoverage :: Flag Bool
configExactConfiguration :: Flag Bool
configFlagError :: Flag String
configRelocatable :: Flag Bool
configDebugInfo :: Flag DebugInfoLevel
configDumpBuildInfo :: Flag DumpBuildInfo
configUseResponseFiles :: Flag Bool
configAllowDependingOnPrivateLibs :: Flag Bool
configAllowDependingOnPrivateLibs :: Flag Bool
configUseResponseFiles :: Flag Bool
configPrograms_ :: Option' (Last' ProgramDb)
configUserInstall :: Flag Bool
configScratchDir :: Flag String
configRelocatable :: Flag Bool
configFlagError :: Flag String
configExactConfiguration :: Flag Bool
configBenchmarks :: Flag Bool
configTests :: Flag Bool
configPackageDBs :: [Maybe PackageDB]
configConstraints :: [PackageVersionConstraint]
configDependencies :: [GivenComponent]
configInstallDirs :: InstallDirs (Flag PathTemplate)
configProgSuffix :: Flag PathTemplate
configProgPrefix :: Flag PathTemplate
configExtraIncludeDirs :: [String]
configExtraFrameworkDirs :: [String]
configExtraLibDirsStatic :: [String]
configExtraLibDirs :: [String]
configConfigureArgs :: [String]
configConfigurationsFlags :: FlagAssignment
configDumpBuildInfo :: Flag DumpBuildInfo
configDebugInfo :: Flag DebugInfoLevel
configStripLibs :: Flag Bool
configStripExes :: Flag Bool
configSplitObjs :: Flag Bool
configSplitSections :: Flag Bool
configOptimization :: Flag OptimisationLevel
configLibCoverage :: Flag Bool
configCoverage :: Flag Bool
configProfLibDetail :: Flag ProfDetailLevel
configProfDetail :: Flag ProfDetailLevel
configProf :: Flag Bool
configProfLib :: Flag Bool
configProfExe :: Flag Bool
configGHCiLib :: Flag Bool
configFullyStaticExe :: Flag Bool
configDynExe :: Flag Bool
configStaticLib :: Flag Bool
configSharedLib :: Flag Bool
configVanillaLib :: Flag Bool
configHcPkg :: Flag String
configHcPath :: Flag String
configHcFlavor :: Flag CompilerFlavor
configProgramPathExtra :: NubList String
configProgramArgs :: [(String, [String])]
configProgramPaths :: [(String, String)]
configCID :: Flag InstalledPackageId
configIPID :: Flag String
configDeterministic :: Flag Bool
configInstantiateWith :: [(ModuleName, Module)]
configVerbosity :: Flag Verbosity
configCabalFilePath :: Flag String
configDistPref :: Flag String
configArgs :: [String]
..})
  where
    configArgs :: [String]
configArgs                = forall a. Monoid a => a
mempty -- unused, passed via args
    configDistPref :: Flag String
configDistPref            = forall a. a -> Flag a
toFlag String
builddir
    configCabalFilePath :: Flag String
configCabalFilePath       = forall a. Monoid a => a
mempty
    configVerbosity :: Flag Verbosity
configVerbosity           = forall a. a -> Flag a
toFlag Verbosity
verbosity

    configInstantiateWith :: [(ModuleName, Module)]
configInstantiateWith     = forall k a. Map k a -> [(k, a)]
Map.toList Map ModuleName Module
elabInstantiatedWith

    configDeterministic :: Flag Bool
configDeterministic       = forall a. Monoid a => a
mempty -- doesn't matter, configIPID/configCID overridese
    configIPID :: Flag String
configIPID                = case ElaboratedPackageOrComponent
elabPkgOrComp of
                                  ElabPackage ElaboratedPackage
pkg -> forall a. a -> Flag a
toFlag (forall a. Pretty a => a -> String
prettyShow (ElaboratedPackage -> InstalledPackageId
pkgInstalledId ElaboratedPackage
pkg))
                                  ElabComponent ElaboratedComponent
_ -> forall a. Monoid a => a
mempty
    configCID :: Flag InstalledPackageId
configCID                 = case ElaboratedPackageOrComponent
elabPkgOrComp of
                                  ElabPackage ElaboratedPackage
_ -> forall a. Monoid a => a
mempty
                                  ElabComponent ElaboratedComponent
_ -> forall a. a -> Flag a
toFlag InstalledPackageId
elabComponentId

    configProgramPaths :: [(String, String)]
configProgramPaths        = forall k a. Map k a -> [(k, a)]
Map.toList Map String String
elabProgramPaths
    configProgramArgs :: [(String, [String])]
configProgramArgs
        | {- elabSetupScriptCliVersion < mkVersion [1,24,3] -} Bool
True
          -- workaround for <https://github.com/haskell/cabal/issues/4010>
          --
          -- It turns out, that even with Cabal 2.0, there's still cases such as e.g.
          -- custom Setup.hs scripts calling out to GHC even when going via
          -- @runProgram ghcProgram@, as e.g. happy does in its
          -- <http://hackage.haskell.org/package/happy-1.19.5/src/Setup.lhs>
          -- (see also <https://github.com/haskell/cabal/pull/4433#issuecomment-299396099>)
          --
          -- So for now, let's pass the rather harmless and idempotent
          -- `-hide-all-packages` flag to all invocations (which has
          -- the benefit that every GHC invocation starts with a
          -- consistently well-defined clean slate) until we find a
          -- better way.
                              = forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$
                                forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. [a] -> [a] -> [a]
(++) String
"ghc" [String
"-hide-all-packages"]
                                               Map String [String]
elabProgramArgs
    configProgramPathExtra :: NubList String
configProgramPathExtra    = forall a. Ord a => [a] -> NubList a
toNubList [String]
elabProgramPathExtra
    configHcFlavor :: Flag CompilerFlavor
configHcFlavor            = forall a. a -> Flag a
toFlag (Compiler -> CompilerFlavor
compilerFlavor Compiler
pkgConfigCompiler)
    configHcPath :: Flag String
configHcPath              = forall a. Monoid a => a
mempty -- we use configProgramPaths instead
    configHcPkg :: Flag String
configHcPkg               = forall a. Monoid a => a
mempty -- we use configProgramPaths instead

    configVanillaLib :: Flag Bool
configVanillaLib          = forall a. a -> Flag a
toFlag Bool
elabVanillaLib
    configSharedLib :: Flag Bool
configSharedLib           = forall a. a -> Flag a
toFlag Bool
elabSharedLib
    configStaticLib :: Flag Bool
configStaticLib           = forall a. a -> Flag a
toFlag Bool
elabStaticLib

    configDynExe :: Flag Bool
configDynExe              = forall a. a -> Flag a
toFlag Bool
elabDynExe
    configFullyStaticExe :: Flag Bool
configFullyStaticExe      = forall a. a -> Flag a
toFlag Bool
elabFullyStaticExe
    configGHCiLib :: Flag Bool
configGHCiLib             = forall a. a -> Flag a
toFlag Bool
elabGHCiLib
    configProfExe :: Flag Bool
configProfExe             = forall a. Monoid a => a
mempty
    configProfLib :: Flag Bool
configProfLib             = forall a. a -> Flag a
toFlag Bool
elabProfLib
    configProf :: Flag Bool
configProf                = forall a. a -> Flag a
toFlag Bool
elabProfExe

    -- configProfDetail is for exe+lib, but overridden by configProfLibDetail
    -- so we specify both so we can specify independently
    configProfDetail :: Flag ProfDetailLevel
configProfDetail          = forall a. a -> Flag a
toFlag ProfDetailLevel
elabProfExeDetail
    configProfLibDetail :: Flag ProfDetailLevel
configProfLibDetail       = forall a. a -> Flag a
toFlag ProfDetailLevel
elabProfLibDetail

    configCoverage :: Flag Bool
configCoverage            = forall a. a -> Flag a
toFlag Bool
elabCoverage
    configLibCoverage :: Flag Bool
configLibCoverage         = forall a. Monoid a => a
mempty

    configOptimization :: Flag OptimisationLevel
configOptimization        = forall a. a -> Flag a
toFlag OptimisationLevel
elabOptimization
    configSplitSections :: Flag Bool
configSplitSections       = forall a. a -> Flag a
toFlag Bool
elabSplitSections
    configSplitObjs :: Flag Bool
configSplitObjs           = forall a. a -> Flag a
toFlag Bool
elabSplitObjs
    configStripExes :: Flag Bool
configStripExes           = forall a. a -> Flag a
toFlag Bool
elabStripExes
    configStripLibs :: Flag Bool
configStripLibs           = forall a. a -> Flag a
toFlag Bool
elabStripLibs
    configDebugInfo :: Flag DebugInfoLevel
configDebugInfo           = forall a. a -> Flag a
toFlag DebugInfoLevel
elabDebugInfo
    configDumpBuildInfo :: Flag DumpBuildInfo
configDumpBuildInfo       = forall a. a -> Flag a
toFlag DumpBuildInfo
elabDumpBuildInfo

    configConfigurationsFlags :: FlagAssignment
configConfigurationsFlags = FlagAssignment
elabFlagAssignment
    configConfigureArgs :: [String]
configConfigureArgs       = [String]
elabConfigureScriptArgs
    configExtraLibDirs :: [String]
configExtraLibDirs        = [String]
elabExtraLibDirs
    configExtraLibDirsStatic :: [String]
configExtraLibDirsStatic  = [String]
elabExtraLibDirsStatic
    configExtraFrameworkDirs :: [String]
configExtraFrameworkDirs  = [String]
elabExtraFrameworkDirs
    configExtraIncludeDirs :: [String]
configExtraIncludeDirs    = [String]
elabExtraIncludeDirs
    configProgPrefix :: Flag PathTemplate
configProgPrefix          = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe PathTemplate
elabProgPrefix
    configProgSuffix :: Flag PathTemplate
configProgSuffix          = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe PathTemplate
elabProgSuffix

    configInstallDirs :: InstallDirs (Flag PathTemplate)
configInstallDirs         = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Flag a
toFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PathTemplate
InstallDirs.toPathTemplate)
                                     InstallDirs String
elabInstallDirs

    -- we only use configDependencies, unless we're talking to an old Cabal
    -- in which case we use configConstraints
    -- NB: This does NOT use InstallPlan.depends, which includes executable
    -- dependencies which should NOT be fed in here (also you don't have
    -- enough info anyway)
    configDependencies :: [GivenComponent]
configDependencies        = [ PackageName -> LibraryName -> InstalledPackageId -> GivenComponent
GivenComponent
                                    (forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
srcid)
                                    LibraryName
ln
                                    InstalledPackageId
cid
                                | ConfiguredId PackageIdentifier
srcid Maybe ComponentName
mb_cn InstalledPackageId
cid <- ElaboratedConfiguredPackage -> [ConfiguredId]
elabLibDependencies ElaboratedConfiguredPackage
elab
                                , let ln :: LibraryName
ln = case Maybe ComponentName
mb_cn
                                           of Just (CLibName LibraryName
lname) -> LibraryName
lname
                                              Just ComponentName
_ -> forall a. HasCallStack => String -> a
error String
"non-library dependency"
                                              Maybe ComponentName
Nothing -> LibraryName
LMainLibName
                                ]
    configConstraints :: [PackageVersionConstraint]
configConstraints         =
        case ElaboratedPackageOrComponent
elabPkgOrComp of
            ElabPackage ElaboratedPackage
_ ->
                [ PackageIdentifier -> PackageVersionConstraint
thisPackageVersionConstraint PackageIdentifier
srcid
                | ConfiguredId PackageIdentifier
srcid Maybe ComponentName
_ InstalledPackageId
_uid <- ElaboratedConfiguredPackage -> [ConfiguredId]
elabLibDependencies ElaboratedConfiguredPackage
elab ]
            ElabComponent ElaboratedComponent
_ -> []


    -- explicitly clear, then our package db stack
    -- TODO: [required eventually] have to do this differently for older Cabal versions
    configPackageDBs :: [Maybe PackageDB]
configPackageDBs          = forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just PackageDBStack
elabBuildPackageDBStack

    configTests :: Flag Bool
configTests               = case ElaboratedPackageOrComponent
elabPkgOrComp of
                                    ElabPackage ElaboratedPackage
pkg -> forall a. a -> Flag a
toFlag (OptionalStanza
TestStanzas  OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` ElaboratedPackage -> OptionalStanzaSet
pkgStanzasEnabled ElaboratedPackage
pkg)
                                    ElabComponent ElaboratedComponent
_ -> forall a. Monoid a => a
mempty
    configBenchmarks :: Flag Bool
configBenchmarks          = case ElaboratedPackageOrComponent
elabPkgOrComp of
                                    ElabPackage ElaboratedPackage
pkg -> forall a. a -> Flag a
toFlag (OptionalStanza
BenchStanzas OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` ElaboratedPackage -> OptionalStanzaSet
pkgStanzasEnabled ElaboratedPackage
pkg)
                                    ElabComponent ElaboratedComponent
_ -> forall a. Monoid a => a
mempty

    configExactConfiguration :: Flag Bool
configExactConfiguration  = forall a. a -> Flag a
toFlag Bool
True
    configFlagError :: Flag String
configFlagError           = forall a. Monoid a => a
mempty --TODO: [research required] appears not to be implemented
    configRelocatable :: Flag Bool
configRelocatable         = forall a. Monoid a => a
mempty --TODO: [research required] ???
    configScratchDir :: Flag String
configScratchDir          = forall a. Monoid a => a
mempty -- never use
    configUserInstall :: Flag Bool
configUserInstall         = forall a. Monoid a => a
mempty -- don't rely on defaults
    configPrograms_ :: Option' (Last' ProgramDb)
configPrograms_           = forall a. Monoid a => a
mempty -- never use, shouldn't exist
    configUseResponseFiles :: Flag Bool
configUseResponseFiles    = forall a. Monoid a => a
mempty
    configAllowDependingOnPrivateLibs :: Flag Bool
configAllowDependingOnPrivateLibs = forall a. a -> Flag a
Flag forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Compiler -> Bool
libraryVisibilitySupported Compiler
pkgConfigCompiler

setupHsConfigureArgs :: ElaboratedConfiguredPackage
                     -> [String]
setupHsConfigureArgs :: ElaboratedConfiguredPackage -> [String]
setupHsConfigureArgs (ElaboratedConfiguredPackage { elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabPackage ElaboratedPackage
_ }) = []
setupHsConfigureArgs elab :: ElaboratedConfiguredPackage
elab@(ElaboratedConfiguredPackage { elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabComponent ElaboratedComponent
comp }) =
    [PackageIdentifier -> ComponentTarget -> String
showComponentTarget (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab) (ComponentName -> SubComponentTarget -> ComponentTarget
ComponentTarget ComponentName
cname SubComponentTarget
WholeComponent)]
  where
    cname :: ComponentName
cname = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"setupHsConfigureArgs: trying to configure setup")
                      (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp)

setupHsBuildFlags :: ElaboratedConfiguredPackage
                  -> ElaboratedSharedConfig
                  -> Verbosity
                  -> FilePath
                  -> Cabal.BuildFlags
setupHsBuildFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> String -> BuildFlags
setupHsBuildFlags ElaboratedConfiguredPackage
_ ElaboratedSharedConfig
_ Verbosity
verbosity String
builddir =
    Cabal.BuildFlags {
      buildProgramPaths :: [(String, String)]
buildProgramPaths = forall a. Monoid a => a
mempty, --unused, set at configure time
      buildProgramArgs :: [(String, [String])]
buildProgramArgs  = forall a. Monoid a => a
mempty, --unused, set at configure time
      buildVerbosity :: Flag Verbosity
buildVerbosity    = forall a. a -> Flag a
toFlag Verbosity
verbosity,
      buildDistPref :: Flag String
buildDistPref     = forall a. a -> Flag a
toFlag String
builddir,
      buildNumJobs :: Flag (Maybe Int)
buildNumJobs      = forall a. Monoid a => a
mempty, --TODO: [nice to have] sometimes want to use toFlag (Just numBuildJobs),
      buildArgs :: [String]
buildArgs         = forall a. Monoid a => a
mempty, -- unused, passed via args not flags
      buildCabalFilePath :: Flag String
buildCabalFilePath= forall a. Monoid a => a
mempty
    }


setupHsBuildArgs :: ElaboratedConfiguredPackage -> [String]
setupHsBuildArgs :: ElaboratedConfiguredPackage -> [String]
setupHsBuildArgs elab :: ElaboratedConfiguredPackage
elab@(ElaboratedConfiguredPackage { elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabPackage ElaboratedPackage
_ })
    -- Fix for #3335, don't pass build arguments if it's not supported
    | ElaboratedConfiguredPackage -> Version
elabSetupScriptCliVersion ElaboratedConfiguredPackage
elab forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1,Int
17]
    = forall a b. (a -> b) -> [a] -> [b]
map (PackageIdentifier -> ComponentTarget -> String
showComponentTarget (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab)) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab)
    | Bool
otherwise
    = []
setupHsBuildArgs (ElaboratedConfiguredPackage { elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabComponent ElaboratedComponent
_ })
    = []


setupHsTestFlags :: ElaboratedConfiguredPackage
                 -> ElaboratedSharedConfig
                 -> Verbosity
                 -> FilePath
                 -> Cabal.TestFlags
setupHsTestFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> String -> TestFlags
setupHsTestFlags (ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..}) ElaboratedSharedConfig
_ Verbosity
verbosity String
builddir = Cabal.TestFlags
    { testDistPref :: Flag String
testDistPref    = forall a. a -> Flag a
toFlag String
builddir
    , testVerbosity :: Flag Verbosity
testVerbosity   = forall a. a -> Flag a
toFlag Verbosity
verbosity
    , testMachineLog :: Flag PathTemplate
testMachineLog  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe PathTemplate
elabTestMachineLog
    , testHumanLog :: Flag PathTemplate
testHumanLog    = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe PathTemplate
elabTestHumanLog
    , testShowDetails :: Flag TestShowDetails
testShowDetails = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Flag a
Flag TestShowDetails
Cabal.Always) forall a. a -> Flag a
toFlag Maybe TestShowDetails
elabTestShowDetails
    , testKeepTix :: Flag Bool
testKeepTix     = forall a. a -> Flag a
toFlag Bool
elabTestKeepTix
    , testWrapper :: Flag String
testWrapper     = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe String
elabTestWrapper
    , testFailWhenNoTestSuites :: Flag Bool
testFailWhenNoTestSuites = forall a. a -> Flag a
toFlag Bool
elabTestFailWhenNoTestSuites
    , testOptions :: [PathTemplate]
testOptions     = [PathTemplate]
elabTestTestOptions
    }

setupHsTestArgs :: ElaboratedConfiguredPackage -> [String]
-- TODO: Does the issue #3335 affects test as well
setupHsTestArgs :: ElaboratedConfiguredPackage -> [String]
setupHsTestArgs ElaboratedConfiguredPackage
elab =
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PackageIdentifier -> ComponentTarget -> Maybe String
showTestComponentTarget (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab)) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
elab)


setupHsBenchFlags :: ElaboratedConfiguredPackage
                  -> ElaboratedSharedConfig
                  -> Verbosity
                  -> FilePath
                  -> Cabal.BenchmarkFlags
setupHsBenchFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> String -> BenchmarkFlags
setupHsBenchFlags (ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..}) ElaboratedSharedConfig
_ Verbosity
verbosity String
builddir = Cabal.BenchmarkFlags
    { benchmarkDistPref :: Flag String
benchmarkDistPref  = forall a. a -> Flag a
toFlag String
builddir
    , benchmarkVerbosity :: Flag Verbosity
benchmarkVerbosity = forall a. a -> Flag a
toFlag Verbosity
verbosity
    , benchmarkOptions :: [PathTemplate]
benchmarkOptions   = [PathTemplate]
elabBenchmarkOptions
    }

setupHsBenchArgs :: ElaboratedConfiguredPackage -> [String]
setupHsBenchArgs :: ElaboratedConfiguredPackage -> [String]
setupHsBenchArgs ElaboratedConfiguredPackage
elab =
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PackageIdentifier -> ComponentTarget -> Maybe String
showBenchComponentTarget (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab)) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
elab)


setupHsReplFlags :: ElaboratedConfiguredPackage
                 -> ElaboratedSharedConfig
                 -> Verbosity
                 -> FilePath
                 -> Cabal.ReplFlags
setupHsReplFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> String -> ReplFlags
setupHsReplFlags ElaboratedConfiguredPackage
_ ElaboratedSharedConfig
sharedConfig Verbosity
verbosity String
builddir =
    Cabal.ReplFlags {
      replProgramPaths :: [(String, String)]
replProgramPaths = forall a. Monoid a => a
mempty, --unused, set at configure time
      replProgramArgs :: [(String, [String])]
replProgramArgs  = forall a. Monoid a => a
mempty, --unused, set at configure time
      replVerbosity :: Flag Verbosity
replVerbosity    = forall a. a -> Flag a
toFlag Verbosity
verbosity,
      replDistPref :: Flag String
replDistPref     = forall a. a -> Flag a
toFlag String
builddir,
      replReload :: Flag Bool
replReload       = forall a. Monoid a => a
mempty, --only used as callback from repl
      replReplOptions :: ReplOptions
replReplOptions  = ElaboratedSharedConfig -> ReplOptions
pkgConfigReplOptions ElaboratedSharedConfig
sharedConfig       --runtime override for repl flags
    }


setupHsReplArgs :: ElaboratedConfiguredPackage -> [String]
setupHsReplArgs :: ElaboratedConfiguredPackage -> [String]
setupHsReplArgs ElaboratedConfiguredPackage
elab =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ComponentTarget
t -> [PackageIdentifier -> ComponentTarget -> String
showComponentTarget (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab) ComponentTarget
t]) (ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabReplTarget ElaboratedConfiguredPackage
elab)
    --TODO: should be able to give multiple modules in one component


setupHsCopyFlags :: ElaboratedConfiguredPackage
                 -> ElaboratedSharedConfig
                 -> Verbosity
                 -> FilePath
                 -> FilePath
                 -> Cabal.CopyFlags
setupHsCopyFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> Verbosity
-> String
-> String
-> CopyFlags
setupHsCopyFlags ElaboratedConfiguredPackage
_ ElaboratedSharedConfig
_ Verbosity
verbosity String
builddir String
destdir =
    Cabal.CopyFlags {
      copyArgs :: [String]
copyArgs      = [], -- TODO: could use this to only copy what we enabled
      copyDest :: Flag CopyDest
copyDest      = forall a. a -> Flag a
toFlag (String -> CopyDest
InstallDirs.CopyTo String
destdir),
      copyDistPref :: Flag String
copyDistPref  = forall a. a -> Flag a
toFlag String
builddir,
      copyVerbosity :: Flag Verbosity
copyVerbosity = forall a. a -> Flag a
toFlag Verbosity
verbosity,
      copyCabalFilePath :: Flag String
copyCabalFilePath = forall a. Monoid a => a
mempty
    }

setupHsRegisterFlags :: ElaboratedConfiguredPackage
                     -> ElaboratedSharedConfig
                     -> Verbosity
                     -> FilePath
                     -> FilePath
                     -> Cabal.RegisterFlags
setupHsRegisterFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> Verbosity
-> String
-> String
-> RegisterFlags
setupHsRegisterFlags ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..} ElaboratedSharedConfig
_
                     Verbosity
verbosity String
builddir String
pkgConfFile =
    Cabal.RegisterFlags {
      regPackageDB :: Flag PackageDB
regPackageDB   = forall a. Monoid a => a
mempty,  -- misfeature
      regGenScript :: Flag Bool
regGenScript   = forall a. Monoid a => a
mempty,  -- never use
      regGenPkgConf :: Flag (Maybe String)
regGenPkgConf  = forall a. a -> Flag a
toFlag (forall a. a -> Maybe a
Just String
pkgConfFile),
      regInPlace :: Flag Bool
regInPlace     = case BuildStyle
elabBuildStyle of
                         BuildStyle
BuildInplaceOnly -> forall a. a -> Flag a
toFlag Bool
True
                         BuildStyle
_                -> forall a. a -> Flag a
toFlag Bool
False,
      regPrintId :: Flag Bool
regPrintId     = forall a. Monoid a => a
mempty,  -- never use
      regDistPref :: Flag String
regDistPref    = forall a. a -> Flag a
toFlag String
builddir,
      regArgs :: [String]
regArgs        = [],
      regVerbosity :: Flag Verbosity
regVerbosity   = forall a. a -> Flag a
toFlag Verbosity
verbosity,
      regCabalFilePath :: Flag String
regCabalFilePath = forall a. Monoid a => a
mempty
    }

setupHsHaddockFlags :: ElaboratedConfiguredPackage
                    -> ElaboratedSharedConfig
                    -> Verbosity
                    -> FilePath
                    -> Cabal.HaddockFlags
setupHsHaddockFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> String -> HaddockFlags
setupHsHaddockFlags (ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs String
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabConfigureScriptArgs :: [String]
elabProgramPathExtra :: [String]
elabProgramArgs :: Map String [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..}) (ElaboratedSharedConfig{Platform
ReplOptions
ProgramDb
Compiler
pkgConfigReplOptions :: ReplOptions
pkgConfigCompilerProgs :: ProgramDb
pkgConfigCompiler :: Compiler
pkgConfigPlatform :: Platform
pkgConfigReplOptions :: ElaboratedSharedConfig -> ReplOptions
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
..}) Verbosity
verbosity String
builddir =
    Cabal.HaddockFlags {
      haddockProgramPaths :: [(String, String)]
haddockProgramPaths  =
        case Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
haddockProgram ProgramDb
pkgConfigCompilerProgs of
          Maybe ConfiguredProgram
Nothing  -> forall a. Monoid a => a
mempty
          Just ConfiguredProgram
prg -> [( Program -> String
programName Program
haddockProgram
                       , ProgramLocation -> String
locationPath (ConfiguredProgram -> ProgramLocation
programLocation ConfiguredProgram
prg) )],
      haddockProgramArgs :: [(String, [String])]
haddockProgramArgs   = forall a. Monoid a => a
mempty, --unused, set at configure time
      haddockHoogle :: Flag Bool
haddockHoogle        = forall a. a -> Flag a
toFlag Bool
elabHaddockHoogle,
      haddockHtml :: Flag Bool
haddockHtml          = forall a. a -> Flag a
toFlag Bool
elabHaddockHtml,
      haddockHtmlLocation :: Flag String
haddockHtmlLocation  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe String
elabHaddockHtmlLocation,
      haddockForHackage :: Flag HaddockTarget
haddockForHackage    = forall a. a -> Flag a
toFlag HaddockTarget
elabHaddockForHackage,
      haddockForeignLibs :: Flag Bool
haddockForeignLibs   = forall a. a -> Flag a
toFlag Bool
elabHaddockForeignLibs,
      haddockExecutables :: Flag Bool
haddockExecutables   = forall a. a -> Flag a
toFlag Bool
elabHaddockExecutables,
      haddockTestSuites :: Flag Bool
haddockTestSuites    = forall a. a -> Flag a
toFlag Bool
elabHaddockTestSuites,
      haddockBenchmarks :: Flag Bool
haddockBenchmarks    = forall a. a -> Flag a
toFlag Bool
elabHaddockBenchmarks,
      haddockInternal :: Flag Bool
haddockInternal      = forall a. a -> Flag a
toFlag Bool
elabHaddockInternal,
      haddockCss :: Flag String
haddockCss           = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe String
elabHaddockCss,
      haddockLinkedSource :: Flag Bool
haddockLinkedSource  = forall a. a -> Flag a
toFlag Bool
elabHaddockLinkedSource,
      haddockQuickJump :: Flag Bool
haddockQuickJump     = forall a. a -> Flag a
toFlag Bool
elabHaddockQuickJump,
      haddockHscolourCss :: Flag String
haddockHscolourCss   = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe String
elabHaddockHscolourCss,
      haddockContents :: Flag PathTemplate
haddockContents      = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe PathTemplate
elabHaddockContents,
      haddockDistPref :: Flag String
haddockDistPref      = forall a. a -> Flag a
toFlag String
builddir,
      haddockKeepTempFiles :: Flag Bool
haddockKeepTempFiles = forall a. Monoid a => a
mempty, --TODO: from build settings
      haddockVerbosity :: Flag Verbosity
haddockVerbosity     = forall a. a -> Flag a
toFlag Verbosity
verbosity,
      haddockCabalFilePath :: Flag String
haddockCabalFilePath = forall a. Monoid a => a
mempty,
      haddockIndex :: Flag PathTemplate
haddockIndex         = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe PathTemplate
elabHaddockIndex,
      haddockBaseUrl :: Flag String
haddockBaseUrl       = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe String
elabHaddockBaseUrl,
      haddockLib :: Flag String
haddockLib           = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Flag a
toFlag Maybe String
elabHaddockLib,
      haddockArgs :: [String]
haddockArgs          = forall a. Monoid a => a
mempty
    }

setupHsHaddockArgs :: ElaboratedConfiguredPackage -> [String]
-- TODO: Does the issue #3335 affects test as well
setupHsHaddockArgs :: ElaboratedConfiguredPackage -> [String]
setupHsHaddockArgs ElaboratedConfiguredPackage
elab =
  forall a b. (a -> b) -> [a] -> [b]
map (PackageIdentifier -> ComponentTarget -> String
showComponentTarget (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab)) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets ElaboratedConfiguredPackage
elab)

{-
setupHsTestFlags :: ElaboratedConfiguredPackage
                 -> ElaboratedSharedConfig
                 -> Verbosity
                 -> FilePath
                 -> Cabal.TestFlags
setupHsTestFlags _ _ verbosity builddir =
    Cabal.TestFlags {
    }
-}

------------------------------------------------------------------------------
-- * Sharing installed packages
------------------------------------------------------------------------------

--
-- Nix style store management for tarball packages
--
-- So here's our strategy:
--
-- We use a per-user nix-style hashed store, but /only/ for tarball packages.
-- So that includes packages from hackage repos (and other http and local
-- tarballs). For packages in local directories we do not register them into
-- the shared store by default, we just build them locally inplace.
--
-- The reason we do it like this is that it's easy to make stable hashes for
-- tarball packages, and these packages benefit most from sharing. By contrast
-- unpacked dir packages are harder to hash and they tend to change more
-- frequently so there's less benefit to sharing them.
--
-- When using the nix store approach we have to run the solver *without*
-- looking at the packages installed in the store, just at the source packages
-- (plus core\/global installed packages). Then we do a post-processing pass
-- to replace configured packages in the plan with pre-existing ones, where
-- possible. Where possible of course means where the nix-style package hash
-- equals one that's already in the store.
--
-- One extra wrinkle is that unless we know package tarball hashes upfront, we
-- will have to download the tarballs to find their hashes. So we have two
-- options: delay replacing source with pre-existing installed packages until
-- the point during the execution of the install plan where we have the
-- tarball, or try to do as much up-front as possible and then check again
-- during plan execution. The former isn't great because we would end up
-- telling users we're going to re-install loads of packages when in fact we
-- would just share them. It'd be better to give as accurate a prediction as
-- we can. The latter is better for users, but we do still have to check
-- during plan execution because it's important that we don't replace existing
-- installed packages even if they have the same package hash, because we
-- don't guarantee ABI stability.

-- TODO: [required eventually] for safety of concurrent installs, we must make sure we register but
-- not replace installed packages with ghc-pkg.

packageHashInputs :: ElaboratedSharedConfig
                  -> ElaboratedConfiguredPackage
                  -> PackageHashInputs
packageHashInputs :: ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> PackageHashInputs
packageHashInputs
    ElaboratedSharedConfig
pkgshared
    elab :: ElaboratedConfiguredPackage
elab@(ElaboratedConfiguredPackage {
      elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceHash = Just PackageSourceHash
srchash
    }) =
    PackageHashInputs {
      pkgHashPkgId :: PackageIdentifier
pkgHashPkgId       = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
elab,
      pkgHashComponent :: Maybe Component
pkgHashComponent   =
        case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
          ElabPackage ElaboratedPackage
_ -> forall a. Maybe a
Nothing
          ElabComponent ElaboratedComponent
comp -> forall a. a -> Maybe a
Just (ElaboratedComponent -> Component
compSolverName ElaboratedComponent
comp),
      pkgHashSourceHash :: PackageSourceHash
pkgHashSourceHash  = PackageSourceHash
srchash,
      pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion)
pkgHashPkgConfigDeps = forall a. Ord a => [a] -> Set a
Set.fromList (ElaboratedConfiguredPackage
-> [(PkgconfigName, Maybe PkgconfigVersion)]
elabPkgConfigDependencies ElaboratedConfiguredPackage
elab),
      pkgHashDirectDeps :: Set InstalledPackageId
pkgHashDirectDeps  =
        case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
          ElabPackage (ElaboratedPackage{[(PkgconfigName, Maybe PkgconfigVersion)]
InstalledPackageId
OptionalStanzaSet
ComponentDeps [()]
ComponentDeps [(ConfiguredId, String)]
ComponentDeps [ConfiguredId]
pkgStanzasEnabled :: OptionalStanzaSet
pkgPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
pkgExeDependencyPaths :: ComponentDeps [(ConfiguredId, String)]
pkgExeDependencies :: ComponentDeps [ConfiguredId]
pkgDependsOnSelfLib :: ComponentDeps [()]
pkgLibDependencies :: ComponentDeps [ConfiguredId]
pkgInstalledId :: InstalledPackageId
pkgStanzasEnabled :: ElaboratedPackage -> OptionalStanzaSet
pkgPkgConfigDependencies :: ElaboratedPackage -> [(PkgconfigName, Maybe PkgconfigVersion)]
pkgExeDependencyPaths :: ElaboratedPackage -> ComponentDeps [(ConfiguredId, String)]
pkgExeDependencies :: ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgDependsOnSelfLib :: ElaboratedPackage -> ComponentDeps [()]
pkgLibDependencies :: ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgInstalledId :: ElaboratedPackage -> InstalledPackageId
..}) ->
            forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$
             [ ConfiguredId -> InstalledPackageId
confInstId ConfiguredId
dep
             | ConfiguredId
dep <- forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
CD.select Component -> Bool
relevantDeps ComponentDeps [ConfiguredId]
pkgLibDependencies ] forall a. [a] -> [a] -> [a]
++
             [ ConfiguredId -> InstalledPackageId
confInstId ConfiguredId
dep
             | ConfiguredId
dep <- forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
CD.select Component -> Bool
relevantDeps ComponentDeps [ConfiguredId]
pkgExeDependencies ]
          ElabComponent ElaboratedComponent
comp ->
            forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map ConfiguredId -> InstalledPackageId
confInstId (ElaboratedComponent -> [ConfiguredId]
compLibDependencies ElaboratedComponent
comp
                                       forall a. [a] -> [a] -> [a]
++ ElaboratedComponent -> [ConfiguredId]
compExeDependencies ElaboratedComponent
comp)),
      pkgHashOtherConfig :: PackageHashConfigInputs
pkgHashOtherConfig = ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> PackageHashConfigInputs
packageHashConfigInputs ElaboratedSharedConfig
pkgshared ElaboratedConfiguredPackage
elab
    }
  where
    -- Obviously the main deps are relevant
    relevantDeps :: Component -> Bool
relevantDeps Component
CD.ComponentLib       = Bool
True
    relevantDeps (CD.ComponentSubLib UnqualComponentName
_) = Bool
True
    relevantDeps (CD.ComponentFLib UnqualComponentName
_)   = Bool
True
    relevantDeps (CD.ComponentExe UnqualComponentName
_)   = Bool
True
    -- Setup deps can affect the Setup.hs behaviour and thus what is built
    relevantDeps  Component
CD.ComponentSetup    = Bool
True
    -- However testsuites and benchmarks do not get installed and should not
    -- affect the result, so we do not include them.
    relevantDeps (CD.ComponentTest  UnqualComponentName
_) = Bool
False
    relevantDeps (CD.ComponentBench UnqualComponentName
_) = Bool
False

packageHashInputs ElaboratedSharedConfig
_ ElaboratedConfiguredPackage
pkg =
    forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"packageHashInputs: only for packages with source hashes. "
         forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
pkg)

packageHashConfigInputs :: ElaboratedSharedConfig
                        -> ElaboratedConfiguredPackage
                        -> PackageHashConfigInputs
packageHashConfigInputs :: ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> PackageHashConfigInputs
packageHashConfigInputs shared :: ElaboratedSharedConfig
shared@ElaboratedSharedConfig{Platform
ReplOptions
ProgramDb
Compiler
pkgConfigReplOptions :: ReplOptions
pkgConfigCompilerProgs :: ProgramDb
pkgConfigCompiler :: Compiler
pkgConfigPlatform :: Platform
pkgConfigReplOptions :: ElaboratedSharedConfig -> ReplOptions
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
..} ElaboratedConfiguredPackage
pkg =
    PackageHashConfigInputs {
      pkgHashCompilerId :: CompilerId
pkgHashCompilerId          = Compiler -> CompilerId
compilerId Compiler
pkgConfigCompiler,
      pkgHashPlatform :: Platform
pkgHashPlatform            = Platform
pkgConfigPlatform,
      pkgHashFlagAssignment :: FlagAssignment
pkgHashFlagAssignment      = FlagAssignment
elabFlagAssignment,
      pkgHashConfigureScriptArgs :: [String]
pkgHashConfigureScriptArgs = [String]
elabConfigureScriptArgs,
      pkgHashVanillaLib :: Bool
pkgHashVanillaLib          = Bool
elabVanillaLib,
      pkgHashSharedLib :: Bool
pkgHashSharedLib           = Bool
elabSharedLib,
      pkgHashDynExe :: Bool
pkgHashDynExe              = Bool
elabDynExe,
      pkgHashFullyStaticExe :: Bool
pkgHashFullyStaticExe      = Bool
elabFullyStaticExe,
      pkgHashGHCiLib :: Bool
pkgHashGHCiLib             = Bool
elabGHCiLib,
      pkgHashProfLib :: Bool
pkgHashProfLib             = Bool
elabProfLib,
      pkgHashProfExe :: Bool
pkgHashProfExe             = Bool
elabProfExe,
      pkgHashProfLibDetail :: ProfDetailLevel
pkgHashProfLibDetail       = ProfDetailLevel
elabProfLibDetail,
      pkgHashProfExeDetail :: ProfDetailLevel
pkgHashProfExeDetail       = ProfDetailLevel
elabProfExeDetail,
      pkgHashCoverage :: Bool
pkgHashCoverage            = Bool
elabCoverage,
      pkgHashOptimization :: OptimisationLevel
pkgHashOptimization        = OptimisationLevel
elabOptimization,
      pkgHashSplitSections :: Bool
pkgHashSplitSections       = Bool
elabSplitSections,
      pkgHashSplitObjs :: Bool
pkgHashSplitObjs           = Bool
elabSplitObjs,
      pkgHashStripLibs :: Bool
pkgHashStripLibs           = Bool
elabStripLibs,
      pkgHashStripExes :: Bool
pkgHashStripExes           = Bool
elabStripExes,
      pkgHashDebugInfo :: DebugInfoLevel
pkgHashDebugInfo           = DebugInfoLevel
elabDebugInfo,
      pkgHashProgramArgs :: Map String [String]
pkgHashProgramArgs         = Map String [String]
elabProgramArgs,
      pkgHashExtraLibDirs :: [String]
pkgHashExtraLibDirs        = [String]
elabExtraLibDirs,
      pkgHashExtraLibDirsStatic :: [String]
pkgHashExtraLibDirsStatic  = [String]
elabExtraLibDirsStatic,
      pkgHashExtraFrameworkDirs :: [String]
pkgHashExtraFrameworkDirs  = [String]
elabExtraFrameworkDirs,
      pkgHashExtraIncludeDirs :: [String]
pkgHashExtraIncludeDirs    = [String]
elabExtraIncludeDirs,
      pkgHashProgPrefix :: Maybe PathTemplate
pkgHashProgPrefix          = Maybe PathTemplate
elabProgPrefix,
      pkgHashProgSuffix :: Maybe PathTemplate
pkgHashProgSuffix          = Maybe PathTemplate
elabProgSuffix,
      pkgHashPackageDbs :: [Maybe PackageDB]
pkgHashPackageDbs          = [Maybe PackageDB]
elabPackageDbs,

      pkgHashDocumentation :: Bool
pkgHashDocumentation       = Bool
elabBuildHaddocks,
      pkgHashHaddockHoogle :: Bool
pkgHashHaddockHoogle       = Bool
elabHaddockHoogle,
      pkgHashHaddockHtml :: Bool
pkgHashHaddockHtml         = Bool
elabHaddockHtml,
      pkgHashHaddockHtmlLocation :: Maybe String
pkgHashHaddockHtmlLocation = Maybe String
elabHaddockHtmlLocation,
      pkgHashHaddockForeignLibs :: Bool
pkgHashHaddockForeignLibs  = Bool
elabHaddockForeignLibs,
      pkgHashHaddockExecutables :: Bool
pkgHashHaddockExecutables  = Bool
elabHaddockExecutables,
      pkgHashHaddockTestSuites :: Bool
pkgHashHaddockTestSuites   = Bool
elabHaddockTestSuites,
      pkgHashHaddockBenchmarks :: Bool
pkgHashHaddockBenchmarks   = Bool
elabHaddockBenchmarks,
      pkgHashHaddockInternal :: Bool
pkgHashHaddockInternal     = Bool
elabHaddockInternal,
      pkgHashHaddockCss :: Maybe String
pkgHashHaddockCss          = Maybe String
elabHaddockCss,
      pkgHashHaddockLinkedSource :: Bool
pkgHashHaddockLinkedSource = Bool
elabHaddockLinkedSource,
      pkgHashHaddockQuickJump :: Bool
pkgHashHaddockQuickJump    = Bool
elabHaddockQuickJump,
      pkgHashHaddockContents :: Maybe PathTemplate
pkgHashHaddockContents     = Maybe PathTemplate
elabHaddockContents,
      pkgHashHaddockIndex :: Maybe PathTemplate
pkgHashHaddockIndex        = Maybe PathTemplate
elabHaddockIndex,
      pkgHashHaddockBaseUrl :: Maybe String
pkgHashHaddockBaseUrl      = Maybe String
elabHaddockBaseUrl,
      pkgHashHaddockLib :: Maybe String
pkgHashHaddockLib          = Maybe String
elabHaddockLib
    }
  where
    ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe String
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
InstalledPackageId
Map String String
Map String [String]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs String
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabPkgOrComp :: ElaboratedPackageOrComponent
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe String
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe String
elabHaddockForHackage :: HaddockTarget
elabInstallDirs :: InstallDirs String
elabProgramPathExtra :: [String]
elabProgramPaths :: Map String String
elabDumpBuildInfo :: DumpBuildInfo
elabStaticLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: InstalledPackageId
elabUnitId :: UnitId
elabHaddockLib :: Maybe String
elabHaddockBaseUrl :: Maybe String
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe String
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabBuildHaddocks :: Bool
elabPackageDbs :: [Maybe PackageDB]
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraLibDirs :: [String]
elabProgramArgs :: Map String [String]
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitObjs :: Bool
elabSplitSections :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabConfigureScriptArgs :: [String]
elabFlagAssignment :: FlagAssignment
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
..} = ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
normaliseConfiguredPackage ElaboratedSharedConfig
shared ElaboratedConfiguredPackage
pkg

-- | Given the 'InstalledPackageIndex' for a nix-style package store, and an
-- 'ElaboratedInstallPlan', replace configured source packages by installed
-- packages from the store whenever they exist.
--
improveInstallPlanWithInstalledPackages :: Set UnitId
                                        -> ElaboratedInstallPlan
                                        -> ElaboratedInstallPlan
improveInstallPlanWithInstalledPackages :: Set UnitId -> ElaboratedInstallPlan -> ElaboratedInstallPlan
improveInstallPlanWithInstalledPackages Set UnitId
installedPkgIdSet =
    forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
(srcpkg -> Bool)
-> GenericInstallPlan ipkg srcpkg -> GenericInstallPlan ipkg srcpkg
InstallPlan.installed forall {pkg}. HasUnitId pkg => pkg -> Bool
canPackageBeImproved
  where
    canPackageBeImproved :: pkg -> Bool
canPackageBeImproved pkg
pkg =
      forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId pkg
pkg forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnitId
installedPkgIdSet
    --TODO: sanity checks:
    -- * the installed package must have the expected deps etc
    -- * the installed package must not be broken, valid dep closure

    --TODO: decide what to do if we encounter broken installed packages,
    -- since overwriting is never safe.


-- Path construction
------

-- | The path to the directory that contains a specific executable.
-- NB: For inplace NOT InstallPaths.bindir installDirs; for an
-- inplace build those values are utter nonsense.  So we
-- have to guess where the directory is going to be.
-- Fortunately this is "stable" part of Cabal API.
-- But the way we get the build directory is A HORRIBLE
-- HACK.
binDirectoryFor
  :: DistDirLayout
  -> ElaboratedSharedConfig
  -> ElaboratedConfiguredPackage
  -> FilePath
  -> FilePath
binDirectoryFor :: DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> String
-> String
binDirectoryFor DistDirLayout
layout ElaboratedSharedConfig
config ElaboratedConfiguredPackage
package String
exe = case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
package of
  BuildStyle
BuildAndInstall -> ElaboratedConfiguredPackage -> String
installedBinDirectory ElaboratedConfiguredPackage
package
  BuildStyle
BuildInplaceOnly -> DistDirLayout
-> ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> String
inplaceBinRoot DistDirLayout
layout ElaboratedSharedConfig
config ElaboratedConfiguredPackage
package String -> String -> String
</> String
exe

-- package has been built and installed.
installedBinDirectory :: ElaboratedConfiguredPackage -> FilePath
installedBinDirectory :: ElaboratedConfiguredPackage -> String
installedBinDirectory = forall dir. InstallDirs dir -> dir
InstallDirs.bindir forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> InstallDirs String
elabInstallDirs

-- | The path to the @build@ directory for an inplace build.
inplaceBinRoot
  :: DistDirLayout
  -> ElaboratedSharedConfig
  -> ElaboratedConfiguredPackage
  -> FilePath
inplaceBinRoot :: DistDirLayout
-> ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> String
inplaceBinRoot DistDirLayout
layout ElaboratedSharedConfig
config ElaboratedConfiguredPackage
package
  =  DistDirLayout -> DistDirParams -> String
distBuildDirectory DistDirLayout
layout (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
config ElaboratedConfiguredPackage
package)
 String -> String -> String
</> String
"build"