{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Stack.Build.ConstructPlan
( constructPlan
) where
import Control.Monad.Trans.Maybe ( MaybeT (..) )
import qualified Data.Map.Merge.Strict as Map
import qualified Data.Map.Strict as Map
import Data.Monoid.Map ( MonoidMap(..) )
import qualified Data.Set as Set
import qualified Data.Text as T
import Distribution.Types.BuildType ( BuildType (Configure) )
import Distribution.Types.PackageName ( mkPackageName )
import Path ( parent )
import qualified RIO.NonEmpty as NE
import RIO.Process ( findExecutable )
import RIO.State
( State, StateT (..), execState, get, modify, modify', put )
import RIO.Writer ( WriterT (..), pass, tell )
import Stack.Build.Cache ( tryGetFlagCache )
import Stack.Build.Haddock ( shouldHaddockDeps )
import Stack.Build.Source ( loadLocalPackage )
import Stack.Constants ( compilerOptionsCabalFlag )
import Stack.Package
( applyForceCustomBuild, buildableExes, packageUnknownTools
, processPackageDepsToList
)
import Stack.Prelude hiding ( loadPackage )
import Stack.SourceMap ( getPLIVersion, mkProjectPackage )
import Stack.Types.Build
( CachePkgSrc (..), ConfigCache (..), Plan (..), Task (..)
, TaskConfigOpts (..), TaskType (..)
, installLocationIsMutable, taskIsTarget, taskLocation
, taskProvides, taskTargetIsMutable, toCachePkgSrc
)
import Stack.Types.Build.ConstructPlan
( AddDepRes (..), CombinedMap, Ctx (..), M, PackageInfo (..)
, ToolWarning(..), UnregisterState (..), W (..)
, adrHasLibrary, adrVersion, toTask
)
import Stack.Types.Build.Exception
( BadDependency (..), BuildException (..)
, BuildPrettyException (..), ConstructPlanException (..)
)
import Stack.Types.BuildConfig
( BuildConfig (..), HasBuildConfig (..), stackYamlL )
import Stack.Types.BuildOpts ( BuildOpts (..) )
import Stack.Types.BuildOptsCLI
( BuildOptsCLI (..), BuildSubset (..) )
import Stack.Types.CompCollection ( collectionMember )
import Stack.Types.Compiler ( WhichCompiler (..) )
import Stack.Types.CompilerPaths
( CompilerPaths (..), HasCompiler (..) )
import Stack.Types.Config ( Config (..), HasConfig (..), stackRootL )
import Stack.Types.ConfigureOpts
( BaseConfigOpts (..), ConfigureOpts (..) )
import qualified Stack.Types.ConfigureOpts as ConfigureOpts
import Stack.Types.Curator ( Curator (..) )
import Stack.Types.Dependency ( DepValue (..), isDepTypeLibrary )
import Stack.Types.DumpPackage ( DumpPackage (..), dpParentLibIdent )
import Stack.Types.EnvConfig ( EnvConfig (..), HasEnvConfig (..) )
import Stack.Types.EnvSettings
( EnvSettings (..), minimalEnvSettings )
import Stack.Types.GhcPkgId ( GhcPkgId )
import Stack.Types.GlobalOpts ( GlobalOpts (..) )
import Stack.Types.Installed
( InstallLocation (..), Installed (..), InstalledMap
, installedVersion
)
import Stack.Types.IsMutable ( IsMutable (..) )
import Stack.Types.NamedComponent ( exeComponents, renderComponent )
import Stack.Types.Package
( ExeName (..), LocalPackage (..), Package (..)
, PackageSource (..), installedMapGhcPkgId
, packageIdentifier, psVersion, runMemoizedWith
)
import Stack.Types.ProjectConfig ( isPCGlobalProject )
import Stack.Types.Runner ( HasRunner (..), globalOptsL )
import Stack.Types.SourceMap
( CommonPackage (..), DepPackage (..), FromSnapshot (..)
, GlobalPackage (..), SMTargets (..), SourceMap (..)
)
import Stack.Types.Version
( VersionRange, latestApplicableVersion, versionRangeText
, withinRange
)
import System.Environment ( lookupEnv )
constructPlan ::
forall env. HasEnvConfig env
=> BaseConfigOpts
-> [DumpPackage]
-> ( PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> RIO EnvConfig Package
)
-> SourceMap
-> InstalledMap
-> Bool
-> RIO env Plan
constructPlan :: forall env.
HasEnvConfig env =>
BaseConfigOpts
-> [DumpPackage]
-> (PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO EnvConfig Package)
-> SourceMap
-> InstalledMap
-> Bool
-> RIO env Plan
constructPlan
BaseConfigOpts
baseConfigOpts0
[DumpPackage]
localDumpPkgs
PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO EnvConfig Package
loadPackage0
SourceMap
sourceMap
InstalledMap
installedMap
Bool
initialBuildSteps
= do
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
?callStack::CallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Constructing the build plan"
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasBaseInDeps (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
StyleDoc -> RIO env ()
forall env (m :: * -> *).
(?callStack::CallStack, HasTerm env, MonadReader env m,
MonadIO m) =>
StyleDoc -> m ()
prettyWarn (StyleDoc -> RIO env ()) -> StyleDoc -> RIO env ()
forall a b. (a -> b) -> a -> b
$
[StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"You are trying to upgrade or downgrade the"
, Style -> StyleDoc -> StyleDoc
style Style
Current StyleDoc
"base"
, [Char] -> StyleDoc
flow [Char]
"package, which is almost certainly not what you really \
\want. Please, consider using another GHC version if you \
\need a certain version of"
, Style -> StyleDoc -> StyleDoc
style Style
Current StyleDoc
"base" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, [Char] -> StyleDoc
flow [Char]
"or removing"
, Style -> StyleDoc -> StyleDoc
style Style
Current StyleDoc
"base"
, [Char] -> StyleDoc
flow [Char]
"as an"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"extra-deps" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, [Char] -> StyleDoc
flow [Char]
"For further information, see"
, Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/commercialhaskell/stack/issues/3940" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
EnvConfig
econfig <- Getting EnvConfig env EnvConfig -> RIO env EnvConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EnvConfig env EnvConfig
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL
Version
globalCabalVersion <- Getting Version env Version -> RIO env Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Version env Version -> RIO env Version)
-> Getting Version env Version -> RIO env Version
forall a b. (a -> b) -> a -> b
$ Getting Version env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsL Getting Version env CompilerPaths
-> ((Version -> Const Version Version)
-> CompilerPaths -> Const Version CompilerPaths)
-> Getting Version env Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerPaths -> Version) -> SimpleGetter CompilerPaths Version
forall s a. (s -> a) -> SimpleGetter s a
to (.cabalVersion)
Map PackageName PackageSource
sources <- Version -> RIO env (Map PackageName PackageSource)
getSources Version
globalCabalVersion
Maybe Curator
curator <- Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator))
-> Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator)
forall a b. (a -> b) -> a -> b
$ (BuildConfig -> Const (Maybe Curator) BuildConfig)
-> env -> Const (Maybe Curator) env
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' env BuildConfig
buildConfigL ((BuildConfig -> Const (Maybe Curator) BuildConfig)
-> env -> Const (Maybe Curator) env)
-> ((Maybe Curator -> Const (Maybe Curator) (Maybe Curator))
-> BuildConfig -> Const (Maybe Curator) BuildConfig)
-> Getting (Maybe Curator) env (Maybe Curator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildConfig -> Maybe Curator)
-> SimpleGetter BuildConfig (Maybe Curator)
forall s a. (s -> a) -> SimpleGetter s a
to (.curator)
Text
pathEnvVar <- IO Text -> RIO env Text
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> RIO env Text) -> IO Text -> RIO env Text
forall a b. (a -> b) -> a -> b
$ Text -> ([Char] -> Text) -> Maybe [Char] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty [Char] -> Text
T.pack (Maybe [Char] -> Text) -> IO (Maybe [Char]) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"PATH"
let ctx :: Ctx
ctx = EnvConfig
-> Version
-> Map PackageName PackageSource
-> Maybe Curator
-> Text
-> Ctx
mkCtx EnvConfig
econfig Version
globalCabalVersion Map PackageName PackageSource
sources Maybe Curator
curator Text
pathEnvVar
targetPackageNames :: [PackageName]
targetPackageNames = Map PackageName Target -> [PackageName]
forall k a. Map k a -> [k]
Map.keys SourceMap
sourceMap.targets.targets
onTarget :: PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
onTarget = WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> (PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes))
-> PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
getCachedDepOrAddDep
inner :: WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
inner = (PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> [PackageName]
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
onTarget [PackageName]
targetPackageNames
(((), W Map PackageName (Either ConstructPlanException Task)
efinals Map Text InstallLocation
installExes Map PackageName Text
dirtyReason [StyleDoc] -> [StyleDoc]
warnings ParentMap
parents), Map PackageName (Either ConstructPlanException AddDepRes)
m) <-
IO
(((), W),
Map PackageName (Either ConstructPlanException AddDepRes))
-> RIO
env
(((), W),
Map PackageName (Either ConstructPlanException AddDepRes))
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(((), W),
Map PackageName (Either ConstructPlanException AddDepRes))
-> RIO
env
(((), W),
Map PackageName (Either ConstructPlanException AddDepRes)))
-> IO
(((), W),
Map PackageName (Either ConstructPlanException AddDepRes))
-> RIO
env
(((), W),
Map PackageName (Either ConstructPlanException AddDepRes))
forall a b. (a -> b) -> a -> b
$ Ctx
-> RIO
Ctx
(((), W),
Map PackageName (Either ConstructPlanException AddDepRes))
-> IO
(((), W),
Map PackageName (Either ConstructPlanException AddDepRes))
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO Ctx
ctx (StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)
((), W)
-> Map PackageName (Either ConstructPlanException AddDepRes)
-> RIO
Ctx
(((), W),
Map PackageName (Either ConstructPlanException AddDepRes))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
-> StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)
((), W)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
inner) Map PackageName (Either ConstructPlanException AddDepRes)
forall k a. Map k a
Map.empty)
(StyleDoc -> RIO env ()) -> [StyleDoc] -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ StyleDoc -> RIO env ()
forall env (m :: * -> *).
(?callStack::CallStack, HasTerm env, MonadReader env m,
MonadIO m) =>
StyleDoc -> m ()
prettyWarn ([StyleDoc] -> [StyleDoc]
warnings [])
let ([ConstructPlanException]
errlibs, [(PackageName, AddDepRes)]
adrs) = [Either ConstructPlanException (PackageName, AddDepRes)]
-> ([ConstructPlanException], [(PackageName, AddDepRes)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ConstructPlanException (PackageName, AddDepRes)]
-> ([ConstructPlanException], [(PackageName, AddDepRes)]))
-> [Either ConstructPlanException (PackageName, AddDepRes)]
-> ([ConstructPlanException], [(PackageName, AddDepRes)])
forall a b. (a -> b) -> a -> b
$ ((PackageName, Either ConstructPlanException AddDepRes)
-> Either ConstructPlanException (PackageName, AddDepRes))
-> [(PackageName, Either ConstructPlanException AddDepRes)]
-> [Either ConstructPlanException (PackageName, AddDepRes)]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName, Either ConstructPlanException AddDepRes)
-> Either ConstructPlanException (PackageName, AddDepRes)
forall k e v. (k, Either e v) -> Either e (k, v)
toEither ([(PackageName, Either ConstructPlanException AddDepRes)]
-> [Either ConstructPlanException (PackageName, AddDepRes)])
-> [(PackageName, Either ConstructPlanException AddDepRes)]
-> [Either ConstructPlanException (PackageName, AddDepRes)]
forall a b. (a -> b) -> a -> b
$ Map PackageName (Either ConstructPlanException AddDepRes)
-> [(PackageName, Either ConstructPlanException AddDepRes)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName (Either ConstructPlanException AddDepRes)
m
([ConstructPlanException]
errfinals, [(PackageName, Task)]
finals) =
[Either ConstructPlanException (PackageName, Task)]
-> ([ConstructPlanException], [(PackageName, Task)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ConstructPlanException (PackageName, Task)]
-> ([ConstructPlanException], [(PackageName, Task)]))
-> [Either ConstructPlanException (PackageName, Task)]
-> ([ConstructPlanException], [(PackageName, Task)])
forall a b. (a -> b) -> a -> b
$ ((PackageName, Either ConstructPlanException Task)
-> Either ConstructPlanException (PackageName, Task))
-> [(PackageName, Either ConstructPlanException Task)]
-> [Either ConstructPlanException (PackageName, Task)]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName, Either ConstructPlanException Task)
-> Either ConstructPlanException (PackageName, Task)
forall k e v. (k, Either e v) -> Either e (k, v)
toEither ([(PackageName, Either ConstructPlanException Task)]
-> [Either ConstructPlanException (PackageName, Task)])
-> [(PackageName, Either ConstructPlanException Task)]
-> [Either ConstructPlanException (PackageName, Task)]
forall a b. (a -> b) -> a -> b
$ Map PackageName (Either ConstructPlanException Task)
-> [(PackageName, Either ConstructPlanException Task)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName (Either ConstructPlanException Task)
efinals
errs :: [ConstructPlanException]
errs = [ConstructPlanException]
errlibs [ConstructPlanException]
-> [ConstructPlanException] -> [ConstructPlanException]
forall a. [a] -> [a] -> [a]
++ [ConstructPlanException]
errfinals
if [ConstructPlanException] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConstructPlanException]
errs
then do
let tasks :: Map PackageName Task
tasks = [(PackageName, Task)] -> Map PackageName Task
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PackageName, Task)] -> Map PackageName Task)
-> [(PackageName, Task)] -> Map PackageName Task
forall a b. (a -> b) -> a -> b
$ ((PackageName, AddDepRes) -> Maybe (PackageName, Task))
-> [(PackageName, AddDepRes)] -> [(PackageName, Task)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((PackageName, Maybe Task) -> Maybe (PackageName, Task)
forall k v. (k, Maybe v) -> Maybe (k, v)
toMaybe ((PackageName, Maybe Task) -> Maybe (PackageName, Task))
-> ((PackageName, AddDepRes) -> (PackageName, Maybe Task))
-> (PackageName, AddDepRes)
-> Maybe (PackageName, Task)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddDepRes -> Maybe Task)
-> (PackageName, AddDepRes) -> (PackageName, Maybe Task)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second AddDepRes -> Maybe Task
toTask) [(PackageName, AddDepRes)]
adrs
Plan -> RIO env Plan
takeSubset Plan
{ $sel:tasks:Plan :: Map PackageName Task
tasks = Map PackageName Task
tasks
, $sel:finals:Plan :: Map PackageName Task
finals = [(PackageName, Task)] -> Map PackageName Task
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PackageName, Task)]
finals
, $sel:unregisterLocal:Plan :: Map GhcPkgId (PackageIdentifier, Text)
unregisterLocal =
Map PackageName Task
-> Map PackageName Text
-> [DumpPackage]
-> Bool
-> Map GhcPkgId (PackageIdentifier, Text)
mkUnregisterLocal Map PackageName Task
tasks Map PackageName Text
dirtyReason [DumpPackage]
localDumpPkgs Bool
initialBuildSteps
, $sel:installExes:Plan :: Map Text InstallLocation
installExes =
if BaseConfigOpts
baseConfigOpts0.buildOpts.installExes
Bool -> Bool -> Bool
|| BaseConfigOpts
baseConfigOpts0.buildOpts.installCompilerTool
then Map Text InstallLocation
installExes
else Map Text InstallLocation
forall k a. Map k a
Map.empty
}
else do
Path Abs File
stackYaml <- Getting (Path Abs File) env (Path Abs File)
-> RIO env (Path Abs File)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs File) env (Path Abs File)
forall env. HasBuildConfig env => Lens' env (Path Abs File)
Lens' env (Path Abs File)
stackYamlL
Path Abs Dir
stackRoot <- Getting (Path Abs Dir) env (Path Abs Dir) -> RIO env (Path Abs Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs Dir) env (Path Abs Dir)
forall s. HasConfig s => Lens' s (Path Abs Dir)
Lens' env (Path Abs Dir)
stackRootL
Bool
isImplicitGlobal <-
Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool env Bool -> RIO env Bool)
-> Getting Bool env Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config) -> env -> Const Bool env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL ((Config -> Const Bool Config) -> env -> Const Bool env)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> Getting Bool env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Bool) -> SimpleGetter Config Bool
forall s a. (s -> a) -> SimpleGetter s a
to (ProjectConfig (Project, Path Abs File) -> Bool
forall a. ProjectConfig a -> Bool
isPCGlobalProject (ProjectConfig (Project, Path Abs File) -> Bool)
-> (Config -> ProjectConfig (Project, Path Abs File))
-> Config
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.project))
BuildPrettyException -> RIO env Plan
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, Pretty e) =>
e -> m a
prettyThrowM (BuildPrettyException -> RIO env Plan)
-> BuildPrettyException -> RIO env Plan
forall a b. (a -> b) -> a -> b
$ [ConstructPlanException]
-> Path Abs File
-> Path Abs Dir
-> Bool
-> ParentMap
-> Set PackageName
-> Map PackageName [PackageName]
-> BuildPrettyException
ConstructPlanFailed
[ConstructPlanException]
errs
Path Abs File
stackYaml
Path Abs Dir
stackRoot
Bool
isImplicitGlobal
ParentMap
parents
Ctx
ctx.wanted
Map PackageName [PackageName]
prunedGlobalDeps
where
sourceProject :: Map PackageName ProjectPackage
sourceProject = SourceMap
sourceMap.project
sourceDeps :: Map PackageName DepPackage
sourceDeps = SourceMap
sourceMap.deps
hasBaseInDeps :: Bool
hasBaseInDeps = PackageName -> Map PackageName DepPackage -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member ([Char] -> PackageName
mkPackageName [Char]
"base") Map PackageName DepPackage
sourceDeps
mkCtx :: EnvConfig
-> Version
-> Map PackageName PackageSource
-> Maybe Curator
-> Text
-> Ctx
mkCtx EnvConfig
ctxEnvConfig Version
globalCabalVersion Map PackageName PackageSource
sources Maybe Curator
curator Text
pathEnvVar = Ctx
{ baseConfigOpts :: BaseConfigOpts
baseConfigOpts = BaseConfigOpts
baseConfigOpts0
, loadPackage :: PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Package
loadPackage = \PackageLocationImmutable
w Map FlagName Bool
x [Text]
y [Text]
z -> EnvConfig
-> RIO EnvConfig Package
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Package
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO EnvConfig
ctxEnvConfig (RIO EnvConfig Package
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Package)
-> RIO EnvConfig Package
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Package
forall a b. (a -> b) -> a -> b
$
Version -> Package -> Package
applyForceCustomBuild Version
globalCabalVersion (Package -> Package)
-> RIO EnvConfig Package -> RIO EnvConfig Package
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO EnvConfig Package
loadPackage0 PackageLocationImmutable
w Map FlagName Bool
x [Text]
y [Text]
z
, combinedMap :: Map PackageName PackageInfo
combinedMap = Map PackageName PackageSource
-> InstalledMap -> Map PackageName PackageInfo
combineMap Map PackageName PackageSource
sources InstalledMap
installedMap
, EnvConfig
ctxEnvConfig :: EnvConfig
ctxEnvConfig :: EnvConfig
ctxEnvConfig
, callStack :: [PackageName]
callStack = []
, wanted :: Set PackageName
wanted = Map PackageName Target -> Set PackageName
forall k a. Map k a -> Set k
Map.keysSet SourceMap
sourceMap.targets.targets
, localNames :: Set PackageName
localNames = Map PackageName ProjectPackage -> Set PackageName
forall k a. Map k a -> Set k
Map.keysSet Map PackageName ProjectPackage
sourceProject
, Maybe Curator
curator :: Maybe Curator
curator :: Maybe Curator
curator
, Text
pathEnvVar :: Text
pathEnvVar :: Text
pathEnvVar
}
toEither :: (k, Either e v) -> Either e (k, v)
toEither :: forall k e v. (k, Either e v) -> Either e (k, v)
toEither (k
_, Left e
e) = e -> Either e (k, v)
forall a b. a -> Either a b
Left e
e
toEither (k
k, Right v
v) = (k, v) -> Either e (k, v)
forall a b. b -> Either a b
Right (k
k, v
v)
toMaybe :: (k, Maybe v) -> Maybe (k, v)
toMaybe :: forall k v. (k, Maybe v) -> Maybe (k, v)
toMaybe (k
_, Maybe v
Nothing) = Maybe (k, v)
forall a. Maybe a
Nothing
toMaybe (k
k, Just v
v) = (k, v) -> Maybe (k, v)
forall a. a -> Maybe a
Just (k
k, v
v)
takeSubset :: Plan -> RIO env Plan
takeSubset :: Plan -> RIO env Plan
takeSubset = case BaseConfigOpts
baseConfigOpts0.buildOptsCLI.buildSubset of
BuildSubset
BSAll -> Plan -> RIO env Plan
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
BuildSubset
BSOnlySnapshot -> Plan -> RIO env Plan
stripLocals
BuildSubset
BSOnlyDependencies -> Plan -> RIO env Plan
stripNonDeps
BuildSubset
BSOnlyLocals -> Plan -> RIO env Plan
errorOnSnapshot
stripLocals :: Plan -> RIO env Plan
stripLocals :: Plan -> RIO env Plan
stripLocals Plan
plan = Plan -> RIO env Plan
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Plan
plan
{ tasks = Map.filter checkTask plan.tasks
, finals = Map.empty
, unregisterLocal = Map.empty
, installExes = Map.filter (/= Local) plan.installExes
}
where
checkTask :: Task -> Bool
checkTask Task
task = Task -> InstallLocation
taskLocation Task
task InstallLocation -> InstallLocation -> Bool
forall a. Eq a => a -> a -> Bool
== InstallLocation
Snap
stripNonDeps :: Plan -> RIO env Plan
stripNonDeps :: Plan -> RIO env Plan
stripNonDeps Plan
plan = Plan -> RIO env Plan
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Plan
plan
{ tasks = Map.filter checkTask plan.tasks
, finals = Map.empty
, installExes = Map.empty
}
where
deps :: Set PackageName
deps = Map PackageName DepPackage -> Set PackageName
forall k a. Map k a -> Set k
Map.keysSet Map PackageName DepPackage
sourceDeps
checkTask :: Task -> Bool
checkTask Task
task = Task -> PackageIdentifier
taskProvides Task
task PackageIdentifier -> Set PackageIdentifier -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageIdentifier
missingForDeps
providesDep :: Task -> Bool
providesDep Task
task = PackageIdentifier -> PackageName
pkgName (Task -> PackageIdentifier
taskProvides Task
task) PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageName
deps
tasks :: [Task]
tasks = Map PackageName Task -> [Task]
forall k a. Map k a -> [a]
Map.elems Plan
plan.tasks
missing :: Map PackageIdentifier (Set PackageIdentifier)
missing =
[(PackageIdentifier, Set PackageIdentifier)]
-> Map PackageIdentifier (Set PackageIdentifier)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PackageIdentifier, Set PackageIdentifier)]
-> Map PackageIdentifier (Set PackageIdentifier))
-> [(PackageIdentifier, Set PackageIdentifier)]
-> Map PackageIdentifier (Set PackageIdentifier)
forall a b. (a -> b) -> a -> b
$ (Task -> (PackageIdentifier, Set PackageIdentifier))
-> [Task] -> [(PackageIdentifier, Set PackageIdentifier)]
forall a b. (a -> b) -> [a] -> [b]
map (Task -> PackageIdentifier
taskProvides (Task -> PackageIdentifier)
-> (Task -> Set PackageIdentifier)
-> Task
-> (PackageIdentifier, Set PackageIdentifier)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (.configOpts.missing)) [Task]
tasks
missingForDeps :: Set PackageIdentifier
missingForDeps = (State (Set PackageIdentifier) ()
-> Set PackageIdentifier -> Set PackageIdentifier)
-> Set PackageIdentifier
-> State (Set PackageIdentifier) ()
-> Set PackageIdentifier
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (Set PackageIdentifier) ()
-> Set PackageIdentifier -> Set PackageIdentifier
forall s a. State s a -> s -> s
execState Set PackageIdentifier
forall a. Monoid a => a
mempty (State (Set PackageIdentifier) () -> Set PackageIdentifier)
-> State (Set PackageIdentifier) () -> Set PackageIdentifier
forall a b. (a -> b) -> a -> b
$
[Task]
-> (Task -> State (Set PackageIdentifier) ())
-> State (Set PackageIdentifier) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Task]
tasks ((Task -> State (Set PackageIdentifier) ())
-> State (Set PackageIdentifier) ())
-> (Task -> State (Set PackageIdentifier) ())
-> State (Set PackageIdentifier) ()
forall a b. (a -> b) -> a -> b
$ \Task
task ->
Bool
-> State (Set PackageIdentifier) ()
-> State (Set PackageIdentifier) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Task -> Bool
providesDep Task
task) (State (Set PackageIdentifier) ()
-> State (Set PackageIdentifier) ())
-> State (Set PackageIdentifier) ()
-> State (Set PackageIdentifier) ()
forall a b. (a -> b) -> a -> b
$
[PackageIdentifier]
-> PackageIdentifier -> State (Set PackageIdentifier) ()
forall {m :: * -> *}.
MonadState (Set PackageIdentifier) m =>
[PackageIdentifier] -> PackageIdentifier -> m ()
collectMissing [PackageIdentifier]
forall a. Monoid a => a
mempty (Task -> PackageIdentifier
taskProvides Task
task)
collectMissing :: [PackageIdentifier] -> PackageIdentifier -> m ()
collectMissing [PackageIdentifier]
dependents PackageIdentifier
pid = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageIdentifier
pid PackageIdentifier -> [PackageIdentifier] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageIdentifier]
dependents) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
BuildException -> m ()
forall e a. Exception e => e -> a
impureThrow (BuildException -> m ()) -> BuildException -> m ()
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> BuildException
TaskCycleBug PackageIdentifier
pid
(Set PackageIdentifier -> Set PackageIdentifier) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Set PackageIdentifier
-> Set PackageIdentifier -> Set PackageIdentifier
forall a. Semigroup a => a -> a -> a
<> PackageIdentifier -> Set PackageIdentifier
forall a. a -> Set a
Set.singleton PackageIdentifier
pid)
(PackageIdentifier -> m ()) -> Set PackageIdentifier -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
([PackageIdentifier] -> PackageIdentifier -> m ()
collectMissing (PackageIdentifier
pidPackageIdentifier -> [PackageIdentifier] -> [PackageIdentifier]
forall a. a -> [a] -> [a]
:[PackageIdentifier]
dependents))
(Set PackageIdentifier
-> Maybe (Set PackageIdentifier) -> Set PackageIdentifier
forall a. a -> Maybe a -> a
fromMaybe Set PackageIdentifier
forall a. Monoid a => a
mempty (Maybe (Set PackageIdentifier) -> Set PackageIdentifier)
-> Maybe (Set PackageIdentifier) -> Set PackageIdentifier
forall a b. (a -> b) -> a -> b
$ PackageIdentifier
-> Map PackageIdentifier (Set PackageIdentifier)
-> Maybe (Set PackageIdentifier)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageIdentifier
pid Map PackageIdentifier (Set PackageIdentifier)
missing)
errorOnSnapshot :: Plan -> RIO env Plan
errorOnSnapshot :: Plan -> RIO env Plan
errorOnSnapshot plan :: Plan
plan@(Plan Map PackageName Task
tasks Map PackageName Task
_finals Map GhcPkgId (PackageIdentifier, Text)
_unregister Map Text InstallLocation
installExes) = do
let snapTasks :: [PackageName]
snapTasks = Map PackageName Task -> [PackageName]
forall k a. Map k a -> [k]
Map.keys (Map PackageName Task -> [PackageName])
-> Map PackageName Task -> [PackageName]
forall a b. (a -> b) -> a -> b
$ (Task -> Bool) -> Map PackageName Task -> Map PackageName Task
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\Task
t -> Task -> InstallLocation
taskLocation Task
t InstallLocation -> InstallLocation -> Bool
forall a. Eq a => a -> a -> Bool
== InstallLocation
Snap) Map PackageName Task
tasks
snapExes :: [Text]
snapExes = Map Text InstallLocation -> [Text]
forall k a. Map k a -> [k]
Map.keys (Map Text InstallLocation -> [Text])
-> Map Text InstallLocation -> [Text]
forall a b. (a -> b) -> a -> b
$ (InstallLocation -> Bool)
-> Map Text InstallLocation -> Map Text InstallLocation
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (InstallLocation -> InstallLocation -> Bool
forall a. Eq a => a -> a -> Bool
== InstallLocation
Snap) Map Text InstallLocation
installExes
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PackageName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageName]
snapTasks Bool -> Bool -> Bool
&& [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
snapExes) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
BuildPrettyException -> RIO env ()
forall e (m :: * -> *) a.
(Exception e, MonadIO m, Pretty e) =>
e -> m a
prettyThrowIO (BuildPrettyException -> RIO env ())
-> BuildPrettyException -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [PackageName] -> [Text] -> BuildPrettyException
NotOnlyLocal [PackageName]
snapTasks [Text]
snapExes
Plan -> RIO env Plan
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Plan
plan
prunedGlobalDeps :: Map PackageName [PackageName]
prunedGlobalDeps :: Map PackageName [PackageName]
prunedGlobalDeps = ((GlobalPackage -> Maybe [PackageName])
-> Map PackageName GlobalPackage -> Map PackageName [PackageName])
-> Map PackageName GlobalPackage
-> (GlobalPackage -> Maybe [PackageName])
-> Map PackageName [PackageName]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (GlobalPackage -> Maybe [PackageName])
-> Map PackageName GlobalPackage -> Map PackageName [PackageName]
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe SourceMap
sourceMap.globalPkgs ((GlobalPackage -> Maybe [PackageName])
-> Map PackageName [PackageName])
-> (GlobalPackage -> Maybe [PackageName])
-> Map PackageName [PackageName]
forall a b. (a -> b) -> a -> b
$
\case
ReplacedGlobalPackage [PackageName]
deps ->
let pruned :: [PackageName]
pruned = (PackageName -> Bool) -> [PackageName] -> [PackageName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (PackageName -> Bool) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Bool
inSourceMap) [PackageName]
deps
in if [PackageName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageName]
pruned then Maybe [PackageName]
forall a. Maybe a
Nothing else [PackageName] -> Maybe [PackageName]
forall a. a -> Maybe a
Just [PackageName]
pruned
GlobalPackage Version
_ -> Maybe [PackageName]
forall a. Maybe a
Nothing
where
inSourceMap :: PackageName -> Bool
inSourceMap PackageName
pname =
PackageName
pname PackageName -> Map PackageName DepPackage -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map PackageName DepPackage
sourceDeps Bool -> Bool -> Bool
|| PackageName
pname PackageName -> Map PackageName ProjectPackage -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map PackageName ProjectPackage
sourceProject
getSources :: Version -> RIO env (Map PackageName PackageSource)
getSources :: Version -> RIO env (Map PackageName PackageSource)
getSources Version
globalCabalVersion = do
let loadLocalPackage' :: ProjectPackage -> RIO env LocalPackage
loadLocalPackage' ProjectPackage
pp = do
LocalPackage
lp <- ProjectPackage -> RIO env LocalPackage
forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage ProjectPackage
pp
let lpPackage' :: Package
lpPackage' =
Version -> Package -> Package
applyForceCustomBuild Version
globalCabalVersion LocalPackage
lp.package
LocalPackage -> RIO env LocalPackage
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalPackage
lp { package = lpPackage' }
Map PackageName PackageSource
pPackages <- Map PackageName ProjectPackage
-> (ProjectPackage -> RIO env PackageSource)
-> RIO env (Map PackageName PackageSource)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map PackageName ProjectPackage
sourceProject ((ProjectPackage -> RIO env PackageSource)
-> RIO env (Map PackageName PackageSource))
-> (ProjectPackage -> RIO env PackageSource)
-> RIO env (Map PackageName PackageSource)
forall a b. (a -> b) -> a -> b
$ \ProjectPackage
pp -> do
LocalPackage
lp <- ProjectPackage -> RIO env LocalPackage
forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage' ProjectPackage
pp
PackageSource -> RIO env PackageSource
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageSource -> RIO env PackageSource)
-> PackageSource -> RIO env PackageSource
forall a b. (a -> b) -> a -> b
$ LocalPackage -> PackageSource
PSFilePath LocalPackage
lp
BuildOpts
bopts <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting BuildOpts env BuildOpts -> RIO env BuildOpts)
-> Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall a b. (a -> b) -> a -> b
$ (Config -> Const BuildOpts Config) -> env -> Const BuildOpts env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL ((Config -> Const BuildOpts Config) -> env -> Const BuildOpts env)
-> ((BuildOpts -> Const BuildOpts BuildOpts)
-> Config -> Const BuildOpts Config)
-> Getting BuildOpts env BuildOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> BuildOpts) -> SimpleGetter Config BuildOpts
forall s a. (s -> a) -> SimpleGetter s a
to (.build)
Map PackageName PackageSource
deps <- Map PackageName DepPackage
-> (DepPackage -> RIO env PackageSource)
-> RIO env (Map PackageName PackageSource)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map PackageName DepPackage
sourceDeps ((DepPackage -> RIO env PackageSource)
-> RIO env (Map PackageName PackageSource))
-> (DepPackage -> RIO env PackageSource)
-> RIO env (Map PackageName PackageSource)
forall a b. (a -> b) -> a -> b
$ \DepPackage
dp ->
case DepPackage
dp.location of
PLImmutable PackageLocationImmutable
loc ->
PackageSource -> RIO env PackageSource
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageSource -> RIO env PackageSource)
-> PackageSource -> RIO env PackageSource
forall a b. (a -> b) -> a -> b
$
PackageLocationImmutable
-> Version -> FromSnapshot -> CommonPackage -> PackageSource
PSRemote PackageLocationImmutable
loc (PackageLocationImmutable -> Version
getPLIVersion PackageLocationImmutable
loc) DepPackage
dp.fromSnapshot DepPackage
dp.depCommon
PLMutable ResolvedPath Dir
dir -> do
ProjectPackage
pp <- PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
mkProjectPackage PrintWarnings
YesPrintWarnings ResolvedPath Dir
dir (BuildOpts -> Bool
shouldHaddockDeps BuildOpts
bopts)
LocalPackage
lp <- ProjectPackage -> RIO env LocalPackage
forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage' ProjectPackage
pp
PackageSource -> RIO env PackageSource
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageSource -> RIO env PackageSource)
-> PackageSource -> RIO env PackageSource
forall a b. (a -> b) -> a -> b
$ LocalPackage -> PackageSource
PSFilePath LocalPackage
lp
Map PackageName PackageSource
-> RIO env (Map PackageName PackageSource)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map PackageName PackageSource
-> RIO env (Map PackageName PackageSource))
-> Map PackageName PackageSource
-> RIO env (Map PackageName PackageSource)
forall a b. (a -> b) -> a -> b
$ Map PackageName PackageSource
pPackages Map PackageName PackageSource
-> Map PackageName PackageSource -> Map PackageName PackageSource
forall a. Semigroup a => a -> a -> a
<> Map PackageName PackageSource
deps
mkUnregisterLocal ::
Map PackageName Task
-> Map PackageName Text
-> [DumpPackage]
-> Bool
-> Map GhcPkgId (PackageIdentifier, Text)
mkUnregisterLocal :: Map PackageName Task
-> Map PackageName Text
-> [DumpPackage]
-> Bool
-> Map GhcPkgId (PackageIdentifier, Text)
mkUnregisterLocal Map PackageName Task
tasks Map PackageName Text
dirtyReason [DumpPackage]
localDumpPkgs Bool
initialBuildSteps =
Map GhcPkgId (PackageIdentifier, Text)
-> [DumpPackage] -> Map GhcPkgId (PackageIdentifier, Text)
loop Map GhcPkgId (PackageIdentifier, Text)
forall k a. Map k a
Map.empty [DumpPackage]
localDumpPkgs
where
loop ::
Map GhcPkgId (PackageIdentifier, Text)
-> [DumpPackage]
-> Map GhcPkgId (PackageIdentifier, Text)
loop :: Map GhcPkgId (PackageIdentifier, Text)
-> [DumpPackage] -> Map GhcPkgId (PackageIdentifier, Text)
loop Map GhcPkgId (PackageIdentifier, Text)
toUnregister [DumpPackage]
keep
| UnregisterState
us.anyAdded = Map GhcPkgId (PackageIdentifier, Text)
-> [DumpPackage] -> Map GhcPkgId (PackageIdentifier, Text)
loop UnregisterState
us.toUnregister UnregisterState
us.toKeep
| Bool
otherwise = UnregisterState
us.toUnregister
where
us :: UnregisterState
us = State UnregisterState () -> UnregisterState -> UnregisterState
forall s a. State s a -> s -> s
execState ((DumpPackage -> State UnregisterState ())
-> [DumpPackage] -> State UnregisterState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DumpPackage -> State UnregisterState ()
go [DumpPackage]
keep) UnregisterState
initialUnregisterState
initialUnregisterState :: UnregisterState
initialUnregisterState = UnregisterState
{ Map GhcPkgId (PackageIdentifier, Text)
toUnregister :: Map GhcPkgId (PackageIdentifier, Text)
toUnregister :: Map GhcPkgId (PackageIdentifier, Text)
toUnregister
, toKeep :: [DumpPackage]
toKeep = []
, anyAdded :: Bool
anyAdded = Bool
False
}
go :: DumpPackage -> State UnregisterState ()
go :: DumpPackage -> State UnregisterState ()
go DumpPackage
dp = do
UnregisterState
us <- StateT UnregisterState Identity UnregisterState
forall s (m :: * -> *). MonadState s m => m s
get
case Map GhcPkgId (PackageIdentifier, Text)
-> PackageIdentifier
-> Maybe PackageIdentifier
-> [GhcPkgId]
-> Maybe Text
maybeUnregisterReason UnregisterState
us.toUnregister PackageIdentifier
ident Maybe PackageIdentifier
mParentLibId [GhcPkgId]
deps of
Maybe Text
Nothing -> UnregisterState -> State UnregisterState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put UnregisterState
us { toKeep = dp : us.toKeep }
Just Text
reason -> UnregisterState -> State UnregisterState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put UnregisterState
us
{ toUnregister = Map.insert gid (ident, reason) us.toUnregister
, anyAdded = True
}
where
gid :: GhcPkgId
gid = DumpPackage
dp.ghcPkgId
ident :: PackageIdentifier
ident = DumpPackage
dp.packageIdent
mParentLibId :: Maybe PackageIdentifier
mParentLibId = DumpPackage -> Maybe PackageIdentifier
dpParentLibIdent DumpPackage
dp
deps :: [GhcPkgId]
deps = DumpPackage
dp.depends
maybeUnregisterReason ::
Map GhcPkgId (PackageIdentifier, Text)
-> PackageIdentifier
-> Maybe PackageIdentifier
-> [GhcPkgId]
-> Maybe Text
maybeUnregisterReason :: Map GhcPkgId (PackageIdentifier, Text)
-> PackageIdentifier
-> Maybe PackageIdentifier
-> [GhcPkgId]
-> Maybe Text
maybeUnregisterReason Map GhcPkgId (PackageIdentifier, Text)
toUnregister PackageIdentifier
ident Maybe PackageIdentifier
mParentLibId [GhcPkgId]
deps
| Just Task
task <- PackageName -> Map PackageName Task -> Maybe Task
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
relevantPkgName Map PackageName Task
tasks =
if Bool
initialBuildSteps
Bool -> Bool -> Bool
&& Task -> Bool
taskIsTarget Task
task
Bool -> Bool -> Bool
&& Task -> PackageIdentifier
taskProvides Task
task PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier
relevantPkgId
then Maybe Text
forall a. Maybe a
Nothing
else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> Map PackageName Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
relevantPkgName Map PackageName Text
dirtyReason
| (PackageIdentifier
dep, Text
_):[(PackageIdentifier, Text)]
_ <- (GhcPkgId -> Maybe (PackageIdentifier, Text))
-> [GhcPkgId] -> [(PackageIdentifier, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (GhcPkgId
-> Map GhcPkgId (PackageIdentifier, Text)
-> Maybe (PackageIdentifier, Text)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map GhcPkgId (PackageIdentifier, Text)
toUnregister) [GhcPkgId]
deps =
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Dependency being unregistered: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
dep)
| Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing
where
relevantPkgId :: PackageIdentifier
relevantPkgId :: PackageIdentifier
relevantPkgId = PackageIdentifier -> Maybe PackageIdentifier -> PackageIdentifier
forall a. a -> Maybe a -> a
fromMaybe PackageIdentifier
ident Maybe PackageIdentifier
mParentLibId
relevantPkgName :: PackageName
relevantPkgName :: PackageName
relevantPkgName = PackageName
-> (PackageIdentifier -> PackageName)
-> Maybe PackageIdentifier
-> PackageName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PackageIdentifier -> PackageName
pkgName PackageIdentifier
ident) PackageIdentifier -> PackageName
pkgName Maybe PackageIdentifier
mParentLibId
addFinal ::
LocalPackage
-> Package
-> Bool
-> Bool
-> M ()
addFinal :: LocalPackage
-> Package
-> Bool
-> Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
addFinal LocalPackage
lp Package
package Bool
isAllInOne Bool
buildHaddocks = do
Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
depsRes <- Package
-> M (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
addPackageDeps Package
package
Either ConstructPlanException Task
res <- case Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
depsRes of
Left ConstructPlanException
e -> Either ConstructPlanException Task
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException Task)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConstructPlanException Task
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException Task))
-> Either ConstructPlanException Task
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException Task)
forall a b. (a -> b) -> a -> b
$ ConstructPlanException -> Either ConstructPlanException Task
forall a b. a -> Either a b
Left ConstructPlanException
e
Right (Set PackageIdentifier
missing, Map PackageIdentifier GhcPkgId
present, IsMutable
_minLoc) -> do
Ctx
ctx <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Ctx
forall r (m :: * -> *). MonadReader r m => m r
ask
Either ConstructPlanException Task
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException Task)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConstructPlanException Task
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException Task))
-> Either ConstructPlanException Task
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException Task)
forall a b. (a -> b) -> a -> b
$ Task -> Either ConstructPlanException Task
forall a b. b -> Either a b
Right Task
{ $sel:configOpts:Task :: TaskConfigOpts
configOpts = Set PackageIdentifier
-> (Map PackageIdentifier GhcPkgId -> ConfigureOpts)
-> TaskConfigOpts
TaskConfigOpts Set PackageIdentifier
missing ((Map PackageIdentifier GhcPkgId -> ConfigureOpts)
-> TaskConfigOpts)
-> (Map PackageIdentifier GhcPkgId -> ConfigureOpts)
-> TaskConfigOpts
forall a b. (a -> b) -> a -> b
$ \Map PackageIdentifier GhcPkgId
missing' ->
let allDeps :: Map PackageIdentifier GhcPkgId
allDeps = Map PackageIdentifier GhcPkgId
-> Map PackageIdentifier GhcPkgId -> Map PackageIdentifier GhcPkgId
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map PackageIdentifier GhcPkgId
present Map PackageIdentifier GhcPkgId
missing'
in EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> IsMutable
-> Package
-> ConfigureOpts
ConfigureOpts.configureOpts
(Getting EnvConfig Ctx EnvConfig -> Ctx -> EnvConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EnvConfig Ctx EnvConfig
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' Ctx EnvConfig
envConfigL Ctx
ctx)
Ctx
ctx.baseConfigOpts
Map PackageIdentifier GhcPkgId
allDeps
Bool
True
IsMutable
Mutable
Package
package
, Bool
buildHaddocks :: Bool
$sel:buildHaddocks:Task :: Bool
buildHaddocks
, Map PackageIdentifier GhcPkgId
present :: Map PackageIdentifier GhcPkgId
$sel:present:Task :: Map PackageIdentifier GhcPkgId
present
, $sel:taskType:Task :: TaskType
taskType = LocalPackage -> TaskType
TTLocalMutable LocalPackage
lp
, $sel:allInOne:Task :: Bool
allInOne = Bool
isAllInOne
, $sel:cachePkgSrc:Task :: CachePkgSrc
cachePkgSrc = [Char] -> CachePkgSrc
CacheSrcLocal (Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent LocalPackage
lp.cabalFP))
, $sel:buildTypeConfig:Task :: Bool
buildTypeConfig = Package -> Bool
packageBuildTypeConfig Package
package
}
W
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell W
forall a. Monoid a => a
mempty { wFinals = Map.singleton package.name res }
getCachedDepOrAddDep ::
PackageName
-> M (Either ConstructPlanException AddDepRes)
getCachedDepOrAddDep :: PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
getCachedDepOrAddDep PackageName
name = do
Map PackageName (Either ConstructPlanException AddDepRes)
libMap <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Map PackageName (Either ConstructPlanException AddDepRes))
forall s (m :: * -> *). MonadState s m => m s
get
case PackageName
-> Map PackageName (Either ConstructPlanException AddDepRes)
-> Maybe (Either ConstructPlanException AddDepRes)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName (Either ConstructPlanException AddDepRes)
libMap of
Just Either ConstructPlanException AddDepRes
res -> do
Text
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall env (m :: * -> *).
(?callStack::CallStack, HasRunner env, MonadIO m,
MonadReader env m) =>
Text -> Utf8Builder -> m ()
logDebugPlanS Text
"getCachedDepOrAddDep" (Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Using cached result for "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageName -> Utf8Builder
forall a. IsString a => PackageName -> a
fromPackageName PackageName
name
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Either ConstructPlanException AddDepRes -> [Char]
forall a. Show a => a -> [Char]
show Either ConstructPlanException AddDepRes
res)
Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ConstructPlanException AddDepRes
res
Maybe (Either ConstructPlanException AddDepRes)
Nothing -> PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
checkCallStackAndAddDep PackageName
name
checkCallStackAndAddDep ::
PackageName
-> M (Either ConstructPlanException AddDepRes)
checkCallStackAndAddDep :: PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
checkCallStackAndAddDep PackageName
name = do
Ctx
ctx <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Ctx
forall r (m :: * -> *). MonadReader r m => m r
ask
Either ConstructPlanException AddDepRes
res <- if PackageName
name PackageName -> [PackageName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Ctx
ctx.callStack
then do
Text
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall env (m :: * -> *).
(?callStack::CallStack, HasRunner env, MonadIO m,
MonadReader env m) =>
Text -> Utf8Builder -> m ()
logDebugPlanS Text
"checkCallStackAndAddDep" (Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Detected cycle "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageName -> Utf8Builder
forall a. IsString a => PackageName -> a
fromPackageName PackageName
name
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (PackageName -> [Char]) -> [PackageName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map PackageName -> [Char]
packageNameString Ctx
ctx.callStack)
Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes))
-> Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a b. (a -> b) -> a -> b
$ ConstructPlanException -> Either ConstructPlanException AddDepRes
forall a b. a -> Either a b
Left (ConstructPlanException -> Either ConstructPlanException AddDepRes)
-> ConstructPlanException
-> Either ConstructPlanException AddDepRes
forall a b. (a -> b) -> a -> b
$ [PackageName] -> ConstructPlanException
DependencyCycleDetected ([PackageName] -> ConstructPlanException)
-> [PackageName] -> ConstructPlanException
forall a b. (a -> b) -> a -> b
$ PackageName
name PackageName -> [PackageName] -> [PackageName]
forall a. a -> [a] -> [a]
: Ctx
ctx.callStack
else case PackageName -> Map PackageName PackageInfo -> Maybe PackageInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Ctx
ctx.combinedMap of
Maybe PackageInfo
Nothing -> do
Text
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall env (m :: * -> *).
(?callStack::CallStack, HasRunner env, MonadIO m,
MonadReader env m) =>
Text -> Utf8Builder -> m ()
logDebugPlanS Text
"checkCallStackAndAddDep" (Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"No package info for "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageName -> Utf8Builder
forall a. IsString a => PackageName -> a
fromPackageName PackageName
name
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"."
Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes))
-> Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a b. (a -> b) -> a -> b
$ ConstructPlanException -> Either ConstructPlanException AddDepRes
forall a b. a -> Either a b
Left (ConstructPlanException -> Either ConstructPlanException AddDepRes)
-> ConstructPlanException
-> Either ConstructPlanException AddDepRes
forall a b. (a -> b) -> a -> b
$ PackageName -> ConstructPlanException
UnknownPackage PackageName
name
Just PackageInfo
packageInfo ->
(Ctx -> Ctx)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a.
(Ctx -> Ctx)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\Ctx
ctx' -> Ctx
ctx' { callStack = name : ctx'.callStack }) (WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a b. (a -> b) -> a -> b
$
PackageName
-> PackageInfo
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
addDep PackageName
name PackageInfo
packageInfo
PackageName
-> Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
updateLibMap PackageName
name Either ConstructPlanException AddDepRes
res
Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ConstructPlanException AddDepRes
res
addDep ::
PackageName
-> PackageInfo
-> M (Either ConstructPlanException AddDepRes)
addDep :: PackageName
-> PackageInfo
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
addDep PackageName
name PackageInfo
packageInfo = do
Text
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall env (m :: * -> *).
(?callStack::CallStack, HasRunner env, MonadIO m,
MonadReader env m) =>
Text -> Utf8Builder -> m ()
logDebugPlanS Text
"addDep" (Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Package info for "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageName -> Utf8Builder
forall a. IsString a => PackageName -> a
fromPackageName PackageName
name
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageInfo -> [Char]
forall a. Show a => a -> [Char]
show PackageInfo
packageInfo)
case PackageInfo
packageInfo of
PIOnlyInstalled InstallLocation
loc Installed
installed -> do
let version :: Version
version = Installed -> Version
installedVersion Installed
installed
askPkgLoc :: WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
askPkgLoc = RIO Ctx (Maybe PackageLocationImmutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m) =>
RIO env a -> m a
liftRIO (RIO Ctx (Maybe PackageLocationImmutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable))
-> RIO Ctx (Maybe PackageLocationImmutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ do
Maybe (Revision, BlobKey, TreeKey)
mrev <- RequireHackageIndex
-> PackageName
-> Version
-> RIO Ctx (Maybe (Revision, BlobKey, TreeKey))
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
RequireHackageIndex
-> PackageName
-> Version
-> RIO env (Maybe (Revision, BlobKey, TreeKey))
getLatestHackageRevision RequireHackageIndex
YesRequireHackageIndex PackageName
name Version
version
case Maybe (Revision, BlobKey, TreeKey)
mrev of
Maybe (Revision, BlobKey, TreeKey)
Nothing -> do
Maybe (NonEmpty PackageName)
cs <- (Ctx -> Maybe (NonEmpty PackageName))
-> RIO Ctx (Maybe (NonEmpty PackageName))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ([PackageName] -> Maybe (NonEmpty PackageName)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([PackageName] -> Maybe (NonEmpty PackageName))
-> (Ctx -> [PackageName]) -> Ctx -> Maybe (NonEmpty PackageName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.callStack))
[PackageName]
cs' <- RIO Ctx [PackageName]
-> (NonEmpty PackageName -> RIO Ctx [PackageName])
-> Maybe (NonEmpty PackageName)
-> RIO Ctx [PackageName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(BuildException -> RIO Ctx [PackageName]
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO BuildException
CallStackEmptyBug)
([PackageName] -> RIO Ctx [PackageName]
forall a. a -> RIO Ctx a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackageName] -> RIO Ctx [PackageName])
-> (NonEmpty PackageName -> [PackageName])
-> NonEmpty PackageName
-> RIO Ctx [PackageName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty PackageName -> [PackageName]
forall a. NonEmpty a -> [a]
NE.tail)
Maybe (NonEmpty PackageName)
cs
[StyleDoc] -> RIO Ctx ()
forall env (m :: * -> *).
(?callStack::CallStack, HasTerm env, MonadReader env m,
MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
([StyleDoc] -> RIO Ctx ()) -> [StyleDoc] -> RIO Ctx ()
forall a b. (a -> b) -> a -> b
$ [Char] -> StyleDoc
flow [Char]
"No latest package revision found for"
StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
: Style -> StyleDoc -> StyleDoc
style Style
Current (PackageName -> StyleDoc
forall a. IsString a => PackageName -> a
fromPackageName PackageName
name) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
: [Char] -> StyleDoc
flow [Char]
"dependency callstack:"
StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
: Maybe Style -> Bool -> [StyleDoc] -> [StyleDoc]
forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList Maybe Style
forall a. Maybe a
Nothing Bool
False
((PackageName -> StyleDoc) -> [PackageName] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map PackageName -> StyleDoc
forall a. IsString a => PackageName -> a
fromPackageName [PackageName]
cs' :: [StyleDoc])
Maybe PackageLocationImmutable
-> RIO Ctx (Maybe PackageLocationImmutable)
forall a. a -> RIO Ctx a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PackageLocationImmutable
forall a. Maybe a
Nothing
Just (Revision
_rev, BlobKey
cfKey, TreeKey
treeKey) ->
Maybe PackageLocationImmutable
-> RIO Ctx (Maybe PackageLocationImmutable)
forall a. a -> RIO Ctx a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PackageLocationImmutable
-> RIO Ctx (Maybe PackageLocationImmutable))
-> Maybe PackageLocationImmutable
-> RIO Ctx (Maybe PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> Maybe PackageLocationImmutable
forall a. a -> Maybe a
Just (PackageLocationImmutable -> Maybe PackageLocationImmutable)
-> PackageLocationImmutable -> Maybe PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$
PackageIdentifier -> BlobKey -> TreeKey -> PackageLocationImmutable
PLIHackage (PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name Version
version) BlobKey
cfKey TreeKey
treeKey
PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
-> InstallLocation
-> Map FlagName Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
tellExecutablesUpstream PackageName
name WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
askPkgLoc InstallLocation
loc Map FlagName Bool
forall k a. Map k a
Map.empty
Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes))
-> Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a b. (a -> b) -> a -> b
$ AddDepRes -> Either ConstructPlanException AddDepRes
forall a b. b -> Either a b
Right (AddDepRes -> Either ConstructPlanException AddDepRes)
-> AddDepRes -> Either ConstructPlanException AddDepRes
forall a b. (a -> b) -> a -> b
$ InstallLocation -> Installed -> AddDepRes
ADRFound InstallLocation
loc Installed
installed
PIOnlySource PackageSource
ps -> do
PackageName
-> PackageSource
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
tellExecutables PackageName
name PackageSource
ps
PackageName
-> PackageSource
-> Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
installPackage PackageName
name PackageSource
ps Maybe Installed
forall a. Maybe a
Nothing
PIBoth PackageSource
ps Installed
installed -> do
PackageName
-> PackageSource
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
tellExecutables PackageName
name PackageSource
ps
PackageName
-> PackageSource
-> Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
installPackage PackageName
name PackageSource
ps (Installed -> Maybe Installed
forall a. a -> Maybe a
Just Installed
installed)
tellExecutables :: PackageName -> PackageSource -> M ()
tellExecutables :: PackageName
-> PackageSource
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
tellExecutables PackageName
_name (PSFilePath LocalPackage
lp)
| LocalPackage
lp.wanted = InstallLocation
-> Package
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
tellExecutablesPackage InstallLocation
Local LocalPackage
lp.package
| Bool
otherwise = ()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
tellExecutables PackageName
name (PSRemote PackageLocationImmutable
pkgloc Version
_version FromSnapshot
_fromSnapshot CommonPackage
cp) =
PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
-> InstallLocation
-> Map FlagName Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
tellExecutablesUpstream PackageName
name (Maybe PackageLocationImmutable
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PackageLocationImmutable
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable))
-> Maybe PackageLocationImmutable
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> Maybe PackageLocationImmutable
forall a. a -> Maybe a
Just PackageLocationImmutable
pkgloc) InstallLocation
Snap CommonPackage
cp.flags
tellExecutablesUpstream ::
PackageName
-> M (Maybe PackageLocationImmutable)
-> InstallLocation
-> Map FlagName Bool
-> M ()
tellExecutablesUpstream :: PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
-> InstallLocation
-> Map FlagName Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
tellExecutablesUpstream PackageName
name WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
retrievePkgLoc InstallLocation
loc Map FlagName Bool
flags = do
Ctx
ctx <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Ctx
forall r (m :: * -> *). MonadReader r m => m r
ask
Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageName
name PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Ctx
ctx.wanted) (WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$ do
Maybe PackageLocationImmutable
mPkgLoc <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe PackageLocationImmutable)
retrievePkgLoc
Maybe PackageLocationImmutable
-> (PackageLocationImmutable
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe PackageLocationImmutable
mPkgLoc ((PackageLocationImmutable
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> (PackageLocationImmutable
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$ \PackageLocationImmutable
pkgLoc -> do
Package
p <- Ctx
ctx.loadPackage PackageLocationImmutable
pkgLoc Map FlagName Bool
flags [] []
InstallLocation
-> Package
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
tellExecutablesPackage InstallLocation
loc Package
p
tellExecutablesPackage :: InstallLocation -> Package -> M ()
tellExecutablesPackage :: InstallLocation
-> Package
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
tellExecutablesPackage InstallLocation
loc Package
p = do
Map PackageName PackageInfo
cm <- (Ctx -> Map PackageName PackageInfo)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Map PackageName PackageInfo)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.combinedMap)
let myComps :: Set Text
myComps =
case PackageName -> Map PackageName PackageInfo -> Maybe PackageInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Package
p.name Map PackageName PackageInfo
cm of
Maybe PackageInfo
Nothing -> Bool -> Set Text -> Set Text
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False Set Text
forall a. Set a
Set.empty
Just (PIOnlyInstalled InstallLocation
_ Installed
_) -> Set Text
forall a. Set a
Set.empty
Just (PIOnlySource PackageSource
ps) -> PackageSource -> Set Text
goSource PackageSource
ps
Just (PIBoth PackageSource
ps Installed
_) -> PackageSource -> Set Text
goSource PackageSource
ps
goSource :: PackageSource -> Set Text
goSource (PSFilePath LocalPackage
lp)
| LocalPackage
lp.wanted = Set NamedComponent -> Set Text
exeComponents LocalPackage
lp.components
| Bool
otherwise = Set Text
forall a. Set a
Set.empty
goSource PSRemote{} = Set Text
forall a. Set a
Set.empty
W
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell W
forall a. Monoid a => a
mempty
{ wInstall = Map.fromList $
map (, loc) $ Set.toList $ filterComps myComps $ buildableExes p
}
where
filterComps :: Set a -> Set a -> Set a
filterComps Set a
myComps Set a
x
| Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
myComps = Set a
x
| Bool
otherwise = Set a -> Set a -> Set a
forall {a}. Ord a => Set a -> Set a -> Set a
Set.intersection Set a
x Set a
myComps
installPackage :: PackageName
-> PackageSource
-> Maybe Installed
-> M (Either ConstructPlanException AddDepRes)
installPackage :: PackageName
-> PackageSource
-> Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
installPackage PackageName
name PackageSource
ps Maybe Installed
minstalled = do
Ctx
ctx <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Ctx
forall r (m :: * -> *). MonadReader r m => m r
ask
case PackageSource
ps of
PSRemote PackageLocationImmutable
pkgLoc Version
_version FromSnapshot
_fromSnapshot CommonPackage
cp -> do
Text
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall env (m :: * -> *).
(?callStack::CallStack, HasRunner env, MonadIO m,
MonadReader env m) =>
Text -> Utf8Builder -> m ()
logDebugPlanS Text
"installPackage" (Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Doing all-in-one build for upstream package "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageName -> Utf8Builder
forall a. IsString a => PackageName -> a
fromPackageName PackageName
name
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"."
Package
package <- Ctx
ctx.loadPackage
PackageLocationImmutable
pkgLoc CommonPackage
cp.flags CommonPackage
cp.ghcOptions CommonPackage
cp.cabalConfigOpts
Bool
-> Bool
-> PackageSource
-> Package
-> Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
resolveDepsAndInstall Bool
True CommonPackage
cp.buildHaddocks PackageSource
ps Package
package Maybe Installed
minstalled
PSFilePath LocalPackage
lp -> do
case LocalPackage
lp.testBench of
Maybe Package
Nothing -> do
Text
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall env (m :: * -> *).
(?callStack::CallStack, HasRunner env, MonadIO m,
MonadReader env m) =>
Text -> Utf8Builder -> m ()
logDebugPlanS Text
"installPackage" (Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"No test or bench component for "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageName -> Utf8Builder
forall a. IsString a => PackageName -> a
fromPackageName PackageName
name
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" so doing an all-in-one build."
Bool
-> Bool
-> PackageSource
-> Package
-> Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
resolveDepsAndInstall
Bool
True LocalPackage
lp.buildHaddocks PackageSource
ps LocalPackage
lp.package Maybe Installed
minstalled
Just Package
tb -> do
Map PackageName (Either ConstructPlanException AddDepRes)
libMap <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Map PackageName (Either ConstructPlanException AddDepRes))
forall s (m :: * -> *). MonadState s m => m s
get
Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
res <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable),
W -> W)
-> M (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
forall a.
WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(a, W -> W)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable),
W -> W)
-> M (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable),
W -> W)
-> M (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
forall a b. (a -> b) -> a -> b
$ do
Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
res <- Package
-> M (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
addPackageDeps Package
tb
let writerFunc :: a -> a
writerFunc a
w = case Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
res of
Left ConstructPlanException
_ -> a
forall a. Monoid a => a
mempty
Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
_ -> a
w
(Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable),
W -> W)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable),
W -> W)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
res, W -> W
forall {a}. Monoid a => a -> a
writerFunc)
case Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
res of
Right (Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
deps -> do
Text
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall env (m :: * -> *).
(?callStack::CallStack, HasRunner env, MonadIO m,
MonadReader env m) =>
Text -> Utf8Builder -> m ()
logDebugPlanS Text
"installPackage" (Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"For "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageName -> Utf8Builder
forall a. IsString a => PackageName -> a
fromPackageName PackageName
name
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", successfully added package deps."
Bool
splitRequired <- Maybe Curator -> Bool
forall {r}.
(HasField "expectTestFailure" r (Set PackageName),
HasField "expectBenchmarkFailure" r (Set PackageName)) =>
Maybe r -> Bool
expectedTestOrBenchFailures (Maybe Curator -> Bool)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Curator)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ctx -> Maybe Curator)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Curator)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.curator)
let isAllInOne :: Bool
isAllInOne = Bool -> Bool
not Bool
splitRequired
AddDepRes
adr <- Bool
-> Bool
-> PackageSource
-> Package
-> Maybe Installed
-> (Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)
-> M AddDepRes
installPackageGivenDeps
Bool
isAllInOne LocalPackage
lp.buildHaddocks PackageSource
ps Package
tb Maybe Installed
minstalled (Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
deps
let finalAllInOne :: Bool
finalAllInOne = case AddDepRes
adr of
ADRToInstall Task
_ | Bool
splitRequired -> Bool
False
AddDepRes
_ -> Bool
True
LocalPackage
-> Package
-> Bool
-> Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
addFinal LocalPackage
lp Package
tb Bool
finalAllInOne Bool
False
Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes))
-> Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a b. (a -> b) -> a -> b
$ AddDepRes -> Either ConstructPlanException AddDepRes
forall a b. b -> Either a b
Right AddDepRes
adr
Left ConstructPlanException
_ -> do
Text
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall env (m :: * -> *).
(?callStack::CallStack, HasRunner env, MonadIO m,
MonadReader env m) =>
Text -> Utf8Builder -> m ()
logDebugPlanS Text
"installPackage" (Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> Utf8Builder
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Before trying cyclic plan, resetting lib result map to: "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Map PackageName (Either ConstructPlanException AddDepRes) -> [Char]
forall a. Show a => a -> [Char]
show Map PackageName (Either ConstructPlanException AddDepRes)
libMap)
Map PackageName (Either ConstructPlanException AddDepRes)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Map PackageName (Either ConstructPlanException AddDepRes)
libMap
Either ConstructPlanException AddDepRes
res' <- Bool
-> Bool
-> PackageSource
-> Package
-> Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
resolveDepsAndInstall
Bool
False LocalPackage
lp.buildHaddocks PackageSource
ps LocalPackage
lp.package Maybe Installed
minstalled
Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Either ConstructPlanException AddDepRes -> Bool
forall a b. Either a b -> Bool
isRight Either ConstructPlanException AddDepRes
res') (WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$ do
PackageName
-> Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
updateLibMap PackageName
name Either ConstructPlanException AddDepRes
res'
LocalPackage
-> Package
-> Bool
-> Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
addFinal LocalPackage
lp Package
tb Bool
False Bool
False
Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ConstructPlanException AddDepRes
res'
where
expectedTestOrBenchFailures :: Maybe r -> Bool
expectedTestOrBenchFailures Maybe r
maybeCurator = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
r
curator <- Maybe r
maybeCurator
Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PackageName
name r
curator.expectTestFailure
Bool -> Bool -> Bool
|| PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PackageName
name r
curator.expectBenchmarkFailure
resolveDepsAndInstall ::
Bool
-> Bool
-> PackageSource
-> Package
-> Maybe Installed
-> M (Either ConstructPlanException AddDepRes)
resolveDepsAndInstall :: Bool
-> Bool
-> PackageSource
-> Package
-> Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
resolveDepsAndInstall Bool
isAllInOne Bool
buildHaddocks PackageSource
ps Package
package Maybe Installed
minstalled = do
Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
res <- Package
-> M (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
addPackageDeps Package
package
case Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
res of
Left ConstructPlanException
err -> Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes))
-> Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall a b. (a -> b) -> a -> b
$ ConstructPlanException -> Either ConstructPlanException AddDepRes
forall a b. a -> Either a b
Left ConstructPlanException
err
Right (Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
deps ->
AddDepRes -> Either ConstructPlanException AddDepRes
forall a b. b -> Either a b
Right (AddDepRes -> Either ConstructPlanException AddDepRes)
-> M AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Bool
-> Bool
-> PackageSource
-> Package
-> Maybe Installed
-> (Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)
-> M AddDepRes
installPackageGivenDeps
Bool
isAllInOne Bool
buildHaddocks PackageSource
ps Package
package Maybe Installed
minstalled (Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
deps
installPackageGivenDeps ::
Bool
-> Bool
-> PackageSource
-> Package
-> Maybe Installed
-> ( Set PackageIdentifier
, Map PackageIdentifier GhcPkgId
, IsMutable )
-> M AddDepRes
installPackageGivenDeps :: Bool
-> Bool
-> PackageSource
-> Package
-> Maybe Installed
-> (Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)
-> M AddDepRes
installPackageGivenDeps Bool
isAllInOne Bool
buildHaddocks PackageSource
ps Package
package Maybe Installed
minstalled
(Set PackageIdentifier
missing, Map PackageIdentifier GhcPkgId
present, IsMutable
minMutable) = do
let name :: PackageName
name = Package
package.name
Ctx
ctx <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Ctx
forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe Installed
mRightVersionInstalled <- case (Maybe Installed
minstalled, Set PackageIdentifier -> Bool
forall a. Set a -> Bool
Set.null Set PackageIdentifier
missing) of
(Just Installed
installed, Bool
True) -> do
Bool
shouldInstall <-
PackageSource
-> Installed
-> Package
-> Map PackageIdentifier GhcPkgId
-> Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
checkDirtiness PackageSource
ps Installed
installed Package
package Map PackageIdentifier GhcPkgId
present Bool
buildHaddocks
Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Installed)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Installed))
-> Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Installed)
forall a b. (a -> b) -> a -> b
$ if Bool
shouldInstall then Maybe Installed
forall a. Maybe a
Nothing else Installed -> Maybe Installed
forall a. a -> Maybe a
Just Installed
installed
(Just Installed
_, Bool
False) -> do
let t :: Text
t = Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
(PackageIdentifier -> Text) -> [PackageIdentifier] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Text
T.pack ([Char] -> Text)
-> (PackageIdentifier -> [Char]) -> PackageIdentifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
packageNameString (PackageName -> [Char])
-> (PackageIdentifier -> PackageName)
-> PackageIdentifier
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
pkgName) (Set PackageIdentifier -> [PackageIdentifier]
forall a. Set a -> [a]
Set.toList Set PackageIdentifier
missing)
W
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell W
forall a. Monoid a => a
mempty
{ wDirty =
Map.singleton name $ "missing dependencies: " <> addEllipsis t
}
Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Installed)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Installed
forall a. Maybe a
Nothing
(Maybe Installed
Nothing, Bool
_) -> Maybe Installed
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Installed)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Installed
forall a. Maybe a
Nothing
let loc :: InstallLocation
loc = PackageSource -> InstallLocation
psLocation PackageSource
ps
mutable :: IsMutable
mutable = InstallLocation -> IsMutable
installLocationIsMutable InstallLocation
loc IsMutable -> IsMutable -> IsMutable
forall a. Semigroup a => a -> a -> a
<> IsMutable
minMutable
AddDepRes -> M AddDepRes
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddDepRes -> M AddDepRes) -> AddDepRes -> M AddDepRes
forall a b. (a -> b) -> a -> b
$ case Maybe Installed
mRightVersionInstalled of
Just Installed
installed -> InstallLocation -> Installed -> AddDepRes
ADRFound InstallLocation
loc Installed
installed
Maybe Installed
Nothing -> Task -> AddDepRes
ADRToInstall Task
{ $sel:configOpts:Task :: TaskConfigOpts
configOpts = Set PackageIdentifier
-> (Map PackageIdentifier GhcPkgId -> ConfigureOpts)
-> TaskConfigOpts
TaskConfigOpts Set PackageIdentifier
missing ((Map PackageIdentifier GhcPkgId -> ConfigureOpts)
-> TaskConfigOpts)
-> (Map PackageIdentifier GhcPkgId -> ConfigureOpts)
-> TaskConfigOpts
forall a b. (a -> b) -> a -> b
$ \Map PackageIdentifier GhcPkgId
missing' ->
let allDeps :: Map PackageIdentifier GhcPkgId
allDeps = Map PackageIdentifier GhcPkgId
-> Map PackageIdentifier GhcPkgId -> Map PackageIdentifier GhcPkgId
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map PackageIdentifier GhcPkgId
present Map PackageIdentifier GhcPkgId
missing'
in EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> IsMutable
-> Package
-> ConfigureOpts
ConfigureOpts.configureOpts
(Getting EnvConfig Ctx EnvConfig -> Ctx -> EnvConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EnvConfig Ctx EnvConfig
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' Ctx EnvConfig
envConfigL Ctx
ctx)
Ctx
ctx.baseConfigOpts
Map PackageIdentifier GhcPkgId
allDeps
(PackageSource -> Bool
psLocal PackageSource
ps)
IsMutable
mutable
Package
package
, Bool
$sel:buildHaddocks:Task :: Bool
buildHaddocks :: Bool
buildHaddocks
, Map PackageIdentifier GhcPkgId
$sel:present:Task :: Map PackageIdentifier GhcPkgId
present :: Map PackageIdentifier GhcPkgId
present
, $sel:taskType:Task :: TaskType
taskType =
case PackageSource
ps of
PSFilePath LocalPackage
lp ->
LocalPackage -> TaskType
TTLocalMutable LocalPackage
lp
PSRemote PackageLocationImmutable
pkgLoc Version
_version FromSnapshot
_fromSnapshot CommonPackage
_cp ->
IsMutable -> Package -> PackageLocationImmutable -> TaskType
TTRemotePackage IsMutable
mutable Package
package PackageLocationImmutable
pkgLoc
, $sel:allInOne:Task :: Bool
allInOne = Bool
isAllInOne
, $sel:cachePkgSrc:Task :: CachePkgSrc
cachePkgSrc = PackageSource -> CachePkgSrc
toCachePkgSrc PackageSource
ps
, $sel:buildTypeConfig:Task :: Bool
buildTypeConfig = Package -> Bool
packageBuildTypeConfig Package
package
}
packageBuildTypeConfig :: Package -> Bool
packageBuildTypeConfig :: Package -> Bool
packageBuildTypeConfig Package
pkg = Package
pkg.buildType BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Configure
updateLibMap :: PackageName -> Either ConstructPlanException AddDepRes -> M ()
updateLibMap :: PackageName
-> Either ConstructPlanException AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
updateLibMap PackageName
name Either ConstructPlanException AddDepRes
val = (Map PackageName (Either ConstructPlanException AddDepRes)
-> Map PackageName (Either ConstructPlanException AddDepRes))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map PackageName (Either ConstructPlanException AddDepRes)
-> Map PackageName (Either ConstructPlanException AddDepRes))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> (Map PackageName (Either ConstructPlanException AddDepRes)
-> Map PackageName (Either ConstructPlanException AddDepRes))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$ \Map PackageName (Either ConstructPlanException AddDepRes)
mp ->
case (PackageName
-> Map PackageName (Either ConstructPlanException AddDepRes)
-> Maybe (Either ConstructPlanException AddDepRes)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName (Either ConstructPlanException AddDepRes)
mp, Either ConstructPlanException AddDepRes
val) of
(Just (Left DependencyCycleDetected{}), Left ConstructPlanException
_) -> Map PackageName (Either ConstructPlanException AddDepRes)
mp
(Maybe (Either ConstructPlanException AddDepRes),
Either ConstructPlanException AddDepRes)
_ -> PackageName
-> Either ConstructPlanException AddDepRes
-> Map PackageName (Either ConstructPlanException AddDepRes)
-> Map PackageName (Either ConstructPlanException AddDepRes)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PackageName
name Either ConstructPlanException AddDepRes
val Map PackageName (Either ConstructPlanException AddDepRes)
mp
addEllipsis :: Text -> Text
addEllipsis :: Text -> Text
addEllipsis Text
t
| Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100 = Text
t
| Bool
otherwise = Int -> Text -> Text
T.take Int
97 Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."
addPackageDeps ::
Package
-> M ( Either
ConstructPlanException
( Set PackageIdentifier
, Map PackageIdentifier GhcPkgId
, IsMutable
)
)
addPackageDeps :: Package
-> M (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
addPackageDeps Package
package = do
Package
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
checkAndWarnForUnknownTools Package
package
let pkgId :: PackageIdentifier
pkgId = Package -> PackageIdentifier
packageIdentifier Package
package
[Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)]
deps <- Package
-> (PackageName
-> DepValue
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
[Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)]
forall (m :: * -> *) resT.
Monad m =>
Package -> (PackageName -> DepValue -> m resT) -> m [resT]
processPackageDepsToList Package
package (PackageIdentifier
-> PackageName
-> DepValue
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
processDep PackageIdentifier
pkgId)
Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> M (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> M (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)))
-> Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> M (Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
forall a b. (a -> b) -> a -> b
$ case [Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)]
-> ([(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))],
[(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)]
deps of
([], [(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)]
pairs) -> (Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
forall a b. b -> Either a b
Right ((Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
-> (Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)
-> Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
forall a b. (a -> b) -> a -> b
$ [(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)]
-> (Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)
forall a. Monoid a => [a] -> a
mconcat [(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)]
pairs
([(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))]
errs, [(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)]
_) ->
ConstructPlanException
-> Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
forall a b. a -> Either a b
Left (ConstructPlanException
-> Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
-> ConstructPlanException
-> Either
ConstructPlanException
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
forall a b. (a -> b) -> a -> b
$ Package
-> Map
PackageName (VersionRange, Maybe (Version, BlobKey), BadDependency)
-> ConstructPlanException
DependencyPlanFailures Package
package ([(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))]
-> Map
PackageName (VersionRange, Maybe (Version, BlobKey), BadDependency)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))]
errs)
processDep ::
PackageIdentifier
-> PackageName
-> DepValue
-> M ( Either
( PackageName
, (VersionRange, Maybe (Version, BlobKey), BadDependency)
)
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
)
processDep :: PackageIdentifier
-> PackageName
-> DepValue
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
processDep PackageIdentifier
pkgId PackageName
name DepValue
value = do
Maybe (Version, BlobKey)
mLatestApplicable <- PackageName -> VersionRange -> M (Maybe (Version, BlobKey))
getLatestApplicableVersionAndRev PackageName
name VersionRange
range
Either ConstructPlanException AddDepRes
eRes <- PackageName
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either ConstructPlanException AddDepRes)
getCachedDepOrAddDep PackageName
name
case Either ConstructPlanException AddDepRes
eRes of
Left ConstructPlanException
e -> do
WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
addParent
let bd :: BadDependency
bd = case ConstructPlanException
e of
UnknownPackage PackageName
name' -> Bool -> BadDependency -> BadDependency
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PackageName
name' PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name) BadDependency
NotInBuildPlan
DependencyCycleDetected [PackageName]
names -> [PackageName] -> BadDependency
BDDependencyCycleDetected [PackageName]
names
DependencyPlanFailures Package
_ Map
PackageName (VersionRange, Maybe (Version, BlobKey), BadDependency)
_ ->
Version -> BadDependency
Couldn'tResolveItsDependencies Version
version
Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)))
-> Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
forall a b. (a -> b) -> a -> b
$ (PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
-> Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
forall a b. a -> Either a b
Left (PackageName
name, (VersionRange
range, Maybe (Version, BlobKey)
mLatestApplicable, BadDependency
bd))
Right AddDepRes
adr
| DepType -> Bool
isDepTypeLibrary DepValue
value.depType Bool -> Bool -> Bool
&& Bool -> Bool
not (AddDepRes -> Bool
adrHasLibrary AddDepRes
adr) ->
Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)))
-> Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
forall a b. (a -> b) -> a -> b
$ (PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
-> Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
forall a b. a -> Either a b
Left (PackageName
name, (VersionRange
range, Maybe (Version, BlobKey)
forall a. Maybe a
Nothing, BadDependency
HasNoLibrary))
Right AddDepRes
adr -> do
WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
addParent
Bool
inRange <- PackageIdentifier
-> PackageName
-> VersionRange
-> AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
adrInRange PackageIdentifier
pkgId PackageName
name VersionRange
range AddDepRes
adr
Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)))
-> Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
forall a b. (a -> b) -> a -> b
$ if Bool
inRange
then (Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
forall a b. b -> Either a b
Right ((Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
-> Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable))
-> (Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)
-> Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
forall a b. (a -> b) -> a -> b
$ AddDepRes
-> (Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)
processAdr AddDepRes
adr
else (PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
-> Either
(PackageName,
(VersionRange, Maybe (Version, BlobKey), BadDependency))
(Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
forall a b. a -> Either a b
Left
( PackageName
name
, ( VersionRange
range
, Maybe (Version, BlobKey)
mLatestApplicable
, Version -> BadDependency
DependencyMismatch (Version -> BadDependency) -> Version -> BadDependency
forall a b. (a -> b) -> a -> b
$ AddDepRes -> Version
adrVersion AddDepRes
adr
)
)
where
range :: VersionRange
range = DepValue
value.versionRange
version :: Version
version = PackageIdentifier -> Version
pkgVersion PackageIdentifier
pkgId
addParent :: WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
addParent =
let parentMap :: Map PackageName [(PackageIdentifier, VersionRange)]
parentMap = PackageName
-> [(PackageIdentifier, VersionRange)]
-> Map PackageName [(PackageIdentifier, VersionRange)]
forall k a. k -> a -> Map k a
Map.singleton PackageName
name [(PackageIdentifier
pkgId, VersionRange
range)]
in W
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell W
forall a. Monoid a => a
mempty { wParents = MonoidMap parentMap }
getLatestApplicableVersionAndRev ::
PackageName
-> VersionRange
-> M (Maybe (Version, BlobKey))
getLatestApplicableVersionAndRev :: PackageName -> VersionRange -> M (Maybe (Version, BlobKey))
getLatestApplicableVersionAndRev PackageName
name VersionRange
range = do
Ctx
ctx <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Ctx
forall r (m :: * -> *). MonadReader r m => m r
ask
Map Version (Map Revision BlobKey)
vsAndRevs <- Ctx
-> RIO Ctx (Map Version (Map Revision BlobKey))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Map Version (Map Revision BlobKey))
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO Ctx
ctx (RIO Ctx (Map Version (Map Revision BlobKey))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Map Version (Map Revision BlobKey)))
-> RIO Ctx (Map Version (Map Revision BlobKey))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Map Version (Map Revision BlobKey))
forall a b. (a -> b) -> a -> b
$
RequireHackageIndex
-> UsePreferredVersions
-> PackageName
-> RIO Ctx (Map Version (Map Revision BlobKey))
forall env.
(HasPantryConfig env, HasLogFunc env) =>
RequireHackageIndex
-> UsePreferredVersions
-> PackageName
-> RIO env (Map Version (Map Revision BlobKey))
getHackagePackageVersions RequireHackageIndex
YesRequireHackageIndex UsePreferredVersions
UsePreferredVersions PackageName
name
Maybe (Version, BlobKey) -> M (Maybe (Version, BlobKey))
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Version, BlobKey) -> M (Maybe (Version, BlobKey)))
-> Maybe (Version, BlobKey) -> M (Maybe (Version, BlobKey))
forall a b. (a -> b) -> a -> b
$ do
Version
lappVer <- VersionRange -> Set Version -> Maybe Version
latestApplicableVersion VersionRange
range (Set Version -> Maybe Version) -> Set Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Map Version (Map Revision BlobKey) -> Set Version
forall k a. Map k a -> Set k
Map.keysSet Map Version (Map Revision BlobKey)
vsAndRevs
Map Revision BlobKey
revs <- Version
-> Map Version (Map Revision BlobKey)
-> Maybe (Map Revision BlobKey)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
lappVer Map Version (Map Revision BlobKey)
vsAndRevs
(BlobKey
cabalHash, Map Revision BlobKey
_) <- Map Revision BlobKey -> Maybe (BlobKey, Map Revision BlobKey)
forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map Revision BlobKey
revs
(Version, BlobKey) -> Maybe (Version, BlobKey)
forall a. a -> Maybe a
Just (Version
lappVer, BlobKey
cabalHash)
adrInRange ::
PackageIdentifier
-> PackageName
-> VersionRange
-> AddDepRes
-> M Bool
adrInRange :: PackageIdentifier
-> PackageName
-> VersionRange
-> AddDepRes
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
adrInRange PackageIdentifier
pkgId PackageName
name VersionRange
range AddDepRes
adr = if AddDepRes -> Version
adrVersion AddDepRes
adr Version -> VersionRange -> Bool
`withinRange` VersionRange
range
then Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
else do
Bool
allowNewer <- Getting Bool Ctx Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool Ctx Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool)
-> Getting Bool Ctx Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config) -> Ctx -> Const Bool Ctx
forall env. HasConfig env => Lens' env Config
Lens' Ctx Config
configL ((Config -> Const Bool Config) -> Ctx -> Const Bool Ctx)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> Getting Bool Ctx Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Bool) -> SimpleGetter Config Bool
forall s a. (s -> a) -> SimpleGetter s a
to (.allowNewer)
Maybe [PackageName]
allowNewerDeps <- Getting (Maybe [PackageName]) Ctx (Maybe [PackageName])
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe [PackageName])
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Maybe [PackageName]) Ctx (Maybe [PackageName])
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe [PackageName]))
-> Getting (Maybe [PackageName]) Ctx (Maybe [PackageName])
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe [PackageName])
forall a b. (a -> b) -> a -> b
$ (Config -> Const (Maybe [PackageName]) Config)
-> Ctx -> Const (Maybe [PackageName]) Ctx
forall env. HasConfig env => Lens' env Config
Lens' Ctx Config
configL ((Config -> Const (Maybe [PackageName]) Config)
-> Ctx -> Const (Maybe [PackageName]) Ctx)
-> ((Maybe [PackageName]
-> Const (Maybe [PackageName]) (Maybe [PackageName]))
-> Config -> Const (Maybe [PackageName]) Config)
-> Getting (Maybe [PackageName]) Ctx (Maybe [PackageName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Maybe [PackageName])
-> SimpleGetter Config (Maybe [PackageName])
forall s a. (s -> a) -> SimpleGetter s a
to (.allowNewerDeps)
if Bool
allowNewer
then case Maybe [PackageName]
allowNewerDeps of
Maybe [PackageName]
Nothing -> do
Bool
-> StyleDoc
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall {m :: * -> *}. MonadWriter W m => Bool -> StyleDoc -> m ()
warn_ Bool
True (StyleDoc
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> StyleDoc
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
[StyleDoc] -> StyleDoc
fillSep
[ Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"allow-newer"
, StyleDoc
"enabled"
]
Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Just [PackageName]
boundsIgnoredDeps -> do
let pkgName' :: StyleDoc
pkgName' = PackageName -> StyleDoc
forall a. IsString a => PackageName -> a
fromPackageName PackageName
pkgName
isBoundsIgnoreDep :: Bool
isBoundsIgnoreDep = PackageName
pkgName PackageName -> [PackageName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageName]
boundsIgnoredDeps
reason :: StyleDoc
reason = if Bool
isBoundsIgnoreDep
then [StyleDoc] -> StyleDoc
fillSep
[ Style -> StyleDoc -> StyleDoc
style Style
Current StyleDoc
pkgName'
, [Char] -> StyleDoc
flow [Char]
"is an"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"allow-newer-dep"
, [Char] -> StyleDoc
flow [Char]
"and"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"allow-newer"
, StyleDoc
"enabled"
]
else [StyleDoc] -> StyleDoc
fillSep
[ Style -> StyleDoc -> StyleDoc
style Style
Current StyleDoc
pkgName'
, [Char] -> StyleDoc
flow [Char]
"is not an"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"allow-newer-dep"
, [Char] -> StyleDoc
flow [Char]
"although"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"allow-newer"
, StyleDoc
"enabled"
]
Bool
-> StyleDoc
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall {m :: * -> *}. MonadWriter W m => Bool -> StyleDoc -> m ()
warn_ Bool
isBoundsIgnoreDep StyleDoc
reason
Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
isBoundsIgnoreDep
else do
Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe [PackageName] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [PackageName]
allowNewerDeps) (WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
Bool
-> StyleDoc
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall {m :: * -> *}. MonadWriter W m => Bool -> StyleDoc -> m ()
warn_ Bool
False (StyleDoc
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
())
-> StyleDoc
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a b. (a -> b) -> a -> b
$
[StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"although"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"allow-newer-deps"
, [Char] -> StyleDoc
flow [Char]
"are specified,"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"allow-newer"
, StyleDoc
"is"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"false"
]
Bool
pkgInSnapshot <- PackageName
-> Version
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
inSnapshot PackageName
pkgName Version
version
Bool
adrInSnapshot <- PackageName
-> Version
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
inSnapshot PackageName
name (AddDepRes -> Version
adrVersion AddDepRes
adr)
if Bool
pkgInSnapshot Bool -> Bool -> Bool
&& Bool
adrInSnapshot
then do
Bool
-> StyleDoc
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall {m :: * -> *}. MonadWriter W m => Bool -> StyleDoc -> m ()
warn_ Bool
True
( [Char] -> StyleDoc
flow [Char]
"trusting snapshot over Cabal file dependency \
\information"
)
Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
else Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
where
PackageIdentifier PackageName
pkgName Version
version = PackageIdentifier
pkgId
warn_ :: Bool -> StyleDoc -> m ()
warn_ Bool
isIgnoring StyleDoc
reason = W -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell W
forall a. Monoid a => a
mempty { wWarnings = (msg:) }
where
msg :: StyleDoc
msg = [StyleDoc] -> StyleDoc
fillSep
[ if Bool
isIgnoring
then StyleDoc
"Ignoring"
else [Char] -> StyleDoc
flow [Char]
"Not ignoring"
, Style -> StyleDoc -> StyleDoc
style Style
Current (PackageName -> StyleDoc
forall a. IsString a => PackageName -> a
fromPackageName PackageName
pkgName) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"'s"
, [Char] -> StyleDoc
flow [Char]
"bounds on"
, Style -> StyleDoc -> StyleDoc
style Style
Current (PackageName -> StyleDoc
forall a. IsString a => PackageName -> a
fromPackageName PackageName
name)
, StyleDoc -> StyleDoc
parens ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ VersionRange -> Text
versionRangeText VersionRange
range)
, [Char] -> StyleDoc
flow [Char]
"and using"
, Style -> StyleDoc -> StyleDoc
style
Style
Current
(PackageIdentifier -> StyleDoc
forall a. IsString a => PackageIdentifier -> a
fromPackageId (PackageIdentifier -> StyleDoc) -> PackageIdentifier -> StyleDoc
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name (AddDepRes -> Version
adrVersion AddDepRes
adr)) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Reason:"
, StyleDoc
reason StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
processAdr ::
AddDepRes
-> (Set PackageIdentifier, Map PackageIdentifier GhcPkgId, IsMutable)
processAdr :: AddDepRes
-> (Set PackageIdentifier, Map PackageIdentifier GhcPkgId,
IsMutable)
processAdr AddDepRes
adr = case AddDepRes
adr of
ADRToInstall Task
task ->
(PackageIdentifier -> Set PackageIdentifier
forall a. a -> Set a
Set.singleton (PackageIdentifier -> Set PackageIdentifier)
-> PackageIdentifier -> Set PackageIdentifier
forall a b. (a -> b) -> a -> b
$ Task -> PackageIdentifier
taskProvides Task
task, Map PackageIdentifier GhcPkgId
forall k a. Map k a
Map.empty, Task -> IsMutable
taskTargetIsMutable Task
task)
ADRFound InstallLocation
loc (Executable PackageIdentifier
_) ->
(Set PackageIdentifier
forall a. Set a
Set.empty, Map PackageIdentifier GhcPkgId
forall k a. Map k a
Map.empty, InstallLocation -> IsMutable
installLocationIsMutable InstallLocation
loc)
ADRFound InstallLocation
loc (Library PackageIdentifier
ident InstalledLibraryInfo
installedInfo) ->
( Set PackageIdentifier
forall a. Set a
Set.empty
, PackageIdentifier
-> InstalledLibraryInfo -> Map PackageIdentifier GhcPkgId
installedMapGhcPkgId PackageIdentifier
ident InstalledLibraryInfo
installedInfo
, InstallLocation -> IsMutable
installLocationIsMutable InstallLocation
loc
)
checkDirtiness ::
PackageSource
-> Installed
-> Package
-> Map PackageIdentifier GhcPkgId
-> Bool
-> M Bool
checkDirtiness :: PackageSource
-> Installed
-> Package
-> Map PackageIdentifier GhcPkgId
-> Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
checkDirtiness PackageSource
ps Installed
installed Package
package Map PackageIdentifier GhcPkgId
present Bool
buildHaddocks = do
Ctx
ctx <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Ctx
forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe ConfigCache
moldOpts <- Ctx
-> RIO Ctx (Maybe ConfigCache)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe ConfigCache)
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO Ctx
ctx (RIO Ctx (Maybe ConfigCache)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe ConfigCache))
-> RIO Ctx (Maybe ConfigCache)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe ConfigCache)
forall a b. (a -> b) -> a -> b
$ Installed -> RIO Ctx (Maybe ConfigCache)
forall env.
HasEnvConfig env =>
Installed -> RIO env (Maybe ConfigCache)
tryGetFlagCache Installed
installed
let configureOpts :: ConfigureOpts
configureOpts = EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> IsMutable
-> Package
-> ConfigureOpts
ConfigureOpts.configureOpts
(Getting EnvConfig Ctx EnvConfig -> Ctx -> EnvConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EnvConfig Ctx EnvConfig
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' Ctx EnvConfig
envConfigL Ctx
ctx)
Ctx
ctx.baseConfigOpts
Map PackageIdentifier GhcPkgId
present
(PackageSource -> Bool
psLocal PackageSource
ps)
(InstallLocation -> IsMutable
installLocationIsMutable (InstallLocation -> IsMutable) -> InstallLocation -> IsMutable
forall a b. (a -> b) -> a -> b
$ PackageSource -> InstallLocation
psLocation PackageSource
ps)
Package
package
components :: Set ByteString
components = case PackageSource
ps of
PSFilePath LocalPackage
lp ->
(NamedComponent -> ByteString)
-> Set NamedComponent -> Set ByteString
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (NamedComponent -> Text) -> NamedComponent -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedComponent -> Text
renderComponent) LocalPackage
lp.components
PSRemote{} -> Set ByteString
forall a. Set a
Set.empty
wantConfigCache :: ConfigCache
wantConfigCache = ConfigCache
{ ConfigureOpts
configureOpts :: ConfigureOpts
$sel:configureOpts:ConfigCache :: ConfigureOpts
configureOpts
, $sel:deps:ConfigCache :: Set GhcPkgId
deps = [GhcPkgId] -> Set GhcPkgId
forall a. Ord a => [a] -> Set a
Set.fromList ([GhcPkgId] -> Set GhcPkgId) -> [GhcPkgId] -> Set GhcPkgId
forall a b. (a -> b) -> a -> b
$ Map PackageIdentifier GhcPkgId -> [GhcPkgId]
forall k a. Map k a -> [a]
Map.elems Map PackageIdentifier GhcPkgId
present
, Set ByteString
components :: Set ByteString
$sel:components:ConfigCache :: Set ByteString
components
, Bool
buildHaddocks :: Bool
$sel:buildHaddocks:ConfigCache :: Bool
buildHaddocks
, $sel:pkgSrc:ConfigCache :: CachePkgSrc
pkgSrc = PackageSource -> CachePkgSrc
toCachePkgSrc PackageSource
ps
, $sel:pathEnvVar:ConfigCache :: Text
pathEnvVar = Ctx
ctx.pathEnvVar
}
config :: Config
config = Getting Config Ctx Config -> Ctx -> Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config Ctx Config
forall env. HasConfig env => Lens' env Config
Lens' Ctx Config
configL Ctx
ctx
Maybe Text
mreason <-
case Maybe ConfigCache
moldOpts of
Maybe ConfigCache
Nothing -> Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text))
-> Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"old configure information not found"
Just ConfigCache
oldOpts
| Just Text
reason <- Config -> ConfigCache -> ConfigCache -> Maybe Text
describeConfigDiff Config
config ConfigCache
oldOpts ConfigCache
wantConfigCache ->
Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text))
-> Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
reason
| Bool
True <- PackageSource -> Bool
psForceDirty PackageSource
ps -> Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text))
-> Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"--force-dirty specified"
| Bool
otherwise -> do
Maybe (Set [Char])
dirty <- PackageSource
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe (Set [Char]))
forall (m :: * -> *) env.
(MonadIO m, HasEnvConfig env, MonadReader env m) =>
PackageSource -> m (Maybe (Set [Char]))
psDirty PackageSource
ps
Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text)
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text))
-> Maybe Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe Text)
forall a b. (a -> b) -> a -> b
$
case Maybe (Set [Char])
dirty of
Just Set [Char]
files -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
Text
"local file changes: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addEllipsis ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Set [Char] -> [[Char]]
forall a. Set a -> [a]
Set.toList Set [Char]
files)
Maybe (Set [Char])
Nothing -> Maybe Text
forall a. Maybe a
Nothing
case Maybe Text
mreason of
Maybe Text
Nothing -> Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Just Text
reason -> do
W
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell W
forall a. Monoid a => a
mempty { wDirty = Map.singleton package.name reason }
Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
describeConfigDiff :: Config -> ConfigCache -> ConfigCache -> Maybe Text
describeConfigDiff :: Config -> ConfigCache -> ConfigCache -> Maybe Text
describeConfigDiff Config
config ConfigCache
old ConfigCache
new
| ConfigCache
old.pkgSrc CachePkgSrc -> CachePkgSrc -> Bool
forall a. Eq a => a -> a -> Bool
/= ConfigCache
new.pkgSrc = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
Text
"switching from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
CachePkgSrc -> Text
pkgSrcName ConfigCache
old.pkgSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
CachePkgSrc -> Text
pkgSrcName ConfigCache
new.pkgSrc
| Bool -> Bool
not (ConfigCache
new.deps Set GhcPkgId -> Set GhcPkgId -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` ConfigCache
old.deps) =
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dependencies changed"
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set ByteString -> Bool
forall a. Set a -> Bool
Set.null Set ByteString
newComponents =
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"components added: " Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", "
((ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode) (Set ByteString -> [ByteString]
forall a. Set a -> [a]
Set.toList Set ByteString
newComponents))
| Bool -> Bool
not ConfigCache
old.buildHaddocks Bool -> Bool -> Bool
&& ConfigCache
new.buildHaddocks =
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"rebuilding with haddocks"
| [Text]
oldOpts [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text]
newOpts = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"flags changed from "
, [Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
oldOpts
, [Char]
" to "
, [Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
newOpts
]
| Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing
where
stripGhcOptions :: [Text] -> [Text]
stripGhcOptions = [Text] -> [Text]
go
where
go :: [Text] -> [Text]
go [] = []
go (Text
"--ghc-option":Text
x:[Text]
xs) = WhichCompiler -> Text -> [Text] -> [Text]
go' WhichCompiler
Ghc Text
x [Text]
xs
go (Text
"--ghc-options":Text
x:[Text]
xs) = WhichCompiler -> Text -> [Text] -> [Text]
go' WhichCompiler
Ghc Text
x [Text]
xs
go ((Text -> Text -> Maybe Text
T.stripPrefix Text
"--ghc-option=" -> Just Text
x):[Text]
xs) = WhichCompiler -> Text -> [Text] -> [Text]
go' WhichCompiler
Ghc Text
x [Text]
xs
go ((Text -> Text -> Maybe Text
T.stripPrefix Text
"--ghc-options=" -> Just Text
x):[Text]
xs) = WhichCompiler -> Text -> [Text] -> [Text]
go' WhichCompiler
Ghc Text
x [Text]
xs
go (Text
x:[Text]
xs) = Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
xs
go' :: WhichCompiler -> Text -> [Text] -> [Text]
go' WhichCompiler
wc Text
x [Text]
xs = WhichCompiler -> Text -> [Text] -> [Text]
checkKeepers WhichCompiler
wc Text
x ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
go [Text]
xs
checkKeepers :: WhichCompiler -> Text -> [Text] -> [Text]
checkKeepers WhichCompiler
wc Text
x [Text]
xs =
case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isKeeper ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
x of
[] -> [Text]
xs
[Text]
keepers -> [Char] -> Text
T.pack (WhichCompiler -> [Char]
compilerOptionsCabalFlag WhichCompiler
wc) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> Text
T.unwords [Text]
keepers Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs
isKeeper :: Text -> Bool
isKeeper = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"-fhpc")
userOpts :: ConfigCache -> [Text]
userOpts = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isStackOpt)
([Text] -> [Text])
-> (ConfigCache -> [Text]) -> ConfigCache -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Config
config.rebuildGhcOptions
then [Text] -> [Text]
forall a. a -> a
id
else [Text] -> [Text]
stripGhcOptions)
([Text] -> [Text])
-> (ConfigCache -> [Text]) -> ConfigCache -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Text) -> [[Char]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Text
T.pack
([[Char]] -> [Text])
-> (ConfigCache -> [[Char]]) -> ConfigCache -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(ConfigureOpts [[Char]]
x [[Char]]
y) -> [[Char]]
x [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
y)
(ConfigureOpts -> [[Char]])
-> (ConfigCache -> ConfigureOpts) -> ConfigCache -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.configureOpts)
where
isStackOpt :: Text -> Bool
isStackOpt :: Text -> Bool
isStackOpt Text
t = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isPrefixOf` Text
t)
[ Text
"--dependency="
, Text
"--constraint="
, Text
"--package-db="
, Text
"--libdir="
, Text
"--bindir="
, Text
"--datadir="
, Text
"--libexecdir="
, Text
"--sysconfdir"
, Text
"--docdir="
, Text
"--htmldir="
, Text
"--haddockdir="
, Text
"--enable-tests"
, Text
"--enable-benchmarks"
, Text
"--exact-configuration"
] Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"--user"
([Text]
oldOpts, [Text]
newOpts) = [Text] -> [Text] -> ([Text], [Text])
forall {a}. Eq a => [a] -> [a] -> ([a], [a])
removeMatching (ConfigCache -> [Text]
userOpts ConfigCache
old) (ConfigCache -> [Text]
userOpts ConfigCache
new)
removeMatching :: [a] -> [a] -> ([a], [a])
removeMatching (a
x:[a]
xs) (a
y:[a]
ys)
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a] -> ([a], [a])
removeMatching [a]
xs [a]
ys
removeMatching [a]
xs [a]
ys = ([a]
xs, [a]
ys)
newComponents :: Set ByteString
newComponents =
ConfigCache
new.components Set ByteString -> Set ByteString -> Set ByteString
forall {a}. Ord a => Set a -> Set a -> Set a
`Set.difference` ConfigCache
old.components
pkgSrcName :: CachePkgSrc -> Text
pkgSrcName (CacheSrcLocal [Char]
fp) = [Char] -> Text
T.pack [Char]
fp
pkgSrcName CachePkgSrc
CacheSrcUpstream = Text
"upstream source"
psForceDirty :: PackageSource -> Bool
psForceDirty :: PackageSource -> Bool
psForceDirty (PSFilePath LocalPackage
lp) = LocalPackage
lp.forceDirty
psForceDirty PSRemote{} = Bool
False
psDirty ::
(MonadIO m, HasEnvConfig env, MonadReader env m)
=> PackageSource
-> m (Maybe (Set FilePath))
psDirty :: forall (m :: * -> *) env.
(MonadIO m, HasEnvConfig env, MonadReader env m) =>
PackageSource -> m (Maybe (Set [Char]))
psDirty (PSFilePath LocalPackage
lp) = MemoizedWith EnvConfig (Maybe (Set [Char]))
-> m (Maybe (Set [Char]))
forall env (m :: * -> *) a.
(HasEnvConfig env, MonadReader env m, MonadIO m) =>
MemoizedWith EnvConfig a -> m a
runMemoizedWith LocalPackage
lp.dirtyFiles
psDirty PSRemote {} = Maybe (Set [Char]) -> m (Maybe (Set [Char]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Set [Char])
forall a. Maybe a
Nothing
psLocal :: PackageSource -> Bool
psLocal :: PackageSource -> Bool
psLocal (PSFilePath LocalPackage
_ ) = Bool
True
psLocal PSRemote{} = Bool
False
psLocation :: PackageSource -> InstallLocation
psLocation :: PackageSource -> InstallLocation
psLocation (PSFilePath LocalPackage
_) = InstallLocation
Local
psLocation PSRemote{} = InstallLocation
Snap
checkAndWarnForUnknownTools :: Package -> M ()
checkAndWarnForUnknownTools :: Package
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
checkAndWarnForUnknownTools Package
p = do
let unknownTools :: [Text]
unknownTools = Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Package -> Set Text
packageUnknownTools Package
p
[ToolWarning]
warnings <-
([Maybe ToolWarning] -> [ToolWarning])
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
[Maybe ToolWarning]
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
[ToolWarning]
forall a b.
(a -> b)
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ToolWarning] -> [ToolWarning]
forall a. [Maybe a] -> [a]
catMaybes (WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
[Maybe ToolWarning]
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
[ToolWarning])
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
[Maybe ToolWarning]
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
[ToolWarning]
forall a b. (a -> b) -> a -> b
$ [Text]
-> (Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe ToolWarning))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
[Maybe ToolWarning]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
unknownTools ((Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe ToolWarning))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
[Maybe ToolWarning])
-> (Text
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe ToolWarning))
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
[Maybe ToolWarning]
forall a b. (a -> b) -> a -> b
$ \Text
toolName ->
MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
ToolWarning
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe ToolWarning)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
ToolWarning
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe ToolWarning))
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
ToolWarning
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
(Maybe ToolWarning)
forall a b. (a -> b) -> a -> b
$ Text
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
()
forall {s} {m :: * -> *}.
(MonadReader s m, MonadIO m, HasConfig s) =>
Text -> MaybeT m ()
notOnPath Text
toolName MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
()
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
()
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
()
forall a b.
MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
a
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
b
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
()
forall {m :: * -> *}. Applicative m => Text -> MaybeT m ()
notPackageExe Text
toolName MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
()
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
ToolWarning
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
ToolWarning
forall a b.
MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
a
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
b
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text
-> MaybeT
(WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)))
ToolWarning
forall {m :: * -> *}. Applicative m => Text -> MaybeT m ToolWarning
warn Text
toolName
W
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell W
forall a. Monoid a => a
mempty { wWarnings = (map toolWarningText warnings ++) }
()
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
()
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
notOnPath :: Text -> MaybeT m ()
notOnPath Text
toolName = m (Maybe ()) -> MaybeT m ()
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe ()) -> MaybeT m ()) -> m (Maybe ()) -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ do
let settings :: EnvSettings
settings = EnvSettings
minimalEnvSettings { includeLocals = True }
Config
config <- Getting Config s Config -> m Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config s Config
forall env. HasConfig env => Lens' env Config
Lens' s Config
configL
ProcessContext
menv <- IO ProcessContext -> m ProcessContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessContext -> m ProcessContext)
-> IO ProcessContext -> m ProcessContext
forall a b. (a -> b) -> a -> b
$ Config
config.processContextSettings EnvSettings
settings
Either ProcessException [Char]
eFound <- ProcessContext
-> RIO ProcessContext (Either ProcessException [Char])
-> m (Either ProcessException [Char])
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO ProcessContext
menv (RIO ProcessContext (Either ProcessException [Char])
-> m (Either ProcessException [Char]))
-> RIO ProcessContext (Either ProcessException [Char])
-> m (Either ProcessException [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> RIO ProcessContext (Either ProcessException [Char])
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
[Char] -> m (Either ProcessException [Char])
findExecutable ([Char] -> RIO ProcessContext (Either ProcessException [Char]))
-> [Char] -> RIO ProcessContext (Either ProcessException [Char])
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
toolName
Bool -> m (Maybe ())
forall {f :: * -> *}. Applicative f => Bool -> f (Maybe ())
skipIf (Bool -> m (Maybe ())) -> Bool -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ Either ProcessException [Char] -> Bool
forall a b. Either a b -> Bool
isRight Either ProcessException [Char]
eFound
notPackageExe :: Text -> MaybeT m ()
notPackageExe Text
toolName =
m (Maybe ()) -> MaybeT m ()
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe ()) -> MaybeT m ()) -> m (Maybe ()) -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ Bool -> m (Maybe ())
forall {f :: * -> *}. Applicative f => Bool -> f (Maybe ())
skipIf (Bool -> m (Maybe ())) -> Bool -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ Text -> CompCollection StackExecutable -> Bool
forall component. Text -> CompCollection component -> Bool
collectionMember Text
toolName Package
p.executables
warn :: Text -> MaybeT m ToolWarning
warn Text
name = m (Maybe ToolWarning) -> MaybeT m ToolWarning
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe ToolWarning) -> MaybeT m ToolWarning)
-> (ToolWarning -> m (Maybe ToolWarning))
-> ToolWarning
-> MaybeT m ToolWarning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ToolWarning -> m (Maybe ToolWarning)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ToolWarning -> m (Maybe ToolWarning))
-> (ToolWarning -> Maybe ToolWarning)
-> ToolWarning
-> m (Maybe ToolWarning)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToolWarning -> Maybe ToolWarning
forall a. a -> Maybe a
Just (ToolWarning -> MaybeT m ToolWarning)
-> ToolWarning -> MaybeT m ToolWarning
forall a b. (a -> b) -> a -> b
$ ExeName -> PackageName -> ToolWarning
ToolWarning (Text -> ExeName
ExeName Text
name) Package
p.name
skipIf :: Bool -> f (Maybe ())
skipIf Bool
p' = Maybe () -> f (Maybe ())
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe () -> f (Maybe ())) -> Maybe () -> f (Maybe ())
forall a b. (a -> b) -> a -> b
$ if Bool
p' then Maybe ()
forall a. Maybe a
Nothing else () -> Maybe ()
forall a. a -> Maybe a
Just ()
toolWarningText :: ToolWarning -> StyleDoc
toolWarningText :: ToolWarning -> StyleDoc
toolWarningText (ToolWarning (ExeName Text
toolName) PackageName
pkgName') = [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"No packages found in snapshot which provide a"
, Style -> StyleDoc -> StyleDoc
style Style
PkgComponent ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
toolName)
, [Char] -> StyleDoc
flow [Char]
"executable, which is a build-tool dependency of"
, Style -> StyleDoc -> StyleDoc
style Style
Current (PackageName -> StyleDoc
forall a. IsString a => PackageName -> a
fromPackageName PackageName
pkgName')
]
inSnapshot :: PackageName -> Version -> M Bool
inSnapshot :: PackageName
-> Version
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
inSnapshot PackageName
name Version
version = do
Ctx
ctx <- WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Ctx
forall r (m :: * -> *). MonadReader r m => m r
ask
Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall a.
a
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool)
-> Bool
-> WriterT
W
(StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx))
Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
PackageInfo
ps <- PackageName -> Map PackageName PackageInfo -> Maybe PackageInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Ctx
ctx.combinedMap
case PackageInfo
ps of
PIOnlySource (PSRemote PackageLocationImmutable
_ Version
srcVersion FromSnapshot
FromSnapshot CommonPackage
_) ->
Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Version
srcVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
version
PIBoth (PSRemote PackageLocationImmutable
_ Version
srcVersion FromSnapshot
FromSnapshot CommonPackage
_) Installed
_ ->
Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Version
srcVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
version
PIOnlyInstalled InstallLocation
loc (Library PackageIdentifier
pid InstalledLibraryInfo
_) ->
Bool -> Maybe Bool -> Maybe Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (InstallLocation
loc InstallLocation -> InstallLocation -> Bool
forall a. Eq a => a -> a -> Bool
== InstallLocation
Snap) (Maybe Bool -> Maybe Bool) -> Maybe Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
Bool -> Maybe Bool -> Maybe Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PackageIdentifier -> Version
pkgVersion PackageIdentifier
pid Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
version) (Maybe Bool -> Maybe Bool) -> Maybe Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
PackageInfo
_ -> Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
logDebugPlanS ::
(HasCallStack, HasRunner env, MonadIO m, MonadReader env m)
=> LogSource
-> Utf8Builder
-> m ()
logDebugPlanS :: forall env (m :: * -> *).
(?callStack::CallStack, HasRunner env, MonadIO m,
MonadReader env m) =>
Text -> Utf8Builder -> m ()
logDebugPlanS Text
s Utf8Builder
msg = do
Bool
debugPlan <- Getting Bool env Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool env Bool -> m Bool)
-> Getting Bool env Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (GlobalOpts -> Const Bool GlobalOpts) -> env -> Const Bool env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL ((GlobalOpts -> Const Bool GlobalOpts) -> env -> Const Bool env)
-> ((Bool -> Const Bool Bool)
-> GlobalOpts -> Const Bool GlobalOpts)
-> Getting Bool env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalOpts -> Bool) -> SimpleGetter GlobalOpts Bool
forall s a. (s -> a) -> SimpleGetter s a
to (.planInLog)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugPlan (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
?callStack::CallStack) =>
Text -> Utf8Builder -> m ()
logDebugS Text
s Utf8Builder
msg
combineSourceInstalled :: PackageSource
-> (InstallLocation, Installed)
-> PackageInfo
combineSourceInstalled :: PackageSource -> (InstallLocation, Installed) -> PackageInfo
combineSourceInstalled PackageSource
ps (InstallLocation
location, Installed
installed) =
Bool -> PackageInfo -> PackageInfo
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PackageSource -> Version
psVersion PackageSource
ps Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Installed -> Version
installedVersion Installed
installed) (PackageInfo -> PackageInfo) -> PackageInfo -> PackageInfo
forall a b. (a -> b) -> a -> b
$
case InstallLocation
location of
InstallLocation
Snap -> InstallLocation -> Installed -> PackageInfo
PIOnlyInstalled InstallLocation
location Installed
installed
InstallLocation
Local -> PackageSource -> Installed -> PackageInfo
PIBoth PackageSource
ps Installed
installed
combineMap :: Map PackageName PackageSource -> InstalledMap -> CombinedMap
combineMap :: Map PackageName PackageSource
-> InstalledMap -> Map PackageName PackageInfo
combineMap = SimpleWhenMissing PackageName PackageSource PackageInfo
-> SimpleWhenMissing
PackageName (InstallLocation, Installed) PackageInfo
-> SimpleWhenMatched
PackageName PackageSource (InstallLocation, Installed) PackageInfo
-> Map PackageName PackageSource
-> InstalledMap
-> Map PackageName PackageInfo
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
((PackageName -> PackageSource -> PackageInfo)
-> SimpleWhenMissing PackageName PackageSource PackageInfo
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\PackageName
_ PackageSource
s -> PackageSource -> PackageInfo
PIOnlySource PackageSource
s))
((PackageName -> (InstallLocation, Installed) -> PackageInfo)
-> SimpleWhenMissing
PackageName (InstallLocation, Installed) PackageInfo
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\PackageName
_ (InstallLocation, Installed)
i -> (InstallLocation -> Installed -> PackageInfo)
-> (InstallLocation, Installed) -> PackageInfo
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry InstallLocation -> Installed -> PackageInfo
PIOnlyInstalled (InstallLocation, Installed)
i))
((PackageName
-> PackageSource -> (InstallLocation, Installed) -> PackageInfo)
-> SimpleWhenMatched
PackageName PackageSource (InstallLocation, Installed) PackageInfo
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (\PackageName
_ PackageSource
s (InstallLocation, Installed)
i -> PackageSource -> (InstallLocation, Installed) -> PackageInfo
combineSourceInstalled PackageSource
s (InstallLocation, Installed)
i))