{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# 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
configWorkDir :: !(Path Rel Dir)
, Config -> Path Abs File
configUserConfigPath :: !(Path Abs File)
, Config -> BuildOpts
configBuild :: !BuildOpts
, Config -> DockerOpts
configDocker :: !DockerOpts
, Config -> NixOpts
configNix :: !NixOpts
, Config -> EnvSettings -> IO ProcessContext
configProcessContextSettings :: !(EnvSettings -> IO ProcessContext)
, Config -> Path Abs Dir
configLocalProgramsBase :: !(Path Abs Dir)
, Config -> Path Abs Dir
configLocalPrograms :: !(Path Abs Dir)
, Config -> Bool
configHideTHLoading :: !Bool
, Config -> Bool
configPrefixTimestamps :: !Bool
, Config -> Platform
configPlatform :: !Platform
, Config -> PlatformVariant
configPlatformVariant :: !PlatformVariant
, Config -> Maybe GHCVariant
configGHCVariant :: !(Maybe GHCVariant)
, Config -> Maybe CompilerBuild
configGHCBuild :: !(Maybe CompilerBuild)
, Config -> Text
configLatestSnapshot :: !Text
, Config -> Bool
configSystemGHC :: !Bool
, Config -> Bool
configInstallGHC :: !Bool
, Config -> Bool
configSkipGHCCheck :: !Bool
, Config -> Bool
configSkipMsys :: !Bool
, Config -> VersionCheck
configCompilerCheck :: !VersionCheck
, Config -> CompilerRepository
configCompilerRepository :: !CompilerRepository
, Config -> Path Abs Dir
configLocalBin :: !(Path Abs Dir)
, Config -> VersionRange
configRequireStackVersion :: !VersionRange
, Config -> Int
configJobs :: !Int
, Config -> Maybe (Path Abs File)
configOverrideGccPath :: !(Maybe (Path Abs File))
, :: ![FilePath]
, :: ![FilePath]
, Config -> [Text]
configCustomPreprocessorExts :: ![Text]
, Config -> Bool
configConcurrentTests :: !Bool
, Config -> Map Text Text
configTemplateParams :: !(Map Text Text)
, Config -> Maybe SCM
configScmInit :: !(Maybe SCM)
, Config -> Map PackageName [Text]
configGhcOptionsByName :: !(Map PackageName [Text])
, Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat :: !(Map ApplyGhcOptions [Text])
, Config -> Map CabalConfigKey [Text]
configCabalConfigOpts :: !(Map CabalConfigKey [Text])
, Config -> [FilePath]
configSetupInfoLocations :: ![String]
, Config -> SetupInfo
configSetupInfoInline :: !SetupInfo
, Config -> PvpBounds
configPvpBounds :: !PvpBounds
, Config -> Bool
configModifyCodePage :: !Bool
, Config -> Bool
configRebuildGhcOptions :: !Bool
, Config -> ApplyGhcOptions
configApplyGhcOptions :: !ApplyGhcOptions
, Config -> ApplyProgOptions
configApplyProgOptions :: !ApplyProgOptions
, Config -> Bool
configAllowNewer :: !Bool
, Config -> Maybe [PackageName]
configAllowNewerDeps :: !(Maybe [PackageName])
, Config -> Maybe TemplateName
configDefaultTemplate :: !(Maybe TemplateName)
, Config -> Bool
configAllowDifferentUser :: !Bool
, Config -> DumpLogs
configDumpLogs :: !DumpLogs
, Config -> ProjectConfig (Project, Path Abs File)
configProject :: !(ProjectConfig (Project, Path Abs File))
, Config -> Bool
configAllowLocals :: !Bool
, Config -> Bool
configSaveHackageCreds :: !Bool
, Config -> Text
configHackageBaseUrl :: !Text
, Config -> Runner
configRunner :: !Runner
, Config -> PantryConfig
configPantryConfig :: !PantryConfig
, Config -> Path Abs Dir
configStackRoot :: !(Path Abs Dir)
, Config -> Maybe AbstractResolver
configResolver :: !(Maybe AbstractResolver)
, Config -> UserStorage
configUserStorage :: !UserStorage
, Config -> Bool
configHideSourcePaths :: !Bool
, Config -> Bool
configRecommendUpgrade :: !Bool
, Config -> Bool
configNotifyIfNixOnPath :: !Bool
, Config -> Bool
configNoRunCompile :: !Bool
, Config -> Bool
configStackDeveloperMode :: !Bool
, Config -> Maybe (CasaRepoPrefix, Int)
configCasa :: !(Maybe (CasaRepoPrefix, Int))
}
configProjectRoot :: Config -> Maybe (Path Abs Dir)
configProjectRoot :: Config -> Maybe (Path Abs Dir)
configProjectRoot Config
c =
case Config -> ProjectConfig (Project, Path Abs File)
configProject Config
c 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 Config -> Text
configLatestSnapshot
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 Config -> Path Abs Dir
configStackRoot
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 Config -> Platform
configPlatform (\Config
x Platform
y -> Config
x { configPlatform :: Platform
configPlatform = 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 Config -> PlatformVariant
configPlatformVariant (\Config
x PlatformVariant
y -> Config
x { configPlatformVariant :: PlatformVariant
configPlatformVariant = 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
. Config -> Maybe GHCVariant
configGHCVariant
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 Config -> PantryConfig
configPantryConfig (\Config
x PantryConfig
y -> Config
x { configPantryConfig :: PantryConfig
configPantryConfig = 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 Config -> Runner
configRunner (\Config
x Runner
y -> Config
x { configRunner :: Runner
configRunner = 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 Config -> Path Abs Dir
configStackRoot (\Config
x Path Abs Dir
y -> Config
x { configStackRoot :: Path Abs Dir
configStackRoot = Path Abs Dir
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 Config -> Path Abs File
configUserConfigPath (\Config
x Path Abs File
y -> Config
x { configUserConfigPath :: Path Abs File
configUserConfigPath = Path Abs File
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
Config -> BuildOpts
configBuild
(\Config
x BuildOpts
y -> Config
x { configBuild :: BuildOpts
configBuild = BuildOpts
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
Config -> EnvSettings -> IO ProcessContext
configProcessContextSettings
(\Config
x EnvSettings -> IO ProcessContext
y -> Config
x { configProcessContextSettings :: EnvSettings -> IO ProcessContext
configProcessContextSettings = EnvSettings -> IO ProcessContext
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 Config -> Path Rel Dir
configWorkDir (\Config
x Path Rel Dir
y -> Config
x { configWorkDir :: Path Rel Dir
configWorkDir = Path Rel Dir
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 -> Bool
configStackDeveloperMode Config
config
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