{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Stack.Types.Config
(
Config (..)
, HasConfig (..)
, askLatestSnapshotUrl
, configProjectRoot
, ghcInstallHook
, buildOptsL
, envOverrideSettingsL
, globalOptsL
, stackGlobalConfigL
, stackRootL
, workDirL
, prettyStackDevL
) where
import Casa.Client ( CasaRepoPrefix )
import Distribution.System ( Platform )
import Path ( (</>), parent, reldir, relfile )
import RIO.Process ( HasProcessContext (..), ProcessContext )
import Stack.Prelude
import Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
import Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
import Stack.Types.BuildOpts ( BuildOpts )
import Stack.Types.CabalConfigKey ( CabalConfigKey )
import Stack.Types.Compiler ( CompilerRepository )
import Stack.Types.CompilerBuild ( CompilerBuild )
import Stack.Types.Docker ( DockerOpts )
import Stack.Types.DumpLogs ( DumpLogs )
import Stack.Types.EnvSettings ( EnvSettings )
import Stack.Types.GHCVariant ( GHCVariant (..), HasGHCVariant (..) )
import Stack.Types.Nix ( NixOpts )
import Stack.Types.Platform ( HasPlatform (..), PlatformVariant )
import Stack.Types.Project ( Project (..) )
import Stack.Types.ProjectConfig ( ProjectConfig (..) )
import Stack.Types.PvpBounds ( PvpBounds )
import Stack.Types.Resolver ( AbstractResolver )
import Stack.Types.Runner ( HasRunner (..), Runner, globalOptsL )
import Stack.Types.SCM ( SCM )
import Stack.Types.SetupInfo ( SetupInfo )
import Stack.Types.Storage ( UserStorage )
import Stack.Types.TemplateName ( TemplateName )
import Stack.Types.Version ( VersionCheck (..), VersionRange )
data Config = Config
{ Config -> Path Rel Dir
workDir :: !(Path Rel Dir)
, Config -> Path Abs File
userConfigPath :: !(Path Abs File)
, Config -> BuildOpts
build :: !BuildOpts
, Config -> DockerOpts
docker :: !DockerOpts
, Config -> NixOpts
nix :: !NixOpts
, Config -> EnvSettings -> IO ProcessContext
processContextSettings :: !(EnvSettings -> IO ProcessContext)
, Config -> Path Abs Dir
localProgramsBase :: !(Path Abs Dir)
, Config -> Path Abs Dir
localPrograms :: !(Path Abs Dir)
, Config -> Bool
hideTHLoading :: !Bool
, Config -> Bool
prefixTimestamps :: !Bool
, Config -> Platform
platform :: !Platform
, Config -> PlatformVariant
platformVariant :: !PlatformVariant
, Config -> Maybe GHCVariant
ghcVariant :: !(Maybe GHCVariant)
, Config -> Maybe CompilerBuild
ghcBuild :: !(Maybe CompilerBuild)
, Config -> Text
latestSnapshot :: !Text
, Config -> Bool
systemGHC :: !Bool
, Config -> Bool
installGHC :: !Bool
, Config -> Bool
skipGHCCheck :: !Bool
, Config -> Bool
skipMsys :: !Bool
, Config -> VersionCheck
compilerCheck :: !VersionCheck
, Config -> CompilerRepository
compilerRepository :: !CompilerRepository
, Config -> Path Abs Dir
localBin :: !(Path Abs Dir)
, Config -> VersionRange
requireStackVersion :: !VersionRange
, Config -> Int
jobs :: !Int
, Config -> Maybe (Path Abs File)
overrideGccPath :: !(Maybe (Path Abs File))
, :: ![FilePath]
, :: ![FilePath]
, Config -> [Text]
customPreprocessorExts :: ![Text]
, Config -> Bool
concurrentTests :: !Bool
, Config -> Map Text Text
templateParams :: !(Map Text Text)
, Config -> Maybe SCM
scmInit :: !(Maybe SCM)
, Config -> Map PackageName [Text]
ghcOptionsByName :: !(Map PackageName [Text])
, Config -> Map ApplyGhcOptions [Text]
ghcOptionsByCat :: !(Map ApplyGhcOptions [Text])
, Config -> Map CabalConfigKey [Text]
cabalConfigOpts :: !(Map CabalConfigKey [Text])
, Config -> [FilePath]
setupInfoLocations :: ![String]
, Config -> SetupInfo
setupInfoInline :: !SetupInfo
, Config -> PvpBounds
pvpBounds :: !PvpBounds
, Config -> Bool
modifyCodePage :: !Bool
, Config -> Bool
rebuildGhcOptions :: !Bool
, Config -> ApplyGhcOptions
applyGhcOptions :: !ApplyGhcOptions
, Config -> ApplyProgOptions
applyProgOptions :: !ApplyProgOptions
, Config -> Bool
allowNewer :: !Bool
, Config -> Maybe [PackageName]
allowNewerDeps :: !(Maybe [PackageName])
, Config -> Maybe TemplateName
defaultTemplate :: !(Maybe TemplateName)
, Config -> Bool
allowDifferentUser :: !Bool
, Config -> DumpLogs
dumpLogs :: !DumpLogs
, Config -> ProjectConfig (Project, Path Abs File)
project :: !(ProjectConfig (Project, Path Abs File))
, Config -> Bool
allowLocals :: !Bool
, Config -> Bool
saveHackageCreds :: !Bool
, Config -> Text
hackageBaseUrl :: !Text
, Config -> Runner
runner :: !Runner
, Config -> PantryConfig
pantryConfig :: !PantryConfig
, Config -> Path Abs Dir
stackRoot :: !(Path Abs Dir)
, Config -> Maybe AbstractResolver
resolver :: !(Maybe AbstractResolver)
, Config -> UserStorage
userStorage :: !UserStorage
, Config -> Bool
hideSourcePaths :: !Bool
, Config -> Bool
recommendUpgrade :: !Bool
, Config -> Bool
notifyIfNixOnPath :: !Bool
, Config -> Bool
notifyIfGhcUntested :: !Bool
, Config -> Bool
notifyIfCabalUntested :: !Bool
, Config -> Bool
notifyIfArchUnknown :: !Bool
, Config -> Bool
noRunCompile :: !Bool
, Config -> Bool
stackDeveloperMode :: !Bool
, Config -> Maybe (CasaRepoPrefix, Int)
casa :: !(Maybe (CasaRepoPrefix, Int))
}
configProjectRoot :: Config -> Maybe (Path Abs Dir)
configProjectRoot :: Config -> Maybe (Path Abs Dir)
configProjectRoot Config
c =
case Config
c.project of
PCProject (Project
_, Path Abs File
fp) -> Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just (Path Abs Dir -> Maybe (Path Abs Dir))
-> Path Abs Dir -> Maybe (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
fp
ProjectConfig (Project, Path Abs File)
PCGlobalProject -> Maybe (Path Abs Dir)
forall a. Maybe a
Nothing
PCNoProject [PackageIdentifierRevision]
_deps -> Maybe (Path Abs Dir)
forall a. Maybe a
Nothing
askLatestSnapshotUrl :: (MonadReader env m, HasConfig env) => m Text
askLatestSnapshotUrl :: forall env (m :: * -> *).
(MonadReader env m, HasConfig env) =>
m Text
askLatestSnapshotUrl = Getting Text env Text -> m Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Text env Text -> m Text)
-> Getting Text env Text -> m Text
forall a b. (a -> b) -> a -> b
$ (Config -> Const Text Config) -> env -> Const Text env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL ((Config -> Const Text Config) -> env -> Const Text env)
-> ((Text -> Const Text Text) -> Config -> Const Text Config)
-> Getting Text env Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Text) -> SimpleGetter Config Text
forall s a. (s -> a) -> SimpleGetter s a
to (.latestSnapshot)
hooksDir :: HasConfig env => RIO env (Path Abs Dir)
hooksDir :: forall env. HasConfig env => RIO env (Path Abs Dir)
hooksDir = do
Path Abs Dir
sr <- 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)
-> RIO env (Path Abs Dir))
-> Getting (Path Abs Dir) env (Path Abs Dir)
-> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ (Config -> Const (Path Abs Dir) Config)
-> env -> Const (Path Abs Dir) env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL ((Config -> Const (Path Abs Dir) Config)
-> env -> Const (Path Abs Dir) env)
-> ((Path Abs Dir -> Const (Path Abs Dir) (Path Abs Dir))
-> Config -> Const (Path Abs Dir) Config)
-> Getting (Path Abs Dir) env (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Path Abs Dir) -> SimpleGetter Config (Path Abs Dir)
forall s a. (s -> a) -> SimpleGetter s a
to (.stackRoot)
Path Abs Dir -> RIO env (Path Abs Dir)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir
sr Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [reldir|hooks|])
ghcInstallHook :: HasConfig env => RIO env (Path Abs File)
ghcInstallHook :: forall env. HasConfig env => RIO env (Path Abs File)
ghcInstallHook = do
Path Abs Dir
hd <- RIO env (Path Abs Dir)
forall env. HasConfig env => RIO env (Path Abs Dir)
hooksDir
Path Abs File -> RIO env (Path Abs File)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir
hd Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|ghc-install.sh|])
class ( HasPlatform env
, HasGHCVariant env
, HasProcessContext env
, HasPantryConfig env
, HasTerm env
, HasRunner env
) => HasConfig env where
configL :: Lens' env Config
instance HasPlatform Config where
platformL :: Lens' Config Platform
platformL = (Config -> Platform)
-> (Config -> Platform -> Config) -> Lens' Config Platform
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.platform) (\Config
x Platform
y -> Config
x { platform = y })
platformVariantL :: Lens' Config PlatformVariant
platformVariantL =
(Config -> PlatformVariant)
-> (Config -> PlatformVariant -> Config)
-> Lens' Config PlatformVariant
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.platformVariant) (\Config
x PlatformVariant
y -> Config
x { platformVariant = y })
instance HasGHCVariant Config where
ghcVariantL :: SimpleGetter Config GHCVariant
ghcVariantL = (Config -> GHCVariant) -> SimpleGetter Config GHCVariant
forall s a. (s -> a) -> SimpleGetter s a
to ((Config -> GHCVariant) -> SimpleGetter Config GHCVariant)
-> (Config -> GHCVariant) -> SimpleGetter Config GHCVariant
forall a b. (a -> b) -> a -> b
$ GHCVariant -> Maybe GHCVariant -> GHCVariant
forall a. a -> Maybe a -> a
fromMaybe GHCVariant
GHCStandard (Maybe GHCVariant -> GHCVariant)
-> (Config -> Maybe GHCVariant) -> Config -> GHCVariant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.ghcVariant)
instance HasProcessContext Config where
processContextL :: Lens' Config ProcessContext
processContextL = (Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
Lens' Config Runner
runnerL ((Runner -> f Runner) -> Config -> f Config)
-> ((ProcessContext -> f ProcessContext) -> Runner -> f Runner)
-> (ProcessContext -> f ProcessContext)
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessContext -> f ProcessContext) -> Runner -> f Runner
forall env. HasProcessContext env => Lens' env ProcessContext
Lens' Runner ProcessContext
processContextL
instance HasPantryConfig Config where
pantryConfigL :: Lens' Config PantryConfig
pantryConfigL = (Config -> PantryConfig)
-> (Config -> PantryConfig -> Config) -> Lens' Config PantryConfig
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(.pantryConfig)
(\Config
x PantryConfig
y -> Config
x { pantryConfig = y })
instance HasConfig Config where
configL :: Lens' Config Config
configL = (Config -> f Config) -> Config -> f Config
forall a. a -> a
id
{-# INLINE configL #-}
instance HasRunner Config where
runnerL :: Lens' Config Runner
runnerL = (Config -> Runner)
-> (Config -> Runner -> Config) -> Lens' Config Runner
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.runner) (\Config
x Runner
y -> Config
x { runner = y })
instance HasLogFunc Config where
logFuncL :: Lens' Config LogFunc
logFuncL = (Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
Lens' Config Runner
runnerL ((Runner -> f Runner) -> Config -> f Config)
-> ((LogFunc -> f LogFunc) -> Runner -> f Runner)
-> (LogFunc -> f LogFunc)
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogFunc -> f LogFunc) -> Runner -> f Runner
forall env. HasLogFunc env => Lens' env LogFunc
Lens' Runner LogFunc
logFuncL
instance HasStylesUpdate Config where
stylesUpdateL :: Lens' Config StylesUpdate
stylesUpdateL = (Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
Lens' Config Runner
runnerL ((Runner -> f Runner) -> Config -> f Config)
-> ((StylesUpdate -> f StylesUpdate) -> Runner -> f Runner)
-> (StylesUpdate -> f StylesUpdate)
-> Config
-> f Config
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 Config where
useColorL :: Lens' Config Bool
useColorL = (Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
Lens' Config Runner
runnerL ((Runner -> f Runner) -> Config -> f Config)
-> ((Bool -> f Bool) -> Runner -> f Runner)
-> (Bool -> f Bool)
-> Config
-> f Config
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' Config Int
termWidthL = (Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
Lens' Config Runner
runnerL ((Runner -> f Runner) -> Config -> f Config)
-> ((Int -> f Int) -> Runner -> f Runner)
-> (Int -> f Int)
-> Config
-> f Config
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
stackRootL :: HasConfig s => Lens' s (Path Abs Dir)
stackRootL :: forall s. HasConfig s => Lens' s (Path Abs Dir)
stackRootL =
(Config -> f Config) -> s -> f s
forall env. HasConfig env => Lens' env Config
Lens' s Config
configL ((Config -> f Config) -> s -> f s)
-> ((Path Abs Dir -> f (Path Abs Dir)) -> Config -> f Config)
-> (Path Abs Dir -> f (Path Abs Dir))
-> s
-> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Path Abs Dir)
-> (Config -> Path Abs Dir -> Config)
-> Lens Config Config (Path Abs Dir) (Path Abs Dir)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.stackRoot) (\Config
x Path Abs Dir
y -> Config
x { stackRoot = y })
stackGlobalConfigL :: HasConfig s => Lens' s (Path Abs File)
stackGlobalConfigL :: forall s. HasConfig s => Lens' s (Path Abs File)
stackGlobalConfigL = (Config -> f Config) -> s -> f s
forall env. HasConfig env => Lens' env Config
Lens' s Config
configL ((Config -> f Config) -> s -> f s)
-> ((Path Abs File -> f (Path Abs File)) -> Config -> f Config)
-> (Path Abs File -> f (Path Abs File))
-> s
-> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Path Abs File)
-> (Config -> Path Abs File -> Config)
-> Lens Config Config (Path Abs File) (Path Abs File)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(.userConfigPath)
(\Config
x Path Abs File
y -> Config
x { userConfigPath = y })
buildOptsL :: HasConfig s => Lens' s BuildOpts
buildOptsL :: forall s. HasConfig s => Lens' s BuildOpts
buildOptsL = (Config -> f Config) -> s -> f s
forall env. HasConfig env => Lens' env Config
Lens' s Config
configL ((Config -> f Config) -> s -> f s)
-> ((BuildOpts -> f BuildOpts) -> Config -> f Config)
-> (BuildOpts -> f BuildOpts)
-> s
-> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> BuildOpts)
-> (Config -> BuildOpts -> Config)
-> Lens Config Config BuildOpts BuildOpts
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.build) (\Config
x BuildOpts
y -> Config
x { build = y })
envOverrideSettingsL ::
HasConfig env
=> Lens' env (EnvSettings -> IO ProcessContext)
envOverrideSettingsL :: forall env.
HasConfig env =>
Lens' env (EnvSettings -> IO ProcessContext)
envOverrideSettingsL = (Config -> f Config) -> env -> f env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL ((Config -> f Config) -> env -> f env)
-> (((EnvSettings -> IO ProcessContext)
-> f (EnvSettings -> IO ProcessContext))
-> Config -> f Config)
-> ((EnvSettings -> IO ProcessContext)
-> f (EnvSettings -> IO ProcessContext))
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> EnvSettings -> IO ProcessContext)
-> (Config -> (EnvSettings -> IO ProcessContext) -> Config)
-> Lens
Config
Config
(EnvSettings -> IO ProcessContext)
(EnvSettings -> IO ProcessContext)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(.processContextSettings)
(\Config
x EnvSettings -> IO ProcessContext
y -> Config
x { processContextSettings = y })
workDirL :: HasConfig env => Lens' env (Path Rel Dir)
workDirL :: forall env. HasConfig env => Lens' env (Path Rel Dir)
workDirL = (Config -> f Config) -> env -> f env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL ((Config -> f Config) -> env -> f env)
-> ((Path Rel Dir -> f (Path Rel Dir)) -> Config -> f Config)
-> (Path Rel Dir -> f (Path Rel Dir))
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Path Rel Dir)
-> (Config -> Path Rel Dir -> Config)
-> Lens Config Config (Path Rel Dir) (Path Rel Dir)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.workDir) (\Config
x Path Rel Dir
y -> Config
x { workDir = y })
prettyStackDevL :: HasConfig env => [StyleDoc] -> RIO env ()
prettyStackDevL :: forall env. HasConfig env => [StyleDoc] -> RIO env ()
prettyStackDevL [StyleDoc]
docs = do
Config
config <- Getting Config env Config -> RIO env Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL
if Config
config.stackDeveloperMode
then [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL [StyleDoc]
docs
else [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyDebugL [StyleDoc]
docs