{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
module Distribution.Client.ProjectOrchestration (
CurrentCommand(..),
establishProjectBaseContext,
establishProjectBaseContextWithRoot,
ProjectBaseContext(..),
BuildTimeSettings(..),
commandLineFlagsToProjectConfig,
withInstallPlan,
runProjectPreBuildPhase,
ProjectBuildContext(..),
readTargetSelectors,
reportTargetSelectorProblems,
resolveTargets,
TargetsMap,
allTargetSelectors,
uniqueTargetSelectors,
TargetSelector(..),
TargetImplicitCwd(..),
PackageId,
AvailableTarget(..),
AvailableTargetStatus(..),
TargetRequested(..),
ComponentName(..),
ComponentKind(..),
ComponentTarget(..),
SubComponentTarget(..),
selectComponentTargetBasic,
distinctTargetComponents,
filterTargetsKind,
filterTargetsKindWith,
selectBuildableTargets,
selectBuildableTargetsWith,
selectBuildableTargets',
selectBuildableTargetsWith',
forgetTargetsDetail,
pruneInstallPlanToTargets,
TargetAction(..),
pruneInstallPlanToDependencies,
CannotPruneDependencies(..),
printPlan,
runProjectBuildPhase,
runProjectPostBuildPhase,
dieOnBuildFailures,
establishDummyProjectBaseContext,
establishDummyDistDirLayout,
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Compat.Directory
( makeAbsolute )
import Distribution.Client.ProjectConfig
import Distribution.Client.ProjectPlanning
hiding ( pruneInstallPlanToTargets )
import qualified Distribution.Client.ProjectPlanning as ProjectPlanning
( pruneInstallPlanToTargets )
import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.ProjectBuilding
import Distribution.Client.ProjectPlanOutput
import Distribution.Client.TargetProblem
( TargetProblem (..) )
import Distribution.Client.Types
( GenericReadyPackage(..), UnresolvedSourcePackage
, PackageSpecifier(..)
, SourcePackageDb(..)
, WriteGhcEnvironmentFilesPolicy(..)
, PackageLocation(..)
, DocsResult(..)
, TestsResult(..) )
import Distribution.Solver.Types.PackageIndex
( lookupPackageName )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.TargetSelector
( TargetSelector(..), TargetImplicitCwd(..)
, ComponentKind(..), componentKind
, readTargetSelectors, reportTargetSelectorProblems )
import Distribution.Client.DistDirLayout
import Distribution.Client.BuildReports.Anonymous (cabalInstallID)
import qualified Distribution.Client.BuildReports.Anonymous as BuildReports
import qualified Distribution.Client.BuildReports.Storage as BuildReports
( storeLocal )
import Distribution.Client.Config (getCabalDir)
import Distribution.Client.HttpUtils
import Distribution.Client.Setup hiding (packageName)
import Distribution.Compiler
( CompilerFlavor(GHC) )
import Distribution.Types.ComponentName
( componentNameString )
import Distribution.Types.InstalledPackageInfo
( InstalledPackageInfo )
import Distribution.Types.UnqualComponentName
( UnqualComponentName, packageNameToUnqualComponentName )
import Distribution.Solver.Types.OptionalStanza
import Distribution.Package
import Distribution.Types.Flag
( FlagAssignment, showFlagAssignment, diffFlagAssignment )
import Distribution.Simple.LocalBuildInfo
( ComponentName(..), pkgComponents )
import Distribution.Simple.Flag
( fromFlagOrDefault, flagToMaybe )
import qualified Distribution.Simple.Setup as Setup
import Distribution.Simple.Command (commandShowOptions)
import Distribution.Simple.Configure (computeEffectiveProfiling)
import Distribution.Simple.Utils
( die', warn, notice, noticeNoWrap, debugNoWrap, createDirectoryIfMissingVerbose, ordNub )
import Distribution.Verbosity
import Distribution.Version
( mkVersion )
import Distribution.Simple.Compiler
( compilerCompatVersion, showCompilerId, compilerId, compilerInfo
, OptimisationLevel(..))
import Distribution.Utils.NubList
( fromNubList )
import Distribution.System
( Platform(Platform) )
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as Set
import qualified Data.Map as Map
import Control.Exception ( assert )
#ifdef MIN_VERSION_unix
import System.Posix.Signals (sigKILL, sigSEGV)
#endif
data CurrentCommand = InstallCommand | HaddockCommand | OtherCommand
deriving (Int -> CurrentCommand -> ShowS
[CurrentCommand] -> ShowS
CurrentCommand -> String
(Int -> CurrentCommand -> ShowS)
-> (CurrentCommand -> String)
-> ([CurrentCommand] -> ShowS)
-> Show CurrentCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrentCommand] -> ShowS
$cshowList :: [CurrentCommand] -> ShowS
show :: CurrentCommand -> String
$cshow :: CurrentCommand -> String
showsPrec :: Int -> CurrentCommand -> ShowS
$cshowsPrec :: Int -> CurrentCommand -> ShowS
Show, CurrentCommand -> CurrentCommand -> Bool
(CurrentCommand -> CurrentCommand -> Bool)
-> (CurrentCommand -> CurrentCommand -> Bool) -> Eq CurrentCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrentCommand -> CurrentCommand -> Bool
$c/= :: CurrentCommand -> CurrentCommand -> Bool
== :: CurrentCommand -> CurrentCommand -> Bool
$c== :: CurrentCommand -> CurrentCommand -> Bool
Eq)
data ProjectBaseContext = ProjectBaseContext {
ProjectBaseContext -> DistDirLayout
distDirLayout :: DistDirLayout,
ProjectBaseContext -> CabalDirLayout
cabalDirLayout :: CabalDirLayout,
ProjectBaseContext -> ProjectConfig
projectConfig :: ProjectConfig,
ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages :: [PackageSpecifier UnresolvedSourcePackage],
ProjectBaseContext -> BuildTimeSettings
buildSettings :: BuildTimeSettings,
ProjectBaseContext -> CurrentCommand
currentCommand :: CurrentCommand
}
establishProjectBaseContext
:: Verbosity
-> ProjectConfig
-> CurrentCommand
-> IO ProjectBaseContext
establishProjectBaseContext :: Verbosity
-> ProjectConfig -> CurrentCommand -> IO ProjectBaseContext
establishProjectBaseContext Verbosity
verbosity ProjectConfig
cliConfig CurrentCommand
currentCommand = do
ProjectRoot
projectRoot <- (BadProjectRoot -> IO ProjectRoot)
-> (ProjectRoot -> IO ProjectRoot)
-> Either BadProjectRoot ProjectRoot
-> IO ProjectRoot
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either BadProjectRoot -> IO ProjectRoot
forall e a. Exception e => e -> IO a
throwIO ProjectRoot -> IO ProjectRoot
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BadProjectRoot ProjectRoot -> IO ProjectRoot)
-> IO (Either BadProjectRoot ProjectRoot) -> IO ProjectRoot
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe String
-> Maybe String -> IO (Either BadProjectRoot ProjectRoot)
findProjectRoot Maybe String
forall a. Maybe a
Nothing Maybe String
mprojectFile
Verbosity
-> ProjectConfig
-> ProjectRoot
-> CurrentCommand
-> IO ProjectBaseContext
establishProjectBaseContextWithRoot Verbosity
verbosity ProjectConfig
cliConfig ProjectRoot
projectRoot CurrentCommand
currentCommand
where
mprojectFile :: Maybe String
mprojectFile = Flag String -> Maybe String
forall a. Flag a -> Maybe a
Setup.flagToMaybe Flag String
projectConfigProjectFile
ProjectConfigShared { Flag String
projectConfigProjectFile :: ProjectConfigShared -> Flag String
projectConfigProjectFile :: Flag String
projectConfigProjectFile} = ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig
establishProjectBaseContextWithRoot
:: Verbosity
-> ProjectConfig
-> ProjectRoot
-> CurrentCommand
-> IO ProjectBaseContext
establishProjectBaseContextWithRoot :: Verbosity
-> ProjectConfig
-> ProjectRoot
-> CurrentCommand
-> IO ProjectBaseContext
establishProjectBaseContextWithRoot Verbosity
verbosity ProjectConfig
cliConfig ProjectRoot
projectRoot CurrentCommand
currentCommand = do
String
cabalDir <- IO String
getCabalDir
let distDirLayout :: DistDirLayout
distDirLayout = ProjectRoot -> Maybe String -> DistDirLayout
defaultDistDirLayout ProjectRoot
projectRoot Maybe String
mdistDirectory
HttpTransport
httpTransport <- Verbosity -> [String] -> Maybe String -> IO HttpTransport
configureTransport Verbosity
verbosity
(NubList String -> [String]
forall a. NubList a -> [a]
fromNubList (NubList String -> [String])
-> (ProjectConfigShared -> NubList String)
-> ProjectConfigShared
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfigShared -> NubList String
projectConfigProgPathExtra (ProjectConfigShared -> [String])
-> ProjectConfigShared -> [String]
forall a b. (a -> b) -> a -> b
$ ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig)
(Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe (Flag String -> Maybe String)
-> (ProjectConfigBuildOnly -> Flag String)
-> ProjectConfigBuildOnly
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfigBuildOnly -> Flag String
projectConfigHttpTransport (ProjectConfigBuildOnly -> Maybe String)
-> ProjectConfigBuildOnly -> Maybe String
forall a b. (a -> b) -> a -> b
$ ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly ProjectConfig
cliConfig)
(ProjectConfig
projectConfig, [PackageSpecifier UnresolvedSourcePackage]
localPackages) <-
Verbosity
-> HttpTransport
-> DistDirLayout
-> ProjectConfig
-> IO (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
rebuildProjectConfig Verbosity
verbosity
HttpTransport
httpTransport
DistDirLayout
distDirLayout
ProjectConfig
cliConfig
let ProjectConfigBuildOnly {
Flag String
projectConfigLogsDir :: ProjectConfigBuildOnly -> Flag String
projectConfigLogsDir :: Flag String
projectConfigLogsDir
} = ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly ProjectConfig
projectConfig
ProjectConfigShared {
Flag String
projectConfigStoreDir :: ProjectConfigShared -> Flag String
projectConfigStoreDir :: Flag String
projectConfigStoreDir
} = ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
projectConfig
mlogsDir :: Maybe String
mlogsDir = Flag String -> Maybe String
forall a. Flag a -> Maybe a
Setup.flagToMaybe Flag String
projectConfigLogsDir
Maybe String
mstoreDir <- Maybe (IO String) -> IO (Maybe String)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Maybe (IO String) -> IO (Maybe String))
-> Maybe (IO String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO String
makeAbsolute
(String -> IO String) -> Maybe String -> Maybe (IO String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Flag String -> Maybe String
forall a. Flag a -> Maybe a
Setup.flagToMaybe Flag String
projectConfigStoreDir
let cabalDirLayout :: CabalDirLayout
cabalDirLayout = String -> Maybe String -> Maybe String -> CabalDirLayout
mkCabalDirLayout String
cabalDir Maybe String
mstoreDir Maybe String
mlogsDir
buildSettings :: BuildTimeSettings
buildSettings = Verbosity -> CabalDirLayout -> ProjectConfig -> BuildTimeSettings
resolveBuildTimeSettings
Verbosity
verbosity CabalDirLayout
cabalDirLayout
ProjectConfig
projectConfig
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ProjectConfig -> [String]
projectPackages ProjectConfig
projectConfig) Bool -> Bool -> Bool
&& [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ProjectConfig -> [String]
projectPackagesOptional ProjectConfig
projectConfig)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
warn Verbosity
verbosity String
"There are no packages or optional-packages in the project"
ProjectBaseContext -> IO ProjectBaseContext
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext :: DistDirLayout
-> CabalDirLayout
-> ProjectConfig
-> [PackageSpecifier UnresolvedSourcePackage]
-> BuildTimeSettings
-> CurrentCommand
-> ProjectBaseContext
ProjectBaseContext {
DistDirLayout
distDirLayout :: DistDirLayout
distDirLayout :: DistDirLayout
distDirLayout,
CabalDirLayout
cabalDirLayout :: CabalDirLayout
cabalDirLayout :: CabalDirLayout
cabalDirLayout,
ProjectConfig
projectConfig :: ProjectConfig
projectConfig :: ProjectConfig
projectConfig,
[PackageSpecifier UnresolvedSourcePackage]
localPackages :: [PackageSpecifier UnresolvedSourcePackage]
localPackages :: [PackageSpecifier UnresolvedSourcePackage]
localPackages,
BuildTimeSettings
buildSettings :: BuildTimeSettings
buildSettings :: BuildTimeSettings
buildSettings,
CurrentCommand
currentCommand :: CurrentCommand
currentCommand :: CurrentCommand
currentCommand
}
where
mdistDirectory :: Maybe String
mdistDirectory = Flag String -> Maybe String
forall a. Flag a -> Maybe a
Setup.flagToMaybe Flag String
projectConfigDistDir
ProjectConfigShared { Flag String
projectConfigDistDir :: ProjectConfigShared -> Flag String
projectConfigDistDir :: Flag String
projectConfigDistDir } = ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig
data ProjectBuildContext = ProjectBuildContext {
ProjectBuildContext -> ElaboratedInstallPlan
elaboratedPlanOriginal :: ElaboratedInstallPlan,
ProjectBuildContext -> ElaboratedInstallPlan
elaboratedPlanToExecute:: ElaboratedInstallPlan,
ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared :: ElaboratedSharedConfig,
ProjectBuildContext -> BuildStatusMap
pkgsBuildStatus :: BuildStatusMap,
ProjectBuildContext -> TargetsMap
targetsMap :: TargetsMap
}
withInstallPlan
:: Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO a)
-> IO a
withInstallPlan :: Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO a)
-> IO a
withInstallPlan
Verbosity
verbosity
ProjectBaseContext {
DistDirLayout
distDirLayout :: DistDirLayout
distDirLayout :: ProjectBaseContext -> DistDirLayout
distDirLayout,
CabalDirLayout
cabalDirLayout :: CabalDirLayout
cabalDirLayout :: ProjectBaseContext -> CabalDirLayout
cabalDirLayout,
ProjectConfig
projectConfig :: ProjectConfig
projectConfig :: ProjectBaseContext -> ProjectConfig
projectConfig,
[PackageSpecifier UnresolvedSourcePackage]
localPackages :: [PackageSpecifier UnresolvedSourcePackage]
localPackages :: ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages
}
ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO a
action = do
(ElaboratedInstallPlan
elaboratedPlan, ElaboratedInstallPlan
_, ElaboratedSharedConfig
elaboratedShared, TotalIndexState
_, ActiveRepos
_) <-
Verbosity
-> DistDirLayout
-> CabalDirLayout
-> ProjectConfig
-> [PackageSpecifier UnresolvedSourcePackage]
-> IO
(ElaboratedInstallPlan, ElaboratedInstallPlan,
ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
rebuildInstallPlan Verbosity
verbosity
DistDirLayout
distDirLayout CabalDirLayout
cabalDirLayout
ProjectConfig
projectConfig
[PackageSpecifier UnresolvedSourcePackage]
localPackages
ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO a
action ElaboratedInstallPlan
elaboratedPlan ElaboratedSharedConfig
elaboratedShared
runProjectPreBuildPhase
:: Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan -> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext
runProjectPreBuildPhase :: Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan
-> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext
runProjectPreBuildPhase
Verbosity
verbosity
ProjectBaseContext {
DistDirLayout
distDirLayout :: DistDirLayout
distDirLayout :: ProjectBaseContext -> DistDirLayout
distDirLayout,
CabalDirLayout
cabalDirLayout :: CabalDirLayout
cabalDirLayout :: ProjectBaseContext -> CabalDirLayout
cabalDirLayout,
ProjectConfig
projectConfig :: ProjectConfig
projectConfig :: ProjectBaseContext -> ProjectConfig
projectConfig,
[PackageSpecifier UnresolvedSourcePackage]
localPackages :: [PackageSpecifier UnresolvedSourcePackage]
localPackages :: ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages
}
ElaboratedInstallPlan -> IO (ElaboratedInstallPlan, TargetsMap)
selectPlanSubset = do
(ElaboratedInstallPlan
elaboratedPlan, ElaboratedInstallPlan
_, ElaboratedSharedConfig
elaboratedShared, TotalIndexState
_, ActiveRepos
_) <-
Verbosity
-> DistDirLayout
-> CabalDirLayout
-> ProjectConfig
-> [PackageSpecifier UnresolvedSourcePackage]
-> IO
(ElaboratedInstallPlan, ElaboratedInstallPlan,
ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
rebuildInstallPlan Verbosity
verbosity
DistDirLayout
distDirLayout CabalDirLayout
cabalDirLayout
ProjectConfig
projectConfig
[PackageSpecifier UnresolvedSourcePackage]
localPackages
(ElaboratedInstallPlan
elaboratedPlan', TargetsMap
targets) <- ElaboratedInstallPlan -> IO (ElaboratedInstallPlan, TargetsMap)
selectPlanSubset ElaboratedInstallPlan
elaboratedPlan
BuildStatusMap
pkgsBuildStatus <- DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> IO BuildStatusMap
rebuildTargetsDryRun DistDirLayout
distDirLayout ElaboratedSharedConfig
elaboratedShared
ElaboratedInstallPlan
elaboratedPlan'
let elaboratedPlan'' :: ElaboratedInstallPlan
elaboratedPlan'' = BuildStatusMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
improveInstallPlanWithUpToDatePackages
BuildStatusMap
pkgsBuildStatus ElaboratedInstallPlan
elaboratedPlan'
Verbosity -> String -> IO ()
debugNoWrap Verbosity
verbosity (ElaboratedInstallPlan -> String
forall ipkg srcpkg.
(Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg -> String
InstallPlan.showInstallPlan ElaboratedInstallPlan
elaboratedPlan'')
ProjectBuildContext -> IO ProjectBuildContext
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBuildContext :: ElaboratedInstallPlan
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> BuildStatusMap
-> TargetsMap
-> ProjectBuildContext
ProjectBuildContext {
elaboratedPlanOriginal :: ElaboratedInstallPlan
elaboratedPlanOriginal = ElaboratedInstallPlan
elaboratedPlan,
elaboratedPlanToExecute :: ElaboratedInstallPlan
elaboratedPlanToExecute = ElaboratedInstallPlan
elaboratedPlan'',
ElaboratedSharedConfig
elaboratedShared :: ElaboratedSharedConfig
elaboratedShared :: ElaboratedSharedConfig
elaboratedShared,
BuildStatusMap
pkgsBuildStatus :: BuildStatusMap
pkgsBuildStatus :: BuildStatusMap
pkgsBuildStatus,
targetsMap :: TargetsMap
targetsMap = TargetsMap
targets
}
runProjectBuildPhase :: Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> IO BuildOutcomes
runProjectBuildPhase :: Verbosity
-> ProjectBaseContext -> ProjectBuildContext -> IO BuildOutcomes
runProjectBuildPhase Verbosity
_ ProjectBaseContext{BuildTimeSettings
buildSettings :: BuildTimeSettings
buildSettings :: ProjectBaseContext -> BuildTimeSettings
buildSettings} ProjectBuildContext
_
| BuildTimeSettings -> Bool
buildSettingDryRun BuildTimeSettings
buildSettings
= BuildOutcomes -> IO BuildOutcomes
forall (m :: * -> *) a. Monad m => a -> m a
return BuildOutcomes
forall k a. Map k a
Map.empty
runProjectBuildPhase Verbosity
verbosity
ProjectBaseContext{[PackageSpecifier UnresolvedSourcePackage]
CabalDirLayout
DistDirLayout
BuildTimeSettings
ProjectConfig
CurrentCommand
currentCommand :: CurrentCommand
buildSettings :: BuildTimeSettings
localPackages :: [PackageSpecifier UnresolvedSourcePackage]
projectConfig :: ProjectConfig
cabalDirLayout :: CabalDirLayout
distDirLayout :: DistDirLayout
currentCommand :: ProjectBaseContext -> CurrentCommand
buildSettings :: ProjectBaseContext -> BuildTimeSettings
localPackages :: ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
projectConfig :: ProjectBaseContext -> ProjectConfig
cabalDirLayout :: ProjectBaseContext -> CabalDirLayout
distDirLayout :: ProjectBaseContext -> DistDirLayout
..} ProjectBuildContext {TargetsMap
BuildStatusMap
ElaboratedInstallPlan
ElaboratedSharedConfig
targetsMap :: TargetsMap
pkgsBuildStatus :: BuildStatusMap
elaboratedShared :: ElaboratedSharedConfig
elaboratedPlanToExecute :: ElaboratedInstallPlan
elaboratedPlanOriginal :: ElaboratedInstallPlan
targetsMap :: ProjectBuildContext -> TargetsMap
pkgsBuildStatus :: ProjectBuildContext -> BuildStatusMap
elaboratedShared :: ProjectBuildContext -> ElaboratedSharedConfig
elaboratedPlanToExecute :: ProjectBuildContext -> ElaboratedInstallPlan
elaboratedPlanOriginal :: ProjectBuildContext -> ElaboratedInstallPlan
..} =
(BuildOutcomes -> BuildOutcomes)
-> IO BuildOutcomes -> IO BuildOutcomes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BuildOutcomes -> BuildOutcomes -> BuildOutcomes
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (BuildStatusMap -> BuildOutcomes
previousBuildOutcomes BuildStatusMap
pkgsBuildStatus)) (IO BuildOutcomes -> IO BuildOutcomes)
-> IO BuildOutcomes -> IO BuildOutcomes
forall a b. (a -> b) -> a -> b
$
Verbosity
-> DistDirLayout
-> StoreDirLayout
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> BuildStatusMap
-> BuildTimeSettings
-> IO BuildOutcomes
rebuildTargets Verbosity
verbosity
DistDirLayout
distDirLayout
(CabalDirLayout -> StoreDirLayout
cabalStoreDirLayout CabalDirLayout
cabalDirLayout)
ElaboratedInstallPlan
elaboratedPlanToExecute
ElaboratedSharedConfig
elaboratedShared
BuildStatusMap
pkgsBuildStatus
BuildTimeSettings
buildSettings
where
previousBuildOutcomes :: BuildStatusMap -> BuildOutcomes
previousBuildOutcomes :: BuildStatusMap -> BuildOutcomes
previousBuildOutcomes =
(BuildStatus -> Maybe (Either BuildFailure BuildResult))
-> BuildStatusMap -> BuildOutcomes
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe ((BuildStatus -> Maybe (Either BuildFailure BuildResult))
-> BuildStatusMap -> BuildOutcomes)
-> (BuildStatus -> Maybe (Either BuildFailure BuildResult))
-> BuildStatusMap
-> BuildOutcomes
forall a b. (a -> b) -> a -> b
$ \BuildStatus
status -> case BuildStatus
status of
BuildStatusUpToDate BuildResult
buildSuccess -> Either BuildFailure BuildResult
-> Maybe (Either BuildFailure BuildResult)
forall a. a -> Maybe a
Just (BuildResult -> Either BuildFailure BuildResult
forall a b. b -> Either a b
Right BuildResult
buildSuccess)
BuildStatus
_ -> Maybe (Either BuildFailure BuildResult)
forall a. Maybe a
Nothing
runProjectPostBuildPhase :: Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> BuildOutcomes
-> IO ()
runProjectPostBuildPhase :: Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> BuildOutcomes
-> IO ()
runProjectPostBuildPhase Verbosity
_ ProjectBaseContext{BuildTimeSettings
buildSettings :: BuildTimeSettings
buildSettings :: ProjectBaseContext -> BuildTimeSettings
buildSettings} ProjectBuildContext
_ BuildOutcomes
_
| BuildTimeSettings -> Bool
buildSettingDryRun BuildTimeSettings
buildSettings
= () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runProjectPostBuildPhase Verbosity
verbosity
ProjectBaseContext {[PackageSpecifier UnresolvedSourcePackage]
CabalDirLayout
DistDirLayout
BuildTimeSettings
ProjectConfig
CurrentCommand
currentCommand :: CurrentCommand
buildSettings :: BuildTimeSettings
localPackages :: [PackageSpecifier UnresolvedSourcePackage]
projectConfig :: ProjectConfig
cabalDirLayout :: CabalDirLayout
distDirLayout :: DistDirLayout
currentCommand :: ProjectBaseContext -> CurrentCommand
buildSettings :: ProjectBaseContext -> BuildTimeSettings
localPackages :: ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
projectConfig :: ProjectBaseContext -> ProjectConfig
cabalDirLayout :: ProjectBaseContext -> CabalDirLayout
distDirLayout :: ProjectBaseContext -> DistDirLayout
..} bc :: ProjectBuildContext
bc@ProjectBuildContext {TargetsMap
BuildStatusMap
ElaboratedInstallPlan
ElaboratedSharedConfig
targetsMap :: TargetsMap
pkgsBuildStatus :: BuildStatusMap
elaboratedShared :: ElaboratedSharedConfig
elaboratedPlanToExecute :: ElaboratedInstallPlan
elaboratedPlanOriginal :: ElaboratedInstallPlan
targetsMap :: ProjectBuildContext -> TargetsMap
pkgsBuildStatus :: ProjectBuildContext -> BuildStatusMap
elaboratedShared :: ProjectBuildContext -> ElaboratedSharedConfig
elaboratedPlanToExecute :: ProjectBuildContext -> ElaboratedInstallPlan
elaboratedPlanOriginal :: ProjectBuildContext -> ElaboratedInstallPlan
..}
BuildOutcomes
buildOutcomes = do
PostBuildProjectStatus
postBuildStatus <- Verbosity
-> DistDirLayout
-> ElaboratedInstallPlan
-> BuildStatusMap
-> BuildOutcomes
-> IO PostBuildProjectStatus
updatePostBuildProjectStatus
Verbosity
verbosity
DistDirLayout
distDirLayout
ElaboratedInstallPlan
elaboratedPlanOriginal
BuildStatusMap
pkgsBuildStatus
BuildOutcomes
buildOutcomes
let writeGhcEnvFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy
writeGhcEnvFilesPolicy =
ProjectConfigShared -> Flag WriteGhcEnvironmentFilesPolicy
projectConfigWriteGhcEnvironmentFilesPolicy (ProjectConfigShared -> Flag WriteGhcEnvironmentFilesPolicy)
-> (ProjectConfig -> ProjectConfigShared)
-> ProjectConfig
-> Flag WriteGhcEnvironmentFilesPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfig -> ProjectConfigShared
projectConfigShared
(ProjectConfig -> Flag WriteGhcEnvironmentFilesPolicy)
-> ProjectConfig -> Flag WriteGhcEnvironmentFilesPolicy
forall a b. (a -> b) -> a -> b
$ ProjectConfig
projectConfig
shouldWriteGhcEnvironment :: Bool
shouldWriteGhcEnvironment :: Bool
shouldWriteGhcEnvironment =
case WriteGhcEnvironmentFilesPolicy
-> Flag WriteGhcEnvironmentFilesPolicy
-> WriteGhcEnvironmentFilesPolicy
forall a. a -> Flag a -> a
fromFlagOrDefault WriteGhcEnvironmentFilesPolicy
NeverWriteGhcEnvironmentFiles
Flag WriteGhcEnvironmentFilesPolicy
writeGhcEnvFilesPolicy
of
WriteGhcEnvironmentFilesPolicy
AlwaysWriteGhcEnvironmentFiles -> Bool
True
WriteGhcEnvironmentFilesPolicy
NeverWriteGhcEnvironmentFiles -> Bool
False
WriteGhcEnvironmentFilesPolicy
WriteGhcEnvironmentFilesOnlyForGhc844AndNewer ->
let compiler :: Compiler
compiler = ElaboratedSharedConfig -> Compiler
pkgConfigCompiler ElaboratedSharedConfig
elaboratedShared
ghcCompatVersion :: Maybe Version
ghcCompatVersion = CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
compiler
in Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
4,Int
4]) Maybe Version
ghcCompatVersion
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldWriteGhcEnvironment (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO (Maybe String) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe String) -> IO ()) -> IO (Maybe String) -> IO ()
forall a b. (a -> b) -> a -> b
$ String
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> PostBuildProjectStatus
-> IO (Maybe String)
writePlanGhcEnvironment (DistDirLayout -> String
distProjectRootDirectory DistDirLayout
distDirLayout)
ElaboratedInstallPlan
elaboratedPlanOriginal
ElaboratedSharedConfig
elaboratedShared
PostBuildProjectStatus
postBuildStatus
BuildTimeSettings
-> ProjectBuildContext
-> ElaboratedInstallPlan
-> BuildOutcomes
-> IO ()
writeBuildReports BuildTimeSettings
buildSettings ProjectBuildContext
bc ElaboratedInstallPlan
elaboratedPlanToExecute BuildOutcomes
buildOutcomes
Verbosity
-> CurrentCommand
-> ElaboratedInstallPlan
-> BuildOutcomes
-> IO ()
dieOnBuildFailures Verbosity
verbosity CurrentCommand
currentCommand ElaboratedInstallPlan
elaboratedPlanToExecute BuildOutcomes
buildOutcomes
type TargetsMap = Map UnitId [(ComponentTarget, NonEmpty TargetSelector)]
allTargetSelectors :: TargetsMap -> [TargetSelector]
allTargetSelectors :: TargetsMap -> [TargetSelector]
allTargetSelectors = ((ComponentTarget, NonEmpty TargetSelector) -> [TargetSelector])
-> [(ComponentTarget, NonEmpty TargetSelector)] -> [TargetSelector]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NonEmpty TargetSelector -> [TargetSelector]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty TargetSelector -> [TargetSelector])
-> ((ComponentTarget, NonEmpty TargetSelector)
-> NonEmpty TargetSelector)
-> (ComponentTarget, NonEmpty TargetSelector)
-> [TargetSelector]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ComponentTarget, NonEmpty TargetSelector)
-> NonEmpty TargetSelector
forall a b. (a, b) -> b
snd) ([(ComponentTarget, NonEmpty TargetSelector)] -> [TargetSelector])
-> (TargetsMap -> [(ComponentTarget, NonEmpty TargetSelector)])
-> TargetsMap
-> [TargetSelector]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(ComponentTarget, NonEmpty TargetSelector)]]
-> [(ComponentTarget, NonEmpty TargetSelector)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ComponentTarget, NonEmpty TargetSelector)]]
-> [(ComponentTarget, NonEmpty TargetSelector)])
-> (TargetsMap -> [[(ComponentTarget, NonEmpty TargetSelector)]])
-> TargetsMap
-> [(ComponentTarget, NonEmpty TargetSelector)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetsMap -> [[(ComponentTarget, NonEmpty TargetSelector)]]
forall k a. Map k a -> [a]
Map.elems
uniqueTargetSelectors :: TargetsMap -> [TargetSelector]
uniqueTargetSelectors :: TargetsMap -> [TargetSelector]
uniqueTargetSelectors = [TargetSelector] -> [TargetSelector]
forall a. Ord a => [a] -> [a]
ordNub ([TargetSelector] -> [TargetSelector])
-> (TargetsMap -> [TargetSelector])
-> TargetsMap
-> [TargetSelector]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetsMap -> [TargetSelector]
allTargetSelectors
resolveTargets :: forall err.
(forall k. TargetSelector
-> [AvailableTarget k]
-> Either (TargetProblem err) [k])
-> (forall k. SubComponentTarget
-> AvailableTarget k
-> Either (TargetProblem err) k )
-> ElaboratedInstallPlan
-> Maybe (SourcePackageDb)
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
resolveTargets :: (forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem err) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
resolveTargets forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k]
selectPackageTargets forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem err) k
selectComponentTarget
ElaboratedInstallPlan
installPlan Maybe SourcePackageDb
mPkgDb =
([(TargetSelector, [(UnitId, ComponentTarget)])] -> TargetsMap)
-> Either
[TargetProblem err] [(TargetSelector, [(UnitId, ComponentTarget)])]
-> Either [TargetProblem err] TargetsMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(TargetSelector, [(UnitId, ComponentTarget)])] -> TargetsMap
mkTargetsMap
(Either
[TargetProblem err] [(TargetSelector, [(UnitId, ComponentTarget)])]
-> Either [TargetProblem err] TargetsMap)
-> ([TargetSelector]
-> Either
[TargetProblem err]
[(TargetSelector, [(UnitId, ComponentTarget)])])
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (TargetProblem err)
-> Either
[TargetProblem err]
[(TargetSelector, [(UnitId, ComponentTarget)])])
-> ([(TargetSelector, [(UnitId, ComponentTarget)])]
-> Either
[TargetProblem err]
[(TargetSelector, [(UnitId, ComponentTarget)])])
-> Either
(NonEmpty (TargetProblem err))
[(TargetSelector, [(UnitId, ComponentTarget)])]
-> Either
[TargetProblem err] [(TargetSelector, [(UnitId, ComponentTarget)])]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([TargetProblem err]
-> Either
[TargetProblem err] [(TargetSelector, [(UnitId, ComponentTarget)])]
forall a b. a -> Either a b
Left ([TargetProblem err]
-> Either
[TargetProblem err]
[(TargetSelector, [(UnitId, ComponentTarget)])])
-> (NonEmpty (TargetProblem err) -> [TargetProblem err])
-> NonEmpty (TargetProblem err)
-> Either
[TargetProblem err] [(TargetSelector, [(UnitId, ComponentTarget)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (TargetProblem err) -> [TargetProblem err]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) [(TargetSelector, [(UnitId, ComponentTarget)])]
-> Either
[TargetProblem err] [(TargetSelector, [(UnitId, ComponentTarget)])]
forall a b. b -> Either a b
Right
(Either
(NonEmpty (TargetProblem err))
[(TargetSelector, [(UnitId, ComponentTarget)])]
-> Either
[TargetProblem err]
[(TargetSelector, [(UnitId, ComponentTarget)])])
-> ([TargetSelector]
-> Either
(NonEmpty (TargetProblem err))
[(TargetSelector, [(UnitId, ComponentTarget)])])
-> [TargetSelector]
-> Either
[TargetProblem err] [(TargetSelector, [(UnitId, ComponentTarget)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either
(TargetProblem err) (TargetSelector, [(UnitId, ComponentTarget)])]
-> Either
(NonEmpty (TargetProblem err))
[(TargetSelector, [(UnitId, ComponentTarget)])]
forall e a. [Either e a] -> Either (NonEmpty e) [a]
checkErrors
([Either
(TargetProblem err) (TargetSelector, [(UnitId, ComponentTarget)])]
-> Either
(NonEmpty (TargetProblem err))
[(TargetSelector, [(UnitId, ComponentTarget)])])
-> ([TargetSelector]
-> [Either
(TargetProblem err) (TargetSelector, [(UnitId, ComponentTarget)])])
-> [TargetSelector]
-> Either
(NonEmpty (TargetProblem err))
[(TargetSelector, [(UnitId, ComponentTarget)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TargetSelector
-> Either
(TargetProblem err) (TargetSelector, [(UnitId, ComponentTarget)]))
-> [TargetSelector]
-> [Either
(TargetProblem err) (TargetSelector, [(UnitId, ComponentTarget)])]
forall a b. (a -> b) -> [a] -> [b]
map (\TargetSelector
ts -> (,) TargetSelector
ts ([(UnitId, ComponentTarget)]
-> (TargetSelector, [(UnitId, ComponentTarget)]))
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
-> Either
(TargetProblem err) (TargetSelector, [(UnitId, ComponentTarget)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TargetSelector
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
checkTarget TargetSelector
ts)
where
mkTargetsMap :: [(TargetSelector, [(UnitId, ComponentTarget)])]
-> TargetsMap
mkTargetsMap :: [(TargetSelector, [(UnitId, ComponentTarget)])] -> TargetsMap
mkTargetsMap [(TargetSelector, [(UnitId, ComponentTarget)])]
targets =
([(ComponentTarget, TargetSelector)]
-> [(ComponentTarget, NonEmpty TargetSelector)])
-> Map UnitId [(ComponentTarget, TargetSelector)] -> TargetsMap
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [(ComponentTarget, TargetSelector)]
-> [(ComponentTarget, NonEmpty TargetSelector)]
forall a. [(ComponentTarget, a)] -> [(ComponentTarget, NonEmpty a)]
nubComponentTargets
(Map UnitId [(ComponentTarget, TargetSelector)] -> TargetsMap)
-> Map UnitId [(ComponentTarget, TargetSelector)] -> TargetsMap
forall a b. (a -> b) -> a -> b
$ ([(ComponentTarget, TargetSelector)]
-> [(ComponentTarget, TargetSelector)]
-> [(ComponentTarget, TargetSelector)])
-> [(UnitId, [(ComponentTarget, TargetSelector)])]
-> Map UnitId [(ComponentTarget, TargetSelector)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [(ComponentTarget, TargetSelector)]
-> [(ComponentTarget, TargetSelector)]
-> [(ComponentTarget, TargetSelector)]
forall a. Semigroup a => a -> a -> a
(<>)
[ (UnitId
uid, [(ComponentTarget
ct, TargetSelector
ts)])
| (TargetSelector
ts, [(UnitId, ComponentTarget)]
cts) <- [(TargetSelector, [(UnitId, ComponentTarget)])]
targets
, (UnitId
uid, ComponentTarget
ct) <- [(UnitId, ComponentTarget)]
cts ]
AvailableTargetIndexes{AvailableTargetsMap (PackageId, ComponentName)
AvailableTargetsMap (PackageName, ComponentName)
AvailableTargetsMap (PackageName, UnqualComponentName)
AvailableTargetsMap PackageId
AvailableTargetsMap PackageName
availableTargetsByPackageNameAndUnqualComponentName :: AvailableTargetIndexes
-> AvailableTargetsMap (PackageName, UnqualComponentName)
availableTargetsByPackageNameAndComponentName :: AvailableTargetIndexes
-> AvailableTargetsMap (PackageName, ComponentName)
availableTargetsByPackageName :: AvailableTargetIndexes -> AvailableTargetsMap PackageName
availableTargetsByPackageId :: AvailableTargetIndexes -> AvailableTargetsMap PackageId
availableTargetsByPackageIdAndComponentName :: AvailableTargetIndexes
-> AvailableTargetsMap (PackageId, ComponentName)
availableTargetsByPackageNameAndUnqualComponentName :: AvailableTargetsMap (PackageName, UnqualComponentName)
availableTargetsByPackageNameAndComponentName :: AvailableTargetsMap (PackageName, ComponentName)
availableTargetsByPackageName :: AvailableTargetsMap PackageName
availableTargetsByPackageId :: AvailableTargetsMap PackageId
availableTargetsByPackageIdAndComponentName :: AvailableTargetsMap (PackageId, ComponentName)
..} = ElaboratedInstallPlan -> AvailableTargetIndexes
availableTargetIndexes ElaboratedInstallPlan
installPlan
checkTarget :: TargetSelector -> Either (TargetProblem err) [(UnitId, ComponentTarget)]
checkTarget :: TargetSelector
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
checkTarget bt :: TargetSelector
bt@(TargetPackage TargetImplicitCwd
_ [PackageId
pkgid] Maybe ComponentKindFilter
mkfilter)
| Just [AvailableTarget (UnitId, ComponentName)]
ats <- ([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> Maybe [AvailableTarget (UnitId, ComponentName)]
-> Maybe [AvailableTarget (UnitId, ComponentName)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> (ComponentKindFilter
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> Maybe ComponentKindFilter
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall a. a -> a
id ComponentKindFilter
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind Maybe ComponentKindFilter
mkfilter)
(Maybe [AvailableTarget (UnitId, ComponentName)]
-> Maybe [AvailableTarget (UnitId, ComponentName)])
-> Maybe [AvailableTarget (UnitId, ComponentName)]
-> Maybe [AvailableTarget (UnitId, ComponentName)]
forall a b. (a -> b) -> a -> b
$ PackageId
-> AvailableTargetsMap PackageId
-> Maybe [AvailableTarget (UnitId, ComponentName)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageId
pkgid AvailableTargetsMap PackageId
availableTargetsByPackageId
= ([(UnitId, ComponentName)] -> [(UnitId, ComponentTarget)])
-> Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SubComponentTarget
-> [(UnitId, ComponentName)] -> [(UnitId, ComponentTarget)]
forall b.
SubComponentTarget
-> [(b, ComponentName)] -> [(b, ComponentTarget)]
componentTargets SubComponentTarget
WholeComponent)
(Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)])
-> Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. (a -> b) -> a -> b
$ TargetSelector
-> [AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentName)]
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k]
selectPackageTargets TargetSelector
bt [AvailableTarget (UnitId, ComponentName)]
ats
| Bool
otherwise
= TargetProblem err
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. a -> Either a b
Left (PackageId -> TargetProblem err
forall a. PackageId -> TargetProblem a
TargetProblemNoSuchPackage PackageId
pkgid)
checkTarget (TargetPackage TargetImplicitCwd
_ [PackageId]
pkgids Maybe ComponentKindFilter
_)
= String -> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a. HasCallStack => String -> a
error (String
"TODO: add support for multiple packages in a directory. Got\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((PackageId -> String) -> [PackageId] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PackageId -> String
forall a. Pretty a => a -> String
prettyShow [PackageId]
pkgids))
checkTarget bt :: TargetSelector
bt@(TargetAllPackages Maybe ComponentKindFilter
mkfilter) =
([(UnitId, ComponentName)] -> [(UnitId, ComponentTarget)])
-> Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SubComponentTarget
-> [(UnitId, ComponentName)] -> [(UnitId, ComponentTarget)]
forall b.
SubComponentTarget
-> [(b, ComponentName)] -> [(b, ComponentTarget)]
componentTargets SubComponentTarget
WholeComponent)
(Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)])
-> ([AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentName)])
-> [AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetSelector
-> [AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentName)]
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k]
selectPackageTargets TargetSelector
bt
([AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentName)])
-> ([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> [AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> (ComponentKindFilter
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> Maybe ComponentKindFilter
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall a. a -> a
id ComponentKindFilter
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind Maybe ComponentKindFilter
mkfilter
([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> ([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AvailableTarget (UnitId, ComponentName) -> Bool)
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall a. (a -> Bool) -> [a] -> [a]
filter AvailableTarget (UnitId, ComponentName) -> Bool
forall k. AvailableTarget k -> Bool
availableTargetLocalToProject
([AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)])
-> [AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. (a -> b) -> a -> b
$ [[AvailableTarget (UnitId, ComponentName)]]
-> [AvailableTarget (UnitId, ComponentName)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (AvailableTargetsMap PackageId
-> [[AvailableTarget (UnitId, ComponentName)]]
forall k a. Map k a -> [a]
Map.elems AvailableTargetsMap PackageId
availableTargetsByPackageId)
checkTarget (TargetComponent PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget)
| Just [AvailableTarget (UnitId, ComponentName)]
ats <- (PackageId, ComponentName)
-> AvailableTargetsMap (PackageId, ComponentName)
-> Maybe [AvailableTarget (UnitId, ComponentName)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageId
pkgid, ComponentName
cname)
AvailableTargetsMap (PackageId, ComponentName)
availableTargetsByPackageIdAndComponentName
= ([(UnitId, ComponentName)] -> [(UnitId, ComponentTarget)])
-> Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SubComponentTarget
-> [(UnitId, ComponentName)] -> [(UnitId, ComponentTarget)]
forall b.
SubComponentTarget
-> [(b, ComponentName)] -> [(b, ComponentTarget)]
componentTargets SubComponentTarget
subtarget)
(Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)])
-> Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. (a -> b) -> a -> b
$ SubComponentTarget
-> [AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentName)]
forall k.
SubComponentTarget
-> [AvailableTarget k] -> Either (TargetProblem err) [k]
selectComponentTargets SubComponentTarget
subtarget [AvailableTarget (UnitId, ComponentName)]
ats
| PackageId -> AvailableTargetsMap PackageId -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member PackageId
pkgid AvailableTargetsMap PackageId
availableTargetsByPackageId
= TargetProblem err
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. a -> Either a b
Left (PackageId -> ComponentName -> TargetProblem err
forall a. PackageId -> ComponentName -> TargetProblem a
TargetProblemNoSuchComponent PackageId
pkgid ComponentName
cname)
| Bool
otherwise
= TargetProblem err
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. a -> Either a b
Left (PackageId -> TargetProblem err
forall a. PackageId -> TargetProblem a
TargetProblemNoSuchPackage PackageId
pkgid)
checkTarget (TargetComponentUnknown PackageName
pkgname Either UnqualComponentName ComponentName
ecname SubComponentTarget
subtarget)
| Just [AvailableTarget (UnitId, ComponentName)]
ats <- case Either UnqualComponentName ComponentName
ecname of
Left UnqualComponentName
ucname ->
(PackageName, UnqualComponentName)
-> AvailableTargetsMap (PackageName, UnqualComponentName)
-> Maybe [AvailableTarget (UnitId, ComponentName)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
pkgname, UnqualComponentName
ucname)
AvailableTargetsMap (PackageName, UnqualComponentName)
availableTargetsByPackageNameAndUnqualComponentName
Right ComponentName
cname ->
(PackageName, ComponentName)
-> AvailableTargetsMap (PackageName, ComponentName)
-> Maybe [AvailableTarget (UnitId, ComponentName)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
pkgname, ComponentName
cname)
AvailableTargetsMap (PackageName, ComponentName)
availableTargetsByPackageNameAndComponentName
= ([(UnitId, ComponentName)] -> [(UnitId, ComponentTarget)])
-> Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SubComponentTarget
-> [(UnitId, ComponentName)] -> [(UnitId, ComponentTarget)]
forall b.
SubComponentTarget
-> [(b, ComponentName)] -> [(b, ComponentTarget)]
componentTargets SubComponentTarget
subtarget)
(Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)])
-> Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. (a -> b) -> a -> b
$ SubComponentTarget
-> [AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentName)]
forall k.
SubComponentTarget
-> [AvailableTarget k] -> Either (TargetProblem err) [k]
selectComponentTargets SubComponentTarget
subtarget [AvailableTarget (UnitId, ComponentName)]
ats
| PackageName -> AvailableTargetsMap PackageName -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member PackageName
pkgname AvailableTargetsMap PackageName
availableTargetsByPackageName
= TargetProblem err
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. a -> Either a b
Left (PackageName
-> Either UnqualComponentName ComponentName -> TargetProblem err
forall a.
PackageName
-> Either UnqualComponentName ComponentName -> TargetProblem a
TargetProblemUnknownComponent PackageName
pkgname Either UnqualComponentName ComponentName
ecname)
| Bool
otherwise
= TargetProblem err
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. a -> Either a b
Left (PackageName -> TargetProblem err
forall a. PackageName -> TargetProblem a
TargetNotInProject PackageName
pkgname)
checkTarget bt :: TargetSelector
bt@(TargetPackageNamed PackageName
pkgname Maybe ComponentKindFilter
mkfilter)
| Just [AvailableTarget (UnitId, ComponentName)]
ats <- ([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> Maybe [AvailableTarget (UnitId, ComponentName)]
-> Maybe [AvailableTarget (UnitId, ComponentName)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> (ComponentKindFilter
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> Maybe ComponentKindFilter
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall a. a -> a
id ComponentKindFilter
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind Maybe ComponentKindFilter
mkfilter)
(Maybe [AvailableTarget (UnitId, ComponentName)]
-> Maybe [AvailableTarget (UnitId, ComponentName)])
-> Maybe [AvailableTarget (UnitId, ComponentName)]
-> Maybe [AvailableTarget (UnitId, ComponentName)]
forall a b. (a -> b) -> a -> b
$ PackageName
-> AvailableTargetsMap PackageName
-> Maybe [AvailableTarget (UnitId, ComponentName)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pkgname AvailableTargetsMap PackageName
availableTargetsByPackageName
= ([(UnitId, ComponentName)] -> [(UnitId, ComponentTarget)])
-> Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SubComponentTarget
-> [(UnitId, ComponentName)] -> [(UnitId, ComponentTarget)]
forall b.
SubComponentTarget
-> [(b, ComponentName)] -> [(b, ComponentTarget)]
componentTargets SubComponentTarget
WholeComponent)
(Either (TargetProblem err) [(UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)])
-> ([AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentName)])
-> [AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetSelector
-> [AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentName)]
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k]
selectPackageTargets TargetSelector
bt
([AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)])
-> [AvailableTarget (UnitId, ComponentName)]
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. (a -> b) -> a -> b
$ [AvailableTarget (UnitId, ComponentName)]
ats
| Just SourcePackageDb{ PackageIndex UnresolvedSourcePackage
packageIndex :: SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex :: PackageIndex UnresolvedSourcePackage
packageIndex } <- Maybe SourcePackageDb
mPkgDb
, let pkg :: [UnresolvedSourcePackage]
pkg = PackageIndex UnresolvedSourcePackage
-> PackageName -> [UnresolvedSourcePackage]
forall pkg. Package pkg => PackageIndex pkg -> PackageName -> [pkg]
lookupPackageName PackageIndex UnresolvedSourcePackage
packageIndex PackageName
pkgname
, Bool -> Bool
not ([UnresolvedSourcePackage] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnresolvedSourcePackage]
pkg)
= TargetProblem err
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. a -> Either a b
Left (PackageName -> TargetProblem err
forall a. PackageName -> TargetProblem a
TargetAvailableInIndex PackageName
pkgname)
| Bool
otherwise
= TargetProblem err
-> Either (TargetProblem err) [(UnitId, ComponentTarget)]
forall a b. a -> Either a b
Left (PackageName -> TargetProblem err
forall a. PackageName -> TargetProblem a
TargetNotInProject PackageName
pkgname)
componentTargets :: SubComponentTarget
-> [(b, ComponentName)]
-> [(b, ComponentTarget)]
componentTargets :: SubComponentTarget
-> [(b, ComponentName)] -> [(b, ComponentTarget)]
componentTargets SubComponentTarget
subtarget =
((b, ComponentName) -> (b, ComponentTarget))
-> [(b, ComponentName)] -> [(b, ComponentTarget)]
forall a b. (a -> b) -> [a] -> [b]
map ((ComponentName -> ComponentTarget)
-> (b, ComponentName) -> (b, ComponentTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ComponentName
cname -> ComponentName -> SubComponentTarget -> ComponentTarget
ComponentTarget ComponentName
cname SubComponentTarget
subtarget))
selectComponentTargets :: SubComponentTarget
-> [AvailableTarget k]
-> Either (TargetProblem err) [k]
selectComponentTargets :: SubComponentTarget
-> [AvailableTarget k] -> Either (TargetProblem err) [k]
selectComponentTargets SubComponentTarget
subtarget =
(NonEmpty (TargetProblem err) -> Either (TargetProblem err) [k])
-> ([k] -> Either (TargetProblem err) [k])
-> Either (NonEmpty (TargetProblem err)) [k]
-> Either (TargetProblem err) [k]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TargetProblem err -> Either (TargetProblem err) [k]
forall a b. a -> Either a b
Left (TargetProblem err -> Either (TargetProblem err) [k])
-> (NonEmpty (TargetProblem err) -> TargetProblem err)
-> NonEmpty (TargetProblem err)
-> Either (TargetProblem err) [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (TargetProblem err) -> TargetProblem err
forall a. NonEmpty a -> a
NE.head) [k] -> Either (TargetProblem err) [k]
forall a b. b -> Either a b
Right
(Either (NonEmpty (TargetProblem err)) [k]
-> Either (TargetProblem err) [k])
-> ([AvailableTarget k]
-> Either (NonEmpty (TargetProblem err)) [k])
-> [AvailableTarget k]
-> Either (TargetProblem err) [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either (TargetProblem err) k]
-> Either (NonEmpty (TargetProblem err)) [k]
forall e a. [Either e a] -> Either (NonEmpty e) [a]
checkErrors
([Either (TargetProblem err) k]
-> Either (NonEmpty (TargetProblem err)) [k])
-> ([AvailableTarget k] -> [Either (TargetProblem err) k])
-> [AvailableTarget k]
-> Either (NonEmpty (TargetProblem err)) [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AvailableTarget k -> Either (TargetProblem err) k)
-> [AvailableTarget k] -> [Either (TargetProblem err) k]
forall a b. (a -> b) -> [a] -> [b]
map (SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem err) k
forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem err) k
selectComponentTarget SubComponentTarget
subtarget)
checkErrors :: [Either e a] -> Either (NonEmpty e) [a]
checkErrors :: [Either e a] -> Either (NonEmpty e) [a]
checkErrors = (\([e]
es, [a]
xs) -> case [e]
es of { [] -> [a] -> Either (NonEmpty e) [a]
forall a b. b -> Either a b
Right [a]
xs; (e
e:[e]
es') -> NonEmpty e -> Either (NonEmpty e) [a]
forall a b. a -> Either a b
Left (e
ee -> [e] -> NonEmpty e
forall a. a -> [a] -> NonEmpty a
:|[e]
es') })
(([e], [a]) -> Either (NonEmpty e) [a])
-> ([Either e a] -> ([e], [a]))
-> [Either e a]
-> Either (NonEmpty e) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either e a] -> ([e], [a])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
data AvailableTargetIndexes = AvailableTargetIndexes {
AvailableTargetIndexes
-> AvailableTargetsMap (PackageId, ComponentName)
availableTargetsByPackageIdAndComponentName
:: AvailableTargetsMap (PackageId, ComponentName),
AvailableTargetIndexes -> AvailableTargetsMap PackageId
availableTargetsByPackageId
:: AvailableTargetsMap PackageId,
AvailableTargetIndexes -> AvailableTargetsMap PackageName
availableTargetsByPackageName
:: AvailableTargetsMap PackageName,
AvailableTargetIndexes
-> AvailableTargetsMap (PackageName, ComponentName)
availableTargetsByPackageNameAndComponentName
:: AvailableTargetsMap (PackageName, ComponentName),
AvailableTargetIndexes
-> AvailableTargetsMap (PackageName, UnqualComponentName)
availableTargetsByPackageNameAndUnqualComponentName
:: AvailableTargetsMap (PackageName, UnqualComponentName)
}
type AvailableTargetsMap k = Map k [AvailableTarget (UnitId, ComponentName)]
availableTargetIndexes :: ElaboratedInstallPlan -> AvailableTargetIndexes
availableTargetIndexes :: ElaboratedInstallPlan -> AvailableTargetIndexes
availableTargetIndexes ElaboratedInstallPlan
installPlan = AvailableTargetIndexes :: AvailableTargetsMap (PackageId, ComponentName)
-> AvailableTargetsMap PackageId
-> AvailableTargetsMap PackageName
-> AvailableTargetsMap (PackageName, ComponentName)
-> AvailableTargetsMap (PackageName, UnqualComponentName)
-> AvailableTargetIndexes
AvailableTargetIndexes{AvailableTargetsMap (PackageId, ComponentName)
AvailableTargetsMap (PackageName, ComponentName)
AvailableTargetsMap (PackageName, UnqualComponentName)
AvailableTargetsMap PackageId
AvailableTargetsMap PackageName
availableTargetsByPackageNameAndUnqualComponentName :: AvailableTargetsMap (PackageName, UnqualComponentName)
availableTargetsByPackageNameAndComponentName :: AvailableTargetsMap (PackageName, ComponentName)
availableTargetsByPackageName :: AvailableTargetsMap PackageName
availableTargetsByPackageId :: AvailableTargetsMap PackageId
availableTargetsByPackageIdAndComponentName :: AvailableTargetsMap (PackageId, ComponentName)
availableTargetsByPackageNameAndUnqualComponentName :: AvailableTargetsMap (PackageName, UnqualComponentName)
availableTargetsByPackageNameAndComponentName :: AvailableTargetsMap (PackageName, ComponentName)
availableTargetsByPackageName :: AvailableTargetsMap PackageName
availableTargetsByPackageId :: AvailableTargetsMap PackageId
availableTargetsByPackageIdAndComponentName :: AvailableTargetsMap (PackageId, ComponentName)
..}
where
availableTargetsByPackageIdAndComponentName ::
Map (PackageId, ComponentName)
[AvailableTarget (UnitId, ComponentName)]
availableTargetsByPackageIdAndComponentName :: AvailableTargetsMap (PackageId, ComponentName)
availableTargetsByPackageIdAndComponentName =
ElaboratedInstallPlan
-> AvailableTargetsMap (PackageId, ComponentName)
availableTargets ElaboratedInstallPlan
installPlan
availableTargetsByPackageId ::
Map PackageId [AvailableTarget (UnitId, ComponentName)]
availableTargetsByPackageId :: AvailableTargetsMap PackageId
availableTargetsByPackageId =
([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> ((PackageId, ComponentName) -> PackageId)
-> AvailableTargetsMap (PackageId, ComponentName)
-> AvailableTargetsMap PackageId
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith
[AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall a. [a] -> [a] -> [a]
(++) (\(PackageId
pkgid, ComponentName
_cname) -> PackageId
pkgid)
AvailableTargetsMap (PackageId, ComponentName)
availableTargetsByPackageIdAndComponentName
AvailableTargetsMap PackageId
-> AvailableTargetsMap PackageId -> AvailableTargetsMap PackageId
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` AvailableTargetsMap PackageId
forall a. Map PackageId [a]
availableTargetsEmptyPackages
availableTargetsByPackageName ::
Map PackageName [AvailableTarget (UnitId, ComponentName)]
availableTargetsByPackageName :: AvailableTargetsMap PackageName
availableTargetsByPackageName =
([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> (PackageId -> PackageName)
-> AvailableTargetsMap PackageId
-> AvailableTargetsMap PackageName
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith
[AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall a. [a] -> [a] -> [a]
(++) PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName
AvailableTargetsMap PackageId
availableTargetsByPackageId
availableTargetsByPackageNameAndComponentName ::
Map (PackageName, ComponentName)
[AvailableTarget (UnitId, ComponentName)]
availableTargetsByPackageNameAndComponentName :: AvailableTargetsMap (PackageName, ComponentName)
availableTargetsByPackageNameAndComponentName =
([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> ((PackageId, ComponentName) -> (PackageName, ComponentName))
-> AvailableTargetsMap (PackageId, ComponentName)
-> AvailableTargetsMap (PackageName, ComponentName)
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith
[AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall a. [a] -> [a] -> [a]
(++) (\(PackageId
pkgid, ComponentName
cname) -> (PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid, ComponentName
cname))
AvailableTargetsMap (PackageId, ComponentName)
availableTargetsByPackageIdAndComponentName
availableTargetsByPackageNameAndUnqualComponentName ::
Map (PackageName, UnqualComponentName)
[AvailableTarget (UnitId, ComponentName)]
availableTargetsByPackageNameAndUnqualComponentName :: AvailableTargetsMap (PackageName, UnqualComponentName)
availableTargetsByPackageNameAndUnqualComponentName =
([AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)])
-> ((PackageId, ComponentName)
-> (PackageName, UnqualComponentName))
-> AvailableTargetsMap (PackageId, ComponentName)
-> AvailableTargetsMap (PackageName, UnqualComponentName)
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith
[AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
-> [AvailableTarget (UnitId, ComponentName)]
forall a. [a] -> [a] -> [a]
(++) (\(PackageId
pkgid, ComponentName
cname) -> let pname :: PackageName
pname = PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid
cname' :: UnqualComponentName
cname' = PackageName -> ComponentName -> UnqualComponentName
unqualComponentName PackageName
pname ComponentName
cname
in (PackageName
pname, UnqualComponentName
cname'))
AvailableTargetsMap (PackageId, ComponentName)
availableTargetsByPackageIdAndComponentName
where
unqualComponentName ::
PackageName -> ComponentName -> UnqualComponentName
unqualComponentName :: PackageName -> ComponentName -> UnqualComponentName
unqualComponentName PackageName
pkgname =
UnqualComponentName
-> Maybe UnqualComponentName -> UnqualComponentName
forall a. a -> Maybe a -> a
fromMaybe (PackageName -> UnqualComponentName
packageNameToUnqualComponentName PackageName
pkgname)
(Maybe UnqualComponentName -> UnqualComponentName)
-> (ComponentName -> Maybe UnqualComponentName)
-> ComponentName
-> UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentName -> Maybe UnqualComponentName
componentNameString
availableTargetsEmptyPackages :: Map PackageId [a]
availableTargetsEmptyPackages =
[(PackageId, [a])] -> Map PackageId [a]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
pkg, [])
| InstallPlan.Configured ElaboratedConfiguredPackage
pkg <- ElaboratedInstallPlan
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
installPlan
, case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
pkg of
ElabComponent ElaboratedComponent
_ -> Bool
False
ElabPackage ElaboratedPackage
_ -> [Component] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [Component]
pkgComponents (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg))
]
filterTargetsKind :: ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind :: ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
ckind = (ComponentKindFilter -> Bool)
-> [AvailableTarget k] -> [AvailableTarget k]
forall k.
(ComponentKindFilter -> Bool)
-> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKindWith (ComponentKindFilter -> ComponentKindFilter -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentKindFilter
ckind)
filterTargetsKindWith :: (ComponentKind -> Bool)
-> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKindWith :: (ComponentKindFilter -> Bool)
-> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKindWith ComponentKindFilter -> Bool
p [AvailableTarget k]
ts =
[ AvailableTarget k
t | t :: AvailableTarget k
t@(AvailableTarget PackageId
_ ComponentName
cname AvailableTargetStatus k
_ Bool
_) <- [AvailableTarget k]
ts
, ComponentKindFilter -> Bool
p (ComponentName -> ComponentKindFilter
componentKind ComponentName
cname) ]
selectBuildableTargets :: [AvailableTarget k] -> [k]
selectBuildableTargets :: [AvailableTarget k] -> [k]
selectBuildableTargets = (TargetRequested -> Bool) -> [AvailableTarget k] -> [k]
forall k. (TargetRequested -> Bool) -> [AvailableTarget k] -> [k]
selectBuildableTargetsWith (Bool -> TargetRequested -> Bool
forall a b. a -> b -> a
const Bool
True)
zipBuildableTargetsWith :: (TargetRequested -> Bool)
-> [AvailableTarget k] -> [(k, AvailableTarget k)]
zipBuildableTargetsWith :: (TargetRequested -> Bool)
-> [AvailableTarget k] -> [(k, AvailableTarget k)]
zipBuildableTargetsWith TargetRequested -> Bool
p [AvailableTarget k]
ts =
[ (k
k, AvailableTarget k
t) | t :: AvailableTarget k
t@(AvailableTarget PackageId
_ ComponentName
_ (TargetBuildable k
k TargetRequested
req) Bool
_) <- [AvailableTarget k]
ts, TargetRequested -> Bool
p TargetRequested
req ]
selectBuildableTargetsWith :: (TargetRequested -> Bool)
-> [AvailableTarget k] -> [k]
selectBuildableTargetsWith :: (TargetRequested -> Bool) -> [AvailableTarget k] -> [k]
selectBuildableTargetsWith TargetRequested -> Bool
p = ((k, AvailableTarget k) -> k) -> [(k, AvailableTarget k)] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map (k, AvailableTarget k) -> k
forall a b. (a, b) -> a
fst ([(k, AvailableTarget k)] -> [k])
-> ([AvailableTarget k] -> [(k, AvailableTarget k)])
-> [AvailableTarget k]
-> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TargetRequested -> Bool)
-> [AvailableTarget k] -> [(k, AvailableTarget k)]
forall k.
(TargetRequested -> Bool)
-> [AvailableTarget k] -> [(k, AvailableTarget k)]
zipBuildableTargetsWith TargetRequested -> Bool
p
selectBuildableTargets' :: [AvailableTarget k] -> ([k], [AvailableTarget ()])
selectBuildableTargets' :: [AvailableTarget k] -> ([k], [AvailableTarget ()])
selectBuildableTargets' = (TargetRequested -> Bool)
-> [AvailableTarget k] -> ([k], [AvailableTarget ()])
forall k.
(TargetRequested -> Bool)
-> [AvailableTarget k] -> ([k], [AvailableTarget ()])
selectBuildableTargetsWith' (Bool -> TargetRequested -> Bool
forall a b. a -> b -> a
const Bool
True)
selectBuildableTargetsWith' :: (TargetRequested -> Bool)
-> [AvailableTarget k] -> ([k], [AvailableTarget ()])
selectBuildableTargetsWith' :: (TargetRequested -> Bool)
-> [AvailableTarget k] -> ([k], [AvailableTarget ()])
selectBuildableTargetsWith' TargetRequested -> Bool
p =
(([AvailableTarget k] -> [AvailableTarget ()])
-> ([k], [AvailableTarget k]) -> ([k], [AvailableTarget ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([AvailableTarget k] -> [AvailableTarget ()])
-> ([k], [AvailableTarget k]) -> ([k], [AvailableTarget ()]))
-> ((AvailableTarget k -> AvailableTarget ())
-> [AvailableTarget k] -> [AvailableTarget ()])
-> (AvailableTarget k -> AvailableTarget ())
-> ([k], [AvailableTarget k])
-> ([k], [AvailableTarget ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AvailableTarget k -> AvailableTarget ())
-> [AvailableTarget k] -> [AvailableTarget ()]
forall a b. (a -> b) -> [a] -> [b]
map) AvailableTarget k -> AvailableTarget ()
forall k. AvailableTarget k -> AvailableTarget ()
forgetTargetDetail (([k], [AvailableTarget k]) -> ([k], [AvailableTarget ()]))
-> ([AvailableTarget k] -> ([k], [AvailableTarget k]))
-> [AvailableTarget k]
-> ([k], [AvailableTarget ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, AvailableTarget k)] -> ([k], [AvailableTarget k])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(k, AvailableTarget k)] -> ([k], [AvailableTarget k]))
-> ([AvailableTarget k] -> [(k, AvailableTarget k)])
-> [AvailableTarget k]
-> ([k], [AvailableTarget k])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TargetRequested -> Bool)
-> [AvailableTarget k] -> [(k, AvailableTarget k)]
forall k.
(TargetRequested -> Bool)
-> [AvailableTarget k] -> [(k, AvailableTarget k)]
zipBuildableTargetsWith TargetRequested -> Bool
p
forgetTargetDetail :: AvailableTarget k -> AvailableTarget ()
forgetTargetDetail :: AvailableTarget k -> AvailableTarget ()
forgetTargetDetail = (k -> ()) -> AvailableTarget k -> AvailableTarget ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> k -> ()
forall a b. a -> b -> a
const ())
forgetTargetsDetail :: [AvailableTarget k] -> [AvailableTarget ()]
forgetTargetsDetail :: [AvailableTarget k] -> [AvailableTarget ()]
forgetTargetsDetail = (AvailableTarget k -> AvailableTarget ())
-> [AvailableTarget k] -> [AvailableTarget ()]
forall a b. (a -> b) -> [a] -> [b]
map AvailableTarget k -> AvailableTarget ()
forall k. AvailableTarget k -> AvailableTarget ()
forgetTargetDetail
selectComponentTargetBasic :: SubComponentTarget
-> AvailableTarget k
-> Either (TargetProblem a) k
selectComponentTargetBasic :: SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic SubComponentTarget
subtarget
AvailableTarget {
availableTargetPackageId :: forall k. AvailableTarget k -> PackageId
availableTargetPackageId = PackageId
pkgid,
availableTargetComponentName :: forall k. AvailableTarget k -> ComponentName
availableTargetComponentName = ComponentName
cname,
AvailableTargetStatus k
availableTargetStatus :: forall k. AvailableTarget k -> AvailableTargetStatus k
availableTargetStatus :: AvailableTargetStatus k
availableTargetStatus
} =
case AvailableTargetStatus k
availableTargetStatus of
AvailableTargetStatus k
TargetDisabledByUser ->
TargetProblem a -> Either (TargetProblem a) k
forall a b. a -> Either a b
Left (PackageId -> ComponentName -> SubComponentTarget -> TargetProblem a
forall a.
PackageId -> ComponentName -> SubComponentTarget -> TargetProblem a
TargetOptionalStanzaDisabledByUser PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget)
AvailableTargetStatus k
TargetDisabledBySolver ->
TargetProblem a -> Either (TargetProblem a) k
forall a b. a -> Either a b
Left (PackageId -> ComponentName -> SubComponentTarget -> TargetProblem a
forall a.
PackageId -> ComponentName -> SubComponentTarget -> TargetProblem a
TargetOptionalStanzaDisabledBySolver PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget)
AvailableTargetStatus k
TargetNotLocal ->
TargetProblem a -> Either (TargetProblem a) k
forall a b. a -> Either a b
Left (PackageId -> ComponentName -> SubComponentTarget -> TargetProblem a
forall a.
PackageId -> ComponentName -> SubComponentTarget -> TargetProblem a
TargetComponentNotProjectLocal PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget)
AvailableTargetStatus k
TargetNotBuildable ->
TargetProblem a -> Either (TargetProblem a) k
forall a b. a -> Either a b
Left (PackageId -> ComponentName -> SubComponentTarget -> TargetProblem a
forall a.
PackageId -> ComponentName -> SubComponentTarget -> TargetProblem a
TargetComponentNotBuildable PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget)
TargetBuildable k
targetKey TargetRequested
_ ->
k -> Either (TargetProblem a) k
forall a b. b -> Either a b
Right k
targetKey
pruneInstallPlanToTargets :: TargetAction -> TargetsMap
-> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets :: TargetAction
-> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets TargetAction
targetActionType TargetsMap
targetsMap ElaboratedInstallPlan
elaboratedPlan =
Bool -> ElaboratedInstallPlan -> ElaboratedInstallPlan
forall a. HasCallStack => Bool -> a -> a
assert (TargetsMap -> Int
forall k a. Map k a -> Int
Map.size TargetsMap
targetsMap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ElaboratedInstallPlan -> ElaboratedInstallPlan)
-> ElaboratedInstallPlan -> ElaboratedInstallPlan
forall a b. (a -> b) -> a -> b
$
TargetAction
-> Map UnitId [ComponentTarget]
-> ElaboratedInstallPlan
-> ElaboratedInstallPlan
ProjectPlanning.pruneInstallPlanToTargets
TargetAction
targetActionType
(([(ComponentTarget, NonEmpty TargetSelector)] -> [ComponentTarget])
-> TargetsMap -> Map UnitId [ComponentTarget]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (((ComponentTarget, NonEmpty TargetSelector) -> ComponentTarget)
-> [(ComponentTarget, NonEmpty TargetSelector)]
-> [ComponentTarget]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentTarget, NonEmpty TargetSelector) -> ComponentTarget
forall a b. (a, b) -> a
fst) TargetsMap
targetsMap)
ElaboratedInstallPlan
elaboratedPlan
distinctTargetComponents :: TargetsMap -> Set.Set (UnitId, ComponentName)
distinctTargetComponents :: TargetsMap -> Set (UnitId, ComponentName)
distinctTargetComponents TargetsMap
targetsMap =
[(UnitId, ComponentName)] -> Set (UnitId, ComponentName)
forall a. Ord a => [a] -> Set a
Set.fromList [ (UnitId
uid, ComponentName
cname)
| (UnitId
uid, [(ComponentTarget, NonEmpty TargetSelector)]
cts) <- TargetsMap
-> [(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])]
forall k a. Map k a -> [(k, a)]
Map.toList TargetsMap
targetsMap
, (ComponentTarget ComponentName
cname SubComponentTarget
_, NonEmpty TargetSelector
_) <- [(ComponentTarget, NonEmpty TargetSelector)]
cts ]
printPlan :: Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> IO ()
printPlan :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO ()
printPlan Verbosity
verbosity
ProjectBaseContext {
buildSettings :: ProjectBaseContext -> BuildTimeSettings
buildSettings = BuildTimeSettings{Bool
buildSettingDryRun :: Bool
buildSettingDryRun :: BuildTimeSettings -> Bool
buildSettingDryRun},
projectConfig :: ProjectBaseContext -> ProjectConfig
projectConfig = ProjectConfig {
projectConfigLocalPackages :: ProjectConfig -> PackageConfig
projectConfigLocalPackages =
PackageConfig {Flag OptimisationLevel
packageConfigOptimization :: PackageConfig -> Flag OptimisationLevel
packageConfigOptimization :: Flag OptimisationLevel
packageConfigOptimization}
}
}
ProjectBuildContext {
elaboratedPlanToExecute :: ProjectBuildContext -> ElaboratedInstallPlan
elaboratedPlanToExecute = ElaboratedInstallPlan
elaboratedPlan,
ElaboratedSharedConfig
elaboratedShared :: ElaboratedSharedConfig
elaboratedShared :: ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared,
BuildStatusMap
pkgsBuildStatus :: BuildStatusMap
pkgsBuildStatus :: ProjectBuildContext -> BuildStatusMap
pkgsBuildStatus
}
| [GenericReadyPackage ElaboratedConfiguredPackage] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenericReadyPackage ElaboratedConfiguredPackage]
pkgs
= Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"Up to date"
| Bool
otherwise
= Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
(String
showBuildProfile String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"In order, the following "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
wouldWill String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" be built"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
ifNormal String
" (use -v for more details)" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":")
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (GenericReadyPackage ElaboratedConfiguredPackage -> String)
-> [GenericReadyPackage ElaboratedConfiguredPackage] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GenericReadyPackage ElaboratedConfiguredPackage -> String
showPkgAndReason [GenericReadyPackage ElaboratedConfiguredPackage]
pkgs
where
pkgs :: [GenericReadyPackage ElaboratedConfiguredPackage]
pkgs = ElaboratedInstallPlan
-> [GenericReadyPackage ElaboratedConfiguredPackage]
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg -> [GenericReadyPackage srcpkg]
InstallPlan.executionOrder ElaboratedInstallPlan
elaboratedPlan
ifVerbose :: ShowS
ifVerbose String
s | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
verbose = String
s
| Bool
otherwise = String
""
ifNormal :: ShowS
ifNormal String
s | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
verbose = String
""
| Bool
otherwise = String
s
wouldWill :: String
wouldWill | Bool
buildSettingDryRun = String
"would"
| Bool
otherwise = String
"will"
showPkgAndReason :: ElaboratedReadyPackage -> String
showPkgAndReason :: GenericReadyPackage ElaboratedConfiguredPackage -> String
showPkgAndReason (ReadyPackage ElaboratedConfiguredPackage
elab) = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
[ String
" -"
, if Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
deafening
then UnitId -> String
forall a. Pretty a => a -> String
prettyShow (ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab)
else PackageId -> String
forall a. Pretty a => a -> String
prettyShow (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
elab)
, case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
ElabPackage ElaboratedPackage
pkg -> ElaboratedConfiguredPackage -> String
showTargets ElaboratedConfiguredPackage
elab String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
ifVerbose (OptionalStanzaSet -> String
showStanzas (ElaboratedPackage -> OptionalStanzaSet
pkgStanzasEnabled ElaboratedPackage
pkg))
ElabComponent ElaboratedComponent
comp ->
String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ElaboratedConfiguredPackage -> ElaboratedComponent -> String
showComp ElaboratedConfiguredPackage
elab ElaboratedComponent
comp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
, FlagAssignment -> String
showFlagAssignment (ElaboratedConfiguredPackage -> FlagAssignment
nonDefaultFlags ElaboratedConfiguredPackage
elab)
, ElaboratedConfiguredPackage -> String
showConfigureFlags ElaboratedConfiguredPackage
elab
, let buildStatus :: BuildStatus
buildStatus = BuildStatusMap
pkgsBuildStatus BuildStatusMap -> UnitId -> BuildStatus
forall k a. Ord k => Map k a -> k -> a
Map.! ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab
in String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BuildStatus -> String
showBuildStatus BuildStatus
buildStatus String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
]
showComp :: ElaboratedConfiguredPackage -> ElaboratedComponent -> String
showComp :: ElaboratedConfiguredPackage -> ElaboratedComponent -> String
showComp ElaboratedConfiguredPackage
elab ElaboratedComponent
comp =
String
-> (ComponentName -> String) -> Maybe ComponentName -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"custom" ComponentName -> String
forall a. Pretty a => a -> String
prettyShow (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp) String -> ShowS
forall a. [a] -> [a] -> [a]
++
if Map ModuleName Module -> Bool
forall k a. Map k a -> Bool
Map.null (ElaboratedConfiguredPackage -> Map ModuleName Module
elabInstantiatedWith ElaboratedConfiguredPackage
elab)
then String
""
else String
" with " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", "
[ ModuleName -> String
forall a. Pretty a => a -> String
prettyShow ModuleName
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> String
forall a. Pretty a => a -> String
prettyShow Module
v
| (ModuleName
k,Module
v) <- Map ModuleName Module -> [(ModuleName, Module)]
forall k a. Map k a -> [(k, a)]
Map.toList (ElaboratedConfiguredPackage -> Map ModuleName Module
elabInstantiatedWith ElaboratedConfiguredPackage
elab) ]
nonDefaultFlags :: ElaboratedConfiguredPackage -> FlagAssignment
nonDefaultFlags :: ElaboratedConfiguredPackage -> FlagAssignment
nonDefaultFlags ElaboratedConfiguredPackage
elab =
ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment ElaboratedConfiguredPackage
elab FlagAssignment -> FlagAssignment -> FlagAssignment
`diffFlagAssignment` ElaboratedConfiguredPackage -> FlagAssignment
elabFlagDefaults ElaboratedConfiguredPackage
elab
showTargets :: ElaboratedConfiguredPackage -> String
showTargets :: ElaboratedConfiguredPackage -> String
showTargets ElaboratedConfiguredPackage
elab
| [ComponentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab) = String
""
| Bool
otherwise
= String
"("
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [ PackageId -> ComponentTarget -> String
showComponentTarget (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
elab) ComponentTarget
t
| ComponentTarget
t <- ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
elab ]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
showConfigureFlags :: ElaboratedConfiguredPackage -> String
showConfigureFlags :: ElaboratedConfiguredPackage -> String
showConfigureFlags ElaboratedConfiguredPackage
elab =
let fullConfigureFlags :: ConfigFlags
fullConfigureFlags
= GenericReadyPackage ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> String -> ConfigFlags
setupHsConfigureFlags
(ElaboratedConfiguredPackage
-> GenericReadyPackage ElaboratedConfiguredPackage
forall srcpkg. srcpkg -> GenericReadyPackage srcpkg
ReadyPackage ElaboratedConfiguredPackage
elab)
ElaboratedSharedConfig
elaboratedShared
Verbosity
verbosity
String
"$builddir"
nubFlag :: Eq a => a -> Setup.Flag a -> Setup.Flag a
nubFlag :: a -> Flag a -> Flag a
nubFlag a
x (Setup.Flag a
x') | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x' = Flag a
forall a. Flag a
Setup.NoFlag
nubFlag a
_ Flag a
f = Flag a
f
(Bool
tryLibProfiling, Bool
tryExeProfiling) =
ConfigFlags -> (Bool, Bool)
computeEffectiveProfiling ConfigFlags
fullConfigureFlags
partialConfigureFlags :: ConfigFlags
partialConfigureFlags
= ConfigFlags
forall a. Monoid a => a
mempty {
configProf :: Flag Bool
configProf =
Bool -> Flag Bool -> Flag Bool
forall a. Eq a => a -> Flag a -> Flag a
nubFlag Bool
False (ConfigFlags -> Flag Bool
configProf ConfigFlags
fullConfigureFlags),
configProfExe :: Flag Bool
configProfExe =
Bool -> Flag Bool -> Flag Bool
forall a. Eq a => a -> Flag a -> Flag a
nubFlag Bool
tryExeProfiling (ConfigFlags -> Flag Bool
configProfExe ConfigFlags
fullConfigureFlags),
configProfLib :: Flag Bool
configProfLib =
Bool -> Flag Bool -> Flag Bool
forall a. Eq a => a -> Flag a -> Flag a
nubFlag Bool
tryLibProfiling (ConfigFlags -> Flag Bool
configProfLib ConfigFlags
fullConfigureFlags)
}
in [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
CommandUI ConfigFlags -> ConfigFlags -> [String]
forall flags. CommandUI flags -> flags -> [String]
commandShowOptions
(ProgramDb -> CommandUI ConfigFlags
Setup.configureCommand (ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs ElaboratedSharedConfig
elaboratedShared))
ConfigFlags
partialConfigureFlags
showBuildStatus :: BuildStatus -> String
showBuildStatus :: BuildStatus -> String
showBuildStatus BuildStatus
status = case BuildStatus
status of
BuildStatus
BuildStatusPreExisting -> String
"existing package"
BuildStatus
BuildStatusInstalled -> String
"already installed"
BuildStatusDownload {} -> String
"requires download & build"
BuildStatusUnpack {} -> String
"requires build"
BuildStatusRebuild String
_ BuildStatusRebuild
rebuild -> case BuildStatusRebuild
rebuild of
BuildStatusConfigure
(MonitoredValueChanged ()
_) -> String
"configuration changed"
BuildStatusConfigure MonitorChangedReason ()
mreason -> MonitorChangedReason () -> String
forall a. MonitorChangedReason a -> String
showMonitorChangedReason MonitorChangedReason ()
mreason
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
_ BuildReason
buildreason -> case BuildReason
buildreason of
BuildReason
BuildReasonDepsRebuilt -> String
"dependency rebuilt"
BuildReasonFilesChanged
MonitorChangedReason ()
mreason -> MonitorChangedReason () -> String
forall a. MonitorChangedReason a -> String
showMonitorChangedReason MonitorChangedReason ()
mreason
BuildReasonExtraTargets Set ComponentName
_ -> String
"additional components to build"
BuildReason
BuildReasonEphemeralTargets -> String
"ephemeral targets"
BuildStatusUpToDate {} -> String
"up to date"
showMonitorChangedReason :: MonitorChangedReason a -> String
showMonitorChangedReason :: MonitorChangedReason a -> String
showMonitorChangedReason (MonitoredFileChanged String
file) =
String
"file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" changed"
showMonitorChangedReason (MonitoredValueChanged a
_) = String
"value changed"
showMonitorChangedReason MonitorChangedReason a
MonitorFirstRun = String
"first run"
showMonitorChangedReason MonitorChangedReason a
MonitorCorruptCache =
String
"cannot read state cache"
showBuildProfile :: String
showBuildProfile :: String
showBuildProfile = String
"Build profile: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [
String
"-w " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Compiler -> String
showCompilerId (Compiler -> String)
-> (ElaboratedSharedConfig -> Compiler)
-> ElaboratedSharedConfig
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedSharedConfig -> Compiler
pkgConfigCompiler) ElaboratedSharedConfig
elaboratedShared,
String
"-O" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (case Flag OptimisationLevel
packageConfigOptimization of
Setup.Flag OptimisationLevel
NoOptimisation -> String
"0"
Setup.Flag OptimisationLevel
NormalOptimisation -> String
"1"
Setup.Flag OptimisationLevel
MaximumOptimisation -> String
"2"
Flag OptimisationLevel
Setup.NoFlag -> String
"1")]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
writeBuildReports :: BuildTimeSettings -> ProjectBuildContext -> ElaboratedInstallPlan -> BuildOutcomes -> IO ()
writeBuildReports :: BuildTimeSettings
-> ProjectBuildContext
-> ElaboratedInstallPlan
-> BuildOutcomes
-> IO ()
writeBuildReports BuildTimeSettings
settings ProjectBuildContext
buildContext ElaboratedInstallPlan
plan BuildOutcomes
buildOutcomes = do
let plat :: Platform
plat@(Platform Arch
arch OS
os) = ElaboratedSharedConfig -> Platform
pkgConfigPlatform (ElaboratedSharedConfig -> Platform)
-> (ProjectBuildContext -> ElaboratedSharedConfig)
-> ProjectBuildContext
-> Platform
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared (ProjectBuildContext -> Platform)
-> ProjectBuildContext -> Platform
forall a b. (a -> b) -> a -> b
$ ProjectBuildContext
buildContext
comp :: Compiler
comp = ElaboratedSharedConfig -> Compiler
pkgConfigCompiler (ElaboratedSharedConfig -> Compiler)
-> (ProjectBuildContext -> ElaboratedSharedConfig)
-> ProjectBuildContext
-> Compiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared (ProjectBuildContext -> Compiler)
-> ProjectBuildContext -> Compiler
forall a b. (a -> b) -> a -> b
$ ProjectBuildContext
buildContext
getRepo :: PackageLocation local -> Maybe Repo
getRepo (RepoTarballPackage Repo
r PackageId
_ local
_) = Repo -> Maybe Repo
forall a. a -> Maybe a
Just Repo
r
getRepo PackageLocation local
_ = Maybe Repo
forall a. Maybe a
Nothing
fromPlanPackage :: GenericPlanPackage ipkg ElaboratedConfiguredPackage
-> Maybe (Either BuildFailure BuildResult)
-> Maybe (BuildReport, Maybe Repo)
fromPlanPackage (InstallPlan.Configured ElaboratedConfiguredPackage
pkg) (Just Either BuildFailure BuildResult
result) =
let installOutcome :: InstallOutcome
installOutcome = case Either BuildFailure BuildResult
result of
Left bf -> case BuildFailure -> BuildFailureReason
buildFailureReason BuildFailure
bf of
DependentFailed PackageId
p -> PackageId -> InstallOutcome
BuildReports.DependencyFailed PackageId
p
DownloadFailed SomeException
_ -> InstallOutcome
BuildReports.DownloadFailed
UnpackFailed SomeException
_ -> InstallOutcome
BuildReports.UnpackFailed
ConfigureFailed SomeException
_ -> InstallOutcome
BuildReports.ConfigureFailed
BuildFailed SomeException
_ -> InstallOutcome
BuildReports.BuildFailed
TestsFailed SomeException
_ -> InstallOutcome
BuildReports.TestsFailed
InstallFailed SomeException
_ -> InstallOutcome
BuildReports.InstallFailed
ReplFailed SomeException
_ -> InstallOutcome
BuildReports.InstallOk
HaddocksFailed SomeException
_ -> InstallOutcome
BuildReports.InstallOk
BenchFailed SomeException
_ -> InstallOutcome
BuildReports.InstallOk
Right _br -> InstallOutcome
BuildReports.InstallOk
docsOutcome :: Outcome
docsOutcome = case Either BuildFailure BuildResult
result of
Left bf -> case BuildFailure -> BuildFailureReason
buildFailureReason BuildFailure
bf of
HaddocksFailed SomeException
_ -> Outcome
BuildReports.Failed
BuildFailureReason
_ -> Outcome
BuildReports.NotTried
Right br -> case BuildResult -> DocsResult
buildResultDocs BuildResult
br of
DocsResult
DocsNotTried -> Outcome
BuildReports.NotTried
DocsResult
DocsFailed -> Outcome
BuildReports.Failed
DocsResult
DocsOk -> Outcome
BuildReports.Ok
testsOutcome :: Outcome
testsOutcome = case Either BuildFailure BuildResult
result of
Left bf -> case BuildFailure -> BuildFailureReason
buildFailureReason BuildFailure
bf of
TestsFailed SomeException
_ -> Outcome
BuildReports.Failed
BuildFailureReason
_ -> Outcome
BuildReports.NotTried
Right br -> case BuildResult -> TestsResult
buildResultTests BuildResult
br of
TestsResult
TestsNotTried -> Outcome
BuildReports.NotTried
TestsResult
TestsOk -> Outcome
BuildReports.Ok
in (BuildReport, Maybe Repo) -> Maybe (BuildReport, Maybe Repo)
forall a. a -> Maybe a
Just ((BuildReport, Maybe Repo) -> Maybe (BuildReport, Maybe Repo))
-> (BuildReport, Maybe Repo) -> Maybe (BuildReport, Maybe Repo)
forall a b. (a -> b) -> a -> b
$ (PackageId
-> OS
-> Arch
-> CompilerId
-> PackageId
-> FlagAssignment
-> [PackageId]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport
BuildReports.BuildReport (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
pkg) OS
os Arch
arch (Compiler -> CompilerId
compilerId Compiler
comp) PackageId
cabalInstallID (ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment ElaboratedConfiguredPackage
pkg) ((ConfiguredId -> PackageId) -> [ConfiguredId] -> [PackageId]
forall a b. (a -> b) -> [a] -> [b]
map ConfiguredId -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ([ConfiguredId] -> [PackageId]) -> [ConfiguredId] -> [PackageId]
forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> [ConfiguredId]
elabLibDependencies ElaboratedConfiguredPackage
pkg) InstallOutcome
installOutcome Outcome
docsOutcome Outcome
testsOutcome, PackageLocation (Maybe String) -> Maybe Repo
forall local. PackageLocation local -> Maybe Repo
getRepo (PackageLocation (Maybe String) -> Maybe Repo)
-> (ElaboratedConfiguredPackage -> PackageLocation (Maybe String))
-> ElaboratedConfiguredPackage
-> Maybe Repo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> PackageLocation (Maybe String)
elabPkgSourceLocation (ElaboratedConfiguredPackage -> Maybe Repo)
-> ElaboratedConfiguredPackage -> Maybe Repo
forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage
pkg)
fromPlanPackage GenericPlanPackage ipkg ElaboratedConfiguredPackage
_ Maybe (Either BuildFailure BuildResult)
_ = Maybe (BuildReport, Maybe Repo)
forall a. Maybe a
Nothing
buildReports :: [(BuildReport, Maybe Repo)]
buildReports = (GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
-> Maybe (BuildReport, Maybe Repo))
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
-> [(BuildReport, Maybe Repo)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
x -> GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> Maybe (Either BuildFailure BuildResult)
-> Maybe (BuildReport, Maybe Repo)
forall ipkg.
GenericPlanPackage ipkg ElaboratedConfiguredPackage
-> Maybe (Either BuildFailure BuildResult)
-> Maybe (BuildReport, Maybe Repo)
fromPlanPackage GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
x (GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> BuildOutcomes -> Maybe (Either BuildFailure BuildResult)
forall pkg failure result.
HasUnitId pkg =>
pkg
-> BuildOutcomes failure result -> Maybe (Either failure result)
InstallPlan.lookupBuildOutcome GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
x BuildOutcomes
buildOutcomes)) ([GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
-> [(BuildReport, Maybe Repo)])
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
-> [(BuildReport, Maybe Repo)]
forall a b. (a -> b) -> a -> b
$ ElaboratedInstallPlan
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
plan
CompilerInfo
-> [PathTemplate]
-> [(BuildReport, Maybe Repo)]
-> Platform
-> IO ()
BuildReports.storeLocal (Compiler -> CompilerInfo
compilerInfo Compiler
comp)
(BuildTimeSettings -> [PathTemplate]
buildSettingSummaryFile BuildTimeSettings
settings)
[(BuildReport, Maybe Repo)]
buildReports
Platform
plat
dieOnBuildFailures :: Verbosity -> CurrentCommand
-> ElaboratedInstallPlan -> BuildOutcomes -> IO ()
dieOnBuildFailures :: Verbosity
-> CurrentCommand
-> ElaboratedInstallPlan
-> BuildOutcomes
-> IO ()
dieOnBuildFailures Verbosity
verbosity CurrentCommand
currentCommand ElaboratedInstallPlan
plan BuildOutcomes
buildOutcomes
| [(UnitId, BuildFailure)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(UnitId, BuildFailure)]
failures = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
isSimpleCase = IO ()
forall a. IO a
exitFailure
| Bool
otherwise = do
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ do Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> ElaboratedConfiguredPackage -> BuildFailureReason -> String
renderFailureDetail Bool
False ElaboratedConfiguredPackage
pkg BuildFailureReason
reason
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nBuild log ( " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
logfile String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ):"
String -> IO String
readFile String
logfile IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity
| (ElaboratedConfiguredPackage
pkg, ShowBuildSummaryAndLog BuildFailureReason
reason String
logfile)
<- [(ElaboratedConfiguredPackage, BuildFailurePresentation)]
failuresClassification
]
Verbosity -> String -> IO ()
dieIfNotHaddockFailure Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ case BuildFailurePresentation
failureClassification of
ShowBuildSummaryAndLog BuildFailureReason
reason String
_
| Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
> Verbosity
normal
-> Bool -> ElaboratedConfiguredPackage -> BuildFailureReason -> String
renderFailureDetail Bool
mentionDepOf ElaboratedConfiguredPackage
pkg BuildFailureReason
reason
| Bool
otherwise
-> Bool -> ElaboratedConfiguredPackage -> BuildFailureReason -> String
renderFailureSummary Bool
mentionDepOf ElaboratedConfiguredPackage
pkg BuildFailureReason
reason
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". See the build log above for details."
ShowBuildSummaryOnly BuildFailureReason
reason ->
Bool -> ElaboratedConfiguredPackage -> BuildFailureReason -> String
renderFailureDetail Bool
mentionDepOf ElaboratedConfiguredPackage
pkg BuildFailureReason
reason
| let mentionDepOf :: Bool
mentionDepOf = Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
<= Verbosity
normal
, (ElaboratedConfiguredPackage
pkg, BuildFailurePresentation
failureClassification) <- [(ElaboratedConfiguredPackage, BuildFailurePresentation)]
failuresClassification ]
where
failures :: [(UnitId, BuildFailure)]
failures :: [(UnitId, BuildFailure)]
failures = [ (UnitId
pkgid, BuildFailure
failure)
| (UnitId
pkgid, Left BuildFailure
failure) <- BuildOutcomes -> [(UnitId, Either BuildFailure BuildResult)]
forall k a. Map k a -> [(k, a)]
Map.toList BuildOutcomes
buildOutcomes ]
failuresClassification :: [(ElaboratedConfiguredPackage, BuildFailurePresentation)]
failuresClassification :: [(ElaboratedConfiguredPackage, BuildFailurePresentation)]
failuresClassification =
[ (ElaboratedConfiguredPackage
pkg, BuildFailure -> BuildFailurePresentation
classifyBuildFailure BuildFailure
failure)
| (UnitId
pkgid, BuildFailure
failure) <- [(UnitId, BuildFailure)]
failures
, case BuildFailure -> BuildFailureReason
buildFailureReason BuildFailure
failure of
DependentFailed {} -> Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
> Verbosity
normal
BuildFailureReason
_ -> Bool
True
, InstallPlan.Configured ElaboratedConfiguredPackage
pkg <-
Maybe
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage)
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall a. Maybe a -> [a]
maybeToList (ElaboratedInstallPlan
-> UnitId
-> Maybe
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage)
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg
-> UnitId -> Maybe (GenericPlanPackage ipkg srcpkg)
InstallPlan.lookup ElaboratedInstallPlan
plan UnitId
pkgid)
]
dieIfNotHaddockFailure :: Verbosity -> String -> IO ()
dieIfNotHaddockFailure :: Verbosity -> String -> IO ()
dieIfNotHaddockFailure
| CurrentCommand
currentCommand CurrentCommand -> CurrentCommand -> Bool
forall a. Eq a => a -> a -> Bool
== CurrentCommand
HaddockCommand = Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die'
| ((ElaboratedConfiguredPackage, BuildFailurePresentation) -> Bool)
-> [(ElaboratedConfiguredPackage, BuildFailurePresentation)]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ElaboratedConfiguredPackage, BuildFailurePresentation) -> Bool
forall a. (a, BuildFailurePresentation) -> Bool
isHaddockFailure [(ElaboratedConfiguredPackage, BuildFailurePresentation)]
failuresClassification = Verbosity -> String -> IO ()
warn
| Bool
otherwise = Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die'
where
isHaddockFailure :: (a, BuildFailurePresentation) -> Bool
isHaddockFailure
(a
_, ShowBuildSummaryOnly (HaddocksFailed SomeException
_) ) = Bool
True
isHaddockFailure
(a
_, ShowBuildSummaryAndLog (HaddocksFailed SomeException
_) String
_) = Bool
True
isHaddockFailure
(a, BuildFailurePresentation)
_ = Bool
False
classifyBuildFailure :: BuildFailure -> BuildFailurePresentation
classifyBuildFailure :: BuildFailure -> BuildFailurePresentation
classifyBuildFailure BuildFailure {
buildFailureReason :: BuildFailure -> BuildFailureReason
buildFailureReason = BuildFailureReason
reason,
buildFailureLogFile :: BuildFailure -> Maybe String
buildFailureLogFile = Maybe String
mlogfile
} =
BuildFailurePresentation
-> (String -> BuildFailurePresentation)
-> Maybe String
-> BuildFailurePresentation
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BuildFailureReason -> BuildFailurePresentation
ShowBuildSummaryOnly BuildFailureReason
reason)
(BuildFailureReason -> String -> BuildFailurePresentation
ShowBuildSummaryAndLog BuildFailureReason
reason) (Maybe String -> BuildFailurePresentation)
-> Maybe String -> BuildFailurePresentation
forall a b. (a -> b) -> a -> b
$ do
String
logfile <- Maybe String
mlogfile
SomeException
e <- BuildFailureReason -> Maybe SomeException
buildFailureException BuildFailureReason
reason
ExitFailure Int
1 <- SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
logfile
isSimpleCase :: Bool
isSimpleCase :: Bool
isSimpleCase
| [(UnitId
pkgid, BuildFailure
failure)] <- [(UnitId, BuildFailure)]
failures
, [ElaboratedConfiguredPackage
pkg] <- [ElaboratedConfiguredPackage]
rootpkgs
, ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
pkg UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
pkgid
, BuildFailureReason -> Bool
isFailureSelfExplanatory (BuildFailure -> BuildFailureReason
buildFailureReason BuildFailure
failure)
, CurrentCommand
currentCommand CurrentCommand -> CurrentCommand -> Bool
forall a. Eq a => a -> a -> Bool
/= CurrentCommand
InstallCommand
= Bool
True
| Bool
otherwise
= Bool
False
isFailureSelfExplanatory :: BuildFailureReason -> Bool
isFailureSelfExplanatory :: BuildFailureReason -> Bool
isFailureSelfExplanatory (BuildFailed SomeException
e)
| Just (ExitFailure Int
1) <- SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = Bool
True
isFailureSelfExplanatory (ConfigureFailed SomeException
e)
| Just (ExitFailure Int
1) <- SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = Bool
True
isFailureSelfExplanatory BuildFailureReason
_ = Bool
False
rootpkgs :: [ElaboratedConfiguredPackage]
rootpkgs :: [ElaboratedConfiguredPackage]
rootpkgs =
[ ElaboratedConfiguredPackage
pkg
| InstallPlan.Configured ElaboratedConfiguredPackage
pkg <- ElaboratedInstallPlan
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
plan
, ElaboratedConfiguredPackage -> Bool
forall pkg. HasUnitId pkg => pkg -> Bool
hasNoDependents ElaboratedConfiguredPackage
pkg ]
ultimateDeps
:: UnitId
-> [InstallPlan.GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage]
ultimateDeps :: UnitId
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
ultimateDeps UnitId
pkgid =
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
-> Bool)
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall a. (a -> Bool) -> [a] -> [a]
filter (\GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
pkg -> GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> Bool
forall pkg. HasUnitId pkg => pkg -> Bool
hasNoDependents GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
pkg Bool -> Bool -> Bool
&& GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
pkg UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
pkgid)
(ElaboratedInstallPlan
-> [UnitId]
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> [UnitId] -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.reverseDependencyClosure ElaboratedInstallPlan
plan [UnitId
pkgid])
hasNoDependents :: HasUnitId pkg => pkg -> Bool
hasNoDependents :: pkg -> Bool
hasNoDependents = [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
-> Bool)
-> (pkg
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage])
-> pkg
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedInstallPlan
-> UnitId
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> UnitId -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.revDirectDeps ElaboratedInstallPlan
plan (UnitId
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage])
-> (pkg -> UnitId)
-> pkg
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pkg -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId
renderFailureDetail :: Bool -> ElaboratedConfiguredPackage -> BuildFailureReason -> String
renderFailureDetail :: Bool -> ElaboratedConfiguredPackage -> BuildFailureReason -> String
renderFailureDetail Bool
mentionDepOf ElaboratedConfiguredPackage
pkg BuildFailureReason
reason =
Bool -> ElaboratedConfiguredPackage -> BuildFailureReason -> String
renderFailureSummary Bool
mentionDepOf ElaboratedConfiguredPackage
pkg BuildFailureReason
reason String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
String -> ShowS
forall a. [a] -> [a] -> [a]
++ BuildFailureReason -> String
renderFailureExtraDetail BuildFailureReason
reason
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
-> (SomeException -> String) -> Maybe SomeException -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" SomeException -> String
showException (BuildFailureReason -> Maybe SomeException
buildFailureException BuildFailureReason
reason)
renderFailureSummary :: Bool -> ElaboratedConfiguredPackage -> BuildFailureReason -> String
renderFailureSummary :: Bool -> ElaboratedConfiguredPackage -> BuildFailureReason -> String
renderFailureSummary Bool
mentionDepOf ElaboratedConfiguredPackage
pkg BuildFailureReason
reason =
case BuildFailureReason
reason of
DownloadFailed SomeException
_ -> String
"Failed to download " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgstr
UnpackFailed SomeException
_ -> String
"Failed to unpack " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgstr
ConfigureFailed SomeException
_ -> String
"Failed to build " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgstr
BuildFailed SomeException
_ -> String
"Failed to build " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgstr
ReplFailed SomeException
_ -> String
"repl failed for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgstr
HaddocksFailed SomeException
_ -> String
"Failed to build documentation for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgstr
TestsFailed SomeException
_ -> String
"Tests failed for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgstr
BenchFailed SomeException
_ -> String
"Benchmarks failed for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgstr
InstallFailed SomeException
_ -> String
"Failed to build " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgstr
DependentFailed PackageId
depid
-> String
"Failed to build " String -> ShowS
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)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" because it depends on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageId -> String
forall a. Pretty a => a -> String
prettyShow PackageId
depid
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" which itself failed to build"
where
pkgstr :: String
pkgstr = Verbosity -> ElaboratedConfiguredPackage -> String
elabConfiguredName Verbosity
verbosity ElaboratedConfiguredPackage
pkg
String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool
mentionDepOf
then UnitId -> String
renderDependencyOf (ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
pkg)
else String
""
renderFailureExtraDetail :: BuildFailureReason -> String
renderFailureExtraDetail :: BuildFailureReason -> String
renderFailureExtraDetail (ConfigureFailed SomeException
_) =
String
" The failure occurred during the configure step."
renderFailureExtraDetail (InstallFailed SomeException
_) =
String
" The failure occurred during the final install step."
renderFailureExtraDetail BuildFailureReason
_ =
String
""
renderDependencyOf :: UnitId -> String
renderDependencyOf :: UnitId -> String
renderDependencyOf UnitId
pkgid =
case UnitId
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
ultimateDeps UnitId
pkgid of
[] -> String
""
(GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
p1:[]) ->
String
" (which is required by " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Verbosity
-> GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
-> String
elabPlanPackageName Verbosity
verbosity GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
p1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
(GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
p1:GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
p2:[]) ->
String
" (which is required by " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Verbosity
-> GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
-> String
elabPlanPackageName Verbosity
verbosity GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
p1
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Verbosity
-> GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
-> String
elabPlanPackageName Verbosity
verbosity GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
p2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
(GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
p1:GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
p2:[GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
_) ->
String
" (which is required by " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Verbosity
-> GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
-> String
elabPlanPackageName Verbosity
verbosity GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
p1
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Verbosity
-> GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
-> String
elabPlanPackageName Verbosity
verbosity GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
p2
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and others)"
showException :: SomeException -> String
showException SomeException
e = case SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just (ExitFailure Int
1) -> String
""
#ifdef MIN_VERSION_unix
Just (ExitFailure Int
n)
| -Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sigSEGV ->
String
" The build process segfaulted (i.e. SIGSEGV)."
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sigSEGV ->
String
" The build process terminated with exit code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" which may be because some part of it segfaulted. (i.e. SIGSEGV)."
| -Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sigKILL ->
String
" The build process was killed (i.e. SIGKILL). " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
explanation
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sigKILL ->
String
" The build process terminated with exit code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" which may be because some part of it was killed "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(i.e. SIGKILL). " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
explanation
where
explanation :: String
explanation =
String
"The typical reason for this is that there is not "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"enough memory available (e.g. the OS killed a process "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"using lots of memory)."
#endif
Just (ExitFailure Int
n) ->
String
" The build process terminated with exit code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
Maybe ExitCode
_ -> String
" The exception was:\n "
#if MIN_VERSION_base(4,8,0)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
e
#else
++ show e
#endif
buildFailureException :: BuildFailureReason -> Maybe SomeException
buildFailureException :: BuildFailureReason -> Maybe SomeException
buildFailureException BuildFailureReason
reason =
case BuildFailureReason
reason of
DownloadFailed SomeException
e -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
UnpackFailed SomeException
e -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
ConfigureFailed SomeException
e -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
BuildFailed SomeException
e -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
ReplFailed SomeException
e -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
HaddocksFailed SomeException
e -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
TestsFailed SomeException
e -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
BenchFailed SomeException
e -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
InstallFailed SomeException
e -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
DependentFailed PackageId
_ -> Maybe SomeException
forall a. Maybe a
Nothing
data BuildFailurePresentation =
ShowBuildSummaryOnly BuildFailureReason
| ShowBuildSummaryAndLog BuildFailureReason FilePath
establishDummyProjectBaseContext
:: Verbosity
-> ProjectConfig
-> DistDirLayout
-> [PackageSpecifier UnresolvedSourcePackage]
-> CurrentCommand
-> IO ProjectBaseContext
establishDummyProjectBaseContext :: Verbosity
-> ProjectConfig
-> DistDirLayout
-> [PackageSpecifier UnresolvedSourcePackage]
-> CurrentCommand
-> IO ProjectBaseContext
establishDummyProjectBaseContext Verbosity
verbosity ProjectConfig
projectConfig DistDirLayout
distDirLayout [PackageSpecifier UnresolvedSourcePackage]
localPackages CurrentCommand
currentCommand = do
String
cabalDir <- IO String
getCabalDir
let ProjectConfigBuildOnly {
Flag String
projectConfigLogsDir :: Flag String
projectConfigLogsDir :: ProjectConfigBuildOnly -> Flag String
projectConfigLogsDir
} = ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly ProjectConfig
projectConfig
ProjectConfigShared {
Flag String
projectConfigStoreDir :: Flag String
projectConfigStoreDir :: ProjectConfigShared -> Flag String
projectConfigStoreDir
} = ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
projectConfig
mlogsDir :: Maybe String
mlogsDir = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigLogsDir
mstoreDir :: Maybe String
mstoreDir = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigStoreDir
cabalDirLayout :: CabalDirLayout
cabalDirLayout = String -> Maybe String -> Maybe String -> CabalDirLayout
mkCabalDirLayout String
cabalDir Maybe String
mstoreDir Maybe String
mlogsDir
buildSettings :: BuildTimeSettings
buildSettings :: BuildTimeSettings
buildSettings = Verbosity -> CabalDirLayout -> ProjectConfig -> BuildTimeSettings
resolveBuildTimeSettings
Verbosity
verbosity CabalDirLayout
cabalDirLayout
ProjectConfig
projectConfig
ProjectBaseContext -> IO ProjectBaseContext
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext :: DistDirLayout
-> CabalDirLayout
-> ProjectConfig
-> [PackageSpecifier UnresolvedSourcePackage]
-> BuildTimeSettings
-> CurrentCommand
-> ProjectBaseContext
ProjectBaseContext {
DistDirLayout
distDirLayout :: DistDirLayout
distDirLayout :: DistDirLayout
distDirLayout,
CabalDirLayout
cabalDirLayout :: CabalDirLayout
cabalDirLayout :: CabalDirLayout
cabalDirLayout,
ProjectConfig
projectConfig :: ProjectConfig
projectConfig :: ProjectConfig
projectConfig,
[PackageSpecifier UnresolvedSourcePackage]
localPackages :: [PackageSpecifier UnresolvedSourcePackage]
localPackages :: [PackageSpecifier UnresolvedSourcePackage]
localPackages,
BuildTimeSettings
buildSettings :: BuildTimeSettings
buildSettings :: BuildTimeSettings
buildSettings,
CurrentCommand
currentCommand :: CurrentCommand
currentCommand :: CurrentCommand
currentCommand
}
establishDummyDistDirLayout :: Verbosity -> ProjectConfig -> FilePath -> IO DistDirLayout
establishDummyDistDirLayout :: Verbosity -> ProjectConfig -> String -> IO DistDirLayout
establishDummyDistDirLayout Verbosity
verbosity ProjectConfig
cliConfig String
tmpDir = do
let distDirLayout :: DistDirLayout
distDirLayout = ProjectRoot -> Maybe String -> DistDirLayout
defaultDistDirLayout ProjectRoot
projectRoot Maybe String
mdistDirectory
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ DistDirLayout -> String
distDirectory DistDirLayout
distDirLayout
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ DistDirLayout -> String
distProjectCacheDirectory DistDirLayout
distDirLayout
DistDirLayout -> IO DistDirLayout
forall (m :: * -> *) a. Monad m => a -> m a
return DistDirLayout
distDirLayout
where
mdistDirectory :: Maybe String
mdistDirectory = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe
(Flag String -> Maybe String) -> Flag String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ProjectConfigShared -> Flag String
projectConfigDistDir
(ProjectConfigShared -> Flag String)
-> ProjectConfigShared -> Flag String
forall a b. (a -> b) -> a -> b
$ ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig
projectRoot :: ProjectRoot
projectRoot = String -> ProjectRoot
ProjectRootImplicit String
tmpDir