{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Stack.Types.Build.ConstructPlan
( PackageInfo (..)
, CombinedMap
, M
, W (..)
, AddDepRes (..)
, toTask
, adrVersion
, adrHasLibrary
, Ctx (..)
, UnregisterState (..)
, ToolWarning (..)
) where
import Generics.Deriving.Monoid ( mappenddefault, memptydefault )
import RIO.Process ( HasProcessContext (..) )
import RIO.State ( StateT )
import RIO.Writer ( WriterT (..) )
import Stack.Package ( hasBuildableMainLibrary )
import Stack.Prelude hiding ( loadPackage )
import Stack.Types.Build
( Task (..), TaskType (..), taskProvides )
import Stack.Types.Build.Exception ( ConstructPlanException )
import Stack.Types.BuildConfig
( BuildConfig (..), HasBuildConfig(..) )
import Stack.Types.CompilerPaths ( HasCompiler (..) )
import Stack.Types.Config ( HasConfig (..) )
import Stack.Types.ConfigureOpts ( BaseConfigOpts )
import Stack.Types.Curator ( Curator )
import Stack.Types.DumpPackage ( DumpPackage )
import Stack.Types.EnvConfig
( EnvConfig (..), HasEnvConfig (..), HasSourceMap (..) )
import Stack.Types.GhcPkgId ( GhcPkgId )
import Stack.Types.GHCVariant ( HasGHCVariant (..) )
import Stack.Types.Installed
( InstallLocation, Installed (..), installedVersion )
import Stack.Types.Package
( ExeName (..), LocalPackage (..), Package (..)
, PackageSource (..)
)
import Stack.Types.ParentMap ( ParentMap )
import Stack.Types.Platform ( HasPlatform (..) )
import Stack.Types.Runner ( HasRunner (..) )
data PackageInfo
= PIOnlyInstalled InstallLocation Installed
| PIOnlySource PackageSource
| PIBoth PackageSource Installed
deriving Int -> PackageInfo -> ShowS
[PackageInfo] -> ShowS
PackageInfo -> String
(Int -> PackageInfo -> ShowS)
-> (PackageInfo -> String)
-> ([PackageInfo] -> ShowS)
-> Show PackageInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageInfo -> ShowS
showsPrec :: Int -> PackageInfo -> ShowS
$cshow :: PackageInfo -> String
show :: PackageInfo -> String
$cshowList :: [PackageInfo] -> ShowS
showList :: [PackageInfo] -> ShowS
Show
type CombinedMap = Map PackageName PackageInfo
type M =
WriterT
W
( StateT
(Map PackageName (Either ConstructPlanException AddDepRes))
(RIO Ctx)
)
data W = W
{ W -> Map PackageName (Either ConstructPlanException Task)
wFinals :: !(Map PackageName (Either ConstructPlanException Task))
, W -> Map Text InstallLocation
wInstall :: !(Map Text InstallLocation)
, W -> Map PackageName Text
wDirty :: !(Map PackageName Text)
, W -> [StyleDoc] -> [StyleDoc]
wWarnings :: !([StyleDoc] -> [StyleDoc])
, W -> ParentMap
wParents :: !ParentMap
}
deriving (forall x. W -> Rep W x) -> (forall x. Rep W x -> W) -> Generic W
forall x. Rep W x -> W
forall x. W -> Rep W x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. W -> Rep W x
from :: forall x. W -> Rep W x
$cto :: forall x. Rep W x -> W
to :: forall x. Rep W x -> W
Generic
instance Semigroup W where
<> :: W -> W -> W
(<>) = W -> W -> W
forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault
instance Monoid W where
mempty :: W
mempty = W
forall a. (Generic a, Monoid' (Rep a)) => a
memptydefault
mappend :: W -> W -> W
mappend = W -> W -> W
forall a. Semigroup a => a -> a -> a
(<>)
data AddDepRes
= ADRToInstall Task
| ADRFound InstallLocation Installed
deriving Int -> AddDepRes -> ShowS
[AddDepRes] -> ShowS
AddDepRes -> String
(Int -> AddDepRes -> ShowS)
-> (AddDepRes -> String)
-> ([AddDepRes] -> ShowS)
-> Show AddDepRes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddDepRes -> ShowS
showsPrec :: Int -> AddDepRes -> ShowS
$cshow :: AddDepRes -> String
show :: AddDepRes -> String
$cshowList :: [AddDepRes] -> ShowS
showList :: [AddDepRes] -> ShowS
Show
toTask :: AddDepRes -> Maybe Task
toTask :: AddDepRes -> Maybe Task
toTask (ADRToInstall Task
task) = Task -> Maybe Task
forall a. a -> Maybe a
Just Task
task
toTask (ADRFound InstallLocation
_ Installed
_) = Maybe Task
forall a. Maybe a
Nothing
adrVersion :: AddDepRes -> Version
adrVersion :: AddDepRes -> Version
adrVersion (ADRToInstall Task
task) = PackageIdentifier -> Version
pkgVersion (PackageIdentifier -> Version) -> PackageIdentifier -> Version
forall a b. (a -> b) -> a -> b
$ Task -> PackageIdentifier
taskProvides Task
task
adrVersion (ADRFound InstallLocation
_ Installed
installed) = Installed -> Version
installedVersion Installed
installed
adrHasLibrary :: AddDepRes -> Bool
adrHasLibrary :: AddDepRes -> Bool
adrHasLibrary (ADRToInstall Task
task) = case Task
task.taskType of
TTLocalMutable LocalPackage
lp -> Package -> Bool
packageHasLibrary LocalPackage
lp.package
TTRemotePackage IsMutable
_ Package
p PackageLocationImmutable
_ -> Package -> Bool
packageHasLibrary Package
p
where
packageHasLibrary :: Package -> Bool
packageHasLibrary :: Package -> Bool
packageHasLibrary Package
p =
Package -> Bool
hasBuildableMainLibrary Package
p Bool -> Bool -> Bool
|| Bool -> Bool
not (CompCollection StackLibrary -> Bool
forall a. CompCollection a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Package
p.subLibraries)
adrHasLibrary (ADRFound InstallLocation
_ Library{}) = Bool
True
adrHasLibrary (ADRFound InstallLocation
_ Executable{}) = Bool
False
data Ctx = Ctx
{ Ctx -> BaseConfigOpts
baseConfigOpts :: !BaseConfigOpts
, Ctx
-> PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> M Package
loadPackage :: !( PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> M Package
)
, Ctx -> CombinedMap
combinedMap :: !CombinedMap
, Ctx -> EnvConfig
ctxEnvConfig :: !EnvConfig
, Ctx -> [PackageName]
callStack :: ![PackageName]
, Ctx -> Set PackageName
wanted :: !(Set PackageName)
, Ctx -> Set PackageName
localNames :: !(Set PackageName)
, Ctx -> Maybe Curator
curator :: !(Maybe Curator)
, Ctx -> Text
pathEnvVar :: !Text
}
instance HasPlatform Ctx where
platformL :: Lens' Ctx Platform
platformL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
Lens' Ctx Config
configL ((Config -> f Config) -> Ctx -> f Ctx)
-> ((Platform -> f Platform) -> Config -> f Config)
-> (Platform -> f Platform)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Platform -> f Platform) -> Config -> f Config
forall env. HasPlatform env => Lens' env Platform
Lens' Config Platform
platformL
{-# INLINE platformL #-}
platformVariantL :: Lens' Ctx PlatformVariant
platformVariantL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
Lens' Ctx Config
configL ((Config -> f Config) -> Ctx -> f Ctx)
-> ((PlatformVariant -> f PlatformVariant) -> Config -> f Config)
-> (PlatformVariant -> f PlatformVariant)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlatformVariant -> f PlatformVariant) -> Config -> f Config
forall env. HasPlatform env => Lens' env PlatformVariant
Lens' Config PlatformVariant
platformVariantL
{-# INLINE platformVariantL #-}
instance HasGHCVariant Ctx where
ghcVariantL :: SimpleGetter Ctx GHCVariant
ghcVariantL = (Config -> Const r Config) -> Ctx -> Const r Ctx
forall env. HasConfig env => Lens' env Config
Lens' Ctx Config
configL ((Config -> Const r Config) -> Ctx -> Const r Ctx)
-> ((GHCVariant -> Const r GHCVariant) -> Config -> Const r Config)
-> (GHCVariant -> Const r GHCVariant)
-> Ctx
-> Const r Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCVariant -> Const r GHCVariant) -> Config -> Const r Config
forall env. HasGHCVariant env => SimpleGetter env GHCVariant
SimpleGetter Config GHCVariant
ghcVariantL
{-# INLINE ghcVariantL #-}
instance HasLogFunc Ctx where
logFuncL :: Lens' Ctx LogFunc
logFuncL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
Lens' Ctx Config
configL ((Config -> f Config) -> Ctx -> f Ctx)
-> ((LogFunc -> f LogFunc) -> Config -> f Config)
-> (LogFunc -> f LogFunc)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogFunc -> f LogFunc) -> Config -> f Config
forall env. HasLogFunc env => Lens' env LogFunc
Lens' Config LogFunc
logFuncL
instance HasRunner Ctx where
runnerL :: Lens' Ctx Runner
runnerL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
Lens' Ctx Config
configL ((Config -> f Config) -> Ctx -> f Ctx)
-> ((Runner -> f Runner) -> Config -> f Config)
-> (Runner -> f Runner)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
Lens' Config Runner
runnerL
instance HasStylesUpdate Ctx where
stylesUpdateL :: Lens' Ctx StylesUpdate
stylesUpdateL = (Runner -> f Runner) -> Ctx -> f Ctx
forall env. HasRunner env => Lens' env Runner
Lens' Ctx Runner
runnerL ((Runner -> f Runner) -> Ctx -> f Ctx)
-> ((StylesUpdate -> f StylesUpdate) -> Runner -> f Runner)
-> (StylesUpdate -> f StylesUpdate)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StylesUpdate -> f StylesUpdate) -> Runner -> f Runner
forall env. HasStylesUpdate env => Lens' env StylesUpdate
Lens' Runner StylesUpdate
stylesUpdateL
instance HasTerm Ctx where
useColorL :: Lens' Ctx Bool
useColorL = (Runner -> f Runner) -> Ctx -> f Ctx
forall env. HasRunner env => Lens' env Runner
Lens' Ctx Runner
runnerL ((Runner -> f Runner) -> Ctx -> f Ctx)
-> ((Bool -> f Bool) -> Runner -> f Runner)
-> (Bool -> f Bool)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> Runner -> f Runner
forall env. HasTerm env => Lens' env Bool
Lens' Runner Bool
useColorL
termWidthL :: Lens' Ctx Int
termWidthL = (Runner -> f Runner) -> Ctx -> f Ctx
forall env. HasRunner env => Lens' env Runner
Lens' Ctx Runner
runnerL ((Runner -> f Runner) -> Ctx -> f Ctx)
-> ((Int -> f Int) -> Runner -> f Runner)
-> (Int -> f Int)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> Runner -> f Runner
forall env. HasTerm env => Lens' env Int
Lens' Runner Int
termWidthL
instance HasConfig Ctx where
configL :: Lens' Ctx Config
configL = (BuildConfig -> f BuildConfig) -> Ctx -> f Ctx
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' Ctx BuildConfig
buildConfigL ((BuildConfig -> f BuildConfig) -> Ctx -> f Ctx)
-> ((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> (Config -> f Config)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildConfig -> Config)
-> (BuildConfig -> Config -> BuildConfig)
-> Lens BuildConfig BuildConfig Config Config
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.config) (\BuildConfig
x Config
y -> BuildConfig
x { config = y })
{-# INLINE configL #-}
instance HasPantryConfig Ctx where
pantryConfigL :: Lens' Ctx PantryConfig
pantryConfigL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
Lens' Ctx Config
configL ((Config -> f Config) -> Ctx -> f Ctx)
-> ((PantryConfig -> f PantryConfig) -> Config -> f Config)
-> (PantryConfig -> f PantryConfig)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PantryConfig -> f PantryConfig) -> Config -> f Config
forall env. HasPantryConfig env => Lens' env PantryConfig
Lens' Config PantryConfig
pantryConfigL
instance HasProcessContext Ctx where
processContextL :: Lens' Ctx ProcessContext
processContextL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
Lens' Ctx Config
configL ((Config -> f Config) -> Ctx -> f Ctx)
-> ((ProcessContext -> f ProcessContext) -> Config -> f Config)
-> (ProcessContext -> f ProcessContext)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessContext -> f ProcessContext) -> Config -> f Config
forall env. HasProcessContext env => Lens' env ProcessContext
Lens' Config ProcessContext
processContextL
instance HasBuildConfig Ctx where
buildConfigL :: Lens' Ctx BuildConfig
buildConfigL = (EnvConfig -> f EnvConfig) -> Ctx -> f Ctx
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' Ctx EnvConfig
envConfigL ((EnvConfig -> f EnvConfig) -> Ctx -> f Ctx)
-> ((BuildConfig -> f BuildConfig) -> EnvConfig -> f EnvConfig)
-> (BuildConfig -> f BuildConfig)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnvConfig -> BuildConfig)
-> (EnvConfig -> BuildConfig -> EnvConfig)
-> Lens EnvConfig EnvConfig BuildConfig BuildConfig
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(.buildConfig)
(\EnvConfig
x BuildConfig
y -> EnvConfig
x { buildConfig = y })
instance HasSourceMap Ctx where
sourceMapL :: Lens' Ctx SourceMap
sourceMapL = (EnvConfig -> f EnvConfig) -> Ctx -> f Ctx
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' Ctx EnvConfig
envConfigL ((EnvConfig -> f EnvConfig) -> Ctx -> f Ctx)
-> ((SourceMap -> f SourceMap) -> EnvConfig -> f EnvConfig)
-> (SourceMap -> f SourceMap)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceMap -> f SourceMap) -> EnvConfig -> f EnvConfig
forall env. HasSourceMap env => Lens' env SourceMap
Lens' EnvConfig SourceMap
sourceMapL
instance HasCompiler Ctx where
compilerPathsL :: SimpleGetter Ctx CompilerPaths
compilerPathsL = (EnvConfig -> Const r EnvConfig) -> Ctx -> Const r Ctx
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' Ctx EnvConfig
envConfigL ((EnvConfig -> Const r EnvConfig) -> Ctx -> Const r Ctx)
-> ((CompilerPaths -> Const r CompilerPaths)
-> EnvConfig -> Const r EnvConfig)
-> (CompilerPaths -> Const r CompilerPaths)
-> Ctx
-> Const r Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerPaths -> Const r CompilerPaths)
-> EnvConfig -> Const r EnvConfig
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter EnvConfig CompilerPaths
compilerPathsL
instance HasEnvConfig Ctx where
envConfigL :: Lens' Ctx EnvConfig
envConfigL = (Ctx -> EnvConfig)
-> (Ctx -> EnvConfig -> Ctx) -> Lens' Ctx EnvConfig
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.ctxEnvConfig) (\Ctx
x EnvConfig
y -> Ctx
x { ctxEnvConfig = y })
data UnregisterState = UnregisterState
{ UnregisterState -> Map GhcPkgId (PackageIdentifier, Text)
toUnregister :: !(Map GhcPkgId (PackageIdentifier, Text))
, UnregisterState -> [DumpPackage]
toKeep :: ![DumpPackage]
, UnregisterState -> Bool
anyAdded :: !Bool
}
data ToolWarning
= ToolWarning ExeName PackageName
deriving Int -> ToolWarning -> ShowS
[ToolWarning] -> ShowS
ToolWarning -> String
(Int -> ToolWarning -> ShowS)
-> (ToolWarning -> String)
-> ([ToolWarning] -> ShowS)
-> Show ToolWarning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolWarning -> ShowS
showsPrec :: Int -> ToolWarning -> ShowS
$cshow :: ToolWarning -> String
show :: ToolWarning -> String
$cshowList :: [ToolWarning] -> ShowS
showList :: [ToolWarning] -> ShowS
Show