{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- /Elaborated: worked out with great care and nicety of detail; executed with great minuteness: elaborate preparations; elaborate care./
--
-- In this module we construct an install plan that includes all the information needed to execute it.
--
-- Building a project is therefore split into two phases:
--
-- 1. The construction of the install plan (which as far as possible should be pure), done here.
-- 2. The execution of the plan, done in "ProjectBuilding"
--
-- To achieve this we need a representation of this fully elaborated install plan; this 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).
module Distribution.Client.ProjectPlanning
  ( -- * Types for the elaborated install plan
    ElaboratedInstallPlan
  , ElaboratedConfiguredPackage (..)
  , ElaboratedPlanPackage
  , ElaboratedSharedConfig (..)
  , ElaboratedReadyPackage
  , BuildStyle (..)
  , CabalFileText

    -- * Reading the project configuration
    -- $readingTheProjectConfiguration
  , rebuildProjectConfig

    -- * Producing the elaborated install plan
  , 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
  , setupHsCommonFlags
  , setupHsConfigureFlags
  , setupHsConfigureArgs
  , setupHsBuildFlags
  , setupHsBuildArgs
  , setupHsReplFlags
  , setupHsReplArgs
  , setupHsTestFlags
  , setupHsTestArgs
  , setupHsBenchFlags
  , setupHsBenchArgs
  , setupHsCopyFlags
  , setupHsRegisterFlags
  , setupHsHaddockFlags
  , setupHsHaddockArgs
  , packageHashInputs

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

import Distribution.Client.Compat.Prelude
import Text.PrettyPrint
  ( colon
  , comma
  , fsep
  , hang
  , punctuate
  , quotes
  , render
  , text
  , vcat
  , ($$)
  )
import Prelude ()

import Distribution.Client.Config
import Distribution.Client.Dependency
import Distribution.Client.DistDirLayout
import Distribution.Client.FetchUtils
import Distribution.Client.HashValue
import Distribution.Client.HttpUtils
import Distribution.Client.JobControl
import Distribution.Client.PackageHash
import Distribution.Client.ProjectConfig
import Distribution.Client.ProjectConfig.Legacy
import Distribution.Client.ProjectPlanOutput
import Distribution.Client.ProjectPlanning.SetupPolicy
  ( NonSetupLibDepSolverPlanPackage (..)
  , mkDefaultSetupDeps
  , packageSetupScriptSpecVersion
  , packageSetupScriptStyle
  )
import Distribution.Client.ProjectPlanning.Types as Ty
import Distribution.Client.RebuildMonad
import Distribution.Client.Setup hiding (cabalVersion, packageName)
import Distribution.Client.SetupWrapper
import Distribution.Client.Store
import Distribution.Client.Targets (userToPackageConstraint)
import Distribution.Client.Types
import Distribution.Client.Utils (concatMapM, incVersion)

import qualified Distribution.Client.BuildReports.Storage as BuildReports
import qualified Distribution.Client.IndexUtils as IndexUtils
import qualified Distribution.Client.InstallPlan as InstallPlan
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan

import Distribution.CabalSpecVersion
import Distribution.Utils.LogProgress
import Distribution.Utils.MapAccum
import Distribution.Utils.NubList
import Distribution.Utils.Path hiding
  ( (<.>)
  , (</>)
  )

import qualified Hackage.Security.Client as Sec

import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.InstSolverPackage
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PkgConfigDb
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.SourcePackage

import Distribution.ModuleName
import Distribution.Package
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Simple.LocalBuildInfo
  ( Component (..)
  , componentBuildInfo
  , componentName
  , pkgComponents
  )

import Distribution.Simple.BuildWay
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.Simple.Program
import Distribution.Simple.Program.Db
import Distribution.Simple.Program.Find
import Distribution.System

import Distribution.Types.AnnotatedId
import Distribution.Types.ComponentInclude
import Distribution.Types.ComponentName
import Distribution.Types.DumpBuildInfo
import Distribution.Types.GivenComponent
import Distribution.Types.LibraryName
import qualified Distribution.Types.LocalBuildConfig as LBC
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.PkgconfigDependency
import Distribution.Types.UnqualComponentName

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

import Distribution.Simple.Utils
import Distribution.Verbosity
import Distribution.Version

import qualified Distribution.InstalledPackageInfo as IPI
import qualified Distribution.PackageDescription as PD
import qualified Distribution.PackageDescription.Configuration as PD
import qualified Distribution.Simple.Configure as Cabal
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.InstallDirs as InstallDirs
import qualified Distribution.Simple.LocalBuildInfo as Cabal
import qualified Distribution.Simple.Setup as Cabal
import qualified Distribution.Solver.Types.ComponentDeps as CD

import qualified Distribution.Compat.Graph as Graph

import Control.Exception (assert)
import Control.Monad (sequence)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State as State (State, execState, runState, state)
import Data.Foldable (fold)
import Data.List (deleteBy, groupBy)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
import Distribution.Client.Errors
import Distribution.Solver.Types.ProjectConfigPath
import System.FilePath
import qualified Text.PrettyPrint as Disp

-- | 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 PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
..} =
    ( case ElaboratedPackageOrComponent
elabPkgOrComp of
        ElabPackage ElaboratedPackage
pkg -> ElaboratedConfiguredPackage -> ElaboratedPackage -> a -> a
forall a.
ElaboratedConfiguredPackage -> ElaboratedPackage -> a -> a
sanityCheckElaboratedPackage ElaboratedConfiguredPackage
elab ElaboratedPackage
pkg
        ElabComponent ElaboratedComponent
comp -> ElaboratedConfiguredPackage -> ElaboratedComponent -> a -> a
forall a.
ElaboratedConfiguredPackage -> ElaboratedComponent -> a -> a
sanityCheckElaboratedComponent ElaboratedConfiguredPackage
elab ElaboratedComponent
comp
    )
      -- The assertion below fails occasionally for unknown reason
      -- so it was muted until we figure it out, otherwise it severely
      -- hinders our ability to share and test development builds of cabal-install.
      -- Tracking issue: https://github.com/haskell/cabal/issues/6006
      --
      -- 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
      (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. HasCallStack => Bool -> a -> a
assert
        ( BuildStyle -> Bool
isInplaceBuildStyle BuildStyle
elabBuildStyle
            Bool -> Bool -> Bool
|| InstalledPackageId
elabComponentId
              InstalledPackageId -> InstalledPackageId -> Bool
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
      (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. HasCallStack => Bool -> a -> a
assert
        ( OptionalStanzaSet -> Bool
optStanzaSetNull (OptionalStanzaSet -> Bool) -> OptionalStanzaSet -> Bool
forall a b. (a -> b) -> a -> b
$
            (Maybe Bool -> Bool)
-> OptionalStanzaMap (Maybe Bool) -> OptionalStanzaSet
forall a. (a -> Bool) -> OptionalStanzaMap a -> OptionalStanzaSet
optStanzaKeysFilteredByValue (Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
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!)
      (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. HasCallStack => Bool -> a -> a
assert
        ( BuildStyle -> Bool
isInplaceBuildStyle BuildStyle
elabBuildStyle
            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 PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
..}
  ElaboratedComponent{[(PkgconfigName, Maybe PkgconfigVersion)]
[(ConfiguredId, Bool)]
[(ConfiguredId, String)]
[UnitId]
[OpenUnitId]
[ConfiguredId]
Maybe ComponentName
Component
compSolverName :: Component
compComponentName :: Maybe ComponentName
compLibDependencies :: [(ConfiguredId, Bool)]
compLinkedLibDependencies :: [OpenUnitId]
compExeDependencies :: [ConfiguredId]
compPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
compExeDependencyPaths :: [(ConfiguredId, String)]
compOrderLibDependencies :: [UnitId]
compSolverName :: ElaboratedComponent -> Component
compComponentName :: ElaboratedComponent -> Maybe ComponentName
compLibDependencies :: ElaboratedComponent -> [(ConfiguredId, Bool)]
compLinkedLibDependencies :: ElaboratedComponent -> [OpenUnitId]
compExeDependencies :: ElaboratedComponent -> [ConfiguredId]
compPkgConfigDependencies :: ElaboratedComponent -> [(PkgconfigName, Maybe PkgconfigVersion)]
compExeDependencyPaths :: ElaboratedComponent -> [(ConfiguredId, String)]
compOrderLibDependencies :: ElaboratedComponent -> [UnitId]
..} =
    -- Should not be building bench or test if not inplace.
    Bool -> a -> a
forall a. HasCallStack => Bool -> a -> a
assert
      ( BuildStyle -> Bool
isInplaceBuildStyle BuildStyle
elabBuildStyle
          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 PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
..}
  ElaboratedPackage{[(PkgconfigName, Maybe PkgconfigVersion)]
NonEmpty NotPerComponentReason
InstalledPackageId
ComponentDeps [()]
ComponentDeps [(ConfiguredId, Bool)]
ComponentDeps [(ConfiguredId, String)]
ComponentDeps [ConfiguredId]
OptionalStanzaSet
pkgInstalledId :: InstalledPackageId
pkgLibDependencies :: ComponentDeps [(ConfiguredId, Bool)]
pkgDependsOnSelfLib :: ComponentDeps [()]
pkgExeDependencies :: ComponentDeps [ConfiguredId]
pkgExeDependencyPaths :: ComponentDeps [(ConfiguredId, String)]
pkgPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
pkgStanzasEnabled :: OptionalStanzaSet
pkgWhyNotPerComponent :: NonEmpty NotPerComponentReason
pkgInstalledId :: ElaboratedPackage -> InstalledPackageId
pkgLibDependencies :: ElaboratedPackage -> ComponentDeps [(ConfiguredId, Bool)]
pkgDependsOnSelfLib :: ElaboratedPackage -> ComponentDeps [()]
pkgExeDependencies :: ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgExeDependencyPaths :: ElaboratedPackage -> ComponentDeps [(ConfiguredId, String)]
pkgPkgConfigDependencies :: ElaboratedPackage -> [(PkgconfigName, Maybe PkgconfigVersion)]
pkgStanzasEnabled :: ElaboratedPackage -> OptionalStanzaSet
pkgWhyNotPerComponent :: ElaboratedPackage -> NonEmpty NotPerComponentReason
..} =
    -- we should only have enabled stanzas that actually can be built
    -- (according to the solver)
    Bool -> a -> a
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)
      (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. HasCallStack => Bool -> a -> a
assert
        ( (Maybe Bool -> Bool)
-> OptionalStanzaMap (Maybe Bool) -> OptionalStanzaSet
forall a. (a -> Bool) -> OptionalStanzaMap a -> OptionalStanzaSet
optStanzaKeysFilteredByValue (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False) OptionalStanzaMap (Maybe Bool)
elabStanzasRequested
            OptionalStanzaSet -> OptionalStanzaSet -> Bool
`optStanzaSetIsSubset` OptionalStanzaSet
pkgStanzasEnabled
        )

-- $readingTheProjectConfiguration
--
-- The project configuration is assembled into a ProjectConfig as follows:
--
-- CLI arguments are converted using "commandLineFlagsToProjectConfig" in the
-- v2 command entrypoints and passed to "establishProjectBaseContext" which
-- then calls "rebuildProjectConfig".
--
-- "rebuildProjectConfig" then calls "readProjectConfig" to read the project
-- files. Due to the presence of conditionals, this output is in the form of a
-- "ProjectConfigSkeleton" and will be resolved by "rebuildProjectConfig" using
-- "instantiateProjectConfigSkeletonFetchingCompiler".
--
-- "readProjectConfig" also loads the global configuration, which is read with
-- "loadConfig" and convertd to a "ProjectConfig" with "convertLegacyGlobalConfig".
--
-- *Important:* You can notice how some project config options are needed to read the
-- project config! This is evident by the fact that "rebuildProjectConfig"
-- takes "HttpTransport" and "DistDirLayout" as parameters. Two arguments are
-- infact determined from the CLI alone (in "establishProjectBaseContext").
-- Consequently, project files (including global configuration) cannot
-- affect those parameters!
--
-- Furthermore, the project configuration can specify a compiler to use,
-- which we need to resolve the conditionals in the project configuration!
-- To solve this, we configure the compiler from what is obtained by applying
-- the CLI configuration over the the configuration obtained by "flattening"
-- ProjectConfigSkeleton. This means collapsing all conditionals by taking
-- both branches.

-- | 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 UnresolvedSourcePackage])
rebuildProjectConfig
  Verbosity
verbosity
  HttpTransport
httpTransport
  distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout
    { String
distProjectRootDirectory :: String
distProjectRootDirectory :: DistDirLayout -> String
distProjectRootDirectory
    , String
distDirectory :: String
distDirectory :: DistDirLayout -> String
distDirectory
    , String -> String
distProjectCacheFile :: String -> String
distProjectCacheFile :: DistDirLayout -> String -> String
distProjectCacheFile
    , String
distProjectCacheDirectory :: String
distProjectCacheDirectory :: DistDirLayout -> String
distProjectCacheDirectory
    , String -> String
distProjectFile :: String -> String
distProjectFile :: DistDirLayout -> String -> String
distProjectFile
    }
  ProjectConfig
cliConfig = do
    [String]
progsearchpath <- IO [String] -> IO [String]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> IO [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ IO [String]
getSystemSearchPath

    let fileMonitorProjectConfig :: FileMonitor
  (String, String, (Flag CompilerFlavor, Flag String, Flag String),
   [String], MapLast String String, NubList String)
  (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
fileMonitorProjectConfig = String
-> FileMonitor
     (String, String, (Flag CompilerFlavor, Flag String, Flag String),
      [String], MapLast String String, NubList String)
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
forall a b. Eq a => String -> FileMonitor a b
newFileMonitor (String -> String
distProjectCacheFile String
"config")

    (String, String, (Flag CompilerFlavor, Flag String, Flag String),
 [String], MapLast String String, NubList String)
fileMonitorProjectConfigKey <- do
      String
configPath <- Flag String -> IO String
getConfigFilePath Flag String
projectConfigConfigFile
      (String, String, (Flag CompilerFlavor, Flag String, Flag String),
 [String], MapLast String String, NubList String)
-> IO
     (String, String, (Flag CompilerFlavor, Flag String, Flag String),
      [String], MapLast String String, NubList String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( String
configPath
        , String -> String
distProjectFile String
""
        , (Flag CompilerFlavor
projectConfigHcFlavor, Flag String
projectConfigHcPath, Flag String
projectConfigHcPkg)
        , [String]
progsearchpath
        , MapLast String String
packageConfigProgramPaths
        , NubList String
packageConfigProgramPathExtra
        )

    (ProjectConfig
projectConfig, [PackageSpecifier UnresolvedSourcePackage]
localPackages) <-
      String
-> Rebuild
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
-> IO (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
forall a. String -> Rebuild a -> IO a
runRebuild String
distProjectRootDirectory
        (Rebuild
   (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
 -> IO (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage]))
-> Rebuild
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
-> IO (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
forall a b. (a -> b) -> a -> b
$ Verbosity
-> FileMonitor
     (String, String, (Flag CompilerFlavor, Flag String, Flag String),
      [String], MapLast String String, NubList String)
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
-> (String, String,
    (Flag CompilerFlavor, Flag String, Flag String), [String],
    MapLast String String, NubList String)
-> Rebuild
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
-> Rebuild
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
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, (Flag CompilerFlavor, Flag String, Flag String),
   [String], MapLast String String, NubList String)
  (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
fileMonitorProjectConfig
          (String, String, (Flag CompilerFlavor, Flag String, Flag String),
 [String], MapLast String String, NubList String)
fileMonitorProjectConfigKey -- todo check deps too?
        (Rebuild
   (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
 -> Rebuild
      (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage]))
-> Rebuild
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
-> Rebuild
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
forall a b. (a -> b) -> a -> b
$ do
          IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
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
                IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
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 ((ProjectConfig, [ProjectConfigPath]) -> ProjectConfig
forall a b. (a, b) -> a
fst (ProjectConfigSkeleton -> (ProjectConfig, [ProjectConfigPath])
forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
PD.ignoreConditions ProjectConfigSkeleton
projectConfigSkeleton) ProjectConfig -> ProjectConfig -> ProjectConfig
forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig)
                (OS, Arch, CompilerInfo) -> Rebuild (OS, Arch, CompilerInfo)
forall a. a -> Rebuild a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OS
os, Arch
arch, Compiler -> CompilerInfo
compilerInfo Compiler
compiler)

          ProjectConfig
projectConfig <- Rebuild (OS, Arch, CompilerInfo)
-> FlagAssignment -> ProjectConfigSkeleton -> Rebuild ProjectConfig
forall (m :: * -> *).
Monad m =>
m (OS, Arch, CompilerInfo)
-> FlagAssignment -> ProjectConfigSkeleton -> m ProjectConfig
instantiateProjectConfigSkeletonFetchingCompiler Rebuild (OS, Arch, CompilerInfo)
fetchCompiler FlagAssignment
forall a. Monoid a => a
mempty ProjectConfigSkeleton
projectConfigSkeleton
          Bool -> Rebuild () -> Rebuild ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProjectConfigShared -> Flag String
projectConfigDistDir (ProjectConfig -> ProjectConfigShared
projectConfigShared (ProjectConfig -> ProjectConfigShared)
-> ProjectConfig -> ProjectConfigShared
forall a b. (a -> b) -> a -> b
$ ProjectConfig
projectConfig) Flag String -> Flag String -> Bool
forall a. Eq a => a -> a -> Bool
/= Flag String
forall a. Flag a
NoFlag) (Rebuild () -> Rebuild ()) -> Rebuild () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$
            IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$
              Verbosity -> String -> IO ()
warn Verbosity
verbosity String
"The builddir option is not supported in project and config files. It will be ignored."
          [PackageSpecifier UnresolvedSourcePackage]
localPackages <- ProjectConfig -> Rebuild [PackageSpecifier UnresolvedSourcePackage]
phaseReadLocalPackages (ProjectConfig
projectConfig ProjectConfig -> ProjectConfig -> ProjectConfig
forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig)
          (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
-> Rebuild
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectConfig
projectConfig, [PackageSpecifier UnresolvedSourcePackage]
localPackages)

    let configfiles :: [Doc]
configfiles =
          [ String -> Doc
text String
"-" Doc -> Doc -> Doc
<+> ProjectConfigPath -> Doc
docProjectConfigPath ProjectConfigPath
path
          | Explicit ProjectConfigPath
path <- Set ProjectConfigProvenance -> [ProjectConfigProvenance]
forall a. Set a -> [a]
Set.toList (Set ProjectConfigProvenance -> [ProjectConfigProvenance])
-> (Set ProjectConfigProvenance -> Set ProjectConfigProvenance)
-> Set ProjectConfigProvenance
-> [ProjectConfigProvenance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
verbose then Set ProjectConfigProvenance -> Set ProjectConfigProvenance
forall a. a -> a
id else Set ProjectConfigProvenance -> Set ProjectConfigProvenance
onlyTopLevelProvenance) (Set ProjectConfigProvenance -> [ProjectConfigProvenance])
-> Set ProjectConfigProvenance -> [ProjectConfigProvenance]
forall a b. (a -> b) -> a -> b
$ ProjectConfig -> Set ProjectConfigProvenance
projectConfigProvenance ProjectConfig
projectConfig
          ]
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Doc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
configfiles) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Verbosity -> String -> IO ()
notice (Verbosity -> Verbosity
verboseStderr Verbosity
verbosity) (String -> IO ()) -> ([Doc] -> String) -> [Doc] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render (Doc -> String) -> ([Doc] -> Doc) -> [Doc] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> IO ()) -> [Doc] -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"Configuration is affected by the following files:" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
configfiles

    (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
-> IO (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectConfig
projectConfig ProjectConfig -> ProjectConfig -> ProjectConfig
forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig, [PackageSpecifier UnresolvedSourcePackage]
localPackages)
    where
      ProjectConfigShared{Flag CompilerFlavor
projectConfigHcFlavor :: Flag CompilerFlavor
projectConfigHcFlavor :: ProjectConfigShared -> Flag CompilerFlavor
projectConfigHcFlavor, Flag String
projectConfigHcPath :: Flag String
projectConfigHcPath :: ProjectConfigShared -> Flag String
projectConfigHcPath, Flag String
projectConfigHcPkg :: Flag String
projectConfigHcPkg :: ProjectConfigShared -> Flag String
projectConfigHcPkg, Flag Bool
projectConfigIgnoreProject :: Flag Bool
projectConfigIgnoreProject :: ProjectConfigShared -> Flag Bool
projectConfigIgnoreProject, Flag String
projectConfigConfigFile :: Flag String
projectConfigConfigFile :: ProjectConfigShared -> Flag String
projectConfigConfigFile} =
        ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig

      PackageConfig{MapLast String String
packageConfigProgramPaths :: MapLast String String
packageConfigProgramPaths :: PackageConfig -> MapLast String String
packageConfigProgramPaths, NubList String
packageConfigProgramPathExtra :: NubList String
packageConfigProgramPathExtra :: PackageConfig -> NubList String
packageConfigProgramPathExtra} =
        ProjectConfig -> PackageConfig
projectConfigLocalPackages ProjectConfig
cliConfig

      -- 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
      --
      -- NOTE: These are all packages mentioned in the project configuration.
      -- Whether or not they will be considered local to the project will be decided by `shouldBeLocal`.
      phaseReadLocalPackages
        :: ProjectConfig
        -> Rebuild [PackageSpecifier UnresolvedSourcePackage]
      phaseReadLocalPackages :: ProjectConfig -> Rebuild [PackageSpecifier UnresolvedSourcePackage]
phaseReadLocalPackages
        projectConfig :: ProjectConfig
projectConfig@ProjectConfig
          { ProjectConfigShared
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared :: ProjectConfigShared
projectConfigShared
          , ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfig -> 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.
          IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
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 UnresolvedSourcePackage]
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 :: DistDirLayout -> String -> String
distProjectCacheFile :: 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
        , NubList String
projectConfigProgPathExtra :: NubList String
projectConfigProgPathExtra :: ProjectConfigShared -> NubList String
projectConfigProgPathExtra
        }
    , 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)
  (Compiler, Platform, ProgramDb)
fileMonitorCompiler = String
-> FileMonitor
     (Maybe CompilerFlavor, Maybe String, Maybe String, [String],
      MapLast String String, NubList String)
     (Compiler, Platform, ProgramDb)
forall a b. Eq a => String -> FileMonitor a b
newFileMonitor (String
 -> FileMonitor
      (Maybe CompilerFlavor, Maybe String, Maybe String, [String],
       MapLast String String, NubList String)
      (Compiler, Platform, ProgramDb))
-> String
-> FileMonitor
     (Maybe CompilerFlavor, Maybe String, Maybe String, [String],
      MapLast String String, NubList String)
     (Compiler, Platform, ProgramDb)
forall a b. (a -> b) -> a -> b
$ String -> String
distProjectCacheFile String
"compiler"

    [String]
progsearchpath <- IO [String] -> Rebuild [String]
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Rebuild [String])
-> IO [String] -> Rebuild [String]
forall a b. (a -> b) -> a -> b
$ IO [String]
getSystemSearchPath

    Verbosity
-> FileMonitor
     (Maybe CompilerFlavor, Maybe String, Maybe String, [String],
      MapLast String String, NubList String)
     (Compiler, Platform, ProgramDb)
-> (Maybe CompilerFlavor, Maybe String, Maybe String, [String],
    MapLast String String, NubList String)
-> Rebuild (Compiler, Platform, ProgramDb)
-> Rebuild (Compiler, Platform, ProgramDb)
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged
      Verbosity
verbosity
      FileMonitor
  (Maybe CompilerFlavor, Maybe String, Maybe String, [String],
   MapLast String String, NubList String)
  (Compiler, Platform, ProgramDb)
fileMonitorCompiler
      ( Maybe CompilerFlavor
hcFlavor
      , Maybe String
hcPath
      , Maybe String
hcPkg
      , [String]
progsearchpath
      , MapLast String String
packageConfigProgramPaths
      , NubList String
packageConfigProgramPathExtra
      )
      (Rebuild (Compiler, Platform, ProgramDb)
 -> Rebuild (Compiler, Platform, ProgramDb))
-> Rebuild (Compiler, Platform, ProgramDb)
-> Rebuild (Compiler, Platform, ProgramDb)
forall a b. (a -> b) -> a -> b
$ do
        IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
info Verbosity
verbosity String
"Compiler settings changed, reconfiguring..."
        ProgramDb
progdb <-
          IO ProgramDb -> Rebuild ProgramDb
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProgramDb -> Rebuild ProgramDb)
-> IO ProgramDb -> Rebuild ProgramDb
forall a b. (a -> b) -> a -> b
$
            -- Add paths in the global config
            Verbosity
-> [String]
-> [(String, Maybe String)]
-> ProgramDb
-> IO ProgramDb
prependProgramSearchPath Verbosity
verbosity (NubList String -> [String]
forall a. NubList a -> [a]
fromNubList NubList String
projectConfigProgPathExtra) [] ProgramDb
defaultProgramDb
              -- Add paths in the local config
              IO ProgramDb -> (ProgramDb -> IO ProgramDb) -> IO ProgramDb
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity
-> [String]
-> [(String, Maybe String)]
-> ProgramDb
-> IO ProgramDb
prependProgramSearchPath Verbosity
verbosity (NubList String -> [String]
forall a. NubList a -> [a]
fromNubList NubList String
packageConfigProgramPathExtra) []
              IO ProgramDb -> (ProgramDb -> IO ProgramDb) -> IO ProgramDb
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProgramDb -> IO ProgramDb
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProgramDb -> IO ProgramDb)
-> (ProgramDb -> ProgramDb) -> ProgramDb -> IO ProgramDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> ProgramDb -> ProgramDb
userSpecifyPaths (Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
Map.toList (MapLast String String -> Map String String
forall k v. MapLast k v -> Map k v
getMapLast MapLast String String
packageConfigProgramPaths))
        result :: (Compiler, Platform, ProgramDb)
result@(Compiler
_, Platform
_, ProgramDb
progdb') <-
          IO (Compiler, Platform, ProgramDb)
-> Rebuild (Compiler, Platform, ProgramDb)
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Compiler, Platform, ProgramDb)
 -> Rebuild (Compiler, Platform, ProgramDb))
-> IO (Compiler, Platform, ProgramDb)
-> Rebuild (Compiler, Platform, ProgramDb)
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')

        -- Note: There is currently a bug here: we are dropping unconfigured
        -- programs from the 'ProgramDb' when we re-use the cache created by
        -- 'rerunIfChanged'.
        --
        -- See Note [Caching the result of configuring the compiler]

        (Compiler, Platform, ProgramDb)
-> Rebuild (Compiler, Platform, ProgramDb)
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler, Platform, ProgramDb)
result
    where
      hcFlavor :: Maybe CompilerFlavor
hcFlavor = Flag CompilerFlavor -> Maybe CompilerFlavor
forall a. Flag a -> Maybe a
flagToMaybe Flag CompilerFlavor
projectConfigHcFlavor
      hcPath :: Maybe String
hcPath = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigHcPath
      hcPkg :: Maybe String
hcPkg = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigHcPkg

{- Note [Caching the result of configuring the compiler]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We can't straightforwardly cache anything that contains a 'ProgramDb', because
the 'Binary' instance for 'ProgramDb' discards all unconfigured programs.
See that instance, as well as 'restoreProgramDb', for a few more details.

This means that if we try to cache the result of configuring the compiler (which
contains a 'ProgramDb'):

 - On the first run, we will obtain a 'ProgramDb' which may contain several
   unconfigured programs. In particular, configuring GHC will add tools such
   as `ar` and `ld` as unconfigured programs to the 'ProgramDb', with custom
   logic for finding their location based on the location of the GHC binary.
 - On subsequent runs, if we use the cache created by 'rerunIfChanged', we will
   deserialise the 'ProgramDb' from disk, which means it won't include any
   unconfigured programs, which might mean we are unable to find 'ar' or 'ld'.

This is not currently a huge problem because, in the Cabal library, we eagerly
re-run the configureCompiler step (thus recovering any lost information), but
this is wasted work that we should stop doing in Cabal, given that cabal-install
has already figured out all the necessary information about the compiler.

To fix this bug, we can't simply eagerly configure all unconfigured programs,
as was originally attempted, for a couple of reasons:

 - it does more work than necessary, by configuring programs that we may not
   end up needing,
 - it means that we prioritise system executables for built-in build tools
   (such as `alex` and `happy`), instead of using the proper version for a
   package or package component, as specified by a `build-tool-depends` stanza
   or by package-level `extra-prog-path` arguments.
   This lead to bug reports #10633 and #10692.

See #9840 for more information about the problems surrounding the lossly
Binary ProgramDb instance.
-}

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

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

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

-- | 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 UnresolvedSourcePackage]
-> Maybe InstalledPackageIndex
-> IO
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
rebuildInstallPlan
  Verbosity
verbosity
  distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout
    { String
distProjectRootDirectory :: DistDirLayout -> String
distProjectRootDirectory :: String
distProjectRootDirectory
    , String -> String
distProjectCacheFile :: DistDirLayout -> String -> String
distProjectCacheFile :: String -> String
distProjectCacheFile
    }
  CabalDirLayout
    { StoreDirLayout
cabalStoreDirLayout :: StoreDirLayout
cabalStoreDirLayout :: CabalDirLayout -> StoreDirLayout
cabalStoreDirLayout
    } = \ProjectConfig
projectConfig [PackageSpecifier UnresolvedSourcePackage]
localPackages Maybe InstalledPackageIndex
mbInstalledPackages ->
    String
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
-> IO
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
forall a. String -> Rebuild a -> IO a
runRebuild String
distProjectRootDirectory (Rebuild
   (ElaboratedInstallPlan, ElaboratedInstallPlan,
    ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
 -> IO
      (ElaboratedInstallPlan, ElaboratedInstallPlan,
       ElaboratedSharedConfig, TotalIndexState, ActiveRepos))
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
-> IO
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
forall a b. (a -> b) -> a -> b
$ do
      [String]
progsearchpath <- IO [String] -> Rebuild [String]
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Rebuild [String])
-> IO [String] -> Rebuild [String]
forall a b. (a -> b) -> a -> b
$ IO [String]
getSystemSearchPath
      let projectConfigMonitored :: ProjectConfig
projectConfigMonitored = ProjectConfig
projectConfig{projectConfigBuildOnly = mempty}

      -- The overall improved plan is cached
      Verbosity
-> FileMonitor
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
      [String])
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
-> (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
    [String])
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged
        Verbosity
verbosity
        FileMonitor
  (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
   [String])
  (ElaboratedInstallPlan, ElaboratedInstallPlan,
   ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
forall {b}.
FileMonitor
  (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
   [String])
  b
fileMonitorImprovedPlan
        -- react to changes in the project config,
        -- the package .cabal files and the path
        (ProjectConfig
projectConfigMonitored, [PackageSpecifier UnresolvedSourcePackage]
localPackages, [String]
progsearchpath)
        (Rebuild
   (ElaboratedInstallPlan, ElaboratedInstallPlan,
    ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
 -> Rebuild
      (ElaboratedInstallPlan, ElaboratedInstallPlan,
       ElaboratedSharedConfig, TotalIndexState, ActiveRepos))
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
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) <-
            Verbosity
-> FileMonitor
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
      [String])
     (ElaboratedInstallPlan, ElaboratedSharedConfig, TotalIndexState,
      ActiveRepos)
-> (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
    [String])
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedSharedConfig, TotalIndexState,
      ActiveRepos)
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedSharedConfig, TotalIndexState,
      ActiveRepos)
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged
              Verbosity
verbosity
              FileMonitor
  (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
   [String])
  (ElaboratedInstallPlan, ElaboratedSharedConfig, TotalIndexState,
   ActiveRepos)
forall {b}.
FileMonitor
  (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
   [String])
  b
fileMonitorElaboratedPlan
              ( ProjectConfig
projectConfigMonitored
              , [PackageSpecifier UnresolvedSourcePackage]
localPackages
              , [String]
progsearchpath
              )
              (Rebuild
   (ElaboratedInstallPlan, ElaboratedSharedConfig, TotalIndexState,
    ActiveRepos)
 -> Rebuild
      (ElaboratedInstallPlan, ElaboratedSharedConfig, TotalIndexState,
       ActiveRepos))
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedSharedConfig, TotalIndexState,
      ActiveRepos)
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedSharedConfig, TotalIndexState,
      ActiveRepos)
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, Maybe PkgConfigDb
pkgConfigDB, TotalIndexState
totalIndexState, ActiveRepos
activeRepos) <-
                  ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> [PackageSpecifier UnresolvedSourcePackage]
-> InstalledPackageIndex
-> Rebuild
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
phaseRunSolver
                    ProjectConfig
projectConfig
                    (Compiler, Platform, ProgramDb)
compilerEtc
                    [PackageSpecifier UnresolvedSourcePackage]
localPackages
                    (InstalledPackageIndex
-> Maybe InstalledPackageIndex -> InstalledPackageIndex
forall a. a -> Maybe a -> a
fromMaybe InstalledPackageIndex
forall a. Monoid a => a
mempty Maybe InstalledPackageIndex
mbInstalledPackages)
                ( ElaboratedInstallPlan
elaboratedPlan
                  , ElaboratedSharedConfig
elaboratedShared
                  ) <-
                  ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> Maybe PkgConfigDb
-> SolverInstallPlan
-> [PackageSpecifier UnresolvedSourcePackage]
-> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig)
forall loc.
ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> Maybe PkgConfigDb
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig)
phaseElaboratePlan
                    ProjectConfig
projectConfig
                    (Compiler, Platform, ProgramDb)
compilerEtc
                    Maybe PkgConfigDb
pkgConfigDB
                    SolverInstallPlan
solverPlan
                    [PackageSpecifier UnresolvedSourcePackage]
localPackages

                ElaboratedInstallPlan -> ElaboratedSharedConfig -> Rebuild ()
phaseMaintainPlanOutputs ElaboratedInstallPlan
elaboratedPlan ElaboratedSharedConfig
elaboratedShared
                (ElaboratedInstallPlan, ElaboratedSharedConfig, TotalIndexState,
 ActiveRepos)
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedSharedConfig, TotalIndexState,
      ActiveRepos)
forall a. a -> Rebuild a
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

          (ElaboratedInstallPlan, ElaboratedInstallPlan,
 ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
-> Rebuild
     (ElaboratedInstallPlan, ElaboratedInstallPlan,
      ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
improvedPlan, ElaboratedInstallPlan
elaboratedPlan, ElaboratedSharedConfig
elaboratedShared, TotalIndexState
totalIndexState, ActiveRepos
activeRepos)
    where
      fileMonitorSolverPlan :: FileMonitor
  (SolverSettings, [PackageSpecifier UnresolvedSourcePackage],
   Map PackageName (Map OptionalStanza Bool), Compiler, Platform,
   [ConfiguredProgram])
  b
fileMonitorSolverPlan = String
-> FileMonitor
     (SolverSettings, [PackageSpecifier UnresolvedSourcePackage],
      Map PackageName (Map OptionalStanza Bool), Compiler, Platform,
      [ConfiguredProgram])
     b
forall a b. Eq a => String -> FileMonitor a b
newFileMonitorInCacheDir String
"solver-plan"
      fileMonitorSourceHashes :: FileMonitor [(PackageId, PackageLocation (Maybe String))] b
fileMonitorSourceHashes = String
-> FileMonitor [(PackageId, PackageLocation (Maybe String))] b
forall a b. Eq a => String -> FileMonitor a b
newFileMonitorInCacheDir String
"source-hashes"
      fileMonitorElaboratedPlan :: FileMonitor
  (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
   [String])
  b
fileMonitorElaboratedPlan = String
-> FileMonitor
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
      [String])
     b
forall a b. Eq a => String -> FileMonitor a b
newFileMonitorInCacheDir String
"elaborated-plan"
      fileMonitorImprovedPlan :: FileMonitor
  (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
   [String])
  b
fileMonitorImprovedPlan = String
-> FileMonitor
     (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage],
      [String])
     b
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 = String -> FileMonitor a b
forall a b. Eq a => String -> FileMonitor a b
newFileMonitor (String -> FileMonitor a b)
-> (String -> String) -> String -> FileMonitor a b
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.
        IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$
          [ConfiguredProgram] -> Map PackageName PackageConfig -> IO ()
checkBadPerPackageCompilerPaths
            (ProgramDb -> [ConfiguredProgram]
configuredPrograms ProgramDb
compilerprogdb)
            (MapMappend PackageName PackageConfig
-> Map PackageName PackageConfig
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, Maybe PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
      phaseRunSolver :: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> [PackageSpecifier UnresolvedSourcePackage]
-> InstalledPackageIndex
-> Rebuild
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
phaseRunSolver
        projectConfig :: ProjectConfig
projectConfig@ProjectConfig
          { ProjectConfigShared
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared :: ProjectConfigShared
projectConfigShared
          , ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfigBuildOnly
projectConfigBuildOnly
          }
        (Compiler
compiler, Platform
platform, ProgramDb
progdb)
        [PackageSpecifier UnresolvedSourcePackage]
localPackages
        InstalledPackageIndex
installedPackages =
          Verbosity
-> FileMonitor
     (SolverSettings, [PackageSpecifier UnresolvedSourcePackage],
      Map PackageName (Map OptionalStanza Bool), Compiler, Platform,
      [ConfiguredProgram])
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
-> (SolverSettings, [PackageSpecifier UnresolvedSourcePackage],
    Map PackageName (Map OptionalStanza Bool), Compiler, Platform,
    [ConfiguredProgram])
-> Rebuild
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
-> Rebuild
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged
            Verbosity
verbosity
            FileMonitor
  (SolverSettings, [PackageSpecifier UnresolvedSourcePackage],
   Map PackageName (Map OptionalStanza Bool), Compiler, Platform,
   [ConfiguredProgram])
  (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
   ActiveRepos)
forall {b}.
FileMonitor
  (SolverSettings, [PackageSpecifier UnresolvedSourcePackage],
   Map PackageName (Map OptionalStanza Bool), Compiler, Platform,
   [ConfiguredProgram])
  b
fileMonitorSolverPlan
            ( SolverSettings
solverSettings
            , [PackageSpecifier UnresolvedSourcePackage]
localPackages
            , Map PackageName (Map OptionalStanza Bool)
localPackagesEnabledStanzas
            , Compiler
compiler
            , Platform
platform
            , ProgramDb -> [ConfiguredProgram]
programDbSignature ProgramDb
progdb
            )
            (Rebuild
   (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
    ActiveRepos)
 -> Rebuild
      (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
       ActiveRepos))
-> Rebuild
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
-> Rebuild
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
forall a b. (a -> b) -> a -> b
$ do
              InstalledPackageIndex
installedPkgIndex <-
                Verbosity
-> Compiler
-> ProgramDb
-> Platform
-> PackageDBStackCWD
-> Rebuild InstalledPackageIndex
getInstalledPackages
                  Verbosity
verbosity
                  Compiler
compiler
                  ProgramDb
progdb
                  Platform
platform
                  PackageDBStackCWD
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
                  (RepoContext -> IO a) -> IO a
forall a. (RepoContext -> IO a) -> IO a
withRepoCtx
                  (SolverSettings -> Maybe TotalIndexState
solverSettingIndexState SolverSettings
solverSettings)
                  (SolverSettings -> Maybe ActiveRepos
solverSettingActiveRepos SolverSettings
solverSettings)
              Maybe PkgConfigDb
pkgConfigDB <- Verbosity -> ProgramDb -> Rebuild (Maybe 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.

              IO
  (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
   ActiveRepos)
-> Rebuild
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
    ActiveRepos)
 -> Rebuild
      (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
       ActiveRepos))
-> IO
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
-> Rebuild
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
forall a b. (a -> b) -> a -> b
$ do
                Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"Resolving dependencies..."
                Either String SolverInstallPlan
planOrError <-
                  (String
 -> IO (Either String SolverInstallPlan)
 -> IO (Either String SolverInstallPlan))
-> (String -> IO (Either String SolverInstallPlan))
-> (SolverInstallPlan -> IO (Either String SolverInstallPlan))
-> Progress String String SolverInstallPlan
-> IO (Either String SolverInstallPlan)
forall step a fail done.
(step -> a -> a)
-> (fail -> a) -> (done -> a) -> Progress step fail done -> a
foldProgress String
-> IO (Either String SolverInstallPlan)
-> IO (Either String SolverInstallPlan)
logMsg (Either String SolverInstallPlan
-> IO (Either String SolverInstallPlan)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SolverInstallPlan
 -> IO (Either String SolverInstallPlan))
-> (String -> Either String SolverInstallPlan)
-> String
-> IO (Either String SolverInstallPlan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String SolverInstallPlan
forall a b. a -> Either a b
Left) (Either String SolverInstallPlan
-> IO (Either String SolverInstallPlan)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SolverInstallPlan
 -> IO (Either String SolverInstallPlan))
-> (SolverInstallPlan -> Either String SolverInstallPlan)
-> SolverInstallPlan
-> IO (Either String SolverInstallPlan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolverInstallPlan -> Either String SolverInstallPlan
forall a b. b -> Either a b
Right) (Progress String String SolverInstallPlan
 -> IO (Either String SolverInstallPlan))
-> Progress String String SolverInstallPlan
-> IO (Either String SolverInstallPlan)
forall a b. (a -> b) -> a -> b
$
                    Verbosity
-> Compiler
-> Platform
-> SolverSettings
-> InstalledPackageIndex
-> SourcePackageDb
-> Maybe PkgConfigDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> Map PackageName (Map OptionalStanza Bool)
-> Progress String String SolverInstallPlan
planPackages
                      Verbosity
verbosity
                      Compiler
compiler
                      Platform
platform
                      SolverSettings
solverSettings
                      (InstalledPackageIndex
installedPackages InstalledPackageIndex
-> InstalledPackageIndex -> InstalledPackageIndex
forall a. Semigroup a => a -> a -> a
<> InstalledPackageIndex
installedPkgIndex)
                      SourcePackageDb
sourcePkgDb
                      Maybe PkgConfigDb
pkgConfigDB
                      [PackageSpecifier UnresolvedSourcePackage]
localPackages
                      Map PackageName (Map OptionalStanza Bool)
localPackagesEnabledStanzas
                case Either String SolverInstallPlan
planOrError of
                  Left String
msg -> do
                    ProjectConfig
-> Compiler
-> Platform
-> [PackageSpecifier UnresolvedSourcePackage]
-> IO ()
reportPlanningFailure ProjectConfig
projectConfig Compiler
compiler Platform
platform [PackageSpecifier UnresolvedSourcePackage]
localPackages
                    Verbosity
-> CabalInstallException
-> IO
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException
 -> IO
      (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
       ActiveRepos))
-> CabalInstallException
-> IO
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
forall a b. (a -> b) -> a -> b
$ String -> CabalInstallException
PhaseRunSolverErr String
msg
                  Right SolverInstallPlan
plan -> (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
 ActiveRepos)
-> IO
     (SolverInstallPlan, Maybe PkgConfigDb, TotalIndexState,
      ActiveRepos)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SolverInstallPlan
plan, Maybe PkgConfigDb
pkgConfigDB, TotalIndexState
tis, ActiveRepos
ar)
          where
            corePackageDbs :: PackageDBStackCWD
            corePackageDbs :: PackageDBStackCWD
corePackageDbs =
              Bool -> [Maybe PackageDBCWD] -> PackageDBStackCWD
forall fp. Bool -> [Maybe (PackageDBX fp)] -> PackageDBStackX fp
Cabal.interpretPackageDbFlags Bool
False (ProjectConfigShared -> [Maybe PackageDBCWD]
projectConfigPackageDBs ProjectConfigShared
projectConfigShared)

            withRepoCtx :: (RepoContext -> IO a) -> IO a
            withRepoCtx :: forall a. (RepoContext -> IO a) -> IO a
withRepoCtx =
              Verbosity
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> (RepoContext -> IO a)
-> IO a
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 (Either String SolverInstallPlan)
-> IO (Either String SolverInstallPlan)
logMsg String
message IO (Either String SolverInstallPlan)
rest = Verbosity -> String -> IO ()
debugNoWrap Verbosity
verbosity String
message IO ()
-> IO (Either String SolverInstallPlan)
-> IO (Either String SolverInstallPlan)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Either String SolverInstallPlan)
rest

            localPackagesEnabledStanzas :: Map PackageName (Map OptionalStanza Bool)
localPackagesEnabledStanzas =
              [(PackageName, Map OptionalStanza Bool)]
-> Map PackageName (Map OptionalStanza Bool)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (PackageName
pkgname, Map OptionalStanza Bool
stanzas)
                | PackageSpecifier UnresolvedSourcePackage
pkg <- [PackageSpecifier UnresolvedSourcePackage]
localPackages
                , -- TODO: misnomer: we should separate
                -- builtin/global/inplace/local packages
                -- and packages explicitly mentioned in the project
                --
                let pkgname :: PackageName
pkgname = PackageSpecifier UnresolvedSourcePackage -> PackageName
forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget PackageSpecifier UnresolvedSourcePackage
pkg
                    testsEnabled :: Flag Bool
testsEnabled =
                      (PackageConfig -> Flag Bool)
-> ProjectConfig -> PackageName -> Flag Bool
forall a.
(Semigroup a, Monoid a) =>
(PackageConfig -> a) -> ProjectConfig -> PackageName -> a
lookupLocalPackageConfig
                        PackageConfig -> Flag Bool
packageConfigTests
                        ProjectConfig
projectConfig
                        PackageName
pkgname
                    benchmarksEnabled :: Flag Bool
benchmarksEnabled =
                      (PackageConfig -> Flag Bool)
-> ProjectConfig -> PackageName -> Flag Bool
forall a.
(Semigroup a, Monoid a) =>
(PackageConfig -> a) -> ProjectConfig -> PackageName -> a
lookupLocalPackageConfig
                        PackageConfig -> Flag Bool
packageConfigBenchmarks
                        ProjectConfig
projectConfig
                        PackageName
pkgname
                    isLocal :: Bool
isLocal = Maybe PackageId -> Bool
forall a. Maybe a -> Bool
isJust (PackageSpecifier UnresolvedSourcePackage -> Maybe PackageId
forall loc.
PackageSpecifier (SourcePackage (PackageLocation loc))
-> Maybe PackageId
shouldBeLocal PackageSpecifier UnresolvedSourcePackage
pkg)
                    stanzas :: Map OptionalStanza Bool
stanzas
                      | Bool
isLocal =
                          [(OptionalStanza, Bool)] -> Map OptionalStanza Bool
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(OptionalStanza, Bool)] -> Map OptionalStanza Bool)
-> [(OptionalStanza, Bool)] -> Map OptionalStanza Bool
forall a b. (a -> b) -> a -> b
$
                            [ (OptionalStanza
TestStanzas, Bool
enabled)
                            | Bool
enabled <- Flag Bool -> [Bool]
forall a. Flag a -> [a]
flagToList Flag Bool
testsEnabled
                            ]
                              [(OptionalStanza, Bool)]
-> [(OptionalStanza, Bool)] -> [(OptionalStanza, Bool)]
forall a. [a] -> [a] -> [a]
++ [ (OptionalStanza
BenchStanzas, Bool
enabled)
                                 | Bool
enabled <- Flag Bool -> [Bool]
forall a. Flag a -> [a]
flagToList Flag Bool
benchmarksEnabled
                                 ]
                      | Bool
otherwise = [(OptionalStanza, Bool)] -> Map OptionalStanza Bool
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)
        -> Maybe PkgConfigDb
        -> SolverInstallPlan
        -> [PackageSpecifier (SourcePackage (PackageLocation loc))]
        -> Rebuild
            ( ElaboratedInstallPlan
            , ElaboratedSharedConfig
            )
      phaseElaboratePlan :: forall loc.
ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> Maybe PkgConfigDb
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig)
phaseElaboratePlan
        ProjectConfig
          { ProjectConfigShared
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared :: ProjectConfigShared
projectConfigShared
          , PackageConfig
projectConfigAllPackages :: PackageConfig
projectConfigAllPackages :: ProjectConfig -> PackageConfig
projectConfigAllPackages
          , PackageConfig
projectConfigLocalPackages :: ProjectConfig -> PackageConfig
projectConfigLocalPackages :: PackageConfig
projectConfigLocalPackages
          , MapMappend PackageName PackageConfig
projectConfigSpecificPackage :: ProjectConfig -> MapMappend PackageName PackageConfig
projectConfigSpecificPackage :: MapMappend PackageName PackageConfig
projectConfigSpecificPackage
          , ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfigBuildOnly
projectConfigBuildOnly
          }
        (Compiler
compiler, Platform
platform, ProgramDb
progdb)
        Maybe PkgConfigDb
pkgConfigDB
        SolverInstallPlan
solverPlan
        [PackageSpecifier (SourcePackage (PackageLocation loc))]
localPackages = do
          IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
debug Verbosity
verbosity String
"Elaborating the install plan..."

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

          InstallDirTemplates
defaultInstallDirs <- IO InstallDirTemplates -> Rebuild InstallDirTemplates
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InstallDirTemplates -> Rebuild InstallDirTemplates)
-> IO InstallDirTemplates -> Rebuild InstallDirTemplates
forall a b. (a -> b) -> a -> b
$ Compiler -> IO InstallDirTemplates
userInstallDirTemplates Compiler
compiler
          let installDirs :: InstallDirTemplates
installDirs = (Flag PathTemplate -> PathTemplate)
-> InstallDirs (Flag PathTemplate) -> InstallDirTemplates
forall a b. (a -> b) -> InstallDirs a -> InstallDirs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Flag PathTemplate -> PathTemplate
forall a. WithCallStack (Flag a -> a)
Cabal.fromFlag (InstallDirs (Flag PathTemplate) -> InstallDirTemplates)
-> InstallDirs (Flag PathTemplate) -> InstallDirTemplates
forall a b. (a -> b) -> a -> b
$ ((PathTemplate -> Flag PathTemplate)
-> InstallDirTemplates -> InstallDirs (Flag PathTemplate)
forall a b. (a -> b) -> InstallDirs a -> InstallDirs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
Flag InstallDirTemplates
defaultInstallDirs) InstallDirs (Flag PathTemplate)
-> InstallDirs (Flag PathTemplate)
-> InstallDirs (Flag PathTemplate)
forall a. Semigroup a => a -> a -> a
<> (ProjectConfigShared -> InstallDirs (Flag PathTemplate)
projectConfigInstallDirs ProjectConfigShared
projectConfigShared)
          (ElaboratedInstallPlan
elaboratedPlan, ElaboratedSharedConfig
elaboratedShared) <-
            IO (ElaboratedInstallPlan, ElaboratedSharedConfig)
-> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig)
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ElaboratedInstallPlan, ElaboratedSharedConfig)
 -> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig))
-> (LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
    -> IO (ElaboratedInstallPlan, ElaboratedSharedConfig))
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
-> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
-> IO (ElaboratedInstallPlan, ElaboratedSharedConfig)
forall a. Verbosity -> LogProgress a -> IO a
runLogProgress Verbosity
verbosity (LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
 -> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig))
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
-> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig)
forall a b. (a -> b) -> a -> b
$
              Verbosity
-> Platform
-> Compiler
-> ProgramDb
-> Maybe PkgConfigDb
-> DistDirLayout
-> StoreDirLayout
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> Map PackageId PackageSourceHash
-> InstallDirTemplates
-> ProjectConfigShared
-> PackageConfig
-> PackageConfig
-> Map PackageName PackageConfig
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
forall loc.
Verbosity
-> Platform
-> Compiler
-> ProgramDb
-> Maybe PkgConfigDb
-> DistDirLayout
-> StoreDirLayout
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> Map PackageId PackageSourceHash
-> InstallDirTemplates
-> ProjectConfigShared
-> PackageConfig
-> PackageConfig
-> Map PackageName PackageConfig
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
elaborateInstallPlan
                Verbosity
verbosity
                Platform
platform
                Compiler
compiler
                ProgramDb
progdb
                Maybe PkgConfigDb
pkgConfigDB
                DistDirLayout
distDirLayout
                StoreDirLayout
cabalStoreDirLayout
                SolverInstallPlan
solverPlan
                [PackageSpecifier (SourcePackage (PackageLocation loc))]
localPackages
                Map PackageId PackageSourceHash
sourcePackageHashes
                InstallDirTemplates
installDirs
                ProjectConfigShared
projectConfigShared
                PackageConfig
projectConfigAllPackages
                PackageConfig
projectConfigLocalPackages
                (MapMappend PackageName PackageConfig
-> Map PackageName PackageConfig
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
          IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
debugNoWrap Verbosity
verbosity (ElaboratedInstallPlan -> String
showElaboratedInstallPlan ElaboratedInstallPlan
instantiatedPlan)
          (ElaboratedInstallPlan, ElaboratedSharedConfig)
-> Rebuild (ElaboratedInstallPlan, ElaboratedSharedConfig)
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
instantiatedPlan, ElaboratedSharedConfig
elaboratedShared)
          where
            withRepoCtx :: (RepoContext -> IO a) -> IO a
            withRepoCtx :: forall a. (RepoContext -> IO a) -> IO a
withRepoCtx =
              Verbosity
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> (RepoContext -> IO a)
-> IO a
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 = IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
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
        IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
debug Verbosity
verbosity String
"Improving the install plan..."
        Set UnitId
storePkgIdSet <- StoreDirLayout -> Compiler -> Rebuild (Set UnitId)
getStoreEntries StoreDirLayout
cabalStoreDirLayout Compiler
compiler
        let improvedPlan :: ElaboratedInstallPlan
improvedPlan =
              Set UnitId -> ElaboratedInstallPlan -> ElaboratedInstallPlan
improveInstallPlanWithInstalledPackages
                Set UnitId
storePkgIdSet
                ElaboratedInstallPlan
elaboratedPlan
        IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
debugNoWrap Verbosity
verbosity (ElaboratedInstallPlan -> String
showElaboratedInstallPlan 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.
        ElaboratedInstallPlan -> Rebuild ElaboratedInstallPlan
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return ElaboratedInstallPlan
improvedPlan
        where
          compiler :: Compiler
compiler = 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 UnresolvedSourcePackage]
-> IO ()
reportPlanningFailure ProjectConfig
projectConfig Compiler
comp Platform
platform [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
reportFailure (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    CompilerInfo
-> [PathTemplate]
-> [(BuildReport, Maybe Repo)]
-> Platform
-> IO ()
BuildReports.storeLocal
      (Compiler -> CompilerInfo
compilerInfo Compiler
comp)
      (NubList PathTemplate -> [PathTemplate]
forall a. NubList a -> [a]
fromNubList (NubList PathTemplate -> [PathTemplate])
-> NubList PathTemplate -> [PathTemplate]
forall a b. (a -> b) -> a -> b
$ ProjectConfigBuildOnly -> NubList PathTemplate
projectConfigSummaryFile (ProjectConfigBuildOnly -> NubList PathTemplate)
-> (ProjectConfig -> ProjectConfigBuildOnly)
-> ProjectConfig
-> NubList PathTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly (ProjectConfig -> NubList PathTemplate)
-> ProjectConfig -> NubList PathTemplate
forall a b. (a -> b) -> a -> b
$ ProjectConfig
projectConfig)
      [(BuildReport, Maybe Repo)]
buildReports
      Platform
platform
  where
    -- TODO may want to handle the projectConfigLogFile paramenter here, or just remove it entirely?

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

    theSpecifiedPackage :: Package pkg => PackageSpecifier pkg -> Maybe PackageId
    theSpecifiedPackage :: forall pkg. Package pkg => PackageSpecifier pkg -> Maybe PackageId
theSpecifiedPackage PackageSpecifier pkg
pkgSpec =
      case PackageSpecifier pkg
pkgSpec of
        NamedPackage PackageName
name [PackagePropertyVersion VersionRange
version] ->
          PackageName -> Version -> PackageId
PackageIdentifier PackageName
name (Version -> PackageId) -> Maybe Version -> Maybe PackageId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VersionRange -> Maybe Version
trivialRange VersionRange
version
        NamedPackage PackageName
_ [PackageProperty]
_ -> Maybe PackageId
forall a. Maybe a
Nothing
        SpecificSourcePackage pkg
pkg -> PackageId -> Maybe PackageId
forall a. a -> Maybe a
Just (PackageId -> Maybe PackageId) -> PackageId -> Maybe PackageId
forall a b. (a -> b) -> a -> b
$ pkg -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId pkg
pkg
    -- \| If a range includes only a single version, return Just that version.
    trivialRange :: VersionRange -> Maybe Version
    trivialRange :: VersionRange -> Maybe Version
trivialRange =
      Maybe Version
-> (Version -> Maybe Version)
-> (Version -> Maybe Version)
-> (Version -> Maybe Version)
-> (Maybe Version -> Maybe Version -> Maybe Version)
-> (Maybe Version -> Maybe Version -> Maybe Version)
-> VersionRange
-> Maybe Version
forall a.
a
-> (Version -> a)
-> (Version -> a)
-> (Version -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> VersionRange
-> a
foldVersionRange
        Maybe Version
forall a. Maybe a
Nothing
        Version -> Maybe Version
forall a. a -> Maybe a
Just -- "== v"
        (\Version
_ -> Maybe Version
forall a. Maybe a
Nothing)
        (\Version
_ -> Maybe Version
forall a. Maybe a
Nothing)
        (\Maybe Version
_ Maybe Version
_ -> Maybe Version
forall a. Maybe a
Nothing)
        (\Maybe Version
_ 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 = []
    , programOverrideEnv =
        filter
          ((/= "PATH") . fst)
          (programOverrideEnv prog)
    }
  | ConfiguredProgram
prog <- ProgramDb -> [ConfiguredProgram]
configuredPrograms ProgramDb
progdb
  ]

getInstalledPackages
  :: Verbosity
  -> Compiler
  -> ProgramDb
  -> Platform
  -> PackageDBStackCWD
  -> Rebuild InstalledPackageIndex
getInstalledPackages :: Verbosity
-> Compiler
-> ProgramDb
-> Platform
-> PackageDBStackCWD
-> Rebuild InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
compiler ProgramDb
progdb Platform
platform PackageDBStackCWD
packagedbs = do
  [MonitorFilePath] -> Rebuild ()
monitorFiles ([MonitorFilePath] -> Rebuild ())
-> ([String] -> [MonitorFilePath]) -> [String] -> Rebuild ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> MonitorFilePath) -> [String] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map String -> MonitorFilePath
monitorFileOrDirectory
    ([String] -> Rebuild ()) -> Rebuild [String] -> Rebuild ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String] -> Rebuild [String]
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
      ( Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir CWD))
-> PackageDBStackS CWD
-> ProgramDb
-> Platform
-> IO [String]
forall from.
Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackS from
-> ProgramDb
-> Platform
-> IO [String]
IndexUtils.getInstalledPackagesMonitorFiles
          Verbosity
verbosity
          Compiler
compiler
          Maybe (SymbolicPath CWD ('Dir CWD))
forall a. Maybe a
Nothing -- use ambient working directory
          (PackageDBStackCWD -> PackageDBStackS CWD
coercePackageDBStack PackageDBStackCWD
packagedbs)
          ProgramDb
progdb
          Platform
platform
      )
  IO InstalledPackageIndex -> Rebuild InstalledPackageIndex
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InstalledPackageIndex -> Rebuild InstalledPackageIndex)
-> IO InstalledPackageIndex -> Rebuild InstalledPackageIndex
forall a b. (a -> b) -> a -> b
$
    Verbosity
-> Compiler
-> PackageDBStackCWD
-> ProgramDb
-> IO InstalledPackageIndex
IndexUtils.getInstalledPackages
      Verbosity
verbosity
      Compiler
compiler
      PackageDBStackCWD
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) <-
    IO ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo])
-> Rebuild
     ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo])
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo])
 -> Rebuild
      ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo]))
-> IO ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo])
-> Rebuild
     ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo])
forall a b. (a -> b) -> a -> b
$
      (RepoContext
 -> IO ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo]))
-> IO ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo])
forall a. (RepoContext -> IO a) -> IO a
withRepoCtx ((RepoContext
  -> IO ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo]))
 -> IO ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo]))
-> (RepoContext
    -> IO ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo]))
-> IO ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo])
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
        ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo])
-> IO ((SourcePackageDb, TotalIndexState, ActiveRepos), [Repo])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePackageDb, TotalIndexState, ActiveRepos)
sourcePkgDbWithTIS, RepoContext -> [Repo]
repoContextRepos RepoContext
repoctx)

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

getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild (Maybe PkgConfigDb)
getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild (Maybe PkgConfigDb)
getPkgConfigDb Verbosity
verbosity ProgramDb
progdb = do
  [String]
dirs <- IO [String] -> Rebuild [String]
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Rebuild [String])
-> IO [String] -> Rebuild [String]
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.
  (String -> Rebuild Bool) -> [String] -> Rebuild ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> Rebuild Bool
monitorDirectoryStatus [String]
dirs
  IO (Maybe PkgConfigDb) -> Rebuild (Maybe PkgConfigDb)
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PkgConfigDb) -> Rebuild (Maybe PkgConfigDb))
-> IO (Maybe PkgConfigDb) -> Rebuild (Maybe PkgConfigDb)
forall a b. (a -> b) -> a -> b
$ Verbosity -> ProgramDb -> IO (Maybe 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 -> [(PackageId, PackageLocation (Maybe String))]
packageLocationsSignature SolverInstallPlan
solverPlan =
  [ (UnresolvedSourcePackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId UnresolvedSourcePackage
pkg, UnresolvedSourcePackage -> PackageLocation (Maybe String)
forall loc. SourcePackage loc -> loc
srcpkgSource UnresolvedSourcePackage
pkg)
  | SolverInstallPlan.Configured (SolverPackage{solverPkgSource :: forall loc. SolverPackage loc -> SourcePackage loc
solverPkgSource = UnresolvedSourcePackage
pkg}) <-
      SolverInstallPlan
-> [ResolverPackage (PackageLocation (Maybe String))]
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 PackageId 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 :: [(PackageId, PackageLocation (Maybe String))]
allPkgLocations =
        [ (UnresolvedSourcePackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId UnresolvedSourcePackage
pkg, UnresolvedSourcePackage -> PackageLocation (Maybe String)
forall loc. SourcePackage loc -> loc
srcpkgSource UnresolvedSourcePackage
pkg)
        | SolverInstallPlan.Configured (SolverPackage{solverPkgSource :: forall loc. SolverPackage loc -> SourcePackage loc
solverPkgSource = UnresolvedSourcePackage
pkg}) <-
            SolverInstallPlan
-> [ResolverPackage (PackageLocation (Maybe String))]
SolverInstallPlan.toList SolverInstallPlan
solverPlan
        ]

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

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

      -- tarballs from source-repository-package stanzas
      sourceRepoTarballPkgs :: [(PackageId, String)]
sourceRepoTarballPkgs =
        [ (PackageId
pkgid, String
tarball)
        | (PackageId
pkgid, RemoteSourceRepoPackage SourceRepoMaybe
_ (Just String
tarball)) <- [(PackageId, PackageLocation (Maybe String))]
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 :: [(Repo, [PackageId])]
      repoTarballPkgsWithoutMetadata :: [(Repo, PackageId)]
      ( [(Repo, [PackageId])]
repoTarballPkgsWithMetadataUnvalidated
        , [(Repo, PackageId)]
repoTarballPkgsWithoutMetadata
        ) =
          [Either (Repo, [PackageId]) (Repo, PackageId)]
-> ([(Repo, [PackageId])], [(Repo, PackageId)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
            [ case Repo
repo of
              RepoSecure{} -> (Repo, [PackageId]) -> Either (Repo, [PackageId]) (Repo, PackageId)
forall a b. a -> Either a b
Left (Repo
repo, [PackageId
pkgid])
              Repo
_ -> (Repo, PackageId) -> Either (Repo, [PackageId]) (Repo, PackageId)
forall a b. b -> Either a b
Right (Repo
repo, PackageId
pkgid)
            | (PackageId
pkgid, RepoTarballPackage Repo
repo PackageId
_ Maybe String
_) <- [(PackageId, PackageLocation (Maybe String))]
allPkgLocations
            ]

      -- Group up the unvalidated packages by repo so we only read the remote
      -- index once per repo (see #10110). The packages are ungrouped here and then regrouped
      -- below, it would be better in future to refactor this whole code path so that we don't
      -- repeatedly group and ungroup.
      repoTarballPkgsWithMetadataUnvalidatedMap :: Map Repo [PackageId]
repoTarballPkgsWithMetadataUnvalidatedMap = ([PackageId] -> [PackageId] -> [PackageId])
-> [(Repo, [PackageId])] -> Map Repo [PackageId]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [PackageId] -> [PackageId] -> [PackageId]
forall a. [a] -> [a] -> [a]
(++) [(Repo, [PackageId])]
repoTarballPkgsWithMetadataUnvalidated

  ([(Repo, PackageId)]
repoTarballPkgsWithMetadata, [(Repo, PackageId)]
repoTarballPkgsToDownloadWithMeta) <- ([Either (Repo, PackageId) (Repo, PackageId)]
 -> ([(Repo, PackageId)], [(Repo, PackageId)]))
-> Rebuild [Either (Repo, PackageId) (Repo, PackageId)]
-> Rebuild ([(Repo, PackageId)], [(Repo, PackageId)])
forall a b. (a -> b) -> Rebuild a -> Rebuild b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Repo, PackageId) (Repo, PackageId)]
-> ([(Repo, PackageId)], [(Repo, PackageId)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (Rebuild [Either (Repo, PackageId) (Repo, PackageId)]
 -> Rebuild ([(Repo, PackageId)], [(Repo, PackageId)]))
-> Rebuild [Either (Repo, PackageId) (Repo, PackageId)]
-> Rebuild ([(Repo, PackageId)], [(Repo, PackageId)])
forall a b. (a -> b) -> a -> b
$
    IO [Either (Repo, PackageId) (Repo, PackageId)]
-> Rebuild [Either (Repo, PackageId) (Repo, PackageId)]
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Either (Repo, PackageId) (Repo, PackageId)]
 -> Rebuild [Either (Repo, PackageId) (Repo, PackageId)])
-> IO [Either (Repo, PackageId) (Repo, PackageId)]
-> Rebuild [Either (Repo, PackageId) (Repo, PackageId)]
forall a b. (a -> b) -> a -> b
$
      (RepoContext -> IO [Either (Repo, PackageId) (Repo, PackageId)])
-> IO [Either (Repo, PackageId) (Repo, PackageId)]
forall a. (RepoContext -> IO a) -> IO a
withRepoCtx ((RepoContext -> IO [Either (Repo, PackageId) (Repo, PackageId)])
 -> IO [Either (Repo, PackageId) (Repo, PackageId)])
-> (RepoContext -> IO [Either (Repo, PackageId) (Repo, PackageId)])
-> IO [Either (Repo, PackageId) (Repo, PackageId)]
forall a b. (a -> b) -> a -> b
$ \RepoContext
repoctx -> (((Repo, [PackageId])
  -> IO [Either (Repo, PackageId) (Repo, PackageId)])
 -> [(Repo, [PackageId])]
 -> IO [Either (Repo, PackageId) (Repo, PackageId)])
-> [(Repo, [PackageId])]
-> ((Repo, [PackageId])
    -> IO [Either (Repo, PackageId) (Repo, PackageId)])
-> IO [Either (Repo, PackageId) (Repo, PackageId)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Repo, [PackageId])
 -> IO [Either (Repo, PackageId) (Repo, PackageId)])
-> [(Repo, [PackageId])]
-> IO [Either (Repo, PackageId) (Repo, PackageId)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Map Repo [PackageId] -> [(Repo, [PackageId])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Repo [PackageId]
repoTarballPkgsWithMetadataUnvalidatedMap) (((Repo, [PackageId])
  -> IO [Either (Repo, PackageId) (Repo, PackageId)])
 -> IO [Either (Repo, PackageId) (Repo, PackageId)])
-> ((Repo, [PackageId])
    -> IO [Either (Repo, PackageId) (Repo, PackageId)])
-> IO [Either (Repo, PackageId) (Repo, PackageId)]
forall a b. (a -> b) -> a -> b
$
        \(Repo
repo, [PackageId]
pkgids) ->
          Verbosity
-> RepoContext
-> Repo
-> [PackageId]
-> IO [Either (Repo, PackageId) (Repo, PackageId)]
verifyFetchedTarballs Verbosity
verbosity RepoContext
repoctx Repo
repo [PackageId]
pkgids

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

  let repoTarballPkgsToDownload :: [(Repo, PackageId)]
repoTarballPkgsToDownload = [(Repo, PackageId)]
repoTarballPkgsToDownloadWithMeta [(Repo, PackageId)] -> [(Repo, PackageId)] -> [(Repo, PackageId)]
forall a. [a] -> [a] -> [a]
++ [(Repo, PackageId)]
repoTarballPkgsToDownloadWithNoMeta
  ( Map PackageId PackageSourceHash
hashesFromRepoMetadata
    , [(PackageId, 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 [(Repo, PackageId)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Repo, PackageId)]
repoTarballPkgsToDownload Bool -> Bool -> Bool
&& [(Repo, PackageId)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Repo, PackageId)]
repoTarballPkgsWithMetadata
      then (Map PackageId PackageSourceHash, [(PackageId, String)])
-> Rebuild (Map PackageId PackageSourceHash, [(PackageId, String)])
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map PackageId PackageSourceHash
forall k a. Map k a
Map.empty, [])
      else IO (Map PackageId PackageSourceHash, [(PackageId, String)])
-> Rebuild (Map PackageId PackageSourceHash, [(PackageId, String)])
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map PackageId PackageSourceHash, [(PackageId, String)])
 -> Rebuild
      (Map PackageId PackageSourceHash, [(PackageId, String)]))
-> IO (Map PackageId PackageSourceHash, [(PackageId, String)])
-> Rebuild (Map PackageId PackageSourceHash, [(PackageId, String)])
forall a b. (a -> b) -> a -> b
$ (RepoContext
 -> IO (Map PackageId PackageSourceHash, [(PackageId, String)]))
-> IO (Map PackageId PackageSourceHash, [(PackageId, String)])
forall a. (RepoContext -> IO a) -> IO a
withRepoCtx ((RepoContext
  -> IO (Map PackageId PackageSourceHash, [(PackageId, String)]))
 -> IO (Map PackageId PackageSourceHash, [(PackageId, String)]))
-> (RepoContext
    -> IO (Map PackageId PackageSourceHash, [(PackageId, String)]))
-> IO (Map PackageId PackageSourceHash, [(PackageId, String)])
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 PackageId PackageSourceHash
hashesFromRepoMetadata <-
          ((Throws VerificationError, Throws SomeRemoteError,
  Throws InvalidPackageException) =>
 IO (Map PackageId PackageSourceHash))
-> IO (Map PackageId PackageSourceHash)
forall a.
((Throws VerificationError, Throws SomeRemoteError,
  Throws InvalidPackageException) =>
 IO a)
-> IO a
Sec.uncheckClientErrors (((Throws VerificationError, Throws SomeRemoteError,
   Throws InvalidPackageException) =>
  IO (Map PackageId PackageSourceHash))
 -> IO (Map PackageId PackageSourceHash))
-> ((Throws VerificationError, Throws SomeRemoteError,
     Throws InvalidPackageException) =>
    IO (Map PackageId PackageSourceHash))
-> IO (Map PackageId PackageSourceHash)
forall a b. (a -> b) -> a -> b
$ -- TODO: [code cleanup] wrap in our own exceptions
            ([[(PackageId, PackageSourceHash)]]
 -> Map PackageId PackageSourceHash)
-> IO [[(PackageId, PackageSourceHash)]]
-> IO (Map PackageId PackageSourceHash)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(PackageId, PackageSourceHash)] -> Map PackageId PackageSourceHash
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PackageId, PackageSourceHash)]
 -> Map PackageId PackageSourceHash)
-> ([[(PackageId, PackageSourceHash)]]
    -> [(PackageId, PackageSourceHash)])
-> [[(PackageId, PackageSourceHash)]]
-> Map PackageId PackageSourceHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(PackageId, PackageSourceHash)]]
-> [(PackageId, PackageSourceHash)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (IO [[(PackageId, PackageSourceHash)]]
 -> IO (Map PackageId PackageSourceHash))
-> IO [[(PackageId, PackageSourceHash)]]
-> IO (Map PackageId PackageSourceHash)
forall a b. (a -> b) -> a -> b
$
              [IO [(PackageId, PackageSourceHash)]]
-> IO [[(PackageId, PackageSourceHash)]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 {down :: * -> *}.
  Repository down -> IO [(PackageId, PackageSourceHash)])
 -> IO [(PackageId, PackageSourceHash)])
-> (forall {down :: * -> *}.
    Repository down -> IO [(PackageId, PackageSourceHash)])
-> IO [(PackageId, PackageSourceHash)]
forall a b. (a -> b) -> a -> b
$ \Repository down
secureRepo ->
                  Repository down
-> (IndexCallbacks -> IO [(PackageId, PackageSourceHash)])
-> IO [(PackageId, PackageSourceHash)]
forall (down :: * -> *) a.
Repository down -> (IndexCallbacks -> IO a) -> IO a
Sec.withIndex Repository down
secureRepo ((IndexCallbacks -> IO [(PackageId, PackageSourceHash)])
 -> IO [(PackageId, PackageSourceHash)])
-> (IndexCallbacks -> IO [(PackageId, PackageSourceHash)])
-> IO [(PackageId, PackageSourceHash)]
forall a b. (a -> b) -> a -> b
$ \IndexCallbacks
repoIndex ->
                    [IO (PackageId, PackageSourceHash)]
-> IO [(PackageId, PackageSourceHash)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
                      [ do
                        Hash
hash <-
                          Trusted Hash -> Hash
forall a. Trusted a -> a
Sec.trusted
                            (Trusted Hash -> Hash) -> IO (Trusted Hash) -> IO Hash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IndexCallbacks
-> (Throws InvalidPackageException, Throws VerificationError) =>
   PackageId -> IO (Trusted Hash)
Sec.indexLookupHash IndexCallbacks
repoIndex PackageId
pkgid -- strip off Trusted tag

                        -- Note that hackage-security currently uses SHA256
                        -- but this API could in principle give us some other
                        -- choice in future.
                        (PackageId, PackageSourceHash) -> IO (PackageId, PackageSourceHash)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId
pkgid, Hash -> PackageSourceHash
hashFromTUF Hash
hash)
                      | PackageId
pkgid <- [PackageId]
pkgids
                      ]
                | (Repo
repo, [PackageId]
pkgids) <-
                    (NonEmpty (Repo, PackageId) -> (Repo, [PackageId]))
-> [NonEmpty (Repo, PackageId)] -> [(Repo, [PackageId])]
forall a b. (a -> b) -> [a] -> [b]
map (\grp :: NonEmpty (Repo, PackageId)
grp@((Repo
repo, PackageId
_) :| [(Repo, PackageId)]
_) -> (Repo
repo, ((Repo, PackageId) -> PackageId)
-> [(Repo, PackageId)] -> [PackageId]
forall a b. (a -> b) -> [a] -> [b]
map (Repo, PackageId) -> PackageId
forall a b. (a, b) -> b
snd (NonEmpty (Repo, PackageId) -> [(Repo, PackageId)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Repo, PackageId)
grp)))
                      ([NonEmpty (Repo, PackageId)] -> [(Repo, [PackageId])])
-> ([(Repo, PackageId)] -> [NonEmpty (Repo, PackageId)])
-> [(Repo, PackageId)]
-> [(Repo, [PackageId])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Repo, PackageId) -> (Repo, PackageId) -> Bool)
-> [(Repo, PackageId)] -> [NonEmpty (Repo, PackageId)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (RepoName -> RepoName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (RepoName -> RepoName -> Bool)
-> ((Repo, PackageId) -> RepoName)
-> (Repo, PackageId)
-> (Repo, PackageId)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (RemoteRepo -> RepoName
remoteRepoName (RemoteRepo -> RepoName)
-> ((Repo, PackageId) -> RemoteRepo)
-> (Repo, PackageId)
-> RepoName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repo -> RemoteRepo
repoRemote (Repo -> RemoteRepo)
-> ((Repo, PackageId) -> Repo) -> (Repo, PackageId) -> RemoteRepo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repo, PackageId) -> Repo
forall a b. (a, b) -> a
fst))
                      ([(Repo, PackageId)] -> [NonEmpty (Repo, PackageId)])
-> ([(Repo, PackageId)] -> [(Repo, PackageId)])
-> [(Repo, PackageId)]
-> [NonEmpty (Repo, PackageId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Repo, PackageId) -> (Repo, PackageId) -> Ordering)
-> [(Repo, PackageId)] -> [(Repo, PackageId)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RepoName -> RepoName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RepoName -> RepoName -> Ordering)
-> ((Repo, PackageId) -> RepoName)
-> (Repo, PackageId)
-> (Repo, PackageId)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (RemoteRepo -> RepoName
remoteRepoName (RemoteRepo -> RepoName)
-> ((Repo, PackageId) -> RemoteRepo)
-> (Repo, PackageId)
-> RepoName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repo -> RemoteRepo
repoRemote (Repo -> RemoteRepo)
-> ((Repo, PackageId) -> Repo) -> (Repo, PackageId) -> RemoteRepo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repo, PackageId) -> Repo
forall a b. (a, b) -> a
fst))
                      ([(Repo, PackageId)] -> [(Repo, [PackageId])])
-> [(Repo, PackageId)] -> [(Repo, [PackageId])]
forall a b. (a -> b) -> a -> b
$ [(Repo, PackageId)]
repoTarballPkgsWithMetadata
                ]

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

        (Map PackageId PackageSourceHash, [(PackageId, String)])
-> IO (Map PackageId PackageSourceHash, [(PackageId, String)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
          ( Map PackageId PackageSourceHash
hashesFromRepoMetadata
          , [(PackageId, 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 :: [(PackageId, String)]
allTarballFilePkgs =
        [(PackageId, String)]
localTarballPkgs
          [(PackageId, String)]
-> [(PackageId, String)] -> [(PackageId, String)]
forall a. [a] -> [a] -> [a]
++ [(PackageId, String)]
remoteTarballPkgs
          [(PackageId, String)]
-> [(PackageId, String)] -> [(PackageId, String)]
forall a. [a] -> [a] -> [a]
++ [(PackageId, String)]
sourceRepoTarballPkgs
          [(PackageId, String)]
-> [(PackageId, String)] -> [(PackageId, String)]
forall a. [a] -> [a] -> [a]
++ [(PackageId, String)]
repoTarballPkgsDownloaded
          [(PackageId, String)]
-> [(PackageId, String)] -> [(PackageId, String)]
forall a. [a] -> [a] -> [a]
++ [(PackageId, String)]
repoTarballPkgsNewlyDownloaded
  Map PackageId PackageSourceHash
hashesFromTarballFiles <-
    IO (Map PackageId PackageSourceHash)
-> Rebuild (Map PackageId PackageSourceHash)
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map PackageId PackageSourceHash)
 -> Rebuild (Map PackageId PackageSourceHash))
-> IO (Map PackageId PackageSourceHash)
-> Rebuild (Map PackageId PackageSourceHash)
forall a b. (a -> b) -> a -> b
$
      ([(PackageId, PackageSourceHash)]
 -> Map PackageId PackageSourceHash)
-> IO [(PackageId, PackageSourceHash)]
-> IO (Map PackageId PackageSourceHash)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(PackageId, PackageSourceHash)] -> Map PackageId PackageSourceHash
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (IO [(PackageId, PackageSourceHash)]
 -> IO (Map PackageId PackageSourceHash))
-> IO [(PackageId, PackageSourceHash)]
-> IO (Map PackageId PackageSourceHash)
forall a b. (a -> b) -> a -> b
$
        [IO (PackageId, PackageSourceHash)]
-> IO [(PackageId, PackageSourceHash)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
          [ do
            PackageSourceHash
srchash <- String -> IO PackageSourceHash
readFileHashValue String
tarball
            (PackageId, PackageSourceHash) -> IO (PackageId, PackageSourceHash)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId
pkgid, PackageSourceHash
srchash)
          | (PackageId
pkgid, String
tarball) <- [(PackageId, String)]
allTarballFilePkgs
          ]
  [MonitorFilePath] -> Rebuild ()
monitorFiles
    [ String -> MonitorFilePath
monitorFile String
tarball
    | (PackageId
_pkgid, String
tarball) <- [(PackageId, String)]
allTarballFilePkgs
    ]

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

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

-- * Installation planning

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

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

          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrongFlags -> DepResolverParams -> DepResolverParams
setStrongFlags StrongFlags
solverSettingStrongFlags
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowBootLibInstalls -> DepResolverParams -> DepResolverParams
setAllowBootLibInstalls AllowBootLibInstalls
solverSettingAllowBootLibInstalls
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnlyConstrained -> DepResolverParams -> DepResolverParams
setOnlyConstrained OnlyConstrained
solverSettingOnlyConstrained
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
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".
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackagesPreferenceDefault -> DepResolverParams -> DepResolverParams
setPreferenceDefault
            ( if PreferOldest -> Bool
forall a. BooleanFlag a => a -> Bool
Cabal.asBool PreferOldest
solverSettingPreferOldest
                then PackagesPreferenceDefault
PreferAllOldest
                else PackagesPreferenceDefault
PreferLatestForSelected
            )
          {-(if solverSettingUpgradeDeps
               then PreferAllLatest
               else PreferLatestForSelected)-}

          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowOlder -> DepResolverParams -> DepResolverParams
removeLowerBounds AllowOlder
solverSettingAllowOlder
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowNewer -> DepResolverParams -> DepResolverParams
removeUpperBounds AllowNewer
solverSettingAllowNewer
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnresolvedSourcePackage -> Maybe [Dependency])
-> DepResolverParams -> DepResolverParams
addDefaultSetupDependencies
            ( Compiler -> Platform -> PackageDescription -> Maybe [Dependency]
mkDefaultSetupDeps Compiler
comp Platform
platform
                (PackageDescription -> Maybe [Dependency])
-> (UnresolvedSourcePackage -> PackageDescription)
-> UnresolvedSourcePackage
-> Maybe [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
PD.packageDescription
                (GenericPackageDescription -> PackageDescription)
-> (UnresolvedSourcePackage -> GenericPackageDescription)
-> UnresolvedSourcePackage
-> PackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnresolvedSourcePackage -> GenericPackageDescription
forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription
            )
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> DepResolverParams -> DepResolverParams
addSetupCabalMinVersionConstraint Version
setupMinCabalVersionConstraint
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> DepResolverParams -> DepResolverParams
addSetupCabalMaxVersionConstraint Version
setupMaxCabalVersionConstraint
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
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
            ]
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
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
            ]
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
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 UnresolvedSourcePackage
pkg <- [PackageSpecifier UnresolvedSourcePackage]
localPackages
            , let pkgname :: PackageName
pkgname = PackageSpecifier UnresolvedSourcePackage -> PackageName
forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget PackageSpecifier UnresolvedSourcePackage
pkg
                  stanzaM :: Map OptionalStanza Bool
stanzaM = Map OptionalStanza Bool
-> PackageName
-> Map PackageName (Map OptionalStanza Bool)
-> Map OptionalStanza Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map OptionalStanza Bool
forall k a. Map k a
Map.empty PackageName
pkgname Map PackageName (Map OptionalStanza Bool)
pkgStanzasEnable
                  stanzas :: [OptionalStanza]
stanzas =
                    [ OptionalStanza
stanza | OptionalStanza
stanza <- [OptionalStanza
forall a. Bounded a => a
minBound .. OptionalStanza
forall a. Bounded a => a
maxBound], OptionalStanza -> Map OptionalStanza Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup OptionalStanza
stanza Map OptionalStanza Bool
stanzaM Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                    ]
            , Bool -> Bool
not ([OptionalStanza] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptionalStanza]
stanzas)
            ]
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
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 UnresolvedSourcePackage
pkg <- [PackageSpecifier UnresolvedSourcePackage]
localPackages
            , let pkgname :: PackageName
pkgname = PackageSpecifier UnresolvedSourcePackage -> PackageName
forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget PackageSpecifier UnresolvedSourcePackage
pkg
                  stanzaM :: Map OptionalStanza Bool
stanzaM = Map OptionalStanza Bool
-> PackageName
-> Map PackageName (Map OptionalStanza Bool)
-> Map OptionalStanza Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map OptionalStanza Bool
forall k a. Map k a
Map.empty PackageName
pkgname Map PackageName (Map OptionalStanza Bool)
pkgStanzasEnable
                  stanzas :: [OptionalStanza]
stanzas =
                    [ OptionalStanza
stanza | OptionalStanza
stanza <- [OptionalStanza
forall a. Bounded a => a
minBound .. OptionalStanza
forall a. Bounded a => a
maxBound], OptionalStanza -> Map OptionalStanza Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup OptionalStanza
stanza Map OptionalStanza Bool
stanzaM Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                    ]
            , Bool -> Bool
not ([OptionalStanza] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptionalStanza]
stanzas)
            ]
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
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) <- Map PackageName FlagAssignment -> [(PackageName, FlagAssignment)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName FlagAssignment
solverSettingFlagAssignments
            ]
          (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
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 UnresolvedSourcePackage
pkg <- [PackageSpecifier UnresolvedSourcePackage]
localPackages
            , let pkgname :: PackageName
pkgname = PackageSpecifier UnresolvedSourcePackage -> PackageName
forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget PackageSpecifier UnresolvedSourcePackage
pkg
            ]
          (DepResolverParams -> DepResolverParams)
-> DepResolverParams -> DepResolverParams
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 UnresolvedSourcePackage]
-> DepResolverParams
basicInstallPolicy
          InstalledPackageIndex
installedPkgIndex
          SourcePackageDb
sourcePkgDb
          [PackageSpecifier UnresolvedSourcePackage]
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).
      --
      -- 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 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9, Int
10] = [Int] -> Version
mkVersion [Int
3, Int
12]
        | Bool
isGHC, Version
compVer Version -> Version -> Bool
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 Version -> Version -> Bool
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 Version -> Version -> Bool
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 Version -> Version -> Bool
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 Version -> Version -> Bool
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 Version -> Version -> Bool
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 Version -> Version -> Bool
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 Version -> Version -> Bool
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 Version -> Version -> Bool
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 Version -> Version -> Bool
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 Version -> Version -> Bool
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 CompilerFlavor -> [CompilerFlavor] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
2) (Version -> Version) -> Version -> Version
forall a b. (a -> b) -> a -> b
$ Int -> Version -> Version
incVersion Int
1 (Version -> Version) -> Version -> Version
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
  -> Maybe 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
-> Maybe PkgConfigDb
-> DistDirLayout
-> StoreDirLayout
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> Map PackageId PackageSourceHash
-> InstallDirTemplates
-> ProjectConfigShared
-> PackageConfig
-> PackageConfig
-> Map PackageName PackageConfig
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
elaborateInstallPlan
  Verbosity
verbosity
  Platform
platform
  Compiler
compiler
  ProgramDb
compilerprogdb
  Maybe PkgConfigDb
pkgConfigDB
  distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{String
Maybe String
String -> String
CompilerId -> PackageDBCWD
PackageId -> String
DistDirParams -> String
DistDirParams -> String -> String
distProjectRootDirectory :: DistDirLayout -> String
distDirectory :: DistDirLayout -> String
distProjectCacheFile :: DistDirLayout -> String -> String
distProjectCacheDirectory :: DistDirLayout -> String
distProjectFile :: DistDirLayout -> String -> String
distProjectRootDirectory :: String
distProjectFile :: String -> String
distDirectory :: String
distBuildDirectory :: DistDirParams -> String
distBuildRootDirectory :: String
distDownloadSrcDirectory :: String
distUnpackedSrcDirectory :: PackageId -> String
distUnpackedSrcRootDirectory :: String
distProjectCacheFile :: String -> String
distProjectCacheDirectory :: String
distPackageCacheFile :: DistDirParams -> String -> String
distPackageCacheDirectory :: DistDirParams -> String
distSdistFile :: PackageId -> String
distSdistDirectory :: String
distTempDirectory :: String
distBinDirectory :: String
distPackageDB :: CompilerId -> PackageDBCWD
distHaddockOutputDir :: Maybe String
distBuildDirectory :: DistDirLayout -> DistDirParams -> String
distBuildRootDirectory :: DistDirLayout -> String
distDownloadSrcDirectory :: DistDirLayout -> String
distUnpackedSrcDirectory :: DistDirLayout -> PackageId -> String
distUnpackedSrcRootDirectory :: DistDirLayout -> String
distPackageCacheFile :: DistDirLayout -> DistDirParams -> String -> String
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> String
distSdistFile :: DistDirLayout -> PackageId -> String
distSdistDirectory :: DistDirLayout -> String
distTempDirectory :: DistDirLayout -> String
distBinDirectory :: DistDirLayout -> String
distPackageDB :: DistDirLayout -> CompilerId -> PackageDBCWD
distHaddockOutputDir :: DistDirLayout -> Maybe String
..}
  storeDirLayout :: StoreDirLayout
storeDirLayout@StoreDirLayout{Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storePackageDBStack :: Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storePackageDBStack :: StoreDirLayout
-> Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storePackageDBStack}
  SolverInstallPlan
solverPlan
  [PackageSpecifier (SourcePackage (PackageLocation loc))]
localPackages
  Map PackageId PackageSourceHash
sourcePackageHashes
  InstallDirTemplates
defaultInstallDirs
  ProjectConfigShared
sharedPackageConfig
  PackageConfig
allPackagesConfig
  PackageConfig
localPackagesConfig
  Map PackageName PackageConfig
perPackageConfig = do
    ElaboratedInstallPlan
x <- LogProgress ElaboratedInstallPlan
elaboratedInstallPlan
    (ElaboratedInstallPlan, ElaboratedSharedConfig)
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
forall a. a -> LogProgress a
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 = ReplOptions
forall a. Monoid a => a
mempty
          }

      preexistingInstantiatedPkgs :: Map UnitId FullUnitId
      preexistingInstantiatedPkgs :: Map UnitId FullUnitId
preexistingInstantiatedPkgs =
        [(UnitId, FullUnitId)] -> Map UnitId FullUnitId
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((ResolverPackage (PackageLocation (Maybe String))
 -> Maybe (UnitId, FullUnitId))
-> [ResolverPackage (PackageLocation (Maybe String))]
-> [(UnitId, FullUnitId)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ResolverPackage (PackageLocation (Maybe String))
-> Maybe (UnitId, FullUnitId)
forall {loc}. ResolverPackage loc -> Maybe (UnitId, FullUnitId)
f (SolverInstallPlan
-> [ResolverPackage (PackageLocation (Maybe String))]
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) =
                (UnitId, FullUnitId) -> Maybe (UnitId, FullUnitId)
forall a. a -> Maybe a
Just
                  ( InstalledPackageInfo -> UnitId
IPI.installedUnitId InstalledPackageInfo
ipkg
                  , ( InstalledPackageId -> Map ModuleName OpenModule -> FullUnitId
FullUnitId
                        (InstalledPackageInfo -> InstalledPackageId
IPI.installedComponentId InstalledPackageInfo
ipkg)
                        ([(ModuleName, OpenModule)] -> Map ModuleName OpenModule
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
IPI.instantiatedWith InstalledPackageInfo
ipkg))
                    )
                  )
          f ResolverPackage loc
_ = Maybe (UnitId, FullUnitId)
forall a. Maybe a
Nothing

      elaboratedInstallPlan
        :: LogProgress (InstallPlan.GenericInstallPlan IPI.InstalledPackageInfo ElaboratedConfiguredPackage)
      elaboratedInstallPlan :: LogProgress ElaboratedInstallPlan
elaboratedInstallPlan =
        (((SolverId -> [ElaboratedPlanPackage])
  -> ResolverPackage (PackageLocation (Maybe String))
  -> LogProgress [ElaboratedPlanPackage])
 -> SolverInstallPlan -> LogProgress ElaboratedInstallPlan)
-> SolverInstallPlan
-> ((SolverId -> [ElaboratedPlanPackage])
    -> ResolverPackage (PackageLocation (Maybe String))
    -> LogProgress [ElaboratedPlanPackage])
-> LogProgress ElaboratedInstallPlan
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((SolverId -> [ElaboratedPlanPackage])
 -> ResolverPackage (PackageLocation (Maybe String))
 -> LogProgress [ElaboratedPlanPackage])
-> SolverInstallPlan -> LogProgress ElaboratedInstallPlan
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
((SolverId -> [GenericPlanPackage ipkg srcpkg])
 -> ResolverPackage (PackageLocation (Maybe String))
 -> LogProgress [GenericPlanPackage ipkg srcpkg])
-> SolverInstallPlan
-> LogProgress (GenericInstallPlan ipkg srcpkg)
InstallPlan.fromSolverInstallPlanWithProgress SolverInstallPlan
solverPlan (((SolverId -> [ElaboratedPlanPackage])
  -> ResolverPackage (PackageLocation (Maybe String))
  -> LogProgress [ElaboratedPlanPackage])
 -> LogProgress ElaboratedInstallPlan)
-> ((SolverId -> [ElaboratedPlanPackage])
    -> ResolverPackage (PackageLocation (Maybe String))
    -> LogProgress [ElaboratedPlanPackage])
-> LogProgress ElaboratedInstallPlan
forall a b. (a -> b) -> a -> b
$ \SolverId -> [ElaboratedPlanPackage]
mapDep ResolverPackage (PackageLocation (Maybe String))
planpkg ->
          case ResolverPackage (PackageLocation (Maybe String))
planpkg of
            SolverInstallPlan.PreExisting InstSolverPackage
pkg ->
              [ElaboratedPlanPackage] -> LogProgress [ElaboratedPlanPackage]
forall a. a -> LogProgress a
forall (m :: * -> *) a. Monad m => a -> m a
return [InstalledPackageInfo -> ElaboratedPlanPackage
forall ipkg srcpkg. ipkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.PreExisting (InstSolverPackage -> InstalledPackageInfo
instSolverPkgIPI InstSolverPackage
pkg)]
            SolverInstallPlan.Configured SolverPackage (PackageLocation (Maybe String))
pkg ->
              let inplace_doc :: Doc
inplace_doc
                    | SolverPackage (PackageLocation (Maybe String)) -> Bool
forall loc. SolverPackage loc -> Bool
shouldBuildInplaceOnly SolverPackage (PackageLocation (Maybe String))
pkg = String -> Doc
text String
"inplace"
                    | Bool
otherwise = Doc
Disp.empty
               in Doc
-> LogProgress [ElaboratedPlanPackage]
-> LogProgress [ElaboratedPlanPackage]
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 (PackageId -> Doc
forall a. Pretty a => a -> Doc
pretty (SolverPackage (PackageLocation (Maybe String)) -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId SolverPackage (PackageLocation (Maybe String))
pkg))
                    )
                    (LogProgress [ElaboratedPlanPackage]
 -> LogProgress [ElaboratedPlanPackage])
-> LogProgress [ElaboratedPlanPackage]
-> LogProgress [ElaboratedPlanPackage]
forall a b. (a -> b) -> a -> b
$ (ElaboratedConfiguredPackage -> ElaboratedPlanPackage)
-> [ElaboratedConfiguredPackage] -> [ElaboratedPlanPackage]
forall a b. (a -> b) -> [a] -> [b]
map ElaboratedConfiguredPackage -> ElaboratedPlanPackage
forall ipkg srcpkg. srcpkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.Configured ([ElaboratedConfiguredPackage] -> [ElaboratedPlanPackage])
-> LogProgress [ElaboratedConfiguredPackage]
-> LogProgress [ElaboratedPlanPackage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SolverId -> [ElaboratedPlanPackage])
-> SolverPackage (PackageLocation (Maybe String))
-> LogProgress [ElaboratedConfiguredPackage]
elaborateSolverToComponents SolverId -> [ElaboratedPlanPackage]
mapDep SolverPackage (PackageLocation (Maybe String))
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 (PackageLocation (Maybe String))
-> LogProgress [ElaboratedConfiguredPackage]
elaborateSolverToComponents SolverId -> [ElaboratedPlanPackage]
mapDep spkg :: SolverPackage (PackageLocation (Maybe String))
spkg@(SolverPackage UnresolvedSourcePackage
_ 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 (Doc -> LogProgress ()) -> Doc -> LogProgress ()
forall a b. (a -> b) -> a -> b
$
              Doc -> Int -> Doc -> Doc
hang
                (String -> Doc
text String
"Component graph for" Doc -> Doc -> Doc
<+> PackageId -> Doc
forall a. Pretty a => a -> Doc
pretty PackageId
pkgid Doc -> Doc -> Doc
<<>> Doc
colon)
                Int
4
                (ComponentsWithDeps -> Doc
dispComponentsWithDeps ComponentsWithDeps
src_comps)
            ((ConfiguredComponentMap, LinkedComponentMap,
 Map InstalledPackageId String)
_, [ElaboratedConfiguredPackage]
comps) <-
              ((ConfiguredComponentMap, LinkedComponentMap,
  Map InstalledPackageId String)
 -> Component
 -> LogProgress
      ((ConfiguredComponentMap, LinkedComponentMap,
        Map InstalledPackageId String),
       ElaboratedConfiguredPackage))
-> (ConfiguredComponentMap, LinkedComponentMap,
    Map InstalledPackageId String)
-> [Component]
-> LogProgress
     ((ConfiguredComponentMap, LinkedComponentMap,
       Map InstalledPackageId String),
      [ElaboratedConfiguredPackage])
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
                (ConfiguredComponentMap
forall k a. Map k a
Map.empty, LinkedComponentMap
forall k a. Map k a
Map.empty, Map InstalledPackageId String
forall k a. Map k a
Map.empty)
                (((Component, [ComponentName]) -> Component)
-> ComponentsWithDeps -> [Component]
forall a b. (a -> b) -> [a] -> [b]
map (Component, [ComponentName]) -> Component
forall a b. (a, b) -> a
fst ComponentsWithDeps
src_comps)
            let whyNotPerComp :: [NotPerComponentReason]
whyNotPerComp = ComponentsWithDeps -> [NotPerComponentReason]
why_not_per_component ComponentsWithDeps
src_comps
            case [NotPerComponentReason] -> Maybe (NonEmpty NotPerComponentReason)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [NotPerComponentReason]
whyNotPerComp of
              Maybe (NonEmpty NotPerComponentReason)
Nothing -> do
                LogProgress ()
elaborationWarnings
                [ElaboratedConfiguredPackage]
-> LogProgress [ElaboratedConfiguredPackage]
forall a. a -> LogProgress a
forall (m :: * -> *) a. Monad m => a -> m a
return [ElaboratedConfiguredPackage]
comps
              Just NonEmpty NotPerComponentReason
notPerCompReasons -> do
                [ElaboratedConfiguredPackage]
-> NonEmpty NotPerComponentReason -> LogProgress ()
forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
t ElaboratedConfiguredPackage
-> t NotPerComponentReason -> LogProgress ()
checkPerPackageOk [ElaboratedConfiguredPackage]
comps NonEmpty NotPerComponentReason
notPerCompReasons
                ElaboratedConfiguredPackage
pkgComp <-
                  NonEmpty NotPerComponentReason
-> SolverPackage (PackageLocation (Maybe String))
-> ComponentsGraph
-> [ElaboratedConfiguredPackage]
-> LogProgress ElaboratedConfiguredPackage
elaborateSolverToPackage
                    NonEmpty NotPerComponentReason
notPerCompReasons
                    SolverPackage (PackageLocation (Maybe String))
spkg
                    ComponentsGraph
g
                    ([ElaboratedConfiguredPackage]
comps [ElaboratedConfiguredPackage]
-> [ElaboratedConfiguredPackage] -> [ElaboratedConfiguredPackage]
forall a. [a] -> [a] -> [a]
++ Maybe ElaboratedConfiguredPackage -> [ElaboratedConfiguredPackage]
forall a. Maybe a -> [a]
maybeToList Maybe ElaboratedConfiguredPackage
setupComponent)
                [ElaboratedConfiguredPackage]
-> LogProgress [ElaboratedConfiguredPackage]
forall a. a -> LogProgress a
forall (m :: * -> *) a. Monad m => a -> m a
return [ElaboratedConfiguredPackage
pkgComp]
          Left [ComponentName]
cns ->
            Doc -> LogProgress [ElaboratedConfiguredPackage]
forall a. Doc -> LogProgress a
dieProgress (Doc -> LogProgress [ElaboratedConfiguredPackage])
-> Doc -> LogProgress [ElaboratedConfiguredPackage]
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 ((ComponentName -> Doc) -> [ComponentName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc)
-> (ComponentName -> String) -> ComponentName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentName -> String
componentNameStanza) [ComponentName]
cns))
        where
          bt :: BuildType
bt = PackageDescription -> BuildType
PD.buildType (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab0)
          -- You are eligible to per-component build if this list is empty
          why_not_per_component :: ComponentsWithDeps -> [NotPerComponentReason]
why_not_per_component ComponentsWithDeps
g =
            [NotPerComponentReason]
cuz_buildtype [NotPerComponentReason]
-> [NotPerComponentReason] -> [NotPerComponentReason]
forall a. [a] -> [a] -> [a]
++ [NotPerComponentReason]
cuz_spec [NotPerComponentReason]
-> [NotPerComponentReason] -> [NotPerComponentReason]
forall a. [a] -> [a] -> [a]
++ [NotPerComponentReason]
cuz_length [NotPerComponentReason]
-> [NotPerComponentReason] -> [NotPerComponentReason]
forall a. [a] -> [a] -> [a]
++ [NotPerComponentReason]
cuz_flag
            where
              -- 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 :: [NotPerComponentReason]
cuz_buildtype =
                case BuildType
bt of
                  BuildType
PD.Configure -> [NotPerComponentBuildType -> NotPerComponentReason
CuzBuildType NotPerComponentBuildType
CuzConfigureBuildType]
                  BuildType
PD.Custom -> [NotPerComponentBuildType -> NotPerComponentReason
CuzBuildType NotPerComponentBuildType
CuzCustomBuildType]
                  BuildType
PD.Hooks -> [NotPerComponentBuildType -> NotPerComponentReason
CuzBuildType NotPerComponentBuildType
CuzHooksBuildType]
                  BuildType
PD.Make -> [NotPerComponentBuildType -> NotPerComponentReason
CuzBuildType NotPerComponentBuildType
CuzMakeBuildType]
                  BuildType
PD.Simple -> []
              -- 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 :: [NotPerComponentReason]
cuz_spec
                | PackageDescription -> CabalSpecVersion
PD.specVersion PackageDescription
pd CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_8 = []
                | Bool
otherwise = [NotPerComponentReason
CuzCabalSpecVersion]
              -- 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 :: [NotPerComponentReason]
cuz_length
                | ComponentsWithDeps -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ComponentsWithDeps
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = []
                | Bool
otherwise = [NotPerComponentReason
CuzNoBuildableComponents]
              -- For ease of testing, we let per-component builds be toggled
              -- at the top level
              cuz_flag :: [NotPerComponentReason]
cuz_flag
                | Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
True (ProjectConfigShared -> Flag Bool
projectConfigPerComponent ProjectConfigShared
sharedPackageConfig) =
                    []
                | Bool
otherwise = [NotPerComponentReason
CuzDisablePerComponent]

          -- \| 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
-> t NotPerComponentReason -> LogProgress ()
checkPerPackageOk t ElaboratedConfiguredPackage
comps t NotPerComponentReason
reasons = do
            let is_sublib :: ComponentName -> Bool
is_sublib (CLibName (LSubLibName UnqualComponentName
_)) = Bool
True
                is_sublib ComponentName
_ = Bool
False
            Bool -> LogProgress () -> LogProgress ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ElaboratedConfiguredPackage -> Bool)
-> t ElaboratedConfiguredPackage -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ComponentName -> Bool) -> ElaboratedConfiguredPackage -> Bool
matchElabPkg ComponentName -> Bool
is_sublib) t ElaboratedConfiguredPackage
comps) (LogProgress () -> LogProgress ())
-> LogProgress () -> LogProgress ()
forall a b. (a -> b) -> a -> b
$
              Doc -> LogProgress ()
forall a. Doc -> LogProgress a
dieProgress (Doc -> LogProgress ()) -> Doc -> LogProgress ()
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] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (NotPerComponentReason -> Doc) -> [NotPerComponentReason] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc)
-> (NotPerComponentReason -> String)
-> NotPerComponentReason
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotPerComponentReason -> String
whyNotPerComponent) ([NotPerComponentReason] -> [Doc])
-> [NotPerComponentReason] -> [Doc]
forall a b. (a -> b) -> a -> b
$ t NotPerComponentReason -> [NotPerComponentReason]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t NotPerComponentReason
reasons)
          -- TODO: Maybe exclude Backpack too

          (ElaboratedConfiguredPackage
elab0, LogProgress ()
elaborationWarnings) = SolverPackage (PackageLocation (Maybe String))
-> (ElaboratedConfiguredPackage, LogProgress ())
elaborateSolverToCommon SolverPackage (PackageLocation (Maybe String))
spkg
          pkgid :: PackageId
pkgid = ElaboratedConfiguredPackage -> PackageId
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
            | BuildType
bt BuildType -> [BuildType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BuildType
PD.Custom, BuildType
PD.Hooks] =
                ElaboratedConfiguredPackage -> Maybe ElaboratedConfiguredPackage
forall a. a -> Maybe a
Just
                  ElaboratedConfiguredPackage
elab0
                    { elabModuleShape = emptyModuleShape
                    , elabUnitId = notImpl "elabUnitId"
                    , elabComponentId = notImpl "elabComponentId"
                    , elabLinkedInstantiatedWith = Map.empty
                    , elabInstallDirs = notImpl "elabInstallDirs"
                    , elabPkgOrComp = ElabComponent (ElaboratedComponent{..})
                    }
            | Bool
otherwise =
                Maybe ElaboratedConfiguredPackage
forall a. Maybe a
Nothing
            where
              compSolverName :: Component
compSolverName = Component
CD.ComponentSetup
              compComponentName :: Maybe a
compComponentName = Maybe a
forall a. Maybe a
Nothing

              dep_pkgs :: [ElaboratedPlanPackage]
dep_pkgs = (SolverId -> [ElaboratedPlanPackage])
-> SolverId -> [ElaboratedPlanPackage]
elaborateLibSolverId SolverId -> [ElaboratedPlanPackage]
mapDep (SolverId -> [ElaboratedPlanPackage])
-> [SolverId] -> [ElaboratedPlanPackage]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ComponentDeps [SolverId] -> [SolverId]
forall a. Monoid a => ComponentDeps a -> a
CD.setupDeps ComponentDeps [SolverId]
deps0

              compLibDependencies :: [(ConfiguredId, Bool)]
compLibDependencies =
                -- MP: No idea what this function does
                (ElaboratedPlanPackage -> (ConfiguredId, Bool))
-> [ElaboratedPlanPackage] -> [(ConfiguredId, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\ElaboratedPlanPackage
cid -> (ElaboratedPlanPackage -> ConfiguredId
forall a. HasConfiguredId a => a -> ConfiguredId
configuredId ElaboratedPlanPackage
cid, Bool
False)) [ElaboratedPlanPackage]
dep_pkgs
              compLinkedLibDependencies :: a
compLinkedLibDependencies = String -> a
forall {a}. String -> a
notImpl String
"compLinkedLibDependencies"
              compOrderLibDependencies :: a
compOrderLibDependencies = String -> a
forall {a}. String -> a
notImpl String
"compOrderLibDependencies"

              -- Not supported:
              compExeDependencies :: [a]
              compExeDependencies :: forall a. [a]
compExeDependencies = []

              compExeDependencyPaths :: [a]
              compExeDependencyPaths :: forall a. [a]
compExeDependencyPaths = []

              compPkgConfigDependencies :: [a]
              compPkgConfigDependencies :: forall a. [a]
compPkgConfigDependencies = []

              notImpl :: String -> a
notImpl String
f =
                String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
                  String
"Distribution.Client.ProjectPlanning.setupComponent: "
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
                    String -> String -> String
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 =
            Doc
-> LogProgress
     ((ConfiguredComponentMap, LinkedComponentMap,
       Map InstalledPackageId String),
      ElaboratedConfiguredPackage)
-> LogProgress
     ((ConfiguredComponentMap, LinkedComponentMap,
       Map InstalledPackageId String),
      ElaboratedConfiguredPackage)
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))
              )
              (LogProgress
   ((ConfiguredComponentMap, LinkedComponentMap,
     Map InstalledPackageId String),
    ElaboratedConfiguredPackage)
 -> LogProgress
      ((ConfiguredComponentMap, LinkedComponentMap,
        Map InstalledPackageId String),
       ElaboratedConfiguredPackage))
-> LogProgress
     ((ConfiguredComponentMap, LinkedComponentMap,
       Map InstalledPackageId String),
      ElaboratedConfiguredPackage)
-> LogProgress
     ((ConfiguredComponentMap, LinkedComponentMap,
       Map InstalledPackageId String),
      ElaboratedConfiguredPackage)
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
                    (String -> InstalledPackageId
forall a. HasCallStack => String -> a
error String
"Distribution.Client.ProjectPlanning.cc_cid: filled in later")
                    ((Map ComponentName (AnnotatedId InstalledPackageId)
 -> Map ComponentName (AnnotatedId InstalledPackageId)
 -> Map ComponentName (AnnotatedId InstalledPackageId))
-> ConfiguredComponentMap
-> ConfiguredComponentMap
-> ConfiguredComponentMap
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map ComponentName (AnnotatedId InstalledPackageId)
-> Map ComponentName (AnnotatedId InstalledPackageId)
-> Map ComponentName (AnnotatedId InstalledPackageId)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ConfiguredComponentMap
external_lib_cc_map ConfiguredComponentMap
cc_map)
                    ((Map ComponentName (AnnotatedId InstalledPackageId)
 -> Map ComponentName (AnnotatedId InstalledPackageId)
 -> Map ComponentName (AnnotatedId InstalledPackageId))
-> ConfiguredComponentMap
-> ConfiguredComponentMap
-> ConfiguredComponentMap
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map ComponentName (AnnotatedId InstalledPackageId)
-> Map ComponentName (AnnotatedId InstalledPackageId)
-> Map ComponentName (AnnotatedId InstalledPackageId)
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

                let do_ :: ComponentInclude InstalledPackageId rn -> (ConfiguredId, Bool)
do_ ComponentInclude InstalledPackageId rn
cid =
                      let cid' :: ConfiguredId
cid' = AnnotatedId InstalledPackageId -> ConfiguredId
annotatedIdToConfiguredId (AnnotatedId InstalledPackageId -> ConfiguredId)
-> (ComponentInclude InstalledPackageId rn
    -> AnnotatedId InstalledPackageId)
-> ComponentInclude InstalledPackageId rn
-> ConfiguredId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentInclude InstalledPackageId rn
-> AnnotatedId InstalledPackageId
forall id rn. ComponentInclude id rn -> AnnotatedId id
ci_ann_id (ComponentInclude InstalledPackageId rn -> ConfiguredId)
-> ComponentInclude InstalledPackageId rn -> ConfiguredId
forall a b. (a -> b) -> a -> b
$ ComponentInclude InstalledPackageId rn
cid
                       in (ConfiguredId
cid', Bool
False) -- filled in later in pruneInstallPlanPhase2)
                      -- 2. Read out the dependencies from the ConfiguredComponent cc0
                let compLibDependencies :: [(ConfiguredId, Bool)]
compLibDependencies =
                      -- Nub because includes can show up multiple times
                      [(ConfiguredId, Bool)] -> [(ConfiguredId, Bool)]
forall a. Ord a => [a] -> [a]
ordNub
                        ( (ComponentInclude InstalledPackageId IncludeRenaming
 -> (ConfiguredId, Bool))
-> [ComponentInclude InstalledPackageId IncludeRenaming]
-> [(ConfiguredId, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map
                            (\ComponentInclude InstalledPackageId IncludeRenaming
cid -> ComponentInclude InstalledPackageId IncludeRenaming
-> (ConfiguredId, Bool)
forall {rn}.
ComponentInclude InstalledPackageId rn -> (ConfiguredId, Bool)
do_ ComponentInclude InstalledPackageId IncludeRenaming
cid)
                            (ConfiguredComponent
-> [ComponentInclude InstalledPackageId IncludeRenaming]
cc_includes ConfiguredComponent
cc0)
                        )
                    compExeDependencies :: [ConfiguredId]
compExeDependencies =
                      (AnnotatedId InstalledPackageId -> ConfiguredId)
-> [AnnotatedId InstalledPackageId] -> [ConfiguredId]
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 <- [InstalledPackageId
-> Map InstalledPackageId [String] -> Maybe [String]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (AnnotatedId InstalledPackageId -> InstalledPackageId
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, Bool)]
[(ConfiguredId, String)]
[UnitId]
[OpenUnitId]
[ConfiguredId]
Maybe ComponentName
Component
forall {a}. a
compSolverName :: Component
compComponentName :: Maybe ComponentName
compLibDependencies :: [(ConfiguredId, Bool)]
compLinkedLibDependencies :: [OpenUnitId]
compExeDependencies :: [ConfiguredId]
compPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
compExeDependencyPaths :: [(ConfiguredId, String)]
compOrderLibDependencies :: [UnitId]
compLibDependencies :: [(ConfiguredId, Bool)]
compExeDependencies :: [ConfiguredId]
compExeDependencyPaths :: [(ConfiguredId, String)]
compLinkedLibDependencies :: forall {a}. a
compOrderLibDependencies :: forall {a}. a
compComponentName :: Maybe ComponentName
compSolverName :: Component
compPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
..}

                -- 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 = ElabComponent $ elab_comp
                        }
                    cid :: InstalledPackageId
cid = case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab0 of
                      BuildInplaceOnly{} ->
                        String -> InstalledPackageId
mkComponentId (String -> InstalledPackageId) -> String -> InstalledPackageId
forall a b. (a -> b) -> a -> b
$
                          PackageId -> String
forall a. Pretty a => a -> String
prettyShow PackageId
pkgid
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-inplace"
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ ( case ComponentName -> Maybe UnqualComponentName
Cabal.componentNameString ComponentName
cname of
                                  Maybe UnqualComponentName
Nothing -> String
""
                                  Just UnqualComponentName
s -> String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
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 = fmap (const cid) (cc_ann_id cc0)}
                Doc -> LogProgress ()
infoProgress (Doc -> LogProgress ()) -> Doc -> LogProgress ()
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 UnitId -> Map UnitId FullUnitId -> Maybe FullUnitId
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 -> String -> FullUnitId
forall a. HasCallStack => String -> a
error (String
"lookup_uid: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DefUnitId -> String
forall a. Pretty a => a -> String
prettyShow DefUnitId
def_uid)
                LinkedComponent
lc <-
                  Verbosity
-> Bool
-> (DefUnitId -> FullUnitId)
-> PackageId
-> LinkedComponentMap
-> ConfiguredComponent
-> LogProgress LinkedComponent
toLinkedComponent
                    Verbosity
verbosity
                    Bool
False
                    DefUnitId -> FullUnitId
lookup_uid
                    (ElaboratedConfiguredPackage -> PackageId
elabPkgSourceId ElaboratedConfiguredPackage
elab0)
                    (LinkedComponentMap -> LinkedComponentMap -> LinkedComponentMap
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 (Doc -> LogProgress ()) -> Doc -> LogProgress ()
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 = lc_shape lc
                      , elabUnitId = abstractUnitId (lc_uid lc)
                      , elabComponentId = lc_cid lc
                      , elabLinkedInstantiatedWith = Map.fromList (lc_insts lc)
                      , elabPkgOrComp =
                          ElabComponent $
                            elab_comp
                              { compLinkedLibDependencies = ordNub (map ci_id (lc_includes lc))
                              , compOrderLibDependencies =
                                  ordNub
                                    ( map
                                        (abstractUnitId . ci_id)
                                        (lc_includes lc ++ lc_sig_includes lc)
                                    )
                              }
                      }
                  elab :: ElaboratedConfiguredPackage
elab =
                    ElaboratedConfiguredPackage
elab2
                      { elabInstallDirs =
                          computeInstallDirs
                            storeDirLayout
                            defaultInstallDirs
                            elaboratedSharedConfig
                            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' = InstalledPackageId
-> String
-> Map InstalledPackageId String
-> Map InstalledPackageId String
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

                ((ConfiguredComponentMap, LinkedComponentMap,
  Map InstalledPackageId String),
 ElaboratedConfiguredPackage)
-> LogProgress
     ((ConfiguredComponentMap, LinkedComponentMap,
       Map InstalledPackageId String),
      ElaboratedConfiguredPackage)
forall a. a -> LogProgress a
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 = String -> a
forall a. HasCallStack => String -> a
error String
"buildComponent: compLinkedLibDependencies"
              compOrderLibDependencies :: a
compOrderLibDependencies = String -> a
forall a. HasCallStack => String -> a
error String
"buildComponent: compOrderLibDependencies"

              cname :: ComponentName
cname = Component -> ComponentName
Cabal.componentName Component
comp
              compComponentName :: Maybe ComponentName
compComponentName = ComponentName -> Maybe ComponentName
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 = (Component -> Bool) -> ComponentDeps [SolverId] -> [SolverId]
forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
CD.select (Component -> Component -> Bool
forall a. Eq a => a -> a -> Bool
== Component
compSolverName) ComponentDeps [SolverId]
deps0
              external_exe_dep_sids :: [SolverId]
external_exe_dep_sids = (Component -> Bool) -> ComponentDeps [SolverId] -> [SolverId]
forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
CD.select (Component -> Component -> Bool
forall a. Eq a => a -> a -> Bool
== Component
compSolverName) ComponentDeps [SolverId]
exe_deps0

              external_lib_dep_pkgs :: [ElaboratedPlanPackage]
external_lib_dep_pkgs = (SolverId -> [ElaboratedPlanPackage])
-> [SolverId] -> [ElaboratedPlanPackage]
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 =
                (SolverId -> [ElaboratedPlanPackage])
-> [SolverId] -> [ElaboratedPlanPackage]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SolverId -> [ElaboratedPlanPackage]
mapDep ([SolverId] -> [ElaboratedPlanPackage])
-> [SolverId] -> [ElaboratedPlanPackage]
forall a b. (a -> b) -> a -> b
$
                  (SolverId -> PackageName) -> [SolverId] -> [SolverId]
forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubBy (PackageId -> PackageName
pkgName (PackageId -> PackageName)
-> (SolverId -> PackageId) -> SolverId -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolverId -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId) ([SolverId] -> [SolverId]) -> [SolverId] -> [SolverId]
forall a b. (a -> b) -> a -> b
$
                    [SolverId]
external_exe_dep_sids [SolverId] -> [SolverId] -> [SolverId]
forall a. [a] -> [a] -> [a]
++ [SolverId]
external_lib_dep_sids

              external_exe_map :: Map InstalledPackageId [String]
external_exe_map =
                [(InstalledPackageId, [String])] -> Map InstalledPackageId [String]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(InstalledPackageId, [String])]
 -> Map InstalledPackageId [String])
-> [(InstalledPackageId, [String])]
-> Map InstalledPackageId [String]
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 = Map InstalledPackageId [String]
-> Map InstalledPackageId [String]
-> Map InstalledPackageId [String]
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map InstalledPackageId [String]
external_exe_map (Map InstalledPackageId [String]
 -> Map InstalledPackageId [String])
-> Map InstalledPackageId [String]
-> Map InstalledPackageId [String]
forall a b. (a -> b) -> a -> b
$ (String -> [String])
-> Map InstalledPackageId String -> Map InstalledPackageId [String]
forall a b.
(a -> b) -> Map InstalledPackageId a -> Map InstalledPackageId 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 =
                (Map ComponentName (AnnotatedId InstalledPackageId)
 -> Map ComponentName (AnnotatedId InstalledPackageId)
 -> Map ComponentName (AnnotatedId InstalledPackageId))
-> [(PackageName,
     Map ComponentName (AnnotatedId InstalledPackageId))]
-> ConfiguredComponentMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Map ComponentName (AnnotatedId InstalledPackageId)
-> Map ComponentName (AnnotatedId InstalledPackageId)
-> Map ComponentName (AnnotatedId InstalledPackageId)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ([(PackageName,
   Map ComponentName (AnnotatedId InstalledPackageId))]
 -> ConfiguredComponentMap)
-> [(PackageName,
     Map ComponentName (AnnotatedId InstalledPackageId))]
-> ConfiguredComponentMap
forall a b. (a -> b) -> a -> b
$
                  (ElaboratedPlanPackage
 -> (PackageName,
     Map ComponentName (AnnotatedId InstalledPackageId)))
-> [ElaboratedPlanPackage]
-> [(PackageName,
     Map ComponentName (AnnotatedId InstalledPackageId))]
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 =
                (Map ComponentName (AnnotatedId InstalledPackageId)
 -> Map ComponentName (AnnotatedId InstalledPackageId)
 -> Map ComponentName (AnnotatedId InstalledPackageId))
-> [(PackageName,
     Map ComponentName (AnnotatedId InstalledPackageId))]
-> ConfiguredComponentMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Map ComponentName (AnnotatedId InstalledPackageId)
-> Map ComponentName (AnnotatedId InstalledPackageId)
-> Map ComponentName (AnnotatedId InstalledPackageId)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ([(PackageName,
   Map ComponentName (AnnotatedId InstalledPackageId))]
 -> ConfiguredComponentMap)
-> [(PackageName,
     Map ComponentName (AnnotatedId InstalledPackageId))]
-> ConfiguredComponentMap
forall a b. (a -> b) -> a -> b
$
                  (ElaboratedPlanPackage
 -> (PackageName,
     Map ComponentName (AnnotatedId InstalledPackageId)))
-> [ElaboratedPlanPackage]
-> [(PackageName,
     Map ComponentName (AnnotatedId InstalledPackageId))]
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 =
                [(InstalledPackageId, (OpenUnitId, ModuleShape))]
-> LinkedComponentMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(InstalledPackageId, (OpenUnitId, ModuleShape))]
 -> LinkedComponentMap)
-> [(InstalledPackageId, (OpenUnitId, ModuleShape))]
-> LinkedComponentMap
forall a b. (a -> b) -> a -> b
$
                  (ElaboratedPlanPackage
 -> (InstalledPackageId, (OpenUnitId, ModuleShape)))
-> [ElaboratedPlanPackage]
-> [(InstalledPackageId, (OpenUnitId, ModuleShape))]
forall a b. (a -> b) -> [a] -> [b]
map ElaboratedPlanPackage
-> (InstalledPackageId, (OpenUnitId, ModuleShape))
mkShapeMapping ([ElaboratedPlanPackage]
 -> [(InstalledPackageId, (OpenUnitId, ModuleShape))])
-> [ElaboratedPlanPackage]
-> [(InstalledPackageId, (OpenUnitId, ModuleShape))]
forall a b. (a -> b) -> a -> b
$
                    [ElaboratedPlanPackage]
external_lib_dep_pkgs [ElaboratedPlanPackage]
-> [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
forall a. [a] -> [a] -> [a]
++ (SolverId -> [ElaboratedPlanPackage])
-> [SolverId] -> [ElaboratedPlanPackage]
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
                  , Maybe PkgconfigVersion
-> Maybe (Maybe PkgconfigVersion) -> Maybe PkgconfigVersion
forall a. a -> Maybe a -> a
fromMaybe
                      ( String -> Maybe PkgconfigVersion
forall a. HasCallStack => String -> a
error (String -> Maybe PkgconfigVersion)
-> String -> Maybe PkgconfigVersion
forall a b. (a -> b) -> a -> b
$
                          String
"compPkgConfigDependencies: impossible! "
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ PkgconfigName -> String
forall a. Pretty a => a -> String
prettyShow PkgconfigName
pn
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from "
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageId -> String
forall a. Pretty a => a -> String
prettyShow (ElaboratedConfiguredPackage -> PackageId
elabPkgSourceId ElaboratedConfiguredPackage
elab0)
                      )
                      (Maybe PkgConfigDb
pkgConfigDB Maybe PkgConfigDb
-> (PkgConfigDb -> Maybe (Maybe PkgconfigVersion))
-> Maybe (Maybe PkgconfigVersion)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PkgConfigDb
db -> PkgConfigDb -> PkgconfigName -> Maybe (Maybe PkgconfigVersion)
pkgConfigDbPkgVersion PkgConfigDb
db 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
                  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ case ComponentName -> Maybe UnqualComponentName
Cabal.componentNameString ComponentName
cname of
                    Just UnqualComponentName
n -> UnqualComponentName -> String
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 = (ElaboratedPlanPackage -> Bool)
-> [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ComponentName -> Bool) -> ElaboratedPlanPackage -> Bool
matchPlanPkg (ComponentName -> ComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== (LibraryName -> ComponentName
CLibName LibraryName
LMainLibName))) ([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> (SolverId -> [ElaboratedPlanPackage])
-> SolverId
-> [ElaboratedPlanPackage]
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.
        (InstalledPackageInfo -> [String])
-> (ElaboratedConfiguredPackage -> [String])
-> ElaboratedPlanPackage
-> [String]
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage ([String] -> InstalledPackageInfo -> [String]
forall a b. a -> b -> a
const []) ((ElaboratedConfiguredPackage -> [String])
 -> ElaboratedPlanPackage -> [String])
-> (ElaboratedConfiguredPackage -> [String])
-> ElaboratedPlanPackage
-> [String]
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 (UnqualComponentName -> String)
-> (Executable -> UnqualComponentName) -> Executable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
PD.exeName
                    (Executable -> String) -> [Executable] -> [String]
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 (ComponentName -> Maybe UnqualComponentName)
-> Maybe ComponentName -> Maybe (Maybe UnqualComponentName)
forall a b. (a -> b) -> Maybe a -> Maybe b
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) -> [UnqualComponentName -> String
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
              (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
executables

      elaborateSolverToPackage
        :: NE.NonEmpty NotPerComponentReason
        -> SolverPackage UnresolvedPkgLoc
        -> ComponentsGraph
        -> [ElaboratedConfiguredPackage]
        -> LogProgress ElaboratedConfiguredPackage
      elaborateSolverToPackage :: NonEmpty NotPerComponentReason
-> SolverPackage (PackageLocation (Maybe String))
-> ComponentsGraph
-> [ElaboratedConfiguredPackage]
-> LogProgress ElaboratedConfiguredPackage
elaborateSolverToPackage
        NonEmpty NotPerComponentReason
pkgWhyNotPerComponent
        pkg :: SolverPackage (PackageLocation (Maybe String))
pkg@( SolverPackage
                (SourcePackage PackageId
pkgid GenericPackageDescription
_gpd PackageLocation (Maybe String)
_srcloc Maybe CabalFileText
_descOverride)
                FlagAssignment
_flags
                OptionalStanzaSet
_stanzas
                ComponentDeps [SolverId]
_deps0
                ComponentDeps [SolverId]
_exe_deps0
              )
        ComponentsGraph
compGraph
        [ElaboratedConfiguredPackage]
comps = do
          -- Knot tying: the final elab includes the
          -- pkgInstalledId, which is calculated by hashing many
          -- of the other fields of the elaboratedPackage.
          LogProgress ()
elaborationWarnings
          ElaboratedConfiguredPackage
-> LogProgress ElaboratedConfiguredPackage
forall a. a -> LogProgress a
forall (m :: * -> *) a. Monad m => a -> m a
return ElaboratedConfiguredPackage
elab
          where
            (elab0 :: ElaboratedConfiguredPackage
elab0@ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
..}, LogProgress ()
elaborationWarnings) =
              SolverPackage (PackageLocation (Maybe String))
-> (ElaboratedConfiguredPackage, LogProgress ())
elaborateSolverToCommon SolverPackage (PackageLocation (Maybe String))
pkg

            elab1 :: ElaboratedConfiguredPackage
elab1 =
              ElaboratedConfiguredPackage
elab0
                { elabUnitId = newSimpleUnitId pkgInstalledId
                , elabComponentId = pkgInstalledId
                , elabLinkedInstantiatedWith = Map.empty
                , elabPkgOrComp = ElabPackage $ ElaboratedPackage{..}
                , elabModuleShape = modShape
                }

            elab :: ElaboratedConfiguredPackage
elab =
              ElaboratedConfiguredPackage
elab1
                { elabInstallDirs =
                    computeInstallDirs
                      storeDirLayout
                      defaultInstallDirs
                      elaboratedSharedConfig
                      elab1
                }

            modShape :: ModuleShape
modShape = case (ElaboratedConfiguredPackage -> Bool)
-> [ElaboratedConfiguredPackage]
-> Maybe ElaboratedConfiguredPackage
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ComponentName -> Bool) -> ElaboratedConfiguredPackage -> Bool
matchElabPkg (ComponentName -> ComponentName -> Bool
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
              | SolverPackage (PackageLocation (Maybe String)) -> Bool
forall loc. SolverPackage loc -> Bool
shouldBuildInplaceOnly SolverPackage (PackageLocation (Maybe String))
pkg =
                  String -> InstalledPackageId
mkComponentId (PackageId -> String
forall a. Pretty a => a -> String
prettyShow PackageId
pkgid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-inplace")
              | Bool
otherwise =
                  Bool -> InstalledPackageId -> InstalledPackageId
forall a. HasCallStack => Bool -> a -> a
assert (Maybe PackageSourceHash -> Bool
forall a. Maybe a -> Bool
isJust Maybe PackageSourceHash
elabPkgSourceHash) (InstalledPackageId -> InstalledPackageId)
-> InstalledPackageId -> InstalledPackageId
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 -> PackageId
confSrcId ConfiguredId
confid PackageId -> PackageId -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageId
pkgid
            filterExt :: [ConfiguredId] -> [ConfiguredId]
filterExt = (ConfiguredId -> Bool) -> [ConfiguredId] -> [ConfiguredId]
forall a. (a -> Bool) -> [a] -> [a]
filter ConfiguredId -> Bool
isExt

            filterExt' :: [(ConfiguredId, a)] -> [(ConfiguredId, a)]
            filterExt' :: forall a. [(ConfiguredId, a)] -> [(ConfiguredId, a)]
filterExt' = ((ConfiguredId, a) -> Bool)
-> [(ConfiguredId, a)] -> [(ConfiguredId, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ConfiguredId -> Bool
isExt (ConfiguredId -> Bool)
-> ((ConfiguredId, a) -> ConfiguredId) -> (ConfiguredId, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfiguredId, a) -> ConfiguredId
forall a b. (a, b) -> a
fst)

            pkgLibDependencies :: ComponentDeps [(ConfiguredId, Bool)]
pkgLibDependencies =
              (ElaboratedComponent -> [(ConfiguredId, Bool)])
-> ComponentDeps [(ConfiguredId, Bool)]
forall a. Monoid a => (ElaboratedComponent -> a) -> ComponentDeps a
buildComponentDeps ([(ConfiguredId, Bool)] -> [(ConfiguredId, Bool)]
forall a. [(ConfiguredId, a)] -> [(ConfiguredId, a)]
filterExt' ([(ConfiguredId, Bool)] -> [(ConfiguredId, Bool)])
-> (ElaboratedComponent -> [(ConfiguredId, Bool)])
-> ElaboratedComponent
-> [(ConfiguredId, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedComponent -> [(ConfiguredId, Bool)]
compLibDependencies)
            pkgExeDependencies :: ComponentDeps [ConfiguredId]
pkgExeDependencies =
              (ElaboratedComponent -> [ConfiguredId])
-> ComponentDeps [ConfiguredId]
forall a. Monoid a => (ElaboratedComponent -> a) -> ComponentDeps a
buildComponentDeps ([ConfiguredId] -> [ConfiguredId]
filterExt ([ConfiguredId] -> [ConfiguredId])
-> (ElaboratedComponent -> [ConfiguredId])
-> ElaboratedComponent
-> [ConfiguredId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedComponent -> [ConfiguredId]
compExeDependencies)
            pkgExeDependencyPaths :: ComponentDeps [(ConfiguredId, String)]
pkgExeDependencyPaths =
              (ElaboratedComponent -> [(ConfiguredId, String)])
-> ComponentDeps [(ConfiguredId, String)]
forall a. Monoid a => (ElaboratedComponent -> a) -> ComponentDeps a
buildComponentDeps ([(ConfiguredId, String)] -> [(ConfiguredId, String)]
forall a. [(ConfiguredId, a)] -> [(ConfiguredId, a)]
filterExt' ([(ConfiguredId, String)] -> [(ConfiguredId, String)])
-> (ElaboratedComponent -> [(ConfiguredId, String)])
-> ElaboratedComponent
-> [(ConfiguredId, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedComponent -> [(ConfiguredId, String)]
compExeDependencyPaths)

            -- TODO: Why is this flat?
            pkgPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
pkgPkgConfigDependencies =
              ComponentDeps [(PkgconfigName, Maybe PkgconfigVersion)]
-> [(PkgconfigName, Maybe PkgconfigVersion)]
forall a. Monoid a => ComponentDeps a -> a
CD.flatDeps (ComponentDeps [(PkgconfigName, Maybe PkgconfigVersion)]
 -> [(PkgconfigName, Maybe PkgconfigVersion)])
-> ComponentDeps [(PkgconfigName, Maybe PkgconfigVersion)]
-> [(PkgconfigName, Maybe PkgconfigVersion)]
forall a b. (a -> b) -> a -> b
$ (ElaboratedComponent -> [(PkgconfigName, Maybe PkgconfigVersion)])
-> ComponentDeps [(PkgconfigName, Maybe PkgconfigVersion)]
forall a. Monoid a => (ElaboratedComponent -> a) -> ComponentDeps a
buildComponentDeps ElaboratedComponent -> [(PkgconfigName, Maybe PkgconfigVersion)]
compPkgConfigDependencies

            pkgDependsOnSelfLib :: ComponentDeps [()]
pkgDependsOnSelfLib =
              [ComponentDep [()]] -> ComponentDeps [()]
forall a. Monoid a => [ComponentDep a] -> ComponentDeps a
CD.fromList
                [ (ComponentName -> Component
CD.componentNameToComponent ComponentName
cn, [()])
                | Graph.N Component
_ ComponentName
cn [ComponentName]
_ <- [Node ComponentName Component]
-> Maybe [Node ComponentName Component]
-> [Node ComponentName Component]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Node ComponentName Component]
mb_closure
                ]
              where
                mb_closure :: Maybe [Node ComponentName Component]
mb_closure = ComponentsGraph
-> [Key (Node ComponentName Component)]
-> Maybe [Node ComponentName Component]
forall a. Graph a -> [Key a] -> Maybe [a]
Graph.revClosure ComponentsGraph
compGraph [ComponentName
Key (Node ComponentName Component)
k | ComponentName
k <- ComponentsGraph -> [Key (Node ComponentName Component)]
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 :: Monoid a => (ElaboratedComponent -> a) -> CD.ComponentDeps a
            buildComponentDeps :: forall a. Monoid a => (ElaboratedComponent -> a) -> ComponentDeps a
buildComponentDeps ElaboratedComponent -> a
f =
              [ComponentDep a] -> ComponentDeps a
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 = (Maybe Bool -> Bool)
-> OptionalStanzaMap (Maybe Bool) -> OptionalStanzaSet
forall a. (a -> Bool) -> OptionalStanzaMap a -> OptionalStanzaSet
optStanzaKeysFilteredByValue (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False) OptionalStanzaMap (Maybe Bool)
elabStanzasRequested

      elaborateSolverToCommon
        :: SolverPackage UnresolvedPkgLoc
        -> (ElaboratedConfiguredPackage, LogProgress ())
      elaborateSolverToCommon :: SolverPackage (PackageLocation (Maybe String))
-> (ElaboratedConfiguredPackage, LogProgress ())
elaborateSolverToCommon
        pkg :: SolverPackage (PackageLocation (Maybe String))
pkg@( SolverPackage
                (SourcePackage PackageId
pkgid GenericPackageDescription
gdesc PackageLocation (Maybe String)
srcloc Maybe CabalFileText
descOverride)
                FlagAssignment
flags
                OptionalStanzaSet
stanzas
                ComponentDeps [SolverId]
deps0
                ComponentDeps [SolverId]
_exe_deps0
              ) =
          (ElaboratedConfiguredPackage
elaboratedPackage, PackageId -> LogProgress ()
wayWarnings PackageId
pkgid)
          where
            elaboratedPackage :: ElaboratedConfiguredPackage
elaboratedPackage = ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
forall {a}. a
forall a. [a]
forall k a. Map k a
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
elabUnitId :: forall {a}. a
elabComponentId :: forall {a}. a
elabInstantiatedWith :: forall k a. Map k a
elabLinkedInstantiatedWith :: forall {a}. a
elabPkgOrComp :: forall {a}. a
elabInstallDirs :: forall {a}. a
elabModuleShape :: forall {a}. a
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabPkgDescription :: PackageDescription
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabConfigureTargets :: forall a. [a]
elabBuildTargets :: forall a. [a]
elabTestTargets :: forall a. [a]
elabBenchTargets :: forall a. [a]
elabReplTarget :: forall a. [a]
elabHaddockTargets :: forall a. [a]
elabBuildHaddocks :: Bool
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabPackageDbs :: [Maybe PackageDBCWD]
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
..}

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

            elabIsCanonical :: Bool
elabIsCanonical = Bool
True
            elabPkgSourceId :: PackageId
elabPkgSourceId = PackageId
pkgid
            elabPkgDescription :: PackageDescription
elabPkgDescription = case FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
PD.finalizePD
              FlagAssignment
flags
              ComponentRequestedSpec
elabEnabledSpec
              (Bool -> Dependency -> Bool
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]
_ -> String -> PackageDescription
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
PD.flagName PackageFlag
flag, PackageFlag -> Bool
PD.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 = (OptionalStanza -> Maybe Bool) -> OptionalStanzaMap (Maybe Bool)
forall a. (OptionalStanza -> a) -> OptionalStanzaMap a
optStanzaTabulate ((OptionalStanza -> Maybe Bool) -> OptionalStanzaMap (Maybe Bool))
-> (OptionalStanza -> Maybe Bool) -> OptionalStanzaMap (Maybe Bool)
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 -> [Bool] -> Maybe Bool
forall a. [a] -> Maybe a
listToMaybe [Bool
v | Bool
v <- Maybe Bool -> [Bool]
forall a. Maybe a -> [a]
maybeToList Maybe Bool
tests, TestSuite
_ <- PackageDescription -> [TestSuite]
PD.testSuites PackageDescription
elabPkgDescription]
              OptionalStanza
BenchStanzas -> [Bool] -> Maybe Bool
forall a. [a] -> Maybe a
listToMaybe [Bool
v | Bool
v <- Maybe Bool -> [Bool]
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 = PackageId -> (PackageConfig -> Flag Bool) -> Maybe Bool
forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
pkgid PackageConfig -> Flag Bool
packageConfigTests
                benchmarks :: Maybe Bool
benchmarks = PackageId -> (PackageConfig -> Flag Bool) -> Maybe Bool
forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
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 :: [a]
elabReplTarget = []
            elabHaddockTargets :: [a]
elabHaddockTargets = []

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

            -- `documentation: true` should imply `-haddock` for GHC
            addHaddockIfDocumentationEnabled :: ConfiguredProgram -> ConfiguredProgram
            addHaddockIfDocumentationEnabled :: ConfiguredProgram -> ConfiguredProgram
addHaddockIfDocumentationEnabled cp :: ConfiguredProgram
cp@ConfiguredProgram{String
[String]
[(String, Maybe String)]
Maybe Version
ProgramLocation
Map String String
programMonitorFiles :: ConfiguredProgram -> [String]
programOverrideEnv :: ConfiguredProgram -> [(String, Maybe String)]
programId :: String
programVersion :: Maybe Version
programDefaultArgs :: [String]
programOverrideArgs :: [String]
programOverrideEnv :: [(String, Maybe String)]
programProperties :: Map String String
programLocation :: ProgramLocation
programMonitorFiles :: [String]
programId :: ConfiguredProgram -> String
programVersion :: ConfiguredProgram -> Maybe Version
programDefaultArgs :: ConfiguredProgram -> [String]
programOverrideArgs :: ConfiguredProgram -> [String]
programProperties :: ConfiguredProgram -> Map String String
programLocation :: ConfiguredProgram -> ProgramLocation
..} =
              if String
programId String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ghc" Bool -> Bool -> Bool
&& Bool
elabBuildHaddocks
                then ConfiguredProgram
cp{programOverrideArgs = "-haddock" : programOverrideArgs}
                else ConfiguredProgram
cp

            elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceLocation = PackageLocation (Maybe String)
srcloc
            elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceHash = PackageId
-> Map PackageId PackageSourceHash -> Maybe PackageSourceHash
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageId
pkgid Map PackageId PackageSourceHash
sourcePackageHashes
            elabLocalToProject :: Bool
elabLocalToProject = SolverPackage (PackageLocation (Maybe String)) -> Bool
forall pkg. Package pkg => pkg -> Bool
isLocalToProject SolverPackage (PackageLocation (Maybe String))
pkg
            elabBuildStyle :: BuildStyle
elabBuildStyle =
              if SolverPackage (PackageLocation (Maybe String)) -> Bool
forall loc. SolverPackage loc -> Bool
shouldBuildInplaceOnly SolverPackage (PackageLocation (Maybe String))
pkg
                then MemoryOrDisk -> BuildStyle
BuildInplaceOnly MemoryOrDisk
OnDisk
                else BuildStyle
BuildAndInstall
            elabPackageDbs :: [Maybe PackageDBCWD]
elabPackageDbs = ProjectConfigShared -> [Maybe PackageDBCWD]
projectConfigPackageDBs ProjectConfigShared
sharedPackageConfig
            elabBuildPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack = PackageDBStackCWD
buildAndRegisterDbs
            elabRegisterPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack = PackageDBStackCWD
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 :: PackageDBStackCWD
elabSetupPackageDBStack = PackageDBStackCWD
buildAndRegisterDbs

            elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack = PackageDBStackCWD
inplacePackageDbs
            elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack = PackageDBStackCWD
inplacePackageDbs
            elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack = PackageDBStackCWD
inplacePackageDbs

            buildAndRegisterDbs :: PackageDBStackCWD
buildAndRegisterDbs
              | SolverPackage (PackageLocation (Maybe String)) -> Bool
forall loc. SolverPackage loc -> Bool
shouldBuildInplaceOnly SolverPackage (PackageLocation (Maybe String))
pkg = PackageDBStackCWD
inplacePackageDbs
              | Bool
otherwise = PackageDBStackCWD
corePackageDbs

            elabPkgDescriptionOverride :: Maybe CabalFileText
elabPkgDescriptionOverride = Maybe CabalFileText
descOverride

            elabBuildOptions :: BuildOptions
elabBuildOptions =
              LBC.BuildOptions
                { $sel:withVanillaLib:BuildOptions :: Bool
withVanillaLib = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
True PackageConfig -> Flag Bool
packageConfigVanillaLib -- TODO: [required feature]: also needs to be handled recursively
                , $sel:withSharedLib:BuildOptions :: Bool
withSharedLib = Bool
canBuildSharedLibs Bool -> Bool -> Bool
&& PackageId
pkgid PackageId -> Set PackageId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageId
pkgsUseSharedLibrary
                , $sel:withStaticLib:BuildOptions :: Bool
withStaticLib = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigStaticLib
                , $sel:withDynExe:BuildOptions :: Bool
withDynExe = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigDynExe
                , $sel:withFullyStaticExe:BuildOptions :: Bool
withFullyStaticExe = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigFullyStaticExe
                , $sel:withGHCiLib:BuildOptions :: Bool
withGHCiLib = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigGHCiLib -- TODO: [required feature] needs to default to enabled on windows still
                , $sel:withProfExe:BuildOptions :: Bool
withProfExe = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigProf
                , $sel:withProfLib:BuildOptions :: Bool
withProfLib = Bool
canBuildProfilingLibs Bool -> Bool -> Bool
&& PackageId
pkgid PackageId -> Set PackageId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageId
pkgsUseProfilingLibrary
                , $sel:withProfLibShared:BuildOptions :: Bool
withProfLibShared = Bool
canBuildProfilingSharedLibs Bool -> Bool -> Bool
&& PackageId
pkgid PackageId -> Set PackageId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageId
pkgsUseProfilingLibraryShared
                , $sel:exeCoverage:BuildOptions :: Bool
exeCoverage = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigCoverage
                , $sel:libCoverage:BuildOptions :: Bool
libCoverage = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigCoverage
                , $sel:withOptimization:BuildOptions :: OptimisationLevel
withOptimization = PackageId
-> OptimisationLevel
-> (PackageConfig -> Flag OptimisationLevel)
-> OptimisationLevel
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid OptimisationLevel
NormalOptimisation PackageConfig -> Flag OptimisationLevel
packageConfigOptimization
                , $sel:splitObjs:BuildOptions :: Bool
splitObjs = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigSplitObjs
                , $sel:splitSections:BuildOptions :: Bool
splitSections = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigSplitSections
                , $sel:stripLibs:BuildOptions :: Bool
stripLibs = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigStripLibs
                , $sel:stripExes:BuildOptions :: Bool
stripExes = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigStripExes
                , $sel:withDebugInfo:BuildOptions :: DebugInfoLevel
withDebugInfo = PackageId
-> DebugInfoLevel
-> (PackageConfig -> Flag DebugInfoLevel)
-> DebugInfoLevel
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid DebugInfoLevel
NoDebugInfo PackageConfig -> Flag DebugInfoLevel
packageConfigDebugInfo
                , $sel:relocatable:BuildOptions :: Bool
relocatable = PackageId -> Bool -> (PackageConfig -> Flag Bool) -> Bool
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid Bool
False PackageConfig -> Flag Bool
packageConfigRelocatable
                , $sel:withProfLibDetail:BuildOptions :: ProfDetailLevel
withProfLibDetail = ProfDetailLevel
elabProfExeDetail
                , $sel:withProfExeDetail:BuildOptions :: ProfDetailLevel
withProfExeDetail = ProfDetailLevel
elabProfLibDetail
                }

            ( ProfDetailLevel
elabProfExeDetail
              , ProfDetailLevel
elabProfLibDetail
              ) =
                PackageId
-> ProfDetailLevel
-> (PackageConfig -> Flag ProfDetailLevel)
-> (PackageConfig -> Flag ProfDetailLevel)
-> (ProfDetailLevel, ProfDetailLevel)
forall {pkg} {b}.
Package pkg =>
pkg
-> b
-> (PackageConfig -> Flag b)
-> (PackageConfig -> Flag b)
-> (b, b)
perPkgOptionLibExeFlag
                  PackageId
pkgid
                  ProfDetailLevel
ProfDetailDefault
                  PackageConfig -> Flag ProfDetailLevel
packageConfigProfDetail
                  PackageConfig -> Flag ProfDetailLevel
packageConfigProfLibDetail

            elabDumpBuildInfo :: DumpBuildInfo
elabDumpBuildInfo = PackageId
-> DumpBuildInfo
-> (PackageConfig -> Flag DumpBuildInfo)
-> DumpBuildInfo
forall a. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
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 =
              [(String, String)] -> Map String String
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
                ]
                Map String String -> Map String String -> Map String String
forall a. Semigroup a => a -> a -> a
<> PackageId
-> (PackageConfig -> MapLast String String) -> Map String String
forall {pkg} {k} {v}.
(Package pkg, Ord k) =>
pkg -> (PackageConfig -> MapLast k v) -> Map k v
perPkgOptionMapLast PackageId
pkgid PackageConfig -> MapLast String String
packageConfigProgramPaths
            elabProgramArgs :: Map String [String]
elabProgramArgs =
              ([String] -> [String] -> [String])
-> Map String [String]
-> Map String [String]
-> Map String [String]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++)
                ( [(String, [String])] -> Map String [String]
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 -> [String]) -> ConfiguredProgram -> [String]
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> ConfiguredProgram
addHaddockIfDocumentationEnabled ConfiguredProgram
prog
                    , Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args)
                    ]
                )
                (PackageId
-> (PackageConfig -> MapMappend String [String])
-> Map String [String]
forall {pkg} {v} {k}.
(Package pkg, Semigroup v, Ord k) =>
pkg -> (PackageConfig -> MapMappend k v) -> Map k v
perPkgOptionMapMappend PackageId
pkgid PackageConfig -> MapMappend String [String]
packageConfigProgramArgs)
            elabProgramPathExtra :: [String]
elabProgramPathExtra = PackageId -> (PackageConfig -> NubList String) -> [String]
forall {pkg} {a}.
(Package pkg, Ord a) =>
pkg -> (PackageConfig -> NubList a) -> [a]
perPkgOptionNubList PackageId
pkgid PackageConfig -> NubList String
packageConfigProgramPathExtra
            elabConfigureScriptArgs :: [String]
elabConfigureScriptArgs = PackageId -> (PackageConfig -> [String]) -> [String]
forall a. PackageId -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageId
pkgid PackageConfig -> [String]
packageConfigConfigureArgs
            elabExtraLibDirs :: [String]
elabExtraLibDirs = PackageId -> (PackageConfig -> [String]) -> [String]
forall a. PackageId -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageId
pkgid PackageConfig -> [String]
packageConfigExtraLibDirs
            elabExtraLibDirsStatic :: [String]
elabExtraLibDirsStatic = PackageId -> (PackageConfig -> [String]) -> [String]
forall a. PackageId -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageId
pkgid PackageConfig -> [String]
packageConfigExtraLibDirsStatic
            elabExtraFrameworkDirs :: [String]
elabExtraFrameworkDirs = PackageId -> (PackageConfig -> [String]) -> [String]
forall a. PackageId -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageId
pkgid PackageConfig -> [String]
packageConfigExtraFrameworkDirs
            elabExtraIncludeDirs :: [String]
elabExtraIncludeDirs = PackageId -> (PackageConfig -> [String]) -> [String]
forall a. PackageId -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageId
pkgid PackageConfig -> [String]
packageConfigExtraIncludeDirs
            elabProgPrefix :: Maybe PathTemplate
elabProgPrefix = PackageId
-> (PackageConfig -> Flag PathTemplate) -> Maybe PathTemplate
forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
pkgid PackageConfig -> Flag PathTemplate
packageConfigProgPrefix
            elabProgSuffix :: Maybe PathTemplate
elabProgSuffix = PackageId
-> (PackageConfig -> Flag PathTemplate) -> Maybe PathTemplate
forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
pkgid PackageConfig -> Flag PathTemplate
packageConfigProgSuffix

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

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

            elabBenchmarkOptions :: [PathTemplate]
elabBenchmarkOptions = PackageId -> (PackageConfig -> [PathTemplate]) -> [PathTemplate]
forall a. PackageId -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageId
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. PackageId -> a -> (PackageConfig -> Flag a) -> a
perPkgOptionFlag PackageId
pkgid a
def PackageConfig -> Flag a
f = a -> Flag a -> a
forall a. a -> Flag a -> a
fromFlagOrDefault a
def (PackageId -> (PackageConfig -> Flag a) -> Flag a
forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption PackageId
pkgid PackageConfig -> Flag a
f)
      perPkgOptionMaybe :: forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
pkgid PackageConfig -> Flag a
f = Flag a -> Maybe a
forall a. Flag a -> Maybe a
flagToMaybe (PackageId -> (PackageConfig -> Flag a) -> Flag a
forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption PackageId
pkgid PackageConfig -> Flag a
f)
      perPkgOptionList :: forall a. PackageId -> (PackageConfig -> [a]) -> [a]
perPkgOptionList PackageId
pkgid PackageConfig -> [a]
f = PackageId -> (PackageConfig -> [a]) -> [a]
forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption PackageId
pkgid PackageConfig -> [a]
f
      perPkgOptionNubList :: pkg -> (PackageConfig -> NubList a) -> [a]
perPkgOptionNubList pkg
pkgid PackageConfig -> NubList a
f = NubList a -> [a]
forall a. NubList a -> [a]
fromNubList (pkg -> (PackageConfig -> NubList a) -> NubList a
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 = MapLast k v -> Map k v
forall k v. MapLast k v -> Map k v
getMapLast (pkg -> (PackageConfig -> MapLast k v) -> MapLast k v
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 = MapMappend k v -> Map k v
forall k v. MapMappend k v -> Map k v
getMapMappend (pkg -> (PackageConfig -> MapMappend k v) -> MapMappend k v
forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption pkg
pkgid PackageConfig -> MapMappend k v
f)

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

          bothflag :: Flag b
bothflag = pkg -> (PackageConfig -> Flag b) -> Flag b
forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption pkg
pkgid PackageConfig -> Flag b
fboth
          libflag :: Flag b
libflag = pkg -> (PackageConfig -> Flag b) -> Flag b
forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption pkg
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 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` m
local m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` m
perpkg
        where
          global :: m
global = PackageConfig -> m
f PackageConfig
allPackagesConfig
          local :: m
local
            | pkg -> Bool
forall pkg. Package pkg => pkg -> Bool
isLocalToProject pkg
pkg =
                PackageConfig -> m
f PackageConfig
localPackagesConfig
            | Bool
otherwise =
                m
forall a. Monoid a => a
mempty
          perpkg :: m
perpkg = m -> (PackageConfig -> m) -> Maybe PackageConfig -> m
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m
forall a. Monoid a => a
mempty PackageConfig -> m
f (PackageName -> Map PackageName PackageConfig -> Maybe PackageConfig
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (pkg -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName pkg
pkg) Map PackageName PackageConfig
perPackageConfig)

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

      corePackageDbs :: PackageDBStackCWD
corePackageDbs = Compiler -> [Maybe PackageDBCWD] -> PackageDBStackCWD
storePackageDBStack Compiler
compiler (ProjectConfigShared -> [Maybe PackageDBCWD]
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 =
        PackageId -> Set PackageId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member
          (SolverPackage loc -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId SolverPackage loc
pkg)
          Set PackageId
pkgsToBuildInplaceOnly

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

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

      pkgsLocalToProject :: Set PackageId
      pkgsLocalToProject :: Set PackageId
pkgsLocalToProject =
        [PackageId] -> Set PackageId
forall a. Ord a => [a] -> Set a
Set.fromList ([Maybe PackageId] -> [PackageId]
forall a. [Maybe a] -> [a]
catMaybes ((PackageSpecifier (SourcePackage (PackageLocation loc))
 -> Maybe PackageId)
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> [Maybe PackageId]
forall a b. (a -> b) -> [a] -> [b]
map PackageSpecifier (SourcePackage (PackageLocation loc))
-> Maybe PackageId
forall loc.
PackageSpecifier (SourcePackage (PackageLocation loc))
-> Maybe PackageId
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 PackageId
pkgsUseSharedLibrary =
        (PackageId -> Bool) -> Set PackageId
packagesWithLibDepsDownwardClosedProperty PackageId -> Bool
needsSharedLib

      needsSharedLib :: PackageId -> Bool
needsSharedLib PackageId
pkgid =
        Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe
          Bool
compilerShouldUseSharedLibByDefault
          -- Case 1: --enable-shared or --disable-shared is passed explicitly, honour that.
          ( case Maybe Bool
pkgSharedLib of
              Just Bool
v -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
v
              Maybe Bool
Nothing -> case Maybe Bool
pkgDynExe of
                -- case 2: If --enable-executable-dynamic is passed then turn on
                -- shared library generation.
                Just Bool
True ->
                  -- Case 3: If --enable-profiling is passed, then we are going to
                  -- build profiled dynamic, so no need for shared libraries.
                  case Maybe Bool
pkgProf of
                    Just Bool
True -> if Bool
canBuildProfilingSharedLibs then Maybe Bool
forall a. Maybe a
Nothing else Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                    Maybe Bool
_ -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                -- But don't necessarily turn off shared library generation if
                -- --disable-executable-dynamic is passed. The shared objects might
                -- be needed for something different.
                Maybe Bool
_ -> Maybe Bool
forall a. Maybe a
Nothing
          )
        where
          pkgSharedLib :: Maybe Bool
pkgSharedLib = PackageId -> (PackageConfig -> Flag Bool) -> Maybe Bool
forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
pkgid PackageConfig -> Flag Bool
packageConfigSharedLib
          pkgDynExe :: Maybe Bool
pkgDynExe = PackageId -> (PackageConfig -> Flag Bool) -> Maybe Bool
forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
pkgid PackageConfig -> Flag Bool
packageConfigDynExe
          pkgProf :: Maybe Bool
pkgProf = PackageId -> (PackageConfig -> Flag Bool) -> Maybe Bool
forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
pkgid PackageConfig -> Flag Bool
packageConfigProf

      -- 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 -> BuildWay
GHC.compilerBuildWay Compiler
compiler BuildWay -> BuildWay -> Bool
forall a. Eq a => a -> a -> Bool
== BuildWay
DynWay Bool -> Bool -> Bool
&& Bool
canBuildSharedLibs
          CompilerFlavor
GHCJS -> Compiler -> Bool
GHCJS.isDynamic Compiler
compiler
          CompilerFlavor
_ -> Bool
False

      compilerShouldUseProfilingLibByDefault :: Bool
compilerShouldUseProfilingLibByDefault =
        case Compiler -> CompilerFlavor
compilerFlavor Compiler
compiler of
          CompilerFlavor
GHC -> Compiler -> BuildWay
GHC.compilerBuildWay Compiler
compiler BuildWay -> BuildWay -> Bool
forall a. Eq a => a -> a -> Bool
== BuildWay
ProfWay Bool -> Bool -> Bool
&& Bool
canBuildProfilingLibs
          CompilerFlavor
_ -> Bool
False

      compilerShouldUseProfilingSharedLibByDefault :: Bool
compilerShouldUseProfilingSharedLibByDefault =
        case Compiler -> CompilerFlavor
compilerFlavor Compiler
compiler of
          CompilerFlavor
GHC -> Compiler -> BuildWay
GHC.compilerBuildWay Compiler
compiler BuildWay -> BuildWay -> Bool
forall a. Eq a => a -> a -> Bool
== BuildWay
ProfDynWay Bool -> Bool -> Bool
&& Bool
canBuildProfilingSharedLibs
          CompilerFlavor
_ -> Bool
False

      -- Returns False if we definitely can't build shared libs
      canBuildWayLibs :: (Compiler -> Maybe Bool) -> Bool
canBuildWayLibs Compiler -> Maybe Bool
predicate = case Compiler -> Maybe Bool
predicate Compiler
compiler of
        Just Bool
can_build -> Bool
can_build
        -- If we don't know for certain, just assume we can
        -- which matches behaviour in previous cabal releases
        Maybe Bool
Nothing -> Bool
True

      canBuildSharedLibs :: Bool
canBuildSharedLibs = (Compiler -> Maybe Bool) -> Bool
canBuildWayLibs Compiler -> Maybe Bool
dynamicSupported
      canBuildProfilingLibs :: Bool
canBuildProfilingLibs = (Compiler -> Maybe Bool) -> Bool
canBuildWayLibs Compiler -> Maybe Bool
profilingVanillaSupported
      canBuildProfilingSharedLibs :: Bool
canBuildProfilingSharedLibs = (Compiler -> Maybe Bool) -> Bool
canBuildWayLibs Compiler -> Maybe Bool
profilingDynamicSupported

      wayWarnings :: PackageId -> LogProgress ()
wayWarnings PackageId
pkg = do
        Bool -> LogProgress () -> LogProgress ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
          (PackageId -> Bool
needsProfilingLib PackageId
pkg Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
canBuildProfilingLibs)
          (Doc -> LogProgress ()
warnProgress (String -> Doc
text String
"Compiler does not support building p libraries, profiling is disabled"))
        Bool -> LogProgress () -> LogProgress ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
          (PackageId -> Bool
needsSharedLib PackageId
pkg Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
canBuildSharedLibs)
          (Doc -> LogProgress ()
warnProgress (String -> Doc
text String
"Compiler does not support building dyn libraries, dynamic libraries are disabled"))
        Bool -> LogProgress () -> LogProgress ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
          (PackageId -> Bool
needsProfilingLibShared PackageId
pkg Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
canBuildProfilingSharedLibs)
          (Doc -> LogProgress ()
warnProgress (String -> Doc
text String
"Compiler does not support building p_dyn libraries, profiling dynamic libraries are disabled."))

      pkgsUseProfilingLibrary :: Set PackageId
      pkgsUseProfilingLibrary :: Set PackageId
pkgsUseProfilingLibrary =
        (PackageId -> Bool) -> Set PackageId
packagesWithLibDepsDownwardClosedProperty PackageId -> Bool
needsProfilingLib

      needsProfilingLib :: PackageId -> Bool
needsProfilingLib PackageId
pkg =
        Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
compilerShouldUseProfilingLibByDefault (Flag Bool
profBothFlag Flag Bool -> Flag Bool -> Flag Bool
forall a. Semigroup a => a -> a -> a
<> Flag Bool
profLibFlag)
        where
          pkgid :: PackageId
pkgid = PackageId -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId PackageId
pkg
          profBothFlag :: Flag Bool
profBothFlag = PackageId -> (PackageConfig -> Flag Bool) -> Flag Bool
forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption PackageId
pkgid PackageConfig -> Flag Bool
packageConfigProf
          profLibFlag :: Flag Bool
profLibFlag = PackageId -> (PackageConfig -> Flag Bool) -> Flag Bool
forall pkg m.
(Package pkg, Monoid m) =>
pkg -> (PackageConfig -> m) -> m
lookupPerPkgOption PackageId
pkgid PackageConfig -> Flag Bool
packageConfigProfLib

      pkgsUseProfilingLibraryShared :: Set PackageId
      pkgsUseProfilingLibraryShared :: Set PackageId
pkgsUseProfilingLibraryShared =
        (PackageId -> Bool) -> Set PackageId
packagesWithLibDepsDownwardClosedProperty PackageId -> Bool
needsProfilingLibShared

      needsProfilingLibShared :: PackageId -> Bool
needsProfilingLibShared PackageId
pkg =
        Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe
          Bool
compilerShouldUseProfilingSharedLibByDefault
          -- case 1: If --enable-profiling-shared is passed explicitly, honour that
          ( case Maybe Bool
profLibSharedFlag of
              Just Bool
v -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
v
              Maybe Bool
Nothing -> case Maybe Bool
pkgDynExe of
                Just Bool
True ->
                  case Maybe Bool
pkgProf of
                    -- case 2: --enable-executable-dynamic + --enable-profiling
                    -- turn on shared profiling libraries
                    Just Bool
True -> if Bool
canBuildProfilingSharedLibs then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing
                    Maybe Bool
_ -> Maybe Bool
forall a. Maybe a
Nothing
                -- But don't necessarily turn off shared library generation is
                -- --disable-executable-dynamic is passed. The shared objects might
                -- be needed for something different.
                Maybe Bool
_ -> Maybe Bool
forall a. Maybe a
Nothing
          )
        where
          pkgid :: PackageId
pkgid = PackageId -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId PackageId
pkg
          profLibSharedFlag :: Maybe Bool
profLibSharedFlag = PackageId -> (PackageConfig -> Flag Bool) -> Maybe Bool
forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
pkgid PackageConfig -> Flag Bool
packageConfigProfShared
          pkgDynExe :: Maybe Bool
pkgDynExe = PackageId -> (PackageConfig -> Flag Bool) -> Maybe Bool
forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
pkgid PackageConfig -> Flag Bool
packageConfigDynExe
          pkgProf :: Maybe Bool
pkgProf = PackageId -> (PackageConfig -> Flag Bool) -> Maybe Bool
forall a. PackageId -> (PackageConfig -> Flag a) -> Maybe a
perPkgOptionMaybe PackageId
pkgid PackageConfig -> Flag Bool
packageConfigProf

      -- TODO: [code cleanup] unused: the old deprecated packageConfigProfExe

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

      packagesWithLibDepsDownwardClosedProperty :: (PackageId -> Bool) -> Set PackageId
packagesWithLibDepsDownwardClosedProperty PackageId -> Bool
property =
        [PackageId] -> Set PackageId
forall a. Ord a => [a] -> Set a
Set.fromList
          ([PackageId] -> Set PackageId)
-> (Maybe [NonSetupLibDepSolverPlanPackage] -> [PackageId])
-> Maybe [NonSetupLibDepSolverPlanPackage]
-> Set PackageId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonSetupLibDepSolverPlanPackage -> PackageId)
-> [NonSetupLibDepSolverPlanPackage] -> [PackageId]
forall a b. (a -> b) -> [a] -> [b]
map NonSetupLibDepSolverPlanPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId
          ([NonSetupLibDepSolverPlanPackage] -> [PackageId])
-> (Maybe [NonSetupLibDepSolverPlanPackage]
    -> [NonSetupLibDepSolverPlanPackage])
-> Maybe [NonSetupLibDepSolverPlanPackage]
-> [PackageId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NonSetupLibDepSolverPlanPackage]
-> Maybe [NonSetupLibDepSolverPlanPackage]
-> [NonSetupLibDepSolverPlanPackage]
forall a. a -> Maybe a -> a
fromMaybe []
          (Maybe [NonSetupLibDepSolverPlanPackage] -> Set PackageId)
-> Maybe [NonSetupLibDepSolverPlanPackage] -> Set PackageId
forall a b. (a -> b) -> a -> b
$ Graph NonSetupLibDepSolverPlanPackage
-> [Key NonSetupLibDepSolverPlanPackage]
-> Maybe [NonSetupLibDepSolverPlanPackage]
forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure
            Graph NonSetupLibDepSolverPlanPackage
libDepGraph
            [ ResolverPackage (PackageLocation (Maybe String))
-> Key (ResolverPackage (PackageLocation (Maybe String)))
forall a. IsNode a => a -> Key a
Graph.nodeKey ResolverPackage (PackageLocation (Maybe String))
pkg
            | ResolverPackage (PackageLocation (Maybe String))
pkg <- SolverInstallPlan
-> [ResolverPackage (PackageLocation (Maybe String))]
SolverInstallPlan.toList SolverInstallPlan
solverPlan
            , PackageId -> Bool
property (ResolverPackage (PackageLocation (Maybe String)) -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ResolverPackage (PackageLocation (Maybe String))
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 PackageId
shouldBeLocal NamedPackage{} = Maybe PackageId
forall a. Maybe a
Nothing
shouldBeLocal (SpecificSourcePackage SourcePackage (PackageLocation loc)
pkg) = case SourcePackage (PackageLocation loc) -> PackageLocation loc
forall loc. SourcePackage loc -> loc
srcpkgSource SourcePackage (PackageLocation loc)
pkg of
  LocalUnpackedPackage String
_ -> PackageId -> Maybe PackageId
forall a. a -> Maybe a
Just (SourcePackage (PackageLocation loc) -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId SourcePackage (PackageLocation loc)
pkg)
  PackageLocation loc
_ -> Maybe PackageId
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 = (InstalledPackageInfo -> Bool)
-> (ElaboratedConfiguredPackage -> Bool)
-> ElaboratedPlanPackage
-> Bool
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage (ComponentName -> Bool
p (ComponentName -> Bool)
-> (InstalledPackageInfo -> ComponentName)
-> InstalledPackageInfo
-> Bool
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 (LibraryName -> ComponentName)
-> (InstalledPackageInfo -> LibraryName)
-> InstalledPackageInfo
-> ComponentName
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 -> Bool -> (ComponentName -> Bool) -> Maybe ComponentName -> Bool
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.*
      (Component -> Bool) -> [Component] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
        (ComponentName -> Bool
p (ComponentName -> Bool)
-> (Component -> ComponentName) -> Component -> Bool
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 =
  (InstalledPackageInfo
 -> (PackageName,
     Map ComponentName (AnnotatedId InstalledPackageId)))
-> (ElaboratedConfiguredPackage
    -> (PackageName,
        Map ComponentName (AnnotatedId InstalledPackageId)))
-> ElaboratedPlanPackage
-> (PackageName,
    Map ComponentName (AnnotatedId InstalledPackageId))
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage
    ( \InstalledPackageInfo
ipkg ->
        ( InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo
ipkg
        , ComponentName
-> AnnotatedId InstalledPackageId
-> Map ComponentName (AnnotatedId InstalledPackageId)
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 :: PackageId
ann_pid = InstalledPackageInfo -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId InstalledPackageInfo
ipkg
                , ann_cname :: ComponentName
ann_cname = InstalledPackageInfo -> ComponentName
IPI.sourceComponentName InstalledPackageInfo
ipkg
                }
            )
        )
    )
    ((ElaboratedConfiguredPackage
  -> (PackageName,
      Map ComponentName (AnnotatedId InstalledPackageId)))
 -> ElaboratedPlanPackage
 -> (PackageName,
     Map ComponentName (AnnotatedId InstalledPackageId)))
-> (ElaboratedConfiguredPackage
    -> (PackageName,
        Map ComponentName (AnnotatedId InstalledPackageId)))
-> ElaboratedPlanPackage
-> (PackageName,
    Map ComponentName (AnnotatedId InstalledPackageId))
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 :: PackageId
ann_pid = ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
elab
              , ann_cname :: ComponentName
ann_cname = ComponentName
cn
              }
       in ( ElaboratedConfiguredPackage -> PackageName
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 -> Map ComponentName (AnnotatedId InstalledPackageId)
forall k a. Map k a
Map.empty
                  Just ComponentName
n -> ComponentName
-> AnnotatedId InstalledPackageId
-> Map ComponentName (AnnotatedId InstalledPackageId)
forall k a. k -> a -> Map k a
Map.singleton ComponentName
n (ComponentName -> AnnotatedId InstalledPackageId
mk_aid ComponentName
n)
              ElabPackage ElaboratedPackage
_ ->
                [(ComponentName, AnnotatedId InstalledPackageId)]
-> Map ComponentName (AnnotatedId InstalledPackageId)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ComponentName, AnnotatedId InstalledPackageId)]
 -> Map ComponentName (AnnotatedId InstalledPackageId))
-> [(ComponentName, AnnotatedId InstalledPackageId)]
-> Map ComponentName (AnnotatedId InstalledPackageId)
forall a b. (a -> b) -> a -> b
$
                  (Component -> (ComponentName, AnnotatedId InstalledPackageId))
-> [Component] -> [(ComponentName, AnnotatedId InstalledPackageId)]
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) =
      (InstalledPackageInfo -> (InstalledPackageId, ModuleShape))
-> (ElaboratedConfiguredPackage
    -> (InstalledPackageId, ModuleShape))
-> ElaboratedPlanPackage
-> (InstalledPackageId, ModuleShape)
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage
        -- Uses Monad (->)
        ((InstalledPackageId
 -> ModuleShape -> (InstalledPackageId, ModuleShape))
-> (InstalledPackageInfo -> InstalledPackageId)
-> (InstalledPackageInfo -> ModuleShape)
-> InstalledPackageInfo
-> (InstalledPackageId, ModuleShape)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) InstalledPackageInfo -> InstalledPackageId
IPI.installedComponentId InstalledPackageInfo -> ModuleShape
shapeInstalledPackage)
        ((InstalledPackageId
 -> ModuleShape -> (InstalledPackageId, ModuleShape))
-> (ElaboratedConfiguredPackage -> InstalledPackageId)
-> (ElaboratedConfiguredPackage -> ModuleShape)
-> ElaboratedConfiguredPackage
-> (InstalledPackageId, ModuleShape)
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
        ( [(ModuleName, OpenModule)] -> Map ModuleName OpenModule
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (ModuleName
req, ModuleName -> OpenModule
OpenModuleVar ModuleName
req)
            | ModuleName
req <- Set ModuleName -> [ModuleName]
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]
  BuildInplaceOnly{} -> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
root String -> String -> String
</>) ([String] -> [String]) -> [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 -> [UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
n]
      Component
_ -> []
    ElabPackage ElaboratedPackage
_ ->
      (Executable -> String) -> [Executable] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (UnqualComponentName -> String)
-> (Executable -> UnqualComponentName) -> Executable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
PD.exeName)
        ([Executable] -> [String])
-> (ElaboratedConfiguredPackage -> [Executable])
-> ElaboratedConfiguredPackage
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Executable]
PD.executables
        (PackageDescription -> [Executable])
-> (ElaboratedConfiguredPackage -> PackageDescription)
-> ElaboratedConfiguredPackage
-> [Executable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription
        (ElaboratedConfiguredPackage -> [String])
-> ElaboratedConfiguredPackage -> [String]
forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage
package
  where
    noExecutables :: Bool
noExecutables = [Executable] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Executable] -> Bool)
-> (ElaboratedConfiguredPackage -> [Executable])
-> ElaboratedConfiguredPackage
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Executable]
PD.executables (PackageDescription -> [Executable])
-> (ElaboratedConfiguredPackage -> PackageDescription)
-> ElaboratedConfiguredPackage
-> [Executable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription (ElaboratedConfiguredPackage -> Bool)
-> ElaboratedConfiguredPackage -> Bool
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"

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 =
  IndependentGoals
-> Graph ElaboratedPlanPackage -> ElaboratedInstallPlan
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
IndependentGoals
-> Graph (GenericPlanPackage ipkg srcpkg)
-> GenericInstallPlan ipkg srcpkg
InstallPlan.new
    (Bool -> IndependentGoals
IndependentGoals Bool
False)
    ([ElaboratedPlanPackage] -> Graph ElaboratedPlanPackage
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList (InstS -> [ElaboratedPlanPackage]
forall k a. Map k a -> [a]
Map.elems InstS
ready_map))
  where
    pkgs :: [ElaboratedPlanPackage]
pkgs = ElaboratedInstallPlan -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
plan

    cmap :: Map InstalledPackageId ElaboratedPlanPackage
cmap = [(InstalledPackageId, ElaboratedPlanPackage)]
-> Map InstalledPackageId ElaboratedPlanPackage
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 = (InstS -> ((DefUnitId, BuildStyle), InstS))
-> InstM (DefUnitId, BuildStyle)
forall a. (InstS -> (a, InstS)) -> StateT InstS Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((InstS -> ((DefUnitId, BuildStyle), InstS))
 -> InstM (DefUnitId, BuildStyle))
-> (InstS -> ((DefUnitId, BuildStyle), InstS))
-> InstM (DefUnitId, BuildStyle)
forall a b. (a -> b) -> a -> b
$ \InstS
s ->
      case UnitId -> InstS -> Maybe ElaboratedPlanPackage
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') =
                State InstS ElaboratedPlanPackage
-> InstS -> (ElaboratedPlanPackage, InstS)
forall s a. State s a -> s -> (a, s)
runState
                  (UnitId
-> InstalledPackageId
-> Map ModuleName (Module, BuildStyle)
-> State InstS ElaboratedPlanPackage
instantiateComponent UnitId
uid InstalledPackageId
cid Map ModuleName (Module, BuildStyle)
insts)
                  (UnitId -> ElaboratedPlanPackage -> InstS -> 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, ElaboratedPlanPackage -> BuildStyle
forall ipkg.
GenericPlanPackage ipkg ElaboratedConfiguredPackage -> BuildStyle
extractElabBuildStyle ElaboratedPlanPackage
r), UnitId -> ElaboratedPlanPackage -> InstS -> InstS
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, ElaboratedPlanPackage -> BuildStyle
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 (((Module, BuildStyle) -> Module)
-> Map ModuleName (Module, BuildStyle) -> Map ModuleName Module
forall a b. (a -> b) -> Map ModuleName a -> Map ModuleName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Module, BuildStyle) -> Module
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)
-> State InstS ElaboratedPlanPackage
instantiateComponent UnitId
uid InstalledPackageId
cid Map ModuleName (Module, BuildStyle)
insts
      | Just ElaboratedPlanPackage
planpkg <- InstalledPackageId
-> Map InstalledPackageId ElaboratedPlanPackage
-> Maybe ElaboratedPlanPackage
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 <-
                  (OpenUnitId -> StateT InstS Identity DefUnitId)
-> [OpenUnitId] -> StateT InstS Identity [DefUnitId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((DefUnitId, BuildStyle) -> DefUnitId)
-> InstM (DefUnitId, BuildStyle) -> StateT InstS Identity DefUnitId
forall a b.
(a -> b) -> StateT InstS Identity a -> StateT InstS Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DefUnitId, BuildStyle) -> DefUnitId
forall a b. (a, b) -> a
fst (InstM (DefUnitId, BuildStyle) -> StateT InstS Identity DefUnitId)
-> (OpenUnitId -> InstM (DefUnitId, BuildStyle))
-> OpenUnitId
-> StateT InstS Identity DefUnitId
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 = Map ModuleName BuildStyle -> BuildStyle
forall m. Monoid m => Map ModuleName m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (((Module, BuildStyle) -> BuildStyle)
-> Map ModuleName (Module, BuildStyle) -> Map ModuleName BuildStyle
forall a b. (a -> b) -> Map ModuleName a -> Map ModuleName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Module, BuildStyle) -> BuildStyle
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 (ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage)
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
forall a b. (a -> b) -> a -> b
$
                        ElaboratedConfiguredPackage
elab0
                          { elabUnitId = uid
                          , elabComponentId = cid
                          , elabInstantiatedWith = fmap fst insts
                          , elabIsCanonical = Map.null (fmap fst insts)
                          , elabPkgOrComp =
                              ElabComponent
                                comp
                                  { compOrderLibDependencies =
                                      (if Map.null insts then [] else [newSimpleUnitId cid])
                                        ++ ordNub
                                          ( map
                                              unDefUnitId
                                              (deps ++ concatMap (getDep . fst) (Map.elems insts))
                                          )
                                  }
                          }
                    elab :: ElaboratedConfiguredPackage
elab =
                      ElaboratedConfiguredPackage
elab1
                        { elabInstallDirs =
                            computeInstallDirs
                              storeDirLayout
                              defaultInstallDirs
                              elaboratedShared
                              elab1
                        }
                ElaboratedPlanPackage -> State InstS ElaboratedPlanPackage
forall a. a -> StateT InstS Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedPlanPackage -> State InstS ElaboratedPlanPackage)
-> ElaboratedPlanPackage -> State InstS ElaboratedPlanPackage
forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> ElaboratedPlanPackage
forall ipkg srcpkg. srcpkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.Configured ElaboratedConfiguredPackage
elab
            ElaboratedPlanPackage
_ -> ElaboratedPlanPackage -> State InstS ElaboratedPlanPackage
forall a. a -> StateT InstS Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ElaboratedPlanPackage
planpkg
      | Bool
otherwise = String -> State InstS ElaboratedPlanPackage
forall a. HasCallStack => String -> a
error (String
"instantiateComponent: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ InstalledPackageId -> String
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
      (DefUnitId, BuildStyle) -> InstM (DefUnitId, BuildStyle)
forall a. a -> StateT InstS Identity a
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 = (OpenModule -> StateT InstS Identity (Module, BuildStyle))
-> Map ModuleName OpenModule
-> InstM (Map ModuleName (Module, BuildStyle))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map ModuleName a -> f (Map ModuleName b)
traverse (Map ModuleName (Module, BuildStyle)
-> OpenModule -> StateT InstS Identity (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 -> StateT InstS Identity (Module, BuildStyle)
substModule Map ModuleName (Module, BuildStyle)
subst (OpenModuleVar ModuleName
mod_name)
      | Just (Module, BuildStyle)
m <- ModuleName
-> Map ModuleName (Module, BuildStyle)
-> Maybe (Module, BuildStyle)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
mod_name Map ModuleName (Module, BuildStyle)
subst = (Module, BuildStyle) -> StateT InstS Identity (Module, BuildStyle)
forall a. a -> StateT InstS Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Module, BuildStyle)
m
      | Bool
otherwise = String -> StateT InstS Identity (Module, BuildStyle)
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
      (Module, BuildStyle) -> StateT InstS Identity (Module, BuildStyle)
forall a. a -> StateT InstS Identity a
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 -> State InstS ElaboratedPlanPackage
indefiniteComponent UnitId
uid InstalledPackageId
cid
      (InstS -> (UnitId, InstS)) -> InstM UnitId
forall a. (InstS -> (a, InstS)) -> StateT InstS Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((InstS -> (UnitId, InstS)) -> InstM UnitId)
-> (InstS -> (UnitId, InstS)) -> InstM UnitId
forall a b. (a -> b) -> a -> b
$ \InstS
s -> (UnitId
uid, UnitId -> ElaboratedPlanPackage -> InstS -> InstS
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 -> State InstS 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) <- InstalledPackageId
-> Map InstalledPackageId ElaboratedPlanPackage
-> Maybe ElaboratedPlanPackage
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 <- [OpenUnitId]
-> (OpenUnitId -> StateT InstS Identity OpenUnitId)
-> StateT InstS Identity [OpenUnitId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (ElaboratedComponent -> [OpenUnitId]
compLinkedLibDependencies ElaboratedComponent
elab_comp) ((OpenUnitId -> StateT InstS Identity OpenUnitId)
 -> StateT InstS Identity [OpenUnitId])
-> (OpenUnitId -> StateT InstS Identity OpenUnitId)
-> StateT InstS Identity [OpenUnitId]
forall a b. (a -> b) -> a -> b
$ \OpenUnitId
uid ->
              if Set ModuleName -> Bool
forall a. Set a -> Bool
Set.null (OpenUnitId -> Set ModuleName
openUnitIdFreeHoles OpenUnitId
uid)
                then ((DefUnitId, BuildStyle) -> OpenUnitId)
-> InstM (DefUnitId, BuildStyle)
-> StateT InstS Identity OpenUnitId
forall a b.
(a -> b) -> StateT InstS Identity a -> StateT InstS Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DefUnitId -> OpenUnitId
DefiniteUnitId (DefUnitId -> OpenUnitId)
-> ((DefUnitId, BuildStyle) -> DefUnitId)
-> (DefUnitId, BuildStyle)
-> OpenUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DefUnitId, BuildStyle) -> DefUnitId
forall a b. (a, b) -> a
fst) (Map ModuleName (Module, BuildStyle)
-> OpenUnitId -> InstM (DefUnitId, BuildStyle)
substUnitId Map ModuleName (Module, BuildStyle)
forall k a. Map k a
Map.empty OpenUnitId
uid)
                else OpenUnitId -> StateT InstS Identity OpenUnitId
forall a. a -> StateT InstS Identity a
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
            ElaboratedPlanPackage -> State InstS ElaboratedPlanPackage
forall a. a -> StateT InstS Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedPlanPackage -> State InstS ElaboratedPlanPackage)
-> (ElaboratedConfiguredPackage -> ElaboratedPlanPackage)
-> ElaboratedConfiguredPackage
-> State InstS ElaboratedPlanPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> ElaboratedPlanPackage
forall ipkg srcpkg. srcpkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.Configured (ElaboratedConfiguredPackage -> State InstS ElaboratedPlanPackage)
-> ElaboratedConfiguredPackage -> State InstS ElaboratedPlanPackage
forall a b. (a -> b) -> a -> b
$
              ElaboratedConfiguredPackage
epkg
                { elabPkgOrComp =
                    ElabComponent
                      elab_comp
                        { compLinkedLibDependencies = 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 =
                            ordNub $
                              compOrderLibDependencies elab_comp
                                ++ [unDefUnitId d | DefiniteUnitId d <- new_deps]
                        }
                }
      | Just ElaboratedPlanPackage
planpkg <- InstalledPackageId
-> Map InstalledPackageId ElaboratedPlanPackage
-> Maybe ElaboratedPlanPackage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup InstalledPackageId
cid Map InstalledPackageId ElaboratedPlanPackage
cmap =
          ElaboratedPlanPackage -> State InstS ElaboratedPlanPackage
forall a. a -> StateT InstS Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ElaboratedPlanPackage
planpkg
      | Bool
otherwise = String -> State InstS ElaboratedPlanPackage
forall a. HasCallStack => String -> a
error (String
"indefiniteComponent: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ InstalledPackageId -> String
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 = BuildInplaceOnly{}}) = ElaboratedConfiguredPackage
elab
    fixupBuildStyle t :: BuildStyle
t@(BuildInplaceOnly{}) ElaboratedConfiguredPackage
elab =
      ElaboratedConfiguredPackage
elab
        { elabBuildStyle = t
        , elabBuildPackageDBStack = elabInplaceBuildPackageDBStack elab
        , elabRegisterPackageDBStack = elabInplaceRegisterPackageDBStack elab
        , elabSetupPackageDBStack = elabInplaceSetupPackageDBStack elab
        }

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

    work :: State InstS ()
work = [ElaboratedPlanPackage]
-> (ElaboratedPlanPackage -> State InstS ()) -> State InstS ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ElaboratedPlanPackage]
pkgs ((ElaboratedPlanPackage -> State InstS ()) -> State InstS ())
-> (ElaboratedPlanPackage -> State InstS ()) -> State InstS ()
forall a b. (a -> b) -> a -> b
$ \ElaboratedPlanPackage
pkg ->
      case ElaboratedPlanPackage
pkg of
        InstallPlan.Configured ElaboratedConfiguredPackage
elab
          | Bool -> Bool
not (Map ModuleName OpenModule -> Bool
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)
                InstM UnitId -> State InstS () -> State InstS ()
forall a b.
StateT InstS Identity a
-> StateT InstS Identity b -> StateT InstS Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> State InstS ()
forall a. a -> StateT InstS Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ElaboratedPlanPackage
_ ->
          InstalledPackageId
-> Map ModuleName (Module, BuildStyle)
-> InstM (DefUnitId, BuildStyle)
instantiateUnitId (ElaboratedPlanPackage -> InstalledPackageId
getComponentId ElaboratedPlanPackage
pkg) Map ModuleName (Module, BuildStyle)
forall k a. Map k a
Map.empty
            InstM (DefUnitId, BuildStyle) -> State InstS () -> State InstS ()
forall a b.
StateT InstS Identity a
-> StateT InstS Identity b -> StateT InstS Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> State InstS ()
forall a. a -> StateT InstS Identity a
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 -> PackageId
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
(AvailableTarget k -> AvailableTarget k -> Bool)
-> (AvailableTarget k -> AvailableTarget k -> Bool)
-> Eq (AvailableTarget k)
forall k. Eq k => AvailableTarget k -> AvailableTarget k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: AvailableTarget k -> AvailableTarget k -> Bool
Eq, Int -> AvailableTarget k -> String -> String
[AvailableTarget k] -> String -> String
AvailableTarget k -> String
(Int -> AvailableTarget k -> String -> String)
-> (AvailableTarget k -> String)
-> ([AvailableTarget k] -> String -> String)
-> Show (AvailableTarget k)
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
$cshowsPrec :: forall k. Show k => Int -> AvailableTarget k -> String -> String
showsPrec :: Int -> AvailableTarget k -> String -> String
$cshow :: forall k. Show k => AvailableTarget k -> String
show :: AvailableTarget k -> String
$cshowList :: forall k. Show k => [AvailableTarget k] -> String -> String
showList :: [AvailableTarget k] -> String -> String
Show, (forall a b. (a -> b) -> AvailableTarget a -> AvailableTarget b)
-> (forall a b. a -> AvailableTarget b -> AvailableTarget a)
-> Functor AvailableTarget
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
$cfmap :: forall a b. (a -> b) -> AvailableTarget a -> AvailableTarget b
fmap :: forall a b. (a -> b) -> AvailableTarget a -> AvailableTarget b
$c<$ :: forall a b. a -> AvailableTarget b -> AvailableTarget a
<$ :: forall a b. a -> AvailableTarget b -> AvailableTarget a
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
  = -- | When the user does @tests: False@
    TargetDisabledByUser
  | -- | When the solver could not enable tests
    TargetDisabledBySolver
  | -- | When the component has @buildable: False@
    TargetNotBuildable
  | -- | When the component is non-core in a non-local package
    TargetNotLocal
  | -- | The target can or should be built
    TargetBuildable k TargetRequested
  deriving (AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
(AvailableTargetStatus k -> AvailableTargetStatus k -> Bool)
-> (AvailableTargetStatus k -> AvailableTargetStatus k -> Bool)
-> Eq (AvailableTargetStatus k)
forall k.
Eq k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
Eq, Eq (AvailableTargetStatus k)
Eq (AvailableTargetStatus k) =>
(AvailableTargetStatus k -> AvailableTargetStatus k -> Ordering)
-> (AvailableTargetStatus k -> AvailableTargetStatus k -> Bool)
-> (AvailableTargetStatus k -> AvailableTargetStatus k -> Bool)
-> (AvailableTargetStatus k -> AvailableTargetStatus k -> Bool)
-> (AvailableTargetStatus k -> AvailableTargetStatus k -> Bool)
-> (AvailableTargetStatus k
    -> AvailableTargetStatus k -> AvailableTargetStatus k)
-> (AvailableTargetStatus k
    -> AvailableTargetStatus k -> AvailableTargetStatus k)
-> Ord (AvailableTargetStatus k)
AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
AvailableTargetStatus k -> AvailableTargetStatus k -> Ordering
AvailableTargetStatus k
-> AvailableTargetStatus k -> AvailableTargetStatus k
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
$ccompare :: forall k.
Ord k =>
AvailableTargetStatus k -> AvailableTargetStatus k -> Ordering
compare :: AvailableTargetStatus k -> AvailableTargetStatus k -> Ordering
$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
>= :: AvailableTargetStatus k -> AvailableTargetStatus k -> Bool
$cmax :: forall k.
Ord k =>
AvailableTargetStatus k
-> AvailableTargetStatus k -> AvailableTargetStatus k
max :: AvailableTargetStatus k
-> AvailableTargetStatus k -> AvailableTargetStatus k
$cmin :: forall k.
Ord k =>
AvailableTargetStatus k
-> AvailableTargetStatus k -> AvailableTargetStatus k
min :: AvailableTargetStatus k
-> AvailableTargetStatus k -> AvailableTargetStatus k
Ord, Int -> AvailableTargetStatus k -> String -> String
[AvailableTargetStatus k] -> String -> String
AvailableTargetStatus k -> String
(Int -> AvailableTargetStatus k -> String -> String)
-> (AvailableTargetStatus k -> String)
-> ([AvailableTargetStatus k] -> String -> String)
-> Show (AvailableTargetStatus k)
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
$cshowsPrec :: forall k.
Show k =>
Int -> AvailableTargetStatus k -> String -> String
showsPrec :: Int -> AvailableTargetStatus k -> String -> String
$cshow :: forall k. Show k => AvailableTargetStatus k -> String
show :: AvailableTargetStatus k -> String
$cshowList :: forall k. Show k => [AvailableTargetStatus k] -> String -> String
showList :: [AvailableTargetStatus k] -> String -> String
Show, (forall a b.
 (a -> b) -> AvailableTargetStatus a -> AvailableTargetStatus b)
-> (forall a b.
    a -> AvailableTargetStatus b -> AvailableTargetStatus a)
-> Functor AvailableTargetStatus
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
$cfmap :: forall a b.
(a -> b) -> AvailableTargetStatus a -> AvailableTargetStatus b
fmap :: forall a b.
(a -> b) -> AvailableTargetStatus a -> AvailableTargetStatus b
$c<$ :: forall a b. a -> AvailableTargetStatus b -> AvailableTargetStatus a
<$ :: forall a b. a -> AvailableTargetStatus b -> AvailableTargetStatus a
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
  = -- | To be built by default
    TargetRequestedByDefault
  | -- | Not to be built by default
    TargetNotRequestedByDefault
  deriving (TargetRequested -> TargetRequested -> Bool
(TargetRequested -> TargetRequested -> Bool)
-> (TargetRequested -> TargetRequested -> Bool)
-> Eq TargetRequested
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TargetRequested -> TargetRequested -> Bool
== :: TargetRequested -> TargetRequested -> Bool
$c/= :: TargetRequested -> TargetRequested -> Bool
/= :: TargetRequested -> TargetRequested -> Bool
Eq, Eq TargetRequested
Eq TargetRequested =>
(TargetRequested -> TargetRequested -> Ordering)
-> (TargetRequested -> TargetRequested -> Bool)
-> (TargetRequested -> TargetRequested -> Bool)
-> (TargetRequested -> TargetRequested -> Bool)
-> (TargetRequested -> TargetRequested -> Bool)
-> (TargetRequested -> TargetRequested -> TargetRequested)
-> (TargetRequested -> TargetRequested -> TargetRequested)
-> Ord 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
$ccompare :: TargetRequested -> TargetRequested -> Ordering
compare :: TargetRequested -> TargetRequested -> Ordering
$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
>= :: TargetRequested -> TargetRequested -> Bool
$cmax :: TargetRequested -> TargetRequested -> TargetRequested
max :: TargetRequested -> TargetRequested -> TargetRequested
$cmin :: TargetRequested -> TargetRequested -> TargetRequested
min :: TargetRequested -> TargetRequested -> TargetRequested
Ord, Int -> TargetRequested -> String -> String
[TargetRequested] -> String -> String
TargetRequested -> String
(Int -> TargetRequested -> String -> String)
-> (TargetRequested -> String)
-> ([TargetRequested] -> String -> String)
-> Show TargetRequested
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TargetRequested -> String -> String
showsPrec :: Int -> TargetRequested -> String -> String
$cshow :: TargetRequested -> String
show :: TargetRequested -> String
$cshowList :: [TargetRequested] -> String -> String
showList :: [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
     (PackageId, ComponentName)
     [AvailableTarget (UnitId, ComponentName)]
availableTargets ElaboratedInstallPlan
installPlan =
  let rs :: [(PackageId, ComponentName, Bool,
  AvailableTarget (UnitId, ComponentName))]
rs =
        [ (PackageId
pkgid, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target)
        | ElaboratedPlanPackage
pkg <- ElaboratedInstallPlan -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
installPlan
        , (PackageId
pkgid, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target) <- case ElaboratedPlanPackage
pkg of
            InstallPlan.PreExisting InstalledPackageInfo
ipkg -> InstalledPackageInfo
-> [(PackageId, ComponentName, Bool,
     AvailableTarget (UnitId, ComponentName))]
availableInstalledTargets InstalledPackageInfo
ipkg
            InstallPlan.Installed ElaboratedConfiguredPackage
elab -> ElaboratedConfiguredPackage
-> [(PackageId, ComponentName, Bool,
     AvailableTarget (UnitId, ComponentName))]
availableSourceTargets ElaboratedConfiguredPackage
elab
            InstallPlan.Configured ElaboratedConfiguredPackage
elab -> ElaboratedConfiguredPackage
-> [(PackageId, ComponentName, Bool,
     AvailableTarget (UnitId, ComponentName))]
availableSourceTargets ElaboratedConfiguredPackage
elab
        ]
   in Map
  (PackageId, ComponentName)
  [AvailableTarget (UnitId, ComponentName)]
-> Map
     (PackageId, ComponentName)
     [AvailableTarget (UnitId, ComponentName)]
-> Map
     (PackageId, ComponentName)
     [AvailableTarget (UnitId, ComponentName)]
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
        ( ([AvailableTarget (UnitId, ComponentName)]
 -> [AvailableTarget (UnitId, ComponentName)]
 -> [AvailableTarget (UnitId, ComponentName)])
-> [((PackageId, ComponentName),
     [AvailableTarget (UnitId, ComponentName)])]
-> Map
     (PackageId, ComponentName)
     [AvailableTarget (UnitId, ComponentName)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
            [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall a. [a] -> [a] -> [a]
(++)
            [ ((PackageId
pkgid, ComponentName
cname), [AvailableTarget (UnitId, ComponentName)
target])
            | (PackageId
pkgid, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target) <- [(PackageId, ComponentName, Bool,
  AvailableTarget (UnitId, ComponentName))]
rs
            , Bool -> Bool
not Bool
fake
            ]
        )
        ( [((PackageId, ComponentName),
  [AvailableTarget (UnitId, ComponentName)])]
-> Map
     (PackageId, ComponentName)
     [AvailableTarget (UnitId, ComponentName)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ ((PackageId
pkgid, ComponentName
cname), [AvailableTarget (UnitId, ComponentName)
target])
            | (PackageId
pkgid, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target) <- [(PackageId, 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
-> [(PackageId, ComponentName, Bool,
     AvailableTarget (UnitId, ComponentName))]
availableInstalledTargets InstalledPackageInfo
ipkg =
  let unitid :: UnitId
unitid = InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
ipkg
      cname :: ComponentName
cname = LibraryName -> ComponentName
CLibName LibraryName
LMainLibName
      status :: AvailableTargetStatus (UnitId, ComponentName)
status = (UnitId, ComponentName)
-> TargetRequested -> AvailableTargetStatus (UnitId, ComponentName)
forall k. k -> TargetRequested -> AvailableTargetStatus k
TargetBuildable (UnitId
unitid, ComponentName
cname) TargetRequested
TargetRequestedByDefault
      target :: AvailableTarget (UnitId, ComponentName)
target = PackageId
-> ComponentName
-> AvailableTargetStatus (UnitId, ComponentName)
-> Bool
-> AvailableTarget (UnitId, ComponentName)
forall k.
PackageId
-> ComponentName
-> AvailableTargetStatus k
-> Bool
-> AvailableTarget k
AvailableTarget (InstalledPackageInfo -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId InstalledPackageInfo
ipkg) ComponentName
cname AvailableTargetStatus (UnitId, ComponentName)
status Bool
False
      fake :: Bool
fake = Bool
False
   in [(InstalledPackageInfo -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId InstalledPackageInfo
ipkg, ComponentName
cname, Bool
fake, AvailableTarget (UnitId, ComponentName)
target)]

availableSourceTargets
  :: ElaboratedConfiguredPackage
  -> [ ( PackageId
       , ComponentName
       , Bool
       , AvailableTarget (UnitId, ComponentName)
       )
     ]
availableSourceTargets :: ElaboratedConfiguredPackage
-> [(PackageId, 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'.)
  --
  [ (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
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 :: PackageId
availableTargetPackageId = ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
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
            Maybe ComponentName -> Maybe ComponentName -> Bool
forall a. Eq a => a -> a -> Bool
/= ComponentName -> Maybe ComponentName
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 (Component -> Maybe OptionalStanza)
-> Component -> Maybe OptionalStanza
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 -> AvailableTargetStatus (UnitId, ComponentName)
forall k. AvailableTargetStatus k
TargetNotBuildable
          | Bool
otherwise ->
              (UnitId, ComponentName)
-> TargetRequested -> AvailableTargetStatus (UnitId, ComponentName)
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 ( OptionalStanza -> OptionalStanzaMap (Maybe Bool) -> Maybe Bool
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 -> AvailableTargetStatus (UnitId, ComponentName)
forall k. AvailableTargetStatus k
TargetNotLocal
            (Just Bool
False, Bool
_) -> AvailableTargetStatus (UnitId, ComponentName)
forall k. AvailableTargetStatus k
TargetDisabledByUser
            (Maybe Bool
Nothing, Bool
False) -> AvailableTargetStatus (UnitId, ComponentName)
forall k. AvailableTargetStatus k
TargetDisabledBySolver
            (Maybe Bool, Bool)
_ | Bool -> Bool
not Bool
buildable -> AvailableTargetStatus (UnitId, ComponentName)
forall k. AvailableTargetStatus k
TargetNotBuildable
            (Just Bool
True, Bool
True) ->
              (UnitId, ComponentName)
-> TargetRequested -> AvailableTargetStatus (UnitId, ComponentName)
forall k. k -> TargetRequested -> AvailableTargetStatus k
TargetBuildable
                (ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
elab, ComponentName
cname)
                TargetRequested
TargetRequestedByDefault
            (Maybe Bool
Nothing, Bool
True) ->
              (UnitId, ComponentName)
-> TargetRequested -> AvailableTargetStatus (UnitId, ComponentName)
forall k. k -> TargetRequested -> AvailableTargetStatus k
TargetBuildable
                (ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
elab, ComponentName
cname)
                TargetRequested
TargetNotRequestedByDefault
            (Just Bool
True, Bool
False) ->
              String -> AvailableTargetStatus (UnitId, ComponentName)
forall a. HasCallStack => String -> a
error (String -> AvailableTargetStatus (UnitId, ComponentName))
-> String -> AvailableTargetStatus (UnitId, ComponentName)
forall a b. (a -> b) -> a -> b
$ String
"componentAvailableTargetStatus: impossible; cname=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ComponentName -> String
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 Maybe ComponentName -> Maybe ComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentName -> Maybe ComponentName
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 =
  ([(ComponentName, (ComponentTarget, a))]
 -> [(ComponentTarget, NonEmpty a)])
-> [[(ComponentName, (ComponentTarget, a))]]
-> [(ComponentTarget, NonEmpty a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(ComponentTarget, a)] -> [(ComponentTarget, NonEmpty a)]
forall a. [(ComponentTarget, a)] -> [(ComponentTarget, NonEmpty a)]
wholeComponentOverrides ([(ComponentTarget, a)] -> [(ComponentTarget, NonEmpty a)])
-> ([(ComponentName, (ComponentTarget, a))]
    -> [(ComponentTarget, a)])
-> [(ComponentName, (ComponentTarget, a))]
-> [(ComponentTarget, NonEmpty a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ComponentName, (ComponentTarget, a)) -> (ComponentTarget, a))
-> [(ComponentName, (ComponentTarget, a))]
-> [(ComponentTarget, a)]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentName, (ComponentTarget, a)) -> (ComponentTarget, a)
forall a b. (a, b) -> b
snd)
    ([[(ComponentName, (ComponentTarget, a))]]
 -> [(ComponentTarget, NonEmpty a)])
-> ([(ComponentTarget, a)]
    -> [[(ComponentName, (ComponentTarget, a))]])
-> [(ComponentTarget, a)]
-> [(ComponentTarget, NonEmpty a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ComponentName, (ComponentTarget, a))
 -> (ComponentName, (ComponentTarget, a)) -> Bool)
-> [(ComponentName, (ComponentTarget, a))]
-> [[(ComponentName, (ComponentTarget, a))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (ComponentName -> ComponentName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ComponentName -> ComponentName -> Bool)
-> ((ComponentName, (ComponentTarget, a)) -> ComponentName)
-> (ComponentName, (ComponentTarget, a))
-> (ComponentName, (ComponentTarget, a))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ComponentName, (ComponentTarget, a)) -> ComponentName
forall a b. (a, b) -> a
fst)
    ([(ComponentName, (ComponentTarget, a))]
 -> [[(ComponentName, (ComponentTarget, a))]])
-> ([(ComponentTarget, a)]
    -> [(ComponentName, (ComponentTarget, a))])
-> [(ComponentTarget, a)]
-> [[(ComponentName, (ComponentTarget, a))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ComponentName, (ComponentTarget, a))
 -> (ComponentName, (ComponentTarget, a)) -> Ordering)
-> [(ComponentName, (ComponentTarget, a))]
-> [(ComponentName, (ComponentTarget, a))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (ComponentName -> ComponentName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ComponentName -> ComponentName -> Ordering)
-> ((ComponentName, (ComponentTarget, a)) -> ComponentName)
-> (ComponentName, (ComponentTarget, a))
-> (ComponentName, (ComponentTarget, a))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ComponentName, (ComponentTarget, a)) -> ComponentName
forall a b. (a, b) -> a
fst)
    ([(ComponentName, (ComponentTarget, a))]
 -> [(ComponentName, (ComponentTarget, a))])
-> ([(ComponentTarget, a)]
    -> [(ComponentName, (ComponentTarget, a))])
-> [(ComponentTarget, a)]
-> [(ComponentName, (ComponentTarget, a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ComponentTarget, a) -> (ComponentName, (ComponentTarget, a)))
-> [(ComponentTarget, a)]
-> [(ComponentName, (ComponentTarget, a))]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: (ComponentTarget, a)
t@((ComponentTarget ComponentName
cname SubComponentTarget
_, a
_)) -> (ComponentName
cname, (ComponentTarget, a)
t))
    ([(ComponentTarget, a)] -> [(ComponentName, (ComponentTarget, a))])
-> ([(ComponentTarget, a)] -> [(ComponentTarget, a)])
-> [(ComponentTarget, a)]
-> [(ComponentName, (ComponentTarget, a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ComponentTarget, a) -> (ComponentTarget, a))
-> [(ComponentTarget, a)] -> [(ComponentTarget, a)]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentTarget, a) -> (ComponentTarget, a)
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' = ((ComponentTarget, a) -> (ComponentTarget, a) -> Bool)
-> (ComponentTarget, a)
-> [(ComponentTarget, a)]
-> [(ComponentTarget, a)]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy (\(ComponentTarget
t1, a
_) (ComponentTarget
t2, a
_) -> ComponentTarget
t1 ComponentTarget -> ComponentTarget -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentTarget
t2) (ComponentTarget
t, a
x) [(ComponentTarget, a)]
ts
           in
            [(ComponentTarget
t, a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| ((ComponentTarget, a) -> a) -> [(ComponentTarget, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentTarget, a) -> a
forall a b. (a, b) -> b
snd [(ComponentTarget, a)]
ts')]
        [] -> [(ComponentTarget
t, a
x a -> [a] -> NonEmpty a
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 =
  (Bool -> Bool
not (Bool -> Bool)
-> ([ComponentTarget] -> Bool) -> [ComponentTarget] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget ElaboratedConfiguredPackage
elab)
    Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool)
-> ([ComponentTarget] -> Bool) -> [ComponentTarget] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
elab)
    Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool)
-> ([ComponentTarget] -> Bool) -> [ComponentTarget] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
elab)
    Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool)
-> ([ComponentTarget] -> Bool) -> [ComponentTarget] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets ElaboratedConfiguredPackage
elab)
    Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> ([()] -> Bool) -> [()] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
      [ () | ComponentTarget ComponentName
_ SubComponentTarget
subtarget <- ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab, SubComponentTarget
subtarget SubComponentTarget -> SubComponentTarget -> Bool
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 =
  [ComponentName] -> Set ComponentName
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 =
  IndependentGoals
-> Graph ElaboratedPlanPackage -> ElaboratedInstallPlan
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
IndependentGoals
-> Graph (GenericPlanPackage ipkg srcpkg)
-> GenericInstallPlan ipkg srcpkg
InstallPlan.new (ElaboratedInstallPlan -> IndependentGoals
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> IndependentGoals
InstallPlan.planIndepGoals ElaboratedInstallPlan
elaboratedPlan)
    (Graph ElaboratedPlanPackage -> ElaboratedInstallPlan)
-> (ElaboratedInstallPlan -> Graph ElaboratedPlanPackage)
-> ElaboratedInstallPlan
-> ElaboratedInstallPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ElaboratedPlanPackage] -> Graph ElaboratedPlanPackage
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList
    -- We have to do the pruning in two passes
    ([ElaboratedPlanPackage] -> Graph ElaboratedPlanPackage)
-> (ElaboratedInstallPlan -> [ElaboratedPlanPackage])
-> ElaboratedInstallPlan
-> Graph ElaboratedPlanPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
pruneInstallPlanPass2
    ([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> (ElaboratedInstallPlan -> [ElaboratedPlanPackage])
-> ElaboratedInstallPlan
-> [ElaboratedPlanPackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
pruneInstallPlanPass1
    -- Set the targets that will be the roots for pruning
    ([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> (ElaboratedInstallPlan -> [ElaboratedPlanPackage])
-> ElaboratedInstallPlan
-> [ElaboratedPlanPackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetAction
-> Map UnitId [ComponentTarget]
-> [ElaboratedPlanPackage]
-> [ElaboratedPlanPackage]
setRootTargets TargetAction
targetActionType Map UnitId [ComponentTarget]
perPkgTargetsMap
    ([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> (ElaboratedInstallPlan -> [ElaboratedPlanPackage])
-> ElaboratedInstallPlan
-> [ElaboratedPlanPackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedInstallPlan -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList
    (ElaboratedInstallPlan -> ElaboratedInstallPlan)
-> ElaboratedInstallPlan -> ElaboratedInstallPlan
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 -> PackageId
packageId (PrunedPackage ElaboratedConfiguredPackage
elab [UnitId]
_) = ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
elab

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

instance Graph.IsNode PrunedPackage where
  type Key PrunedPackage = UnitId
  nodeKey :: PrunedPackage -> Key PrunedPackage
nodeKey (PrunedPackage ElaboratedConfiguredPackage
elab [UnitId]
_) = ElaboratedConfiguredPackage -> Key ElaboratedConfiguredPackage
forall a. IsNode a => a -> Key a
Graph.nodeKey ElaboratedConfiguredPackage
elab
  nodeNeighbors :: PrunedPackage -> [Key PrunedPackage]
nodeNeighbors (PrunedPackage ElaboratedConfiguredPackage
_ [UnitId]
deps) = [UnitId]
[Key PrunedPackage]
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 =
  Bool
-> ([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> [ElaboratedPlanPackage]
-> [ElaboratedPlanPackage]
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Map UnitId [ComponentTarget] -> Bool
forall k a. Map k a -> Bool
Map.null Map UnitId [ComponentTarget]
perPkgTargetsMap)) (([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
 -> [ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> ([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> [ElaboratedPlanPackage]
-> [ElaboratedPlanPackage]
forall a b. (a -> b) -> a -> b
$
    Bool
-> ([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> [ElaboratedPlanPackage]
-> [ElaboratedPlanPackage]
forall a. HasCallStack => Bool -> a -> a
assert (([ComponentTarget] -> Bool) -> [[ComponentTarget]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool)
-> ([ComponentTarget] -> Bool) -> [ComponentTarget] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Map UnitId [ComponentTarget] -> [[ComponentTarget]]
forall k a. Map k a -> [a]
Map.elems Map UnitId [ComponentTarget]
perPkgTargetsMap)) (([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
 -> [ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> ([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> [ElaboratedPlanPackage]
-> [ElaboratedPlanPackage]
forall a b. (a -> b) -> a -> b
$
      (ElaboratedPlanPackage -> ElaboratedPlanPackage)
-> [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
forall a b. (a -> b) -> [a] -> [b]
map ((ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage)
-> ElaboratedPlanPackage -> ElaboratedPlanPackage
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 ( UnitId -> Map UnitId [ComponentTarget] -> Maybe [ComponentTarget]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ElaboratedConfiguredPackage -> UnitId
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 = tgts}
        (Just [ComponentTarget]
tgts, TargetAction
TargetActionBuild) -> ElaboratedConfiguredPackage
elab{elabBuildTargets = tgts}
        (Just [ComponentTarget]
tgts, TargetAction
TargetActionTest) -> ElaboratedConfiguredPackage
elab{elabTestTargets = tgts}
        (Just [ComponentTarget]
tgts, TargetAction
TargetActionBench) -> ElaboratedConfiguredPackage
elab{elabBenchTargets = tgts}
        (Just [ComponentTarget]
tgts, TargetAction
TargetActionRepl) ->
          ElaboratedConfiguredPackage
elab
            { elabReplTarget = tgts
            , elabBuildHaddocks = False
            , elabBuildStyle = BuildInplaceOnly InMemory
            }
        (Just [ComponentTarget]
tgts, TargetAction
TargetActionHaddock) ->
          (ComponentTarget
 -> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage)
-> ElaboratedConfiguredPackage
-> [ComponentTarget]
-> ElaboratedConfiguredPackage
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            ComponentTarget
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
setElabHaddockTargets
            ( ElaboratedConfiguredPackage
elab
                { elabHaddockTargets = tgts
                , elabBuildHaddocks = True
                }
            )
            [ComponentTarget]
tgts

    setElabHaddockTargets :: ComponentTarget
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
setElabHaddockTargets ComponentTarget
tgt ElaboratedConfiguredPackage
elab
      | ComponentTarget -> Bool
isTestComponentTarget ComponentTarget
tgt = ElaboratedConfiguredPackage
elab{elabHaddockTestSuites = True}
      | ComponentTarget -> Bool
isBenchComponentTarget ComponentTarget
tgt = ElaboratedConfiguredPackage
elab{elabHaddockBenchmarks = True}
      | ComponentTarget -> Bool
isForeignLibComponentTarget ComponentTarget
tgt = ElaboratedConfiguredPackage
elab{elabHaddockForeignLibs = True}
      | ComponentTarget -> Bool
isExeComponentTarget ComponentTarget
tgt = ElaboratedConfiguredPackage
elab{elabHaddockExecutables = True}
      | ComponentTarget -> Bool
isSubLibComponentTarget ComponentTarget
tgt = ElaboratedConfiguredPackage
elab{elabHaddockInternal = 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
  -- if there are repl targets, we need to do a bit more work
  -- See Note [Pruning for Multi Repl]
  | Bool
anyMultiReplTarget = [ElaboratedPlanPackage]
graph_with_repl_targets
  -- otherwise we'll do less
  | Bool
otherwise = [ElaboratedPlanPackage]
pruned_packages
  where
    pkgs' :: [InstallPlan.GenericPlanPackage IPI.InstalledPackageInfo PrunedPackage]
    pkgs' :: [GenericPlanPackage InstalledPackageInfo PrunedPackage]
pkgs' = (ElaboratedPlanPackage
 -> GenericPlanPackage InstalledPackageInfo PrunedPackage)
-> [ElaboratedPlanPackage]
-> [GenericPlanPackage InstalledPackageInfo PrunedPackage]
forall a b. (a -> b) -> [a] -> [b]
map ((ElaboratedConfiguredPackage -> PrunedPackage)
-> ElaboratedPlanPackage
-> GenericPlanPackage InstalledPackageInfo PrunedPackage
forall srcpkg srcpkg' ipkg.
(srcpkg -> srcpkg')
-> GenericPlanPackage ipkg srcpkg
-> GenericPlanPackage ipkg srcpkg'
mapConfiguredPackage ElaboratedConfiguredPackage -> PrunedPackage
prune) [ElaboratedPlanPackage]
pkgs

    prune :: ElaboratedConfiguredPackage -> PrunedPackage
    prune :: ElaboratedConfiguredPackage -> PrunedPackage
prune ElaboratedConfiguredPackage
elab = ElaboratedConfiguredPackage -> [UnitId] -> PrunedPackage
PrunedPackage ElaboratedConfiguredPackage
elab' (ElaboratedConfiguredPackage -> [UnitId]
pruneOptionalDependencies ElaboratedConfiguredPackage
elab')
      where
        elab' :: ElaboratedConfiguredPackage
elab' = ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
addOptionalStanzas ElaboratedConfiguredPackage
elab

    graph :: Graph (GenericPlanPackage InstalledPackageInfo PrunedPackage)
graph = [GenericPlanPackage InstalledPackageInfo PrunedPackage]
-> Graph (GenericPlanPackage InstalledPackageInfo PrunedPackage)
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList [GenericPlanPackage InstalledPackageInfo PrunedPackage]
pkgs'

    roots :: [UnitId]
    roots :: [UnitId]
roots = (GenericPlanPackage InstalledPackageInfo PrunedPackage
 -> Maybe UnitId)
-> [GenericPlanPackage InstalledPackageInfo PrunedPackage]
-> [UnitId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GenericPlanPackage InstalledPackageInfo PrunedPackage
-> Maybe UnitId
forall {ipkg}.
GenericPlanPackage ipkg PrunedPackage -> Maybe UnitId
find_root [GenericPlanPackage InstalledPackageInfo PrunedPackage]
pkgs'

    -- Make a closed graph by calculating the closure from the roots
    pruned_packages :: [ElaboratedPlanPackage]
    pruned_packages :: [ElaboratedPlanPackage]
pruned_packages = (GenericPlanPackage InstalledPackageInfo PrunedPackage
 -> ElaboratedPlanPackage)
-> [GenericPlanPackage InstalledPackageInfo PrunedPackage]
-> [ElaboratedPlanPackage]
forall a b. (a -> b) -> [a] -> [b]
map ((PrunedPackage -> ElaboratedConfiguredPackage)
-> GenericPlanPackage InstalledPackageInfo PrunedPackage
-> ElaboratedPlanPackage
forall srcpkg srcpkg' ipkg.
(srcpkg -> srcpkg')
-> GenericPlanPackage ipkg srcpkg
-> GenericPlanPackage ipkg srcpkg'
mapConfiguredPackage PrunedPackage -> ElaboratedConfiguredPackage
fromPrunedPackage) ([GenericPlanPackage InstalledPackageInfo PrunedPackage]
-> Maybe [GenericPlanPackage InstalledPackageInfo PrunedPackage]
-> [GenericPlanPackage InstalledPackageInfo PrunedPackage]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [GenericPlanPackage InstalledPackageInfo PrunedPackage]
 -> [GenericPlanPackage InstalledPackageInfo PrunedPackage])
-> Maybe [GenericPlanPackage InstalledPackageInfo PrunedPackage]
-> [GenericPlanPackage InstalledPackageInfo PrunedPackage]
forall a b. (a -> b) -> a -> b
$ Graph (GenericPlanPackage InstalledPackageInfo PrunedPackage)
-> [Key (GenericPlanPackage InstalledPackageInfo PrunedPackage)]
-> Maybe [GenericPlanPackage InstalledPackageInfo PrunedPackage]
forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure Graph (GenericPlanPackage InstalledPackageInfo PrunedPackage)
graph [UnitId]
[Key (GenericPlanPackage InstalledPackageInfo PrunedPackage)]
roots)

    closed_graph :: Graph.Graph ElaboratedPlanPackage
    closed_graph :: Graph ElaboratedPlanPackage
closed_graph = [ElaboratedPlanPackage] -> Graph ElaboratedPlanPackage
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList [ElaboratedPlanPackage]
pruned_packages

    -- whether any package has repl targets enabled, and we need to use multi-repl.
    anyMultiReplTarget :: Bool
    anyMultiReplTarget :: Bool
anyMultiReplTarget = [GenericPlanPackage InstalledPackageInfo PrunedPackage] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenericPlanPackage InstalledPackageInfo PrunedPackage]
repls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      where
        repls :: [GenericPlanPackage InstalledPackageInfo PrunedPackage]
repls = (GenericPlanPackage InstalledPackageInfo PrunedPackage -> Bool)
-> [GenericPlanPackage InstalledPackageInfo PrunedPackage]
-> [GenericPlanPackage InstalledPackageInfo PrunedPackage]
forall a. (a -> Bool) -> [a] -> [a]
filter GenericPlanPackage InstalledPackageInfo PrunedPackage -> Bool
forall {ipkg}. GenericPlanPackage ipkg PrunedPackage -> Bool
is_repl_gpp [GenericPlanPackage InstalledPackageInfo PrunedPackage]
pkgs'
        is_repl_gpp :: GenericPlanPackage ipkg PrunedPackage -> Bool
is_repl_gpp (InstallPlan.Configured PrunedPackage
pkg) = PrunedPackage -> Bool
is_repl_pp PrunedPackage
pkg
        is_repl_gpp GenericPlanPackage ipkg PrunedPackage
_ = Bool
False

        is_repl_pp :: PrunedPackage -> Bool
is_repl_pp (PrunedPackage ElaboratedConfiguredPackage
elab [UnitId]
_) = Bool -> Bool
not ([ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget ElaboratedConfiguredPackage
elab))

    -- Anything which is inplace and left after pruning could be a repl target, then just need to check the
    -- reverse closure after calculating roots to capture dependencies which are on the path between roots.
    -- In order to start a multi-repl session with all the desired targets we need to load all these components into
    -- the repl at once to satisfy the closure property.
    all_desired_repl_targets :: Set UnitId
all_desired_repl_targets = [UnitId] -> Set UnitId
forall a. Ord a => [a] -> Set a
Set.fromList [ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
cp | InstallPlan.Configured ElaboratedConfiguredPackage
cp <- [ElaboratedPlanPackage]
-> Maybe [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> Maybe [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
forall a b. (a -> b) -> a -> b
$ Graph ElaboratedPlanPackage
-> [Key ElaboratedPlanPackage] -> Maybe [ElaboratedPlanPackage]
forall a. Graph a -> [Key a] -> Maybe [a]
Graph.revClosure Graph ElaboratedPlanPackage
closed_graph [UnitId]
[Key ElaboratedPlanPackage]
roots]

    add_repl_target :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
    add_repl_target :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
add_repl_target ElaboratedConfiguredPackage
ecp
      | ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
ecp UnitId -> Set UnitId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnitId
all_desired_repl_targets =
          ElaboratedConfiguredPackage
ecp
            { elabReplTarget = maybeToList (ComponentTarget <$> (elabComponentName ecp) <*> pure WholeComponent)
            , elabBuildStyle = BuildInplaceOnly InMemory
            }
      | Bool
otherwise = ElaboratedConfiguredPackage
ecp

    -- Add the repl target information to the ElaboratedPlanPackages
    graph_with_repl_targets :: [ElaboratedPlanPackage]
graph_with_repl_targets
      | Bool
anyMultiReplTarget = (ElaboratedPlanPackage -> ElaboratedPlanPackage)
-> [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
forall a b. (a -> b) -> [a] -> [b]
map ((ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage)
-> ElaboratedPlanPackage -> ElaboratedPlanPackage
forall srcpkg srcpkg' ipkg.
(srcpkg -> srcpkg')
-> GenericPlanPackage ipkg srcpkg
-> GenericPlanPackage ipkg srcpkg'
mapConfiguredPackage ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
add_repl_target) (Graph ElaboratedPlanPackage -> [ElaboratedPlanPackage]
forall a. Graph a -> [a]
Graph.toList Graph ElaboratedPlanPackage
closed_graph)
      | Bool
otherwise = Graph ElaboratedPlanPackage -> [ElaboratedPlanPackage]
forall a. Graph a -> [a]
Graph.toList Graph ElaboratedPlanPackage
closed_graph

    is_root :: PrunedPackage -> Maybe UnitId
    is_root :: PrunedPackage -> Maybe UnitId
is_root (PrunedPackage ElaboratedConfiguredPackage
elab [UnitId]
_) =
      if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
        [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
          [ [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabConfigureTargets ElaboratedConfiguredPackage
elab)
          , [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab)
          , [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
elab)
          , [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
elab)
          , [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget ElaboratedConfiguredPackage
elab)
          , [ComponentTarget] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets ElaboratedConfiguredPackage
elab)
          ]
        then UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just (ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab)
        else Maybe UnitId
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
_ = Maybe UnitId
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 = ElabPackage (pkg{pkgStanzasEnabled = 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.
            OptionalStanzaSet -> OptionalStanzaSet -> OptionalStanzaSet
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)
            OptionalStanzaSet -> OptionalStanzaSet -> OptionalStanzaSet
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

    -- 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
_} =
      ElaboratedConfiguredPackage -> [UnitId]
forall a. IsUnit a => a -> [UnitId]
InstallPlan.depends ElaboratedConfiguredPackage
elab -- no pruning
    pruneOptionalDependencies ElaboratedConfiguredPackage{elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabPackage ElaboratedPackage
pkg} =
      (ComponentDeps [UnitId] -> [UnitId]
forall a. Monoid a => ComponentDeps a -> a
CD.flatDeps (ComponentDeps [UnitId] -> [UnitId])
-> (ComponentDeps [UnitId] -> ComponentDeps [UnitId])
-> ComponentDeps [UnitId]
-> [UnitId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Component -> [UnitId] -> Bool)
-> ComponentDeps [UnitId] -> ComponentDeps [UnitId]
forall a.
(Component -> a -> Bool) -> ComponentDeps a -> ComponentDeps a
CD.filterDeps Component -> [UnitId] -> Bool
keepNeeded) (ElaboratedPackage -> ComponentDeps [UnitId]
pkgOrderDependencies ElaboratedPackage
pkg)
      where
        keepNeeded :: Component -> [UnitId] -> Bool
keepNeeded (CD.ComponentTest UnqualComponentName
_) [UnitId]
_ = OptionalStanza
TestStanzas OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` OptionalStanzaSet
stanzas
        keepNeeded (CD.ComponentBench UnqualComponentName
_) [UnitId]
_ = OptionalStanza
BenchStanzas OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` OptionalStanzaSet
stanzas
        keepNeeded Component
_ [UnitId]
_ = 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
              [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
pkg
              [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
pkg
              [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget ElaboratedConfiguredPackage
pkg
              [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets ElaboratedConfiguredPackage
pkg
        , OptionalStanza
stanza <-
            Maybe OptionalStanza -> [OptionalStanza]
forall a. Maybe a -> [a]
maybeToList (Maybe OptionalStanza -> [OptionalStanza])
-> Maybe OptionalStanza -> [OptionalStanza]
forall a b. (a -> b) -> a -> b
$
              Component -> Maybe OptionalStanza
componentOptionalStanza (Component -> Maybe OptionalStanza)
-> Component -> Maybe OptionalStanza
forall a b. (a -> b) -> a -> b
$
                ComponentName -> Component
CD.componentNameToComponent ComponentName
cname
        ]

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

{-
Note [Pruning for Multi Repl]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

For a multi-repl session, where we load more than one component into a GHCi repl,
it is required to uphold the so-called *closure property*.
This property, whose exact Note you can read in the GHC codebase, states
roughly:

\* If a component you want to load into a repl session transitively depends on a
  component which transitively depends on another component you want to
  load into the repl, then this component needs to be loaded
  into the repl session as well.

We make sure here, that this property is upheld, by calculating the
graph of components that we need to load into the repl given the set of 'roots' which
are the targets specified by the user.

Practically, this is simply achieved by traversing all dependencies of
our roots (graph closure), and then from this closed graph, we calculate
the reverse closure, which gives us all components that depend on
'roots'. Thus, the result is a list of components that we need to load
into the repl to uphold the closure property.
-}

-- | 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 =
            (Component -> Bool) -> ComponentDeps [UnitId] -> [UnitId]
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)
    , (UnitId -> Bool) -> [UnitId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (UnitId -> Set UnitId -> Bool
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 =
  (ElaboratedPlanPackage -> ElaboratedPlanPackage)
-> [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
forall a b. (a -> b) -> [a] -> [b]
map ((ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage)
-> ElaboratedPlanPackage -> ElaboratedPlanPackage
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 =
            ordNub $
              elabBuildTargets elab
                ++ libTargetsRequiredForRevDeps
                ++ exeTargetsRequiredForRevDeps
        , elabPkgOrComp =
            case elabPkgOrComp elab of
              ElabPackage ElaboratedPackage
pkg ->
                let stanzas :: OptionalStanzaSet
stanzas =
                      ElaboratedPackage -> OptionalStanzaSet
pkgStanzasEnabled ElaboratedPackage
pkg
                        OptionalStanzaSet -> OptionalStanzaSet -> OptionalStanzaSet
forall a. Semigroup a => a -> a -> a
<> Set UnitId
-> ElaboratedConfiguredPackage
-> ElaboratedPackage
-> OptionalStanzaSet
optionalStanzasWithDepsAvailable Set UnitId
availablePkgs ElaboratedConfiguredPackage
elab ElaboratedPackage
pkg

                    keepNeeded :: CD.Component -> a -> Bool
                    keepNeeded :: forall a. Component -> a -> Bool
keepNeeded (CD.ComponentTest UnqualComponentName
_) a
_ = OptionalStanza
TestStanzas OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` OptionalStanzaSet
stanzas
                    keepNeeded (CD.ComponentBench UnqualComponentName
_) a
_ = OptionalStanza
BenchStanzas OptionalStanza -> OptionalStanzaSet -> Bool
`optStanzaSetMember` OptionalStanzaSet
stanzas
                    keepNeeded Component
_ a
_ = Bool
True
                 in ElaboratedPackage -> ElaboratedPackageOrComponent
ElabPackage (ElaboratedPackage -> ElaboratedPackageOrComponent)
-> ElaboratedPackage -> ElaboratedPackageOrComponent
forall a b. (a -> b) -> a -> b
$
                      ElaboratedPackage
pkg
                        { pkgStanzasEnabled =
                            stanzas
                        , pkgLibDependencies =
                            CD.mapDeps (\Component
_ -> ((ConfiguredId, Bool) -> (ConfiguredId, Bool))
-> [(ConfiguredId, Bool)] -> [(ConfiguredId, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (ConfiguredId, Bool) -> (ConfiguredId, Bool)
forall {b}. (ConfiguredId, b) -> (ConfiguredId, Bool)
addInternal) $
                              CD.filterDeps keepNeeded (pkgLibDependencies pkg)
                        , pkgExeDependencies =
                            CD.filterDeps keepNeeded (pkgExeDependencies pkg)
                        , pkgExeDependencyPaths =
                            CD.filterDeps keepNeeded (pkgExeDependencyPaths pkg)
                        }
              ElabComponent ElaboratedComponent
comp ->
                ElaboratedComponent -> ElaboratedPackageOrComponent
ElabComponent (ElaboratedComponent -> ElaboratedPackageOrComponent)
-> ElaboratedComponent -> ElaboratedPackageOrComponent
forall a b. (a -> b) -> a -> b
$
                  ElaboratedComponent
comp
                    { compLibDependencies = map addInternal (compLibDependencies comp)
                    }
        }
      where
        -- We initially assume that all the dependencies are external (hence the boolean is always
        -- False) and here we correct the dependencies so the right packages are marked promised.
        addInternal :: (ConfiguredId, b) -> (ConfiguredId, Bool)
addInternal (ConfiguredId
cid, b
_) = (ConfiguredId
cid, (ConfiguredId
cid ConfiguredId -> Set ConfiguredId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ConfiguredId
inMemoryTargets))

        libTargetsRequiredForRevDeps :: [ComponentTarget]
libTargetsRequiredForRevDeps =
          [ ComponentTarget
c
          | ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab UnitId -> Set UnitId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnitId
hasReverseLibDeps
          , let c :: ComponentTarget
c = ComponentName -> SubComponentTarget -> ComponentTarget
ComponentTarget (LibraryName -> ComponentName
CLibName LibraryName
Cabal.defaultLibName) SubComponentTarget
WholeComponent
          , -- Don't enable building for anything which is being build in memory
          ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab BuildStyle -> BuildStyle -> Bool
forall a. Eq a => a -> a -> Bool
/= MemoryOrDisk -> BuildStyle
BuildInplaceOnly MemoryOrDisk
InMemory
          ]
        exeTargetsRequiredForRevDeps :: [ComponentTarget]
exeTargetsRequiredForRevDeps =
          -- TODO: allow requesting executable with different name
          -- than package name
          [ ComponentName -> SubComponentTarget -> ComponentTarget
ComponentTarget
            ( UnqualComponentName -> ComponentName
Cabal.CExeName (UnqualComponentName -> ComponentName)
-> UnqualComponentName -> ComponentName
forall a b. (a -> b) -> a -> b
$
                PackageName -> UnqualComponentName
packageNameToUnqualComponentName (PackageName -> UnqualComponentName)
-> PackageName -> UnqualComponentName
forall a b. (a -> b) -> a -> b
$
                  PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (PackageId -> PackageName) -> PackageId -> PackageName
forall a b. (a -> b) -> a -> b
$
                    ElaboratedConfiguredPackage -> PackageId
elabPkgSourceId ElaboratedConfiguredPackage
elab
            )
            SubComponentTarget
WholeComponent
          | ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab UnitId -> Set UnitId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnitId
hasReverseExeDeps
          ]

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

    inMemoryTargets :: Set ConfiguredId
    inMemoryTargets :: Set ConfiguredId
inMemoryTargets = do
      [ConfiguredId] -> Set ConfiguredId
forall a. Ord a => [a] -> Set a
Set.fromList
        [ ElaboratedConfiguredPackage -> ConfiguredId
forall a. HasConfiguredId a => a -> ConfiguredId
configuredId ElaboratedConfiguredPackage
pkg
        | InstallPlan.Configured ElaboratedConfiguredPackage
pkg <- [ElaboratedPlanPackage]
pkgs
        , BuildInplaceOnly MemoryOrDisk
InMemory <- [ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg]
        ]

    hasReverseLibDeps :: Set UnitId
    hasReverseLibDeps :: Set UnitId
hasReverseLibDeps =
      [UnitId] -> Set UnitId
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 =
      [UnitId] -> Set UnitId
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) =
  srcpkg' -> GenericPlanPackage ipkg srcpkg'
forall ipkg srcpkg. srcpkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.Configured (srcpkg -> srcpkg'
f srcpkg
pkg)
mapConfiguredPackage srcpkg -> srcpkg'
f (InstallPlan.Installed srcpkg
pkg) =
  srcpkg' -> GenericPlanPackage ipkg srcpkg'
forall ipkg srcpkg. srcpkg -> GenericPlanPackage ipkg srcpkg
InstallPlan.Installed (srcpkg -> srcpkg'
f srcpkg
pkg)
mapConfiguredPackage srcpkg -> srcpkg'
_ (InstallPlan.PreExisting ipkg
pkg) =
  ipkg -> GenericPlanPackage ipkg srcpkg'
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 =
  Bool
-> Either CannotPruneDependencies ElaboratedInstallPlan
-> Either CannotPruneDependencies ElaboratedInstallPlan
forall a. HasCallStack => Bool -> a -> a
assert
    ( (UnitId -> Bool) -> [UnitId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
        (Maybe ElaboratedPlanPackage -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ElaboratedPlanPackage -> Bool)
-> (UnitId -> Maybe ElaboratedPlanPackage) -> UnitId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedInstallPlan -> UnitId -> Maybe ElaboratedPlanPackage
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg
-> UnitId -> Maybe (GenericPlanPackage ipkg srcpkg)
InstallPlan.lookup ElaboratedInstallPlan
installPlan)
        (Set UnitId -> [UnitId]
forall a. Set a -> [a]
Set.toList Set UnitId
pkgTargets)
    )
    (Either CannotPruneDependencies ElaboratedInstallPlan
 -> Either CannotPruneDependencies ElaboratedInstallPlan)
-> Either CannotPruneDependencies ElaboratedInstallPlan
-> Either CannotPruneDependencies ElaboratedInstallPlan
forall a b. (a -> b) -> a -> b
$ (Graph ElaboratedPlanPackage -> ElaboratedInstallPlan)
-> Either CannotPruneDependencies (Graph ElaboratedPlanPackage)
-> Either CannotPruneDependencies ElaboratedInstallPlan
forall a b.
(a -> b)
-> Either CannotPruneDependencies a
-> Either CannotPruneDependencies b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IndependentGoals
-> Graph ElaboratedPlanPackage -> ElaboratedInstallPlan
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
IndependentGoals
-> Graph (GenericPlanPackage ipkg srcpkg)
-> GenericInstallPlan ipkg srcpkg
InstallPlan.new (ElaboratedInstallPlan -> IndependentGoals
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> IndependentGoals
InstallPlan.planIndepGoals ElaboratedInstallPlan
installPlan))
      (Either CannotPruneDependencies (Graph ElaboratedPlanPackage)
 -> Either CannotPruneDependencies ElaboratedInstallPlan)
-> (ElaboratedInstallPlan
    -> Either CannotPruneDependencies (Graph ElaboratedPlanPackage))
-> ElaboratedInstallPlan
-> Either CannotPruneDependencies ElaboratedInstallPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph ElaboratedPlanPackage
-> Either CannotPruneDependencies (Graph ElaboratedPlanPackage)
checkBrokenDeps
      (Graph ElaboratedPlanPackage
 -> Either CannotPruneDependencies (Graph ElaboratedPlanPackage))
-> (ElaboratedInstallPlan -> Graph ElaboratedPlanPackage)
-> ElaboratedInstallPlan
-> Either CannotPruneDependencies (Graph ElaboratedPlanPackage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ElaboratedPlanPackage] -> Graph ElaboratedPlanPackage
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList
      ([ElaboratedPlanPackage] -> Graph ElaboratedPlanPackage)
-> (ElaboratedInstallPlan -> [ElaboratedPlanPackage])
-> ElaboratedInstallPlan
-> Graph ElaboratedPlanPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ElaboratedPlanPackage -> Bool)
-> [ElaboratedPlanPackage] -> [ElaboratedPlanPackage]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ElaboratedPlanPackage
pkg -> ElaboratedPlanPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedPlanPackage
pkg UnitId -> Set UnitId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set UnitId
pkgTargets)
      ([ElaboratedPlanPackage] -> [ElaboratedPlanPackage])
-> (ElaboratedInstallPlan -> [ElaboratedPlanPackage])
-> ElaboratedInstallPlan
-> [ElaboratedPlanPackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedInstallPlan -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList
    (ElaboratedInstallPlan
 -> Either CannotPruneDependencies ElaboratedInstallPlan)
-> ElaboratedInstallPlan
-> Either CannotPruneDependencies ElaboratedInstallPlan
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 Graph ElaboratedPlanPackage
-> [(ElaboratedPlanPackage, [Key ElaboratedPlanPackage])]
forall a. Graph a -> [(a, [Key a])]
Graph.broken Graph ElaboratedPlanPackage
graph of
        [] -> Graph ElaboratedPlanPackage
-> Either CannotPruneDependencies (Graph ElaboratedPlanPackage)
forall a b. b -> Either a b
Right Graph ElaboratedPlanPackage
graph
        [(ElaboratedPlanPackage, [Key ElaboratedPlanPackage])]
brokenPackages ->
          CannotPruneDependencies
-> Either CannotPruneDependencies (Graph ElaboratedPlanPackage)
forall a b. a -> Either a b
Left (CannotPruneDependencies
 -> Either CannotPruneDependencies (Graph ElaboratedPlanPackage))
-> CannotPruneDependencies
-> Either CannotPruneDependencies (Graph ElaboratedPlanPackage)
forall a b. (a -> b) -> a -> b
$
            [(ElaboratedPlanPackage, [ElaboratedPlanPackage])]
-> CannotPruneDependencies
CannotPruneDependencies
              [ (ElaboratedPlanPackage
pkg, [ElaboratedPlanPackage]
missingDeps)
              | (ElaboratedPlanPackage
pkg, [UnitId]
missingDepIds) <- [(ElaboratedPlanPackage, [UnitId])]
[(ElaboratedPlanPackage, [Key ElaboratedPlanPackage])]
brokenPackages
              , let missingDeps :: [ElaboratedPlanPackage]
missingDeps = (UnitId -> Maybe ElaboratedPlanPackage)
-> [UnitId] -> [ElaboratedPlanPackage]
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 = ElaboratedInstallPlan -> UnitId -> Maybe ElaboratedPlanPackage
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
(Int -> CannotPruneDependencies -> String -> String)
-> (CannotPruneDependencies -> String)
-> ([CannotPruneDependencies] -> String -> String)
-> Show CannotPruneDependencies
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CannotPruneDependencies -> String -> String
showsPrec :: Int -> CannotPruneDependencies -> String -> String
$cshow :: CannotPruneDependencies -> String
show :: CannotPruneDependencies -> String
$cshowList :: [CannotPruneDependencies] -> String -> String
showList :: [CannotPruneDependencies] -> String -> String
Show)

-- 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
  -> SymbolicPath CWD (Dir Pkg)
  -> SymbolicPath Pkg (Dir Dist)
  -> Bool
  -> Lock
  -> SetupScriptOptions
-- TODO: Fix this so custom is a separate component.  Custom can ALWAYS
-- be a separate component!!!
setupHsScriptOptions :: ElaboratedReadyPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
-> SymbolicPath CWD ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> Bool
-> Lock
-> SetupScriptOptions
setupHsScriptOptions
  (ReadyPackage elab :: ElaboratedConfiguredPackage
elab@ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
..})
  ElaboratedInstallPlan
plan
  ElaboratedSharedConfig{Compiler
ProgramDb
ReplOptions
Platform
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigReplOptions :: ElaboratedSharedConfig -> ReplOptions
pkgConfigPlatform :: Platform
pkgConfigCompiler :: Compiler
pkgConfigCompilerProgs :: ProgramDb
pkgConfigReplOptions :: ReplOptions
..}
  DistDirLayout
distdir
  SymbolicPath CWD ('Dir Pkg)
srcdir
  SymbolicPath Pkg ('Dir Dist)
builddir
  Bool
isParallelBuild
  Lock
cacheLock =
    SetupScriptOptions
      { useCabalVersion :: VersionRange
useCabalVersion = Version -> VersionRange
thisVersion Version
elabSetupScriptCliVersion
      , useCabalSpecVersion :: Maybe Version
useCabalSpecVersion =
          if PackageDescription -> BuildType
PD.buildType PackageDescription
elabPkgDescription BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
PD.Hooks
            then -- NB: we don't want to commit to a Cabal version here:
            --   - all that should matter for Hooks build-type is the
            --     version of Cabal-hooks, not of Cabal,
            --   - if we commit to a Cabal version, the logic in
              Maybe Version
forall a. Maybe a
Nothing
            else Version -> Maybe Version
forall a. a -> Maybe a
Just Version
elabSetupScriptCliVersion
      , useCompiler :: Maybe Compiler
useCompiler = Compiler -> Maybe Compiler
forall a. a -> Maybe a
Just Compiler
pkgConfigCompiler
      , usePlatform :: Maybe Platform
usePlatform = Platform -> Maybe Platform
forall a. a -> Maybe a
Just Platform
pkgConfigPlatform
      , usePackageDB :: PackageDBStackCWD
usePackageDB = PackageDBStackCWD
elabSetupPackageDBStack
      , usePackageIndex :: Maybe InstalledPackageIndex
usePackageIndex = Maybe InstalledPackageIndex
forall a. Maybe a
Nothing
      , useDependencies :: [(InstalledPackageId, PackageId)]
useDependencies =
          [ (InstalledPackageId
uid, PackageId
srcid)
          | (ConfiguredId PackageId
srcid (Just (CLibName LibraryName
LMainLibName)) InstalledPackageId
uid, Bool
_) <-
              ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)]
elabSetupDependencies ElaboratedConfiguredPackage
elab
          ]
      , useDependenciesExclusive :: Bool
useDependenciesExclusive = Bool
True
      , useVersionMacros :: Bool
useVersionMacros = SetupScriptStyle
elabSetupScriptStyle SetupScriptStyle -> SetupScriptStyle -> Bool
forall a. Eq a => a -> a -> Bool
== SetupScriptStyle
SetupCustomExplicitDeps
      , useProgramDb :: ProgramDb
useProgramDb = ProgramDb
pkgConfigCompilerProgs
      , useDistPref :: SymbolicPath Pkg ('Dir Dist)
useDistPref = SymbolicPath Pkg ('Dir Dist)
builddir
      , useLoggingHandle :: Maybe Handle
useLoggingHandle = Maybe Handle
forall a. Maybe a
Nothing -- this gets set later
      , useWorkingDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
useWorkingDir = SymbolicPath CWD ('Dir Pkg) -> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. a -> Maybe a
Just SymbolicPath CWD ('Dir Pkg)
srcdir
      , useExtraPathEnv :: [String]
useExtraPathEnv = ElaboratedConfiguredPackage -> [String]
elabExeDependencyPaths ElaboratedConfiguredPackage
elab [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
elabProgramPathExtra
      , -- note that the above adds the extra-prog-path directly following the elaborated
        -- dep paths, so that it overrides the normal path, but _not_ the elaborated extensions
        -- for build-tools-depends.
        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 = Lock -> Maybe Lock
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
  -> Compiler
  -> InstalledPackageId
  -> InstallDirs.InstallDirs FilePath
storePackageInstallDirs :: StoreDirLayout
-> Compiler -> InstalledPackageId -> InstallDirs String
storePackageInstallDirs StoreDirLayout
storeDirLayout Compiler
compiler InstalledPackageId
ipkgid =
  StoreDirLayout -> Compiler -> UnitId -> InstallDirs String
storePackageInstallDirs' StoreDirLayout
storeDirLayout Compiler
compiler (UnitId -> InstallDirs String) -> UnitId -> InstallDirs String
forall a b. (a -> b) -> a -> b
$ InstalledPackageId -> UnitId
newSimpleUnitId InstalledPackageId
ipkgid

storePackageInstallDirs'
  :: StoreDirLayout
  -> Compiler
  -> UnitId
  -> InstallDirs.InstallDirs FilePath
storePackageInstallDirs' :: StoreDirLayout -> Compiler -> UnitId -> InstallDirs String
storePackageInstallDirs'
  StoreDirLayout
    { Compiler -> UnitId -> String
storePackageDirectory :: Compiler -> UnitId -> String
storePackageDirectory :: StoreDirLayout -> Compiler -> UnitId -> String
storePackageDirectory
    , Compiler -> String
storeDirectory :: Compiler -> String
storeDirectory :: StoreDirLayout -> Compiler -> String
storeDirectory
    }
  Compiler
compiler
  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
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
..}
    where
      store :: String
store = Compiler -> String
storeDirectory Compiler
compiler
      prefix :: String
prefix = Compiler -> UnitId -> String
storePackageDirectory Compiler
compiler 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 OS -> OS -> Bool
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
  | BuildStyle -> Bool
isInplaceBuildStyle (ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab) =
      -- use the ordinary default install dirs
      ( PackageId
-> UnitId
-> CompilerInfo
-> CopyDest
-> Platform
-> InstallDirTemplates
-> InstallDirs String
InstallDirs.absoluteInstallDirs
          (ElaboratedConfiguredPackage -> PackageId
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
          InstallDirs.libsubdir = ""
        , InstallDirs.libexecsubdir = ""
        , InstallDirs.datasubdir = ""
        }
  | Bool
otherwise =
      -- use special simplified install dirs
      StoreDirLayout -> Compiler -> UnitId -> InstallDirs String
storePackageInstallDirs'
        StoreDirLayout
storeDirLayout
        (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
  :: Monad m
  => (FilePath -> m (SymbolicPath Pkg (Dir PkgDB)))
  -- ^ How to transform a path which is relative to cabal-install cwd to one which
  -- is relative to the route of the package about to be compiled. The simplest way
  -- to do this is to convert the potentially relative path into an absolute path.
  -> ElaboratedInstallPlan
  -> ElaboratedReadyPackage
  -> ElaboratedSharedConfig
  -> Cabal.CommonSetupFlags
  -> m Cabal.ConfigFlags
setupHsConfigureFlags :: forall (m :: * -> *).
Monad m =>
(String -> m (SymbolicPath Pkg ('Dir PkgDB)))
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> m ConfigFlags
setupHsConfigureFlags
  String -> m (SymbolicPath Pkg ('Dir PkgDB))
mkSymbolicPath
  ElaboratedInstallPlan
plan
  (ReadyPackage elab :: ElaboratedConfiguredPackage
elab@ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
..})
  sharedConfig :: ElaboratedSharedConfig
sharedConfig@ElaboratedSharedConfig{Compiler
ProgramDb
ReplOptions
Platform
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigReplOptions :: ElaboratedSharedConfig -> ReplOptions
pkgConfigPlatform :: Platform
pkgConfigCompiler :: Compiler
pkgConfigCompilerProgs :: ProgramDb
pkgConfigReplOptions :: ReplOptions
..}
  CommonSetupFlags
configCommonFlags = do
    -- explicitly clear, then our package db stack
    -- TODO: [required eventually] have to do this differently for older Cabal versions
    [Maybe PackageDB]
configPackageDBs <- ((Maybe PackageDBCWD -> m (Maybe PackageDB))
-> [Maybe PackageDBCWD] -> m [Maybe PackageDB]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Maybe PackageDBCWD -> m (Maybe PackageDB))
 -> [Maybe PackageDBCWD] -> m [Maybe PackageDB])
-> ((String -> m (SymbolicPath Pkg ('Dir PkgDB)))
    -> Maybe PackageDBCWD -> m (Maybe PackageDB))
-> (String -> m (SymbolicPath Pkg ('Dir PkgDB)))
-> [Maybe PackageDBCWD]
-> m [Maybe PackageDB]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageDBCWD -> m PackageDB)
-> Maybe PackageDBCWD -> m (Maybe PackageDB)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((PackageDBCWD -> m PackageDB)
 -> Maybe PackageDBCWD -> m (Maybe PackageDB))
-> ((String -> m (SymbolicPath Pkg ('Dir PkgDB)))
    -> PackageDBCWD -> m PackageDB)
-> (String -> m (SymbolicPath Pkg ('Dir PkgDB)))
-> Maybe PackageDBCWD
-> m (Maybe PackageDB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> m (SymbolicPath Pkg ('Dir PkgDB)))
-> PackageDBCWD -> m PackageDB
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PackageDBX a -> f (PackageDBX b)
traverse) String -> m (SymbolicPath Pkg ('Dir PkgDB))
mkSymbolicPath (Maybe PackageDBCWD
forall a. Maybe a
Nothing Maybe PackageDBCWD -> [Maybe PackageDBCWD] -> [Maybe PackageDBCWD]
forall a. a -> [a] -> [a]
: (PackageDBCWD -> Maybe PackageDBCWD)
-> PackageDBStackCWD -> [Maybe PackageDBCWD]
forall a b. (a -> b) -> [a] -> [b]
map PackageDBCWD -> Maybe PackageDBCWD
forall a. a -> Maybe a
Just PackageDBStackCWD
elabBuildPackageDBStack)
    ConfigFlags -> m ConfigFlags
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigFlags -> m ConfigFlags) -> ConfigFlags -> m ConfigFlags
forall a b. (a -> b) -> a -> b
$
      ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> ConfigFlags -> ConfigFlags
forall a.
ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> a -> a
sanityCheckElaboratedConfiguredPackage
        ElaboratedSharedConfig
sharedConfig
        ElaboratedConfiguredPackage
elab
        Cabal.ConfigFlags{[String]
[Maybe PackageDB]
[(String, String)]
[(String, [String])]
[(ModuleName, Module)]
[PromisedComponent]
[GivenComponent]
[SymbolicPath Pkg ('Dir Framework)]
[SymbolicPath Pkg ('Dir Lib)]
[SymbolicPath Pkg ('Dir Include)]
[PackageVersionConstraint]
Flag Bool
Flag String
Flag [UnitId]
Flag PathTemplate
Flag DumpBuildInfo
Flag ProfDetailLevel
Flag DebugInfoLevel
Flag OptimisationLevel
Flag InstalledPackageId
Flag CompilerFlavor
InstallDirs (Flag PathTemplate)
NubList String
CommonSetupFlags
Option' (Last' ProgramDb)
FlagAssignment
configCommonFlags :: CommonSetupFlags
configPackageDBs :: [Maybe PackageDB]
configVanillaLib :: Flag Bool
configSharedLib :: Flag Bool
configStaticLib :: Flag Bool
configDynExe :: Flag Bool
configFullyStaticExe :: Flag Bool
configGHCiLib :: Flag Bool
configProfLib :: Flag Bool
configProfShared :: Flag Bool
configProfDetail :: Flag ProfDetailLevel
configProfLibDetail :: Flag ProfDetailLevel
configCoverage :: Flag Bool
configLibCoverage :: Flag Bool
configRelocatable :: Flag Bool
configOptimization :: Flag OptimisationLevel
configSplitSections :: Flag Bool
configSplitObjs :: Flag Bool
configStripExes :: Flag Bool
configStripLibs :: Flag Bool
configDebugInfo :: Flag DebugInfoLevel
configProfExe :: Flag Bool
configProf :: Flag Bool
configInstantiateWith :: [(ModuleName, Module)]
configDeterministic :: Flag Bool
configIPID :: Flag String
configCID :: Flag InstalledPackageId
configProgramPaths :: [(String, String)]
configProgramArgs :: [(String, [String])]
configProgramPathExtra :: NubList String
configHcFlavor :: Flag CompilerFlavor
configHcPath :: Flag String
configHcPkg :: Flag String
configDumpBuildInfo :: Flag DumpBuildInfo
configConfigurationsFlags :: FlagAssignment
configConfigureArgs :: [String]
configExtraLibDirs :: [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirsStatic :: [SymbolicPath Pkg ('Dir Lib)]
configExtraFrameworkDirs :: [SymbolicPath Pkg ('Dir Framework)]
configExtraIncludeDirs :: [SymbolicPath Pkg ('Dir Include)]
configProgPrefix :: Flag PathTemplate
configProgSuffix :: Flag PathTemplate
configInstallDirs :: InstallDirs (Flag PathTemplate)
configDependencies :: [GivenComponent]
configPromisedDependencies :: [PromisedComponent]
configConstraints :: [PackageVersionConstraint]
configTests :: Flag Bool
configBenchmarks :: Flag Bool
configExactConfiguration :: Flag Bool
configFlagError :: Flag String
configScratchDir :: Flag String
configUserInstall :: Flag Bool
configPrograms_ :: Option' (Last' ProgramDb)
configUseResponseFiles :: Flag Bool
configAllowDependingOnPrivateLibs :: Flag Bool
configIgnoreBuildTools :: Flag Bool
configCoverageFor :: Flag [UnitId]
configCommonFlags :: CommonSetupFlags
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
configProfShared :: 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 :: [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirsStatic :: [SymbolicPath Pkg ('Dir Lib)]
configExtraFrameworkDirs :: [SymbolicPath Pkg ('Dir Framework)]
configExtraIncludeDirs :: [SymbolicPath Pkg ('Dir Include)]
configIPID :: Flag String
configCID :: Flag InstalledPackageId
configDeterministic :: Flag Bool
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]
configPromisedDependencies :: [PromisedComponent]
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
configCoverageFor :: Flag [UnitId]
configIgnoreBuildTools :: Flag Bool
..}
    where
      Cabal.ConfigFlags
        { Flag Bool
configVanillaLib :: Flag Bool
configVanillaLib :: ConfigFlags -> Flag Bool
configVanillaLib
        , Flag Bool
configSharedLib :: Flag Bool
configSharedLib :: ConfigFlags -> Flag Bool
configSharedLib
        , Flag Bool
configStaticLib :: Flag Bool
configStaticLib :: ConfigFlags -> Flag Bool
configStaticLib
        , Flag Bool
configDynExe :: Flag Bool
configDynExe :: ConfigFlags -> Flag Bool
configDynExe
        , Flag Bool
configFullyStaticExe :: Flag Bool
configFullyStaticExe :: ConfigFlags -> Flag Bool
configFullyStaticExe
        , Flag Bool
configGHCiLib :: Flag Bool
configGHCiLib :: ConfigFlags -> Flag Bool
configGHCiLib
        , -- , configProfExe -- overridden
        Flag Bool
configProfLib :: Flag Bool
configProfLib :: ConfigFlags -> Flag Bool
configProfLib
        , Flag Bool
configProfShared :: Flag Bool
configProfShared :: ConfigFlags -> Flag Bool
configProfShared
        , -- , configProf -- overridden
        Flag ProfDetailLevel
configProfDetail :: Flag ProfDetailLevel
configProfDetail :: ConfigFlags -> Flag ProfDetailLevel
configProfDetail
        , Flag ProfDetailLevel
configProfLibDetail :: Flag ProfDetailLevel
configProfLibDetail :: ConfigFlags -> Flag ProfDetailLevel
configProfLibDetail
        , Flag Bool
configCoverage :: Flag Bool
configCoverage :: ConfigFlags -> Flag Bool
configCoverage
        , Flag Bool
configLibCoverage :: Flag Bool
configLibCoverage :: ConfigFlags -> Flag Bool
configLibCoverage
        , Flag Bool
configRelocatable :: Flag Bool
configRelocatable :: ConfigFlags -> Flag Bool
configRelocatable
        , Flag OptimisationLevel
configOptimization :: Flag OptimisationLevel
configOptimization :: ConfigFlags -> Flag OptimisationLevel
configOptimization
        , Flag Bool
configSplitSections :: Flag Bool
configSplitSections :: ConfigFlags -> Flag Bool
configSplitSections
        , Flag Bool
configSplitObjs :: Flag Bool
configSplitObjs :: ConfigFlags -> Flag Bool
configSplitObjs
        , Flag Bool
configStripExes :: Flag Bool
configStripExes :: ConfigFlags -> Flag Bool
configStripExes
        , Flag Bool
configStripLibs :: Flag Bool
configStripLibs :: ConfigFlags -> Flag Bool
configStripLibs
        , Flag DebugInfoLevel
configDebugInfo :: Flag DebugInfoLevel
configDebugInfo :: ConfigFlags -> Flag DebugInfoLevel
configDebugInfo
        } = BuildOptions -> ConfigFlags
LBC.buildOptionsConfigFlags BuildOptions
elabBuildOptions
      configProfExe :: Flag Bool
configProfExe = Flag Bool
forall a. Monoid a => a
mempty
      configProf :: Flag Bool
configProf = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (Bool -> Flag Bool) -> Bool -> Flag Bool
forall a b. (a -> b) -> a -> b
$ BuildOptions -> Bool
LBC.withProfExe BuildOptions
elabBuildOptions

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

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

      configProgramPaths :: [(String, String)]
configProgramPaths = Map String String -> [(String, String)]
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.
            Map String [String] -> [(String, [String])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String [String] -> [(String, [String])])
-> Map String [String] -> [(String, [String])]
forall a b. (a -> b) -> a -> b
$
              ([String] -> [String] -> [String])
-> String -> [String] -> Map String [String] -> Map String [String]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++)
                String
"ghc"
                [String
"-hide-all-packages"]
                Map String [String]
elabProgramArgs
      configProgramPathExtra :: NubList String
configProgramPathExtra = [String] -> NubList String
forall a. Ord a => [a] -> NubList a
toNubList [String]
elabProgramPathExtra
      configHcFlavor :: Flag CompilerFlavor
configHcFlavor = CompilerFlavor -> Flag CompilerFlavor
forall a. a -> Flag a
toFlag (Compiler -> CompilerFlavor
compilerFlavor Compiler
pkgConfigCompiler)
      configHcPath :: Flag String
configHcPath = Flag String
forall a. Monoid a => a
mempty -- we use configProgramPaths instead
      configHcPkg :: Flag String
configHcPkg = Flag String
forall a. Monoid a => a
mempty -- we use configProgramPaths instead
      configDumpBuildInfo :: Flag DumpBuildInfo
configDumpBuildInfo = DumpBuildInfo -> Flag DumpBuildInfo
forall a. a -> Flag a
toFlag DumpBuildInfo
elabDumpBuildInfo

      configConfigurationsFlags :: FlagAssignment
configConfigurationsFlags = FlagAssignment
elabFlagAssignment
      configConfigureArgs :: [String]
configConfigureArgs = [String]
elabConfigureScriptArgs
      configExtraLibDirs :: [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirs = (String -> SymbolicPath Pkg ('Dir Lib))
-> [String] -> [SymbolicPath Pkg ('Dir Lib)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SymbolicPath Pkg ('Dir Lib)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath ([String] -> [SymbolicPath Pkg ('Dir Lib)])
-> [String] -> [SymbolicPath Pkg ('Dir Lib)]
forall a b. (a -> b) -> a -> b
$ [String]
elabExtraLibDirs
      configExtraLibDirsStatic :: [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirsStatic = (String -> SymbolicPath Pkg ('Dir Lib))
-> [String] -> [SymbolicPath Pkg ('Dir Lib)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SymbolicPath Pkg ('Dir Lib)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath ([String] -> [SymbolicPath Pkg ('Dir Lib)])
-> [String] -> [SymbolicPath Pkg ('Dir Lib)]
forall a b. (a -> b) -> a -> b
$ [String]
elabExtraLibDirsStatic
      configExtraFrameworkDirs :: [SymbolicPath Pkg ('Dir Framework)]
configExtraFrameworkDirs = (String -> SymbolicPath Pkg ('Dir Framework))
-> [String] -> [SymbolicPath Pkg ('Dir Framework)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SymbolicPath Pkg ('Dir Framework)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath ([String] -> [SymbolicPath Pkg ('Dir Framework)])
-> [String] -> [SymbolicPath Pkg ('Dir Framework)]
forall a b. (a -> b) -> a -> b
$ [String]
elabExtraFrameworkDirs
      configExtraIncludeDirs :: [SymbolicPath Pkg ('Dir Include)]
configExtraIncludeDirs = (String -> SymbolicPath Pkg ('Dir Include))
-> [String] -> [SymbolicPath Pkg ('Dir Include)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SymbolicPath Pkg ('Dir Include)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath ([String] -> [SymbolicPath Pkg ('Dir Include)])
-> [String] -> [SymbolicPath Pkg ('Dir Include)]
forall a b. (a -> b) -> a -> b
$ [String]
elabExtraIncludeDirs
      configProgPrefix :: Flag PathTemplate
configProgPrefix = Flag PathTemplate
-> (PathTemplate -> Flag PathTemplate)
-> Maybe PathTemplate
-> Flag PathTemplate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag PathTemplate
forall a. Monoid a => a
mempty PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag Maybe PathTemplate
elabProgPrefix
      configProgSuffix :: Flag PathTemplate
configProgSuffix = Flag PathTemplate
-> (PathTemplate -> Flag PathTemplate)
-> Maybe PathTemplate
-> Flag PathTemplate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag PathTemplate
forall a. Monoid a => a
mempty PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag Maybe PathTemplate
elabProgSuffix

      configInstallDirs :: InstallDirs (Flag PathTemplate)
configInstallDirs =
        (String -> Flag PathTemplate)
-> InstallDirs String -> InstallDirs (Flag PathTemplate)
forall a b. (a -> b) -> InstallDirs a -> InstallDirs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag (PathTemplate -> Flag PathTemplate)
-> (String -> PathTemplate) -> String -> Flag PathTemplate
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 =
        [ ConfiguredId -> GivenComponent
cidToGivenComponent ConfiguredId
cid
        | (ConfiguredId
cid, Bool
is_internal) <- ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)]
elabLibDependencies ElaboratedConfiguredPackage
elab
        , Bool -> Bool
not Bool
is_internal
        ]

      configPromisedDependencies :: [PromisedComponent]
configPromisedDependencies =
        [ ConfiguredId -> PromisedComponent
cidToPromisedComponent ConfiguredId
cid
        | (ConfiguredId
cid, Bool
is_internal) <- ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)]
elabLibDependencies ElaboratedConfiguredPackage
elab
        , Bool
is_internal
        ]

      configConstraints :: [PackageVersionConstraint]
configConstraints =
        case ElaboratedPackageOrComponent
elabPkgOrComp of
          ElabPackage ElaboratedPackage
_ ->
            [ PackageId -> PackageVersionConstraint
thisPackageVersionConstraint PackageId
srcid
            | (ConfiguredId PackageId
srcid Maybe ComponentName
_ InstalledPackageId
_uid, Bool
_) <- ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)]
elabLibDependencies ElaboratedConfiguredPackage
elab
            ]
          ElabComponent ElaboratedComponent
_ -> []

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

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

      cidToGivenComponent :: ConfiguredId -> GivenComponent
      cidToGivenComponent :: ConfiguredId -> GivenComponent
cidToGivenComponent (ConfiguredId PackageId
srcid Maybe ComponentName
mb_cn InstalledPackageId
cid) = PackageName -> LibraryName -> InstalledPackageId -> GivenComponent
GivenComponent (PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
srcid) LibraryName
ln InstalledPackageId
cid
        where
          ln :: LibraryName
ln = case Maybe ComponentName
mb_cn of
            Just (CLibName LibraryName
lname) -> LibraryName
lname
            Just ComponentName
_ -> String -> LibraryName
forall a. HasCallStack => String -> a
error String
"non-library dependency"
            Maybe ComponentName
Nothing -> LibraryName
LMainLibName

      configCoverageFor :: Flag [UnitId]
configCoverageFor = ElaboratedConfiguredPackage
-> ElaboratedInstallPlan -> Flag [UnitId]
determineCoverageFor ElaboratedConfiguredPackage
elab ElaboratedInstallPlan
plan

      cidToPromisedComponent :: ConfiguredId -> PromisedComponent
      cidToPromisedComponent :: ConfiguredId -> PromisedComponent
cidToPromisedComponent (ConfiguredId PackageId
srcid Maybe ComponentName
mb_cn InstalledPackageId
cid) =
        PackageId -> LibraryName -> InstalledPackageId -> PromisedComponent
PromisedComponent PackageId
srcid LibraryName
ln InstalledPackageId
cid
        where
          ln :: LibraryName
ln = case Maybe ComponentName
mb_cn of
            Just (CLibName LibraryName
lname) -> LibraryName
lname
            Just ComponentName
_ -> String -> LibraryName
forall a. HasCallStack => String -> a
error String
"non-library dependency"
            Maybe ComponentName
Nothing -> LibraryName
LMainLibName

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}) =
  [PackageId -> ComponentTarget -> String
showComponentTarget (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
elab) (ComponentName -> SubComponentTarget -> ComponentTarget
ComponentTarget ComponentName
cname SubComponentTarget
WholeComponent)]
  where
    cname :: ComponentName
cname =
      ComponentName -> Maybe ComponentName -> ComponentName
forall a. a -> Maybe a -> a
fromMaybe
        (String -> ComponentName
forall a. HasCallStack => String -> a
error String
"setupHsConfigureArgs: trying to configure setup")
        (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp)

setupHsCommonFlags
  :: Verbosity
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> SymbolicPath Pkg (Dir Dist)
  -> Cabal.CommonSetupFlags
setupHsCommonFlags :: Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist)
-> CommonSetupFlags
setupHsCommonFlags Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg ('Dir Dist)
builddir =
  Cabal.CommonSetupFlags
    { setupDistPref :: Flag (SymbolicPath Pkg ('Dir Dist))
setupDistPref = SymbolicPath Pkg ('Dir Dist) -> Flag (SymbolicPath Pkg ('Dir Dist))
forall a. a -> Flag a
toFlag SymbolicPath Pkg ('Dir Dist)
builddir
    , setupVerbosity :: Flag Verbosity
setupVerbosity = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag Verbosity
verbosity
    , setupCabalFilePath :: Flag (SymbolicPath Pkg 'File)
setupCabalFilePath = Flag (SymbolicPath Pkg 'File)
forall a. Monoid a => a
mempty
    , setupWorkingDir :: Flag (SymbolicPath CWD ('Dir Pkg))
setupWorkingDir = Maybe (SymbolicPath CWD ('Dir Pkg))
-> Flag (SymbolicPath CWD ('Dir Pkg))
forall a. Maybe a -> Flag a
maybeToFlag Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
    , setupTargets :: [String]
setupTargets = []
    }

setupHsBuildFlags
  :: Flag String
  -> ElaboratedConfiguredPackage
  -> ElaboratedSharedConfig
  -> Cabal.CommonSetupFlags
  -> Cabal.BuildFlags
setupHsBuildFlags :: Flag String
-> ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> BuildFlags
setupHsBuildFlags Flag String
par_strat ElaboratedConfiguredPackage
elab ElaboratedSharedConfig
_ CommonSetupFlags
common =
  Cabal.BuildFlags
    { buildCommonFlags :: CommonSetupFlags
buildCommonFlags = CommonSetupFlags
common
    , buildProgramPaths :: [(String, String)]
buildProgramPaths = [(String, String)]
forall a. Monoid a => a
mempty -- unused, set at configure time
    , buildProgramArgs :: [(String, [String])]
buildProgramArgs = [(String, [String])]
forall a. Monoid a => a
mempty -- unused, set at configure time
    , buildNumJobs :: Flag (Maybe Int)
buildNumJobs = Flag (Maybe Int)
forall a. Monoid a => a
mempty -- TODO: [nice to have] sometimes want to use toFlag (Just numBuildJobs),
    , buildUseSemaphore :: Flag String
buildUseSemaphore =
        if ElaboratedConfiguredPackage -> Version
elabSetupScriptCliVersion ElaboratedConfiguredPackage
elab Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
3, Int
11, Int
0, Int
0]
          then -- Cabal 3.11 is the first version that supports parallelism semaphores
            Flag String
par_strat
          else Flag String
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 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1, Int
17] =
      (ComponentTarget -> String) -> [ComponentTarget] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (PackageId -> ComponentTarget -> String
showComponentTarget (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
elab)) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab)
  | Bool
otherwise =
      []
setupHsBuildArgs (ElaboratedConfiguredPackage{elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp = ElabComponent ElaboratedComponent
_}) =
  []

setupHsTestFlags
  :: ElaboratedConfiguredPackage
  -> Cabal.CommonSetupFlags
  -> Cabal.TestFlags
setupHsTestFlags :: ElaboratedConfiguredPackage -> CommonSetupFlags -> TestFlags
setupHsTestFlags (ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
..}) CommonSetupFlags
common =
  Cabal.TestFlags
    { testCommonFlags :: CommonSetupFlags
testCommonFlags = CommonSetupFlags
common
    , testMachineLog :: Flag PathTemplate
testMachineLog = Flag PathTemplate
-> (PathTemplate -> Flag PathTemplate)
-> Maybe PathTemplate
-> Flag PathTemplate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag PathTemplate
forall a. Monoid a => a
mempty PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag Maybe PathTemplate
elabTestMachineLog
    , testHumanLog :: Flag PathTemplate
testHumanLog = Flag PathTemplate
-> (PathTemplate -> Flag PathTemplate)
-> Maybe PathTemplate
-> Flag PathTemplate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag PathTemplate
forall a. Monoid a => a
mempty PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag Maybe PathTemplate
elabTestHumanLog
    , testShowDetails :: Flag TestShowDetails
testShowDetails = Flag TestShowDetails
-> (TestShowDetails -> Flag TestShowDetails)
-> Maybe TestShowDetails
-> Flag TestShowDetails
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TestShowDetails -> Flag TestShowDetails
forall a. a -> Flag a
Flag TestShowDetails
Cabal.Always) TestShowDetails -> Flag TestShowDetails
forall a. a -> Flag a
toFlag Maybe TestShowDetails
elabTestShowDetails
    , testKeepTix :: Flag Bool
testKeepTix = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabTestKeepTix
    , testWrapper :: Flag String
testWrapper = Flag String
-> (String -> Flag String) -> Maybe String -> Flag String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag String
forall a. Monoid a => a
mempty String -> Flag String
forall a. a -> Flag a
toFlag Maybe String
elabTestWrapper
    , testFailWhenNoTestSuites :: Flag Bool
testFailWhenNoTestSuites = Bool -> Flag Bool
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 =
  (ComponentTarget -> Maybe String) -> [ComponentTarget] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PackageId -> ComponentTarget -> Maybe String
showTestComponentTarget (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
elab)) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
elab)

setupHsBenchFlags
  :: ElaboratedConfiguredPackage
  -> ElaboratedSharedConfig
  -> Cabal.CommonSetupFlags
  -> Cabal.BenchmarkFlags
setupHsBenchFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> CommonSetupFlags -> BenchmarkFlags
setupHsBenchFlags (ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
..}) ElaboratedSharedConfig
_ CommonSetupFlags
common =
  Cabal.BenchmarkFlags
    { benchmarkCommonFlags :: CommonSetupFlags
benchmarkCommonFlags = CommonSetupFlags
common
    , benchmarkOptions :: [PathTemplate]
benchmarkOptions = [PathTemplate]
elabBenchmarkOptions
    }

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

setupHsReplFlags
  :: ElaboratedConfiguredPackage
  -> ElaboratedSharedConfig
  -> Cabal.CommonSetupFlags
  -> Cabal.ReplFlags
setupHsReplFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> CommonSetupFlags -> ReplFlags
setupHsReplFlags ElaboratedConfiguredPackage
_ ElaboratedSharedConfig
sharedConfig CommonSetupFlags
common =
  Cabal.ReplFlags
    { replCommonFlags :: CommonSetupFlags
replCommonFlags = CommonSetupFlags
common
    , replProgramPaths :: [(String, String)]
replProgramPaths = [(String, String)]
forall a. Monoid a => a
mempty -- unused, set at configure time
    , replProgramArgs :: [(String, [String])]
replProgramArgs = [(String, [String])]
forall a. Monoid a => a
mempty -- unused, set at configure time
    , replReload :: Flag Bool
replReload = Flag Bool
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 =
  (ComponentTarget -> String) -> [ComponentTarget] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ComponentTarget
t -> PackageId -> ComponentTarget -> String
showComponentTarget (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
elab) ComponentTarget
t) (ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget ElaboratedConfiguredPackage
elab)

setupHsCopyFlags
  :: ElaboratedConfiguredPackage
  -> ElaboratedSharedConfig
  -> Cabal.CommonSetupFlags
  -> FilePath
  -> Cabal.CopyFlags
setupHsCopyFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> String
-> CopyFlags
setupHsCopyFlags ElaboratedConfiguredPackage
_ ElaboratedSharedConfig
_ CommonSetupFlags
common String
destdir =
  Cabal.CopyFlags
    { copyCommonFlags :: CommonSetupFlags
copyCommonFlags = CommonSetupFlags
common
    , copyDest :: Flag CopyDest
copyDest = CopyDest -> Flag CopyDest
forall a. a -> Flag a
toFlag (String -> CopyDest
InstallDirs.CopyTo String
destdir)
    }

setupHsRegisterFlags
  :: ElaboratedConfiguredPackage
  -> ElaboratedSharedConfig
  -> Cabal.CommonSetupFlags
  -> FilePath
  -> Cabal.RegisterFlags
setupHsRegisterFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> CommonSetupFlags
-> String
-> RegisterFlags
setupHsRegisterFlags
  ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
..}
  ElaboratedSharedConfig
_
  CommonSetupFlags
common
  String
pkgConfFile =
    Cabal.RegisterFlags
      { registerCommonFlags :: CommonSetupFlags
registerCommonFlags = CommonSetupFlags
common
      , regPackageDB :: Flag PackageDB
regPackageDB = Flag PackageDB
forall a. Monoid a => a
mempty -- misfeature
      , regGenScript :: Flag Bool
regGenScript = Flag Bool
forall a. Monoid a => a
mempty -- never use
      , regGenPkgConf :: Flag (Maybe (SymbolicPath Pkg ('Dir PkgConf)))
regGenPkgConf = Maybe (SymbolicPath Pkg ('Dir PkgConf))
-> Flag (Maybe (SymbolicPath Pkg ('Dir PkgConf)))
forall a. a -> Flag a
toFlag (SymbolicPath Pkg ('Dir PkgConf)
-> Maybe (SymbolicPath Pkg ('Dir PkgConf))
forall a. a -> Maybe a
Just (String -> SymbolicPath Pkg ('Dir PkgConf)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath String
pkgConfFile))
      , regInPlace :: Flag Bool
regInPlace = case BuildStyle
elabBuildStyle of
          BuildInplaceOnly{} -> Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
          BuildStyle
BuildAndInstall -> Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
False
      , regPrintId :: Flag Bool
regPrintId = Flag Bool
forall a. Monoid a => a
mempty -- never use
      }

setupHsHaddockFlags
  :: ElaboratedConfiguredPackage
  -> ElaboratedSharedConfig
  -> BuildTimeSettings
  -> Cabal.CommonSetupFlags
  -> Cabal.HaddockFlags
setupHsHaddockFlags :: ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> BuildTimeSettings
-> CommonSetupFlags
-> HaddockFlags
setupHsHaddockFlags
  (ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagAssignment :: FlagAssignment
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: [Maybe PackageDBCWD]
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramArgs :: Map String [String]
elabProgramPathExtra :: [String]
elabConfigureScriptArgs :: [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabInstallDirs :: InstallDirs String
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockHscolourCss :: Maybe String
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabBuildHaddocks :: Bool
elabPkgOrComp :: ElaboratedPackageOrComponent
..})
  (ElaboratedSharedConfig{Compiler
ProgramDb
ReplOptions
Platform
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigReplOptions :: ElaboratedSharedConfig -> ReplOptions
pkgConfigPlatform :: Platform
pkgConfigCompiler :: Compiler
pkgConfigCompilerProgs :: ProgramDb
pkgConfigReplOptions :: ReplOptions
..})
  (BuildTimeSettings{buildSettingKeepTempFiles :: BuildTimeSettings -> Bool
buildSettingKeepTempFiles = Bool
keepTmpFiles})
  CommonSetupFlags
common =
    Cabal.HaddockFlags
      { haddockCommonFlags :: CommonSetupFlags
haddockCommonFlags = CommonSetupFlags
common
      , haddockProgramPaths :: [(String, String)]
haddockProgramPaths =
          case Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
haddockProgram ProgramDb
pkgConfigCompilerProgs of
            Maybe ConfiguredProgram
Nothing -> [(String, String)]
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 = [(String, [String])]
forall a. Monoid a => a
mempty -- unused, set at configure time
      , haddockHoogle :: Flag Bool
haddockHoogle = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabHaddockHoogle
      , haddockHtml :: Flag Bool
haddockHtml = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabHaddockHtml
      , haddockHtmlLocation :: Flag String
haddockHtmlLocation = Flag String
-> (String -> Flag String) -> Maybe String -> Flag String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag String
forall a. Monoid a => a
mempty String -> Flag String
forall a. a -> Flag a
toFlag Maybe String
elabHaddockHtmlLocation
      , haddockForHackage :: Flag HaddockTarget
haddockForHackage = HaddockTarget -> Flag HaddockTarget
forall a. a -> Flag a
toFlag HaddockTarget
elabHaddockForHackage
      , haddockForeignLibs :: Flag Bool
haddockForeignLibs = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabHaddockForeignLibs
      , haddockExecutables :: Flag Bool
haddockExecutables = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabHaddockExecutables
      , haddockTestSuites :: Flag Bool
haddockTestSuites = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabHaddockTestSuites
      , haddockBenchmarks :: Flag Bool
haddockBenchmarks = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabHaddockBenchmarks
      , haddockInternal :: Flag Bool
haddockInternal = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabHaddockInternal
      , haddockCss :: Flag String
haddockCss = Flag String
-> (String -> Flag String) -> Maybe String -> Flag String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag String
forall a. Monoid a => a
mempty String -> Flag String
forall a. a -> Flag a
toFlag Maybe String
elabHaddockCss
      , haddockLinkedSource :: Flag Bool
haddockLinkedSource = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabHaddockLinkedSource
      , haddockQuickJump :: Flag Bool
haddockQuickJump = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabHaddockQuickJump
      , haddockHscolourCss :: Flag String
haddockHscolourCss = Flag String
-> (String -> Flag String) -> Maybe String -> Flag String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag String
forall a. Monoid a => a
mempty String -> Flag String
forall a. a -> Flag a
toFlag Maybe String
elabHaddockHscolourCss
      , haddockContents :: Flag PathTemplate
haddockContents = Flag PathTemplate
-> (PathTemplate -> Flag PathTemplate)
-> Maybe PathTemplate
-> Flag PathTemplate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag PathTemplate
forall a. Monoid a => a
mempty PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag Maybe PathTemplate
elabHaddockContents
      , haddockKeepTempFiles :: Flag Bool
haddockKeepTempFiles = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
keepTmpFiles
      , haddockIndex :: Flag PathTemplate
haddockIndex = Flag PathTemplate
-> (PathTemplate -> Flag PathTemplate)
-> Maybe PathTemplate
-> Flag PathTemplate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag PathTemplate
forall a. Monoid a => a
mempty PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag Maybe PathTemplate
elabHaddockIndex
      , haddockBaseUrl :: Flag String
haddockBaseUrl = Flag String
-> (String -> Flag String) -> Maybe String -> Flag String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag String
forall a. Monoid a => a
mempty String -> Flag String
forall a. a -> Flag a
toFlag Maybe String
elabHaddockBaseUrl
      , haddockResourcesDir :: Flag String
haddockResourcesDir = Flag String
-> (String -> Flag String) -> Maybe String -> Flag String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag String
forall a. Monoid a => a
mempty String -> Flag String
forall a. a -> Flag a
toFlag Maybe String
elabHaddockResourcesDir
      , haddockOutputDir :: Flag String
haddockOutputDir = Flag String
-> (String -> Flag String) -> Maybe String -> Flag String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Flag String
forall a. Monoid a => a
mempty String -> Flag String
forall a. a -> Flag a
toFlag Maybe String
elabHaddockOutputDir
      , haddockUseUnicode :: Flag Bool
haddockUseUnicode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
elabHaddockUseUnicode
      }

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

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

-- * 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 :: PackageId
pkgHashPkgId = ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
elab
      , pkgHashComponent :: Maybe Component
pkgHashComponent =
          case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
            ElabPackage ElaboratedPackage
_ -> Maybe Component
forall a. Maybe a
Nothing
            ElabComponent ElaboratedComponent
comp -> Component -> Maybe Component
forall a. a -> Maybe a
Just (ElaboratedComponent -> Component
compSolverName ElaboratedComponent
comp)
      , pkgHashSourceHash :: PackageSourceHash
pkgHashSourceHash = PackageSourceHash
srchash
      , pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion)
pkgHashPkgConfigDeps = [(PkgconfigName, Maybe PkgconfigVersion)]
-> Set (PkgconfigName, Maybe PkgconfigVersion)
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)]
NonEmpty NotPerComponentReason
InstalledPackageId
ComponentDeps [()]
ComponentDeps [(ConfiguredId, Bool)]
ComponentDeps [(ConfiguredId, String)]
ComponentDeps [ConfiguredId]
OptionalStanzaSet
pkgInstalledId :: ElaboratedPackage -> InstalledPackageId
pkgLibDependencies :: ElaboratedPackage -> ComponentDeps [(ConfiguredId, Bool)]
pkgDependsOnSelfLib :: ElaboratedPackage -> ComponentDeps [()]
pkgExeDependencies :: ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgExeDependencyPaths :: ElaboratedPackage -> ComponentDeps [(ConfiguredId, String)]
pkgPkgConfigDependencies :: ElaboratedPackage -> [(PkgconfigName, Maybe PkgconfigVersion)]
pkgStanzasEnabled :: ElaboratedPackage -> OptionalStanzaSet
pkgWhyNotPerComponent :: ElaboratedPackage -> NonEmpty NotPerComponentReason
pkgInstalledId :: InstalledPackageId
pkgLibDependencies :: ComponentDeps [(ConfiguredId, Bool)]
pkgDependsOnSelfLib :: ComponentDeps [()]
pkgExeDependencies :: ComponentDeps [ConfiguredId]
pkgExeDependencyPaths :: ComponentDeps [(ConfiguredId, String)]
pkgPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)]
pkgStanzasEnabled :: OptionalStanzaSet
pkgWhyNotPerComponent :: NonEmpty NotPerComponentReason
..}) ->
              [InstalledPackageId] -> Set InstalledPackageId
forall a. Ord a => [a] -> Set a
Set.fromList ([InstalledPackageId] -> Set InstalledPackageId)
-> [InstalledPackageId] -> Set InstalledPackageId
forall a b. (a -> b) -> a -> b
$
                [ ConfiguredId -> InstalledPackageId
confInstId ConfiguredId
dep
                | (ConfiguredId
dep, Bool
_) <- (Component -> Bool)
-> ComponentDeps [(ConfiguredId, Bool)] -> [(ConfiguredId, Bool)]
forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
CD.select Component -> Bool
relevantDeps ComponentDeps [(ConfiguredId, Bool)]
pkgLibDependencies
                ]
                  [InstalledPackageId]
-> [InstalledPackageId] -> [InstalledPackageId]
forall a. [a] -> [a] -> [a]
++ [ ConfiguredId -> InstalledPackageId
confInstId ConfiguredId
dep
                     | ConfiguredId
dep <- (Component -> Bool)
-> ComponentDeps [ConfiguredId] -> [ConfiguredId]
forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
CD.select Component -> Bool
relevantDeps ComponentDeps [ConfiguredId]
pkgExeDependencies
                     ]
            ElabComponent ElaboratedComponent
comp ->
              [InstalledPackageId] -> Set InstalledPackageId
forall a. Ord a => [a] -> Set a
Set.fromList
                ( (ConfiguredId -> InstalledPackageId)
-> [ConfiguredId] -> [InstalledPackageId]
forall a b. (a -> b) -> [a] -> [b]
map
                    ConfiguredId -> InstalledPackageId
confInstId
                    ( ((ConfiguredId, Bool) -> ConfiguredId)
-> [(ConfiguredId, Bool)] -> [ConfiguredId]
forall a b. (a -> b) -> [a] -> [b]
map (ConfiguredId, Bool) -> ConfiguredId
forall a b. (a, b) -> a
fst (ElaboratedComponent -> [(ConfiguredId, Bool)]
compLibDependencies ElaboratedComponent
comp)
                        [ConfiguredId] -> [ConfiguredId] -> [ConfiguredId]
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 =
  String -> PackageHashInputs
forall a. HasCallStack => String -> a
error (String -> PackageHashInputs) -> String -> PackageHashInputs
forall a b. (a -> b) -> a -> b
$
    String
"packageHashInputs: only for packages with source hashes. "
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageId -> String
forall a. Pretty a => a -> String
prettyShow (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
pkg)

packageHashConfigInputs
  :: ElaboratedSharedConfig
  -> ElaboratedConfiguredPackage
  -> PackageHashConfigInputs
packageHashConfigInputs :: ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> PackageHashConfigInputs
packageHashConfigInputs shared :: ElaboratedSharedConfig
shared@ElaboratedSharedConfig{Compiler
ProgramDb
ReplOptions
Platform
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigReplOptions :: ElaboratedSharedConfig -> ReplOptions
pkgConfigPlatform :: Platform
pkgConfigCompiler :: Compiler
pkgConfigCompilerProgs :: ProgramDb
pkgConfigReplOptions :: ReplOptions
..} ElaboratedConfiguredPackage
pkg =
  PackageHashConfigInputs
    { pkgHashCompilerId :: CompilerId
pkgHashCompilerId = Compiler -> CompilerId
compilerId Compiler
pkgConfigCompiler
    , pkgHashCompilerABI :: AbiTag
pkgHashCompilerABI = Compiler -> AbiTag
compilerAbiTag Compiler
pkgConfigCompiler
    , pkgHashPlatform :: Platform
pkgHashPlatform = Platform
pkgConfigPlatform
    , pkgHashFlagAssignment :: FlagAssignment
pkgHashFlagAssignment = FlagAssignment
elabFlagAssignment
    , pkgHashConfigureScriptArgs :: [String]
pkgHashConfigureScriptArgs = [String]
elabConfigureScriptArgs
    , pkgHashVanillaLib :: Bool
pkgHashVanillaLib = Bool
withVanillaLib
    , pkgHashSharedLib :: Bool
pkgHashSharedLib = Bool
withSharedLib
    , pkgHashDynExe :: Bool
pkgHashDynExe = Bool
withDynExe
    , pkgHashFullyStaticExe :: Bool
pkgHashFullyStaticExe = Bool
withFullyStaticExe
    , pkgHashGHCiLib :: Bool
pkgHashGHCiLib = Bool
withGHCiLib
    , pkgHashProfLib :: Bool
pkgHashProfLib = Bool
withProfLib
    , pkgHashProfExe :: Bool
pkgHashProfExe = Bool
withProfExe
    , pkgHashProfLibDetail :: ProfDetailLevel
pkgHashProfLibDetail = ProfDetailLevel
withProfLibDetail
    , pkgHashProfExeDetail :: ProfDetailLevel
pkgHashProfExeDetail = ProfDetailLevel
withProfExeDetail
    , pkgHashCoverage :: Bool
pkgHashCoverage = Bool
exeCoverage
    , pkgHashOptimization :: OptimisationLevel
pkgHashOptimization = OptimisationLevel
withOptimization
    , pkgHashSplitSections :: Bool
pkgHashSplitSections = Bool
splitSections
    , pkgHashSplitObjs :: Bool
pkgHashSplitObjs = Bool
splitObjs
    , pkgHashStripLibs :: Bool
pkgHashStripLibs = Bool
stripLibs
    , pkgHashStripExes :: Bool
pkgHashStripExes = Bool
stripExes
    , pkgHashDebugInfo :: DebugInfoLevel
pkgHashDebugInfo = DebugInfoLevel
withDebugInfo
    , 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 PackageDBCWD]
pkgHashPackageDbs = [Maybe PackageDBCWD]
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
    , pkgHashHaddockResourcesDir :: Maybe String
pkgHashHaddockResourcesDir = Maybe String
elabHaddockResourcesDir
    , pkgHashHaddockOutputDir :: Maybe String
pkgHashHaddockOutputDir = Maybe String
elabHaddockOutputDir
    , pkgHashHaddockUseUnicode :: Bool
pkgHashHaddockUseUnicode = Bool
elabHaddockUseUnicode
    }
  where
    ElaboratedConfiguredPackage{Bool
[String]
[Maybe PackageDBCWD]
[PathTemplate]
PackageDBStackCWD
[ComponentTarget]
Maybe String
Maybe PathTemplate
Maybe TestShowDetails
Maybe CabalFileText
Maybe PackageSourceHash
Version
ModuleShape
InstallDirs String
DumpBuildInfo
HaddockTarget
BuildOptions
Map String String
Map String [String]
Map ModuleName OpenModule
Map ModuleName Module
PackageDescription
InstalledPackageId
UnitId
PackageId
FlagAssignment
ComponentRequestedSpec
OptionalStanzaMap (Maybe Bool)
OptionalStanzaSet
PackageLocation (Maybe String)
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabComponentId :: ElaboratedConfiguredPackage -> InstalledPackageId
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDBCWD]
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStackCWD
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabBuildOptions :: ElaboratedConfiguredPackage -> BuildOptions
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabProgramPaths :: ElaboratedConfiguredPackage -> Map String String
elabProgramArgs :: ElaboratedConfiguredPackage -> Map String [String]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [String]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [String]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [String]
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [String]
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs String
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockResourcesDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockOutputDir :: ElaboratedConfiguredPackage -> Maybe String
elabHaddockUseUnicode :: ElaboratedConfiguredPackage -> Bool
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe String
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabFlagAssignment :: FlagAssignment
elabConfigureScriptArgs :: [String]
elabProgramArgs :: Map String [String]
elabExtraLibDirs :: [String]
elabExtraLibDirsStatic :: [String]
elabExtraFrameworkDirs :: [String]
elabExtraIncludeDirs :: [String]
elabProgPrefix :: Maybe PathTemplate
elabProgSuffix :: Maybe PathTemplate
elabPackageDbs :: [Maybe PackageDBCWD]
elabBuildHaddocks :: Bool
elabHaddockHoogle :: Bool
elabHaddockHtml :: Bool
elabHaddockHtmlLocation :: Maybe String
elabHaddockForeignLibs :: Bool
elabHaddockExecutables :: Bool
elabHaddockTestSuites :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockInternal :: Bool
elabHaddockCss :: Maybe String
elabHaddockLinkedSource :: Bool
elabHaddockQuickJump :: Bool
elabHaddockContents :: Maybe PathTemplate
elabHaddockIndex :: Maybe PathTemplate
elabHaddockBaseUrl :: Maybe String
elabHaddockResourcesDir :: Maybe String
elabHaddockOutputDir :: Maybe String
elabHaddockUseUnicode :: Bool
elabUnitId :: UnitId
elabComponentId :: InstalledPackageId
elabInstantiatedWith :: Map ModuleName Module
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabIsCanonical :: Bool
elabPkgSourceId :: PackageId
elabModuleShape :: ModuleShape
elabFlagDefaults :: FlagAssignment
elabPkgDescription :: PackageDescription
elabPkgSourceLocation :: PackageLocation (Maybe String)
elabPkgSourceHash :: Maybe PackageSourceHash
elabLocalToProject :: Bool
elabBuildStyle :: BuildStyle
elabEnabledSpec :: ComponentRequestedSpec
elabStanzasAvailable :: OptionalStanzaSet
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabSetupPackageDBStack :: PackageDBStackCWD
elabBuildPackageDBStack :: PackageDBStackCWD
elabRegisterPackageDBStack :: PackageDBStackCWD
elabInplaceSetupPackageDBStack :: PackageDBStackCWD
elabInplaceBuildPackageDBStack :: PackageDBStackCWD
elabInplaceRegisterPackageDBStack :: PackageDBStackCWD
elabPkgDescriptionOverride :: Maybe CabalFileText
elabBuildOptions :: BuildOptions
elabDumpBuildInfo :: DumpBuildInfo
elabProgramPaths :: Map String String
elabProgramPathExtra :: [String]
elabInstallDirs :: InstallDirs String
elabHaddockForHackage :: HaddockTarget
elabHaddockHscolourCss :: Maybe String
elabTestMachineLog :: Maybe PathTemplate
elabTestHumanLog :: Maybe PathTemplate
elabTestShowDetails :: Maybe TestShowDetails
elabTestKeepTix :: Bool
elabTestWrapper :: Maybe String
elabTestFailWhenNoTestSuites :: Bool
elabTestTestOptions :: [PathTemplate]
elabBenchmarkOptions :: [PathTemplate]
elabSetupScriptStyle :: SetupScriptStyle
elabSetupScriptCliVersion :: Version
elabConfigureTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBenchTargets :: [ComponentTarget]
elabReplTarget :: [ComponentTarget]
elabHaddockTargets :: [ComponentTarget]
elabPkgOrComp :: ElaboratedPackageOrComponent
..} = ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
normaliseConfiguredPackage ElaboratedSharedConfig
shared ElaboratedConfiguredPackage
pkg
    LBC.BuildOptions{Bool
ProfDetailLevel
DebugInfoLevel
OptimisationLevel
$sel:withVanillaLib:BuildOptions :: BuildOptions -> Bool
$sel:withSharedLib:BuildOptions :: BuildOptions -> Bool
$sel:withStaticLib:BuildOptions :: BuildOptions -> Bool
$sel:withDynExe:BuildOptions :: BuildOptions -> Bool
$sel:withFullyStaticExe:BuildOptions :: BuildOptions -> Bool
$sel:withGHCiLib:BuildOptions :: BuildOptions -> Bool
$sel:withProfExe:BuildOptions :: BuildOptions -> Bool
$sel:withProfLib:BuildOptions :: BuildOptions -> Bool
$sel:withProfLibShared:BuildOptions :: BuildOptions -> Bool
$sel:exeCoverage:BuildOptions :: BuildOptions -> Bool
$sel:libCoverage:BuildOptions :: BuildOptions -> Bool
$sel:withOptimization:BuildOptions :: BuildOptions -> OptimisationLevel
$sel:splitObjs:BuildOptions :: BuildOptions -> Bool
$sel:splitSections:BuildOptions :: BuildOptions -> Bool
$sel:stripLibs:BuildOptions :: BuildOptions -> Bool
$sel:stripExes:BuildOptions :: BuildOptions -> Bool
$sel:withDebugInfo:BuildOptions :: BuildOptions -> DebugInfoLevel
$sel:relocatable:BuildOptions :: BuildOptions -> Bool
$sel:withProfLibDetail:BuildOptions :: BuildOptions -> ProfDetailLevel
$sel:withProfExeDetail:BuildOptions :: BuildOptions -> ProfDetailLevel
withVanillaLib :: Bool
withSharedLib :: Bool
withDynExe :: Bool
withFullyStaticExe :: Bool
withGHCiLib :: Bool
withProfLib :: Bool
withProfExe :: Bool
withProfLibDetail :: ProfDetailLevel
withProfExeDetail :: ProfDetailLevel
exeCoverage :: Bool
withOptimization :: OptimisationLevel
splitSections :: Bool
splitObjs :: Bool
stripLibs :: Bool
stripExes :: Bool
withDebugInfo :: DebugInfoLevel
withProfLibShared :: Bool
withStaticLib :: Bool
libCoverage :: Bool
relocatable :: Bool
..} = BuildOptions
elabBuildOptions

-- | 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 =
  (ElaboratedConfiguredPackage -> Bool)
-> ElaboratedInstallPlan -> ElaboratedInstallPlan
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
(srcpkg -> Bool)
-> GenericInstallPlan ipkg srcpkg -> GenericInstallPlan ipkg srcpkg
InstallPlan.installed ElaboratedConfiguredPackage -> Bool
canPackageBeImproved
  where
    canPackageBeImproved :: ElaboratedConfiguredPackage -> Bool
canPackageBeImproved ElaboratedConfiguredPackage
pkg =
      ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
pkg UnitId -> Set UnitId -> Bool
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
  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 = InstallDirs String -> String
forall dir. InstallDirs dir -> dir
InstallDirs.bindir (InstallDirs String -> String)
-> (ElaboratedConfiguredPackage -> InstallDirs String)
-> ElaboratedConfiguredPackage
-> String
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"

--------------------------------------------------------------------------------
-- Configure --coverage-for flags

-- The list of non-pre-existing libraries without module holes, i.e. the
-- main library and sub-libraries components of all the local packages in
-- the project that are dependencies of the components being built and that do
-- not require instantiations or are instantiations.
determineCoverageFor
  :: ElaboratedConfiguredPackage
  -- ^ The package or component being configured
  -> ElaboratedInstallPlan
  -> Flag [UnitId]
determineCoverageFor :: ElaboratedConfiguredPackage
-> ElaboratedInstallPlan -> Flag [UnitId]
determineCoverageFor ElaboratedConfiguredPackage
configuredPkg ElaboratedInstallPlan
plan =
  [UnitId] -> Flag [UnitId]
forall a. a -> Flag a
Flag
    ([UnitId] -> Flag [UnitId]) -> [UnitId] -> Flag [UnitId]
forall a b. (a -> b) -> a -> b
$ (ElaboratedPlanPackage -> Maybe UnitId)
-> [ElaboratedPlanPackage] -> [UnitId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
      ( \case
          InstallPlan.Installed ElaboratedConfiguredPackage
elab
            | ElaboratedConfiguredPackage -> Bool
shouldCoverPkg ElaboratedConfiguredPackage
elab -> UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just (UnitId -> Maybe UnitId) -> UnitId -> Maybe UnitId
forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
elab
          InstallPlan.Configured ElaboratedConfiguredPackage
elab
            | ElaboratedConfiguredPackage -> Bool
shouldCoverPkg ElaboratedConfiguredPackage
elab -> UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just (UnitId -> Maybe UnitId) -> UnitId -> Maybe UnitId
forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
elab
          ElaboratedPlanPackage
_ -> Maybe UnitId
forall a. Maybe a
Nothing
      )
    ([ElaboratedPlanPackage] -> [UnitId])
-> [ElaboratedPlanPackage] -> [UnitId]
forall a b. (a -> b) -> a -> b
$ Graph ElaboratedPlanPackage -> [ElaboratedPlanPackage]
forall a. Graph a -> [a]
Graph.toList
    (Graph ElaboratedPlanPackage -> [ElaboratedPlanPackage])
-> Graph ElaboratedPlanPackage -> [ElaboratedPlanPackage]
forall a b. (a -> b) -> a -> b
$ ElaboratedInstallPlan -> Graph ElaboratedPlanPackage
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> Graph (GenericPlanPackage ipkg srcpkg)
InstallPlan.toGraph ElaboratedInstallPlan
plan
  where
    libDeps :: [(ConfiguredId, Bool)]
libDeps = ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)]
elabLibDependencies ElaboratedConfiguredPackage
configuredPkg
    shouldCoverPkg :: ElaboratedConfiguredPackage -> Bool
shouldCoverPkg elab :: ElaboratedConfiguredPackage
elab@ElaboratedConfiguredPackage{ModuleShape
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabModuleShape :: ModuleShape
elabModuleShape, elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageId
elabPkgSourceId = PackageId
pkgSID, Bool
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabLocalToProject :: Bool
elabLocalToProject} =
      Bool
elabLocalToProject
        Bool -> Bool -> Bool
&& Bool -> Bool
not (ModuleShape -> Bool
isIndefiniteOrInstantiation ModuleShape
elabModuleShape)
        -- TODO(#9493): We can only cover libraries in the same package
        -- as the testsuite
        Bool -> Bool -> Bool
&& ElaboratedConfiguredPackage -> PackageId
elabPkgSourceId ElaboratedConfiguredPackage
configuredPkg PackageId -> PackageId -> Bool
forall a. Eq a => a -> a -> Bool
== PackageId
pkgSID
        -- Libraries only! We don't cover testsuite modules, so we never need
        -- the paths to their mix dirs. Furthermore, we do not install testsuites...
        Bool -> Bool -> Bool
&& Bool -> (ComponentName -> Bool) -> Maybe ComponentName -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\case CLibName{} -> Bool
True; CNotLibName{} -> Bool
False) (ElaboratedConfiguredPackage -> Maybe ComponentName
elabComponentName ElaboratedConfiguredPackage
elab)
        -- We only want coverage for libraries which are dependencies of the given one
        Bool -> Bool -> Bool
&& PackageId
pkgSID PackageId -> [PackageId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((ConfiguredId, Bool) -> PackageId)
-> [(ConfiguredId, Bool)] -> [PackageId]
forall a b. (a -> b) -> [a] -> [b]
map (ConfiguredId -> PackageId
confSrcId (ConfiguredId -> PackageId)
-> ((ConfiguredId, Bool) -> ConfiguredId)
-> (ConfiguredId, Bool)
-> PackageId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfiguredId, Bool) -> ConfiguredId
forall a b. (a, b) -> a
fst) [(ConfiguredId, Bool)]
libDeps

    isIndefiniteOrInstantiation :: ModuleShape -> Bool
    isIndefiniteOrInstantiation :: ModuleShape -> Bool
isIndefiniteOrInstantiation = Bool -> Bool
not (Bool -> Bool) -> (ModuleShape -> Bool) -> ModuleShape -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ModuleName -> Bool
forall a. Set a -> Bool
Set.null (Set ModuleName -> Bool)
-> (ModuleShape -> Set ModuleName) -> ModuleShape -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleShape -> Set ModuleName
modShapeRequires