{-# 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
  -- * Lens helpers

  , buildOptsL
  , envOverrideSettingsL
  , globalOptsL
  , stackGlobalConfigL
  , stackRootL
  , workDirL
  -- * Helper logging functions

  , 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 )

-- | The top-level Stackage configuration.

data Config = Config
  { Config -> Path Rel Dir
workDir                :: !(Path Rel Dir)
    -- ^ this allows to override .stack-work directory

  , Config -> Path Abs File
userConfigPath         :: !(Path Abs File)
    -- ^ Path to user configuration file (usually ~/.stack/config.yaml)

  , Config -> BuildOpts
build                  :: !BuildOpts
    -- ^ Build configuration

  , Config -> DockerOpts
docker                 :: !DockerOpts
    -- ^ Docker configuration

  , Config -> NixOpts
nix                    :: !NixOpts
    -- ^ Execution environment (e.g nix-shell) configuration

  , Config -> EnvSettings -> IO ProcessContext
processContextSettings :: !(EnvSettings -> IO ProcessContext)
    -- ^ Environment variables to be passed to external tools

  , Config -> Path Abs Dir
localProgramsBase      :: !(Path Abs Dir)
    -- ^ Non-platform-specific path containing local installations

  , Config -> Path Abs Dir
localPrograms          :: !(Path Abs Dir)
    -- ^ Path containing local installations (mainly GHC)

  , Config -> Bool
hideTHLoading          :: !Bool
    -- ^ Hide the Template Haskell "Loading package ..." messages from the

    -- console

  , Config -> Bool
prefixTimestamps       :: !Bool
    -- ^ Prefix build output with timestamps for each line.

  , Config -> Platform
platform               :: !Platform
    -- ^ The platform we're building for, used in many directory names

  , Config -> PlatformVariant
platformVariant        :: !PlatformVariant
    -- ^ Variant of the platform, also used in directory names

  , Config -> Maybe GHCVariant
ghcVariant             :: !(Maybe GHCVariant)
    -- ^ The variant of GHC requested by the user.

  , Config -> Maybe CompilerBuild
ghcBuild               :: !(Maybe CompilerBuild)
    -- ^ Override build of the compiler distribution (e.g. standard, gmp4,

    -- tinfo6)

  , Config -> Text
latestSnapshot         :: !Text
    -- ^ URL of a JSON file providing the latest LTS and Nightly snapshots.

  , Config -> Bool
systemGHC              :: !Bool
    -- ^ Should we use the system-installed GHC (on the PATH) if

    -- available? Can be overridden by command line options.

  , Config -> Bool
installGHC             :: !Bool
    -- ^ Should we automatically install GHC if missing or the wrong

    -- version is available? Can be overridden by command line options.

  , Config -> Bool
skipGHCCheck           :: !Bool
    -- ^ Don't bother checking the GHC version or architecture.

  , Config -> Bool
skipMsys               :: !Bool
    -- ^ On Windows: don't use a sandboxed MSYS

  , Config -> VersionCheck
compilerCheck          :: !VersionCheck
    -- ^ Specifies which versions of the compiler are acceptable.

  , Config -> CompilerRepository
compilerRepository     :: !CompilerRepository
    -- ^ Specifies the repository containing the compiler sources

  , Config -> Path Abs Dir
localBin               :: !(Path Abs Dir)
    -- ^ Directory we should install executables into

  , Config -> VersionRange
requireStackVersion    :: !VersionRange
    -- ^ Require a version of Stack within this range.

  , Config -> Int
jobs                   :: !Int
    -- ^ How many concurrent jobs to run, defaults to number of capabilities

  , Config -> Maybe (Path Abs File)
overrideGccPath        :: !(Maybe (Path Abs File))
    -- ^ Optional gcc override path

  , Config -> [FilePath]
extraIncludeDirs       :: ![FilePath]
    -- ^ --extra-include-dirs arguments

  , Config -> [FilePath]
extraLibDirs           :: ![FilePath]
    -- ^ --extra-lib-dirs arguments

  , Config -> [Text]
customPreprocessorExts :: ![Text]
    -- ^ List of custom preprocessors to complete the hard coded ones

  , Config -> Bool
concurrentTests        :: !Bool
    -- ^ Run test suites concurrently

  , Config -> Map Text Text
templateParams         :: !(Map Text Text)
    -- ^ Parameters for templates.

  , Config -> Maybe SCM
scmInit                :: !(Maybe SCM)
    -- ^ Initialize SCM (e.g. git) when creating new projects.

  , Config -> Map PackageName [Text]
ghcOptionsByName       :: !(Map PackageName [Text])
    -- ^ Additional GHC options to apply to specific packages.

  , Config -> Map ApplyGhcOptions [Text]
ghcOptionsByCat        :: !(Map ApplyGhcOptions [Text])
    -- ^ Additional GHC options to apply to categories of packages

  , Config -> Map CabalConfigKey [Text]
cabalConfigOpts        :: !(Map CabalConfigKey [Text])
    -- ^ Additional options to be passed to ./Setup.hs configure

  , Config -> [FilePath]
setupInfoLocations     :: ![String]
    -- ^ URLs or paths to stack-setup.yaml files, for finding tools.

    -- If none present, the default setup-info is used.

  , Config -> SetupInfo
setupInfoInline        :: !SetupInfo
    -- ^ Additional SetupInfo to use to find tools.

  , Config -> PvpBounds
pvpBounds              :: !PvpBounds
    -- ^ How PVP upper bounds should be added to packages

  , Config -> Bool
modifyCodePage         :: !Bool
    -- ^ Force the code page to UTF-8 on Windows

  , Config -> Bool
rebuildGhcOptions      :: !Bool
    -- ^ Rebuild on GHC options changes

  , Config -> ApplyGhcOptions
applyGhcOptions        :: !ApplyGhcOptions
    -- ^ Which packages do --ghc-options on the command line apply to?

  , Config -> ApplyProgOptions
applyProgOptions       :: !ApplyProgOptions
    -- ^ Which packages do all and any --PROG-option options on the command line

    -- apply to?

  , Config -> Bool
allowNewer             :: !Bool
    -- ^ Ignore version ranges in .cabal files. Funny naming chosen to

    -- match cabal.

  , Config -> Maybe [PackageName]
allowNewerDeps         :: !(Maybe [PackageName])
    -- ^ Ignore dependency upper and lower bounds only for specified

    -- packages. No effect unless allow-newer is enabled.

  , Config -> Maybe TemplateName
defaultTemplate        :: !(Maybe TemplateName)
    -- ^ The default template to use when none is specified.

    -- (If Nothing, the 'default' default template is used.)

  , Config -> Bool
allowDifferentUser     :: !Bool
    -- ^ Allow users other than the Stack root owner to use the Stack

    -- installation.

  , Config -> DumpLogs
dumpLogs               :: !DumpLogs
    -- ^ Dump logs of local non-dependencies when doing a build.

  , Config -> ProjectConfig (Project, Path Abs File)
project                :: !(ProjectConfig (Project, Path Abs File))
    -- ^ Project information and stack.yaml file location

  , Config -> Bool
allowLocals            :: !Bool
    -- ^ Are we allowed to build local packages? The script

    -- command disallows this.

  , Config -> Bool
saveHackageCreds       :: !Bool
    -- ^ Should we save Hackage credentials to a file?

  , Config -> Text
hackageBaseUrl         :: !Text
    -- ^ Hackage base URL used when uploading packages

  , Config -> Runner
runner                 :: !Runner
  , Config -> PantryConfig
pantryConfig           :: !PantryConfig
  , Config -> Path Abs Dir
stackRoot              :: !(Path Abs Dir)
  , Config -> Maybe AbstractResolver
resolver               :: !(Maybe AbstractResolver)
    -- ^ Any resolver override from the command line

  , Config -> UserStorage
userStorage            :: !UserStorage
    -- ^ Database connection pool for user Stack database

  , Config -> Bool
hideSourcePaths        :: !Bool
    -- ^ Enable GHC hiding source paths?

  , Config -> Bool
recommendUpgrade       :: !Bool
    -- ^ Recommend a Stack upgrade?

  , Config -> Bool
notifyIfNixOnPath      :: !Bool
    -- ^ Notify if the Nix package manager (nix) is on the PATH, but

    -- Stack's Nix integration is not enabled?

  , Config -> Bool
notifyIfGhcUntested    :: !Bool
    -- ^ Notify if Stack has not been tested with the GHC version?

  , Config -> Bool
notifyIfCabalUntested  :: !Bool
    -- ^ Notify if Stack has not been tested with the Cabal version?

  , Config -> Bool
notifyIfArchUnknown    :: !Bool
    -- ^ Notify if the specified machine architecture is unknown to Cabal (the

    -- library)?

  , Config -> Bool
noRunCompile           :: !Bool
    -- ^ Use --no-run and --compile options when using `stack script`

  , Config -> Bool
stackDeveloperMode     :: !Bool
    -- ^ Turn on Stack developer mode for additional messages?

  , Config -> Maybe (CasaRepoPrefix, Int)
casa                   :: !(Maybe (CasaRepoPrefix, Int))
    -- ^ Optional Casa configuration

  }

-- | The project root directory, if in a project.

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

-- | Get the URL to request the information on the latest snapshots

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)

-- | @STACK_ROOT\/hooks\/@

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|])

-- | @STACK_ROOT\/hooks\/ghc-install.sh@

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|])

-----------------------------------

-- Lens classes

-----------------------------------


-- | Class for environment values that can provide a 'Config'.

class ( HasPlatform env
      , HasGHCVariant env
      , HasProcessContext env
      , HasPantryConfig env
      , HasTerm env
      , HasRunner env
      ) => HasConfig env where
  configL :: Lens' env Config

-----------------------------------

-- Lens instances

-----------------------------------


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

-----------------------------------

-- Helper lenses

-----------------------------------


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 })

-- | @".stack-work"@

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 })

-- | In dev mode, print as a warning, otherwise as debug

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