{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors      #-}
{-# LANGUAGE OverloadedRecordDot   #-}
{-# LANGUAGE OverloadedStrings     #-}

{-|
Module      : Stack.Types.ConfigMonoid
License     : BSD-3-Clause
-}

module Stack.Types.ConfigMonoid
  ( ConfigMonoid (..)
  , parseConfigMonoid
  , parseConfigMonoidObject
  , configMonoidAllowDifferentUserName
  , configMonoidGHCVariantName
  , configMonoidInstallGHCName
  , configMonoidInstallMsysName
  , configMonoidRecommendStackUpgradeName
  , configMonoidSystemGHCName
  ) where

import           Data.Aeson.Types ( Object, Value )
import           Data.Aeson.WarningParser
                   ( WarningParser, WithJSONWarnings, (..:?), (..!=)
                   , jsonSubWarnings, jsonSubWarningsT, withObjectWarnings
                   )
import           Casa.Client ( CasaRepoPrefix )
import           Control.Monad.Writer ( tell )
import           Data.Coerce ( coerce )
import qualified Data.Map as Map
import qualified Data.Map.Strict as M
import qualified Data.Monoid as Monoid
import           Data.Monoid.Map ( MonoidMap (..) )
import qualified Data.Yaml as Yaml
import           Distribution.Version ( anyVersion )
import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
import           Stack.Prelude hiding ( snapshotLocation )
import           Stack.Types.AllowNewerDeps ( AllowNewerDeps )
import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
import           Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
import           Stack.Types.BuildOptsMonoid ( BuildOptsMonoid )
import           Stack.Types.Casa ( CasaOptsMonoid )
import           Stack.Types.CabalConfigKey ( CabalConfigKey )
import           Stack.Types.ColorWhen ( ColorWhen )
import           Stack.Types.Compiler
                   ( CompilerBindistPath, CompilerRepository, CompilerTarget )
import           Stack.Types.CompilerBuild ( CompilerBuild )
import           Stack.Types.Docker ( DockerOptsMonoid, VersionRangeJSON (..) )
import           Stack.Types.DumpLogs ( DumpLogs )
import           Stack.Types.GhcOptionKey ( GhcOptionKey (..) )
import           Stack.Types.GhcOptions ( GhcOptions (..) )
import           Stack.Types.GHCVariant ( GHCVariant )
import           Stack.Types.MsysEnvironment ( MsysEnvironment )
import           Stack.Types.Nix ( NixOptsMonoid )
import           Stack.Types.PvpBounds ( PvpBounds )
import           Stack.Types.SCM ( SCM )
import           Stack.Types.SetupInfo ( SetupInfo )
import           Stack.Types.TemplateName ( TemplateName )
import           Stack.Types.Version
                   ( IntersectingVersionRange (..), VersionCheck )
import qualified System.FilePath as FilePath
import Stack.Types.Snapshot (AbstractSnapshot)

-- | An uninterpreted representation of configuration options. Configurations

-- may be "cascaded" using mappend (left-biased).

data ConfigMonoid = ConfigMonoid
  { ConfigMonoid -> First (Path Abs Dir)
stackRoot               :: !(First (Path Abs Dir))
    -- ^ See: 'Stack.Types.Config.stackRoot'

  , ConfigMonoid -> First (Path Rel Dir)
workDir                 :: !(First (Path Rel Dir))
    -- ^ See: 'Stack.Types.Config.workDir'.

  , ConfigMonoid -> BuildOptsMonoid
buildOpts               :: !BuildOptsMonoid
    -- ^ build options.

  , ConfigMonoid -> DockerOptsMonoid
dockerOpts              :: !DockerOptsMonoid
    -- ^ Docker options.

  , ConfigMonoid -> NixOptsMonoid
nixOpts                 :: !NixOptsMonoid
    -- ^ Options for the execution environment (nix-shell or container)

  , ConfigMonoid -> First Int
connectionCount         :: !(First Int)
    -- ^ See: 'Stack.Types.Config.connectionCount'

  , ConfigMonoid -> FirstTrue
hideTHLoading           :: !FirstTrue
    -- ^ See: 'Stack.Types.Config.hideTHLoading'

  , ConfigMonoid -> First Bool
prefixTimestamps        :: !(First Bool)
    -- ^ See: 'Stack.Types.Config.prefixTimestamps'

  , ConfigMonoid -> First Text
latestSnapshot          :: !(First Text)
    -- ^ See: 'Stack.Types.Config.latestSnapshot'

  , ConfigMonoid -> First PackageIndexConfig
packageIndex            :: !(First PackageIndexConfig)
    -- ^ See: 'withPantryConfig'

  , ConfigMonoid -> First Bool
systemGHC               :: !(First Bool)
    -- ^ See: 'Stack.Types.Config.systemGHC'

  , ConfigMonoid -> FirstTrue
installGHC              :: !FirstTrue
    -- ^ See: 'Stack.Types.Config.installGHC'

  , ConfigMonoid -> First Bool
installMsys             :: !(First Bool)
    -- ^ See: 'Stack.Types.Config.installMsys'

  , ConfigMonoid -> FirstFalse
skipGHCCheck            :: !FirstFalse
    -- ^ See: 'Stack.Types.Config.skipGHCCheck'

  , ConfigMonoid -> FirstFalse
skipMsys                :: !FirstFalse
    -- ^ See: 'Stack.Types.Config.skipMsys'

  , ConfigMonoid -> First MsysEnvironment
msysEnvironment         :: !(First MsysEnvironment)
    -- ^ See: 'Stack.Types.Config.msysEnvironment'

  , ConfigMonoid -> First VersionCheck
compilerCheck           :: !(First VersionCheck)
    -- ^ See: 'Stack.Types.Config.compilerCheck'

  , ConfigMonoid -> First CompilerRepository
compilerRepository      :: !(First CompilerRepository)
    -- ^ See: 'Stack.Types.Config.compilerRepository'

  , ConfigMonoid -> First CompilerTarget
compilerTarget          :: !(First CompilerTarget)
    -- ^ See: 'Stack.Types.Config.compilerTarget'

  , ConfigMonoid -> First CompilerBindistPath
compilerBindistPath     :: !(First CompilerBindistPath)
    -- ^ See: 'Stack.Types.Config.compilerBindistPath'

  , ConfigMonoid -> IntersectingVersionRange
requireStackVersion     :: !IntersectingVersionRange
    -- ^ See: 'Stack.Types.Config.requireStackVersion'

  , ConfigMonoid -> First String
arch                    :: !(First String)
    -- ^ Used for overriding the platform

  , ConfigMonoid -> First GHCVariant
ghcVariant              :: !(First GHCVariant)
    -- ^ Used for overriding the platform

  , ConfigMonoid -> First CompilerBuild
ghcBuild                :: !(First CompilerBuild)
    -- ^ Used for overriding the GHC build

  , ConfigMonoid -> First Int
jobs                    :: !(First Int)
    -- ^ See: 'Stack.Types.Config.jobs'

  , ConfigMonoid -> [String]
extraIncludeDirs        :: ![FilePath]
    -- ^ See: 'Stack.Types.Config.extraIncludeDirs'

  , ConfigMonoid -> [String]
extraLibDirs            :: ![FilePath]
    -- ^ See: 'Stack.Types.Config.extraLibDirs'

  , ConfigMonoid -> [Text]
customPreprocessorExts  :: ![Text]
    -- ^ See: 'Stack.Types.Config.customPreprocessorExts'

  , ConfigMonoid -> First (Path Abs File)
overrideGccPath         :: !(First (Path Abs File))
    -- ^ Allow users to override the path to gcc

  , ConfigMonoid -> First String
overrideHpack           :: !(First FilePath)
    -- ^ Use Hpack executable (overrides bundled Hpack)

  , ConfigMonoid -> FirstFalse
hpackForce              :: !FirstFalse
    -- ^ Pass --force to Hpack to always overwrite Cabal file

  , ConfigMonoid -> First Bool
concurrentTests         :: !(First Bool)
    -- ^ See: 'Stack.Types.Config.concurrentTests'

  , ConfigMonoid -> First String
localBinPath            :: !(First FilePath)
    -- ^ Used to override the binary installation dir

  , ConfigMonoid -> First String
fileWatchHook           :: !(First FilePath)
    -- ^ Path to executable used to override --file-watch post-processing.

  , ConfigMonoid -> Map Text Text
templateParameters      :: !(Map Text Text)
    -- ^ Template parameters.

  , ConfigMonoid -> First SCM
scmInit                 :: !(First SCM)
    -- ^ Initialize SCM (e.g. git init) when making new projects?

  , ConfigMonoid -> MonoidMap PackageName (Dual [Text])
ghcOptionsByName        :: !(MonoidMap PackageName (Monoid.Dual [Text]))
    -- ^ See 'Stack.Types.Config.ghcOptionsByName'. Uses 'Monoid.Dual' so that

    -- options from the configs on the right come first, so that they

    -- can be overridden.

  , ConfigMonoid -> MonoidMap ApplyGhcOptions (Dual [Text])
ghcOptionsByCat         :: !(MonoidMap ApplyGhcOptions (Monoid.Dual [Text]))
    -- ^ See 'Stack.Types.Config.ghcOptionsAll'. Uses 'Monoid.Dual' so that options

    -- from the configs on the right come first, so that they can be

    -- overridden.

  , ConfigMonoid -> MonoidMap CabalConfigKey (Dual [Text])
cabalConfigOpts         :: !(MonoidMap CabalConfigKey (Monoid.Dual [Text]))
    -- ^ See 'Stack.Types.Config.cabalConfigOpts'.

  , ConfigMonoid -> [Path Abs Dir]
extraPath               :: ![Path Abs Dir]
    -- ^ Additional paths to search for executables in

  , ConfigMonoid -> [String]
setupInfoLocations      :: ![String]
    -- ^ See 'Stack.Types.Config.setupInfoLocations'

  , ConfigMonoid -> SetupInfo
setupInfoInline         :: !SetupInfo
    -- ^ See 'Stack.Types.Config.setupInfoInline'

  , ConfigMonoid -> First (Path Abs Dir)
localProgramsBase       :: !(First (Path Abs Dir))
    -- ^ Override the default local programs dir, where e.g. GHC is installed.

  , ConfigMonoid -> First PvpBounds
pvpBounds               :: !(First PvpBounds)
    -- ^ See 'Stack.Types.Config.pvpBounds'

  , ConfigMonoid -> FirstTrue
modifyCodePage          :: !FirstTrue
    -- ^ See 'Stack.Types.Config.modifyCodePage'

  , ConfigMonoid -> FirstFalse
rebuildGhcOptions       :: !FirstFalse
    -- ^ See 'Stack.Types.Config.monoidRebuildGhcOptions'

  , ConfigMonoid -> First ApplyGhcOptions
applyGhcOptions         :: !(First ApplyGhcOptions)
    -- ^ See 'Stack.Types.Config.applyGhcOptions'

  , ConfigMonoid -> First ApplyProgOptions
applyProgOptions        :: !(First ApplyProgOptions)
    -- ^ See 'Stack.Types.Config.applyProgOptions'

  , ConfigMonoid -> First Bool
allowNewer              :: !(First Bool)
    -- ^ See 'Stack.Types.Config.monoidAllowNewer'

  , ConfigMonoid -> Maybe AllowNewerDeps
allowNewerDeps          :: !(Maybe AllowNewerDeps)
    -- ^ See 'Stack.Types.Config.monoidAllowNewerDeps'

  , ConfigMonoid -> First (Unresolved AbstractSnapshot)
defaultInitSnapshot     :: !(First (Unresolved AbstractSnapshot))
   -- ^ An optional default snapshot to use with @stack init@ when none is

   -- specified.

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

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

  , ConfigMonoid -> First Bool
allowDifferentUser      :: !(First Bool)
   -- ^ Allow users other than the Stack root owner to use the Stack

   -- installation.

  , ConfigMonoid -> First DumpLogs
dumpLogs                :: !(First DumpLogs)
    -- ^ See 'Stack.Types.Config.dumpLogs'

  , ConfigMonoid -> FirstTrue
saveHackageCreds        :: !FirstTrue
    -- ^ See 'Stack.Types.Config.saveHackageCreds'

  , ConfigMonoid -> First Text
hackageBaseUrl          :: !(First Text)
    -- ^ See 'Stack.Types.Config.hackageBaseUrl'

  , ConfigMonoid -> First ColorWhen
colorWhen               :: !(First ColorWhen)
    -- ^ When to use \'ANSI\' colors

  , ConfigMonoid -> StylesUpdate
styles                  :: !StylesUpdate
  , ConfigMonoid -> FirstTrue
hideSourcePaths         :: !FirstTrue
    -- ^ See 'Stack.Types.Config.hideSourcePaths'

  , ConfigMonoid -> FirstTrue
recommendStackUpgrade   :: !FirstTrue
    -- ^ See 'Stack.Types.Config.recommendStackUpgrade'

  , ConfigMonoid -> FirstFalse
notifyIfNixOnPath       :: !FirstFalse
    -- ^ See 'Stack.Types.Config.notifyIfNixOnPath'

  , ConfigMonoid -> FirstFalse
notifyIfGhcUntested     :: !FirstFalse
    -- ^ See 'Stack.Types.Config.notifyIfGhcUntested'

  , ConfigMonoid -> FirstFalse
notifyIfCabalUntested   :: !FirstFalse
    -- ^ See 'Stack.Types.Config.notifyIfCabalUntested'

  , ConfigMonoid -> FirstTrue
notifyIfArchUnknown     :: !FirstTrue
    -- ^ See 'Stack.Types.Config.notifyIfArchUnknown'

  , ConfigMonoid -> FirstTrue
notifyIfNoRunTests      :: !FirstTrue
    -- ^ See 'Stack.Types.Config.notifyIfNoRunTests'

  , ConfigMonoid -> FirstTrue
notifyIfNoRunBenchmarks :: !FirstTrue
    -- ^ See 'Stack.Types.Config.notifyIfNoRunBenchmarks'

  , ConfigMonoid -> FirstTrue
notifyIfBaseNotBoot     :: !FirstTrue
    -- ^ See 'Stack.Types.Config.notifyIfBaseNotBoot'

  , ConfigMonoid -> CasaOptsMonoid
casaOpts                :: !CasaOptsMonoid
    -- ^ Casa configuration options.

  , ConfigMonoid -> First CasaRepoPrefix
casaRepoPrefix          :: !(First CasaRepoPrefix)
    -- ^ Casa repository prefix (deprecated).

  , ConfigMonoid -> First Text
snapshotLocation        :: !(First Text)
    -- ^ Custom location of LTS/Nightly snapshots

  , ConfigMonoid -> First (Unresolved GlobalHintsLocation)
globalHintsLocation     :: !(First (Unresolved GlobalHintsLocation))
    -- ^ Custom location of global hints

  , ConfigMonoid -> FirstFalse
noRunCompile            :: !FirstFalse
    -- ^ See: 'Stack.Types.Config.noRunCompile'

  , ConfigMonoid -> First Bool
stackDeveloperMode      :: !(First Bool)
    -- ^ See 'Stack.Types.Config.stackDeveloperMode'

  }
  deriving (forall x. ConfigMonoid -> Rep ConfigMonoid x)
-> (forall x. Rep ConfigMonoid x -> ConfigMonoid)
-> Generic ConfigMonoid
forall x. Rep ConfigMonoid x -> ConfigMonoid
forall x. ConfigMonoid -> Rep ConfigMonoid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConfigMonoid -> Rep ConfigMonoid x
from :: forall x. ConfigMonoid -> Rep ConfigMonoid x
$cto :: forall x. Rep ConfigMonoid x -> ConfigMonoid
to :: forall x. Rep ConfigMonoid x -> ConfigMonoid
Generic

instance Semigroup ConfigMonoid where
  <> :: ConfigMonoid -> ConfigMonoid -> ConfigMonoid
(<>) = ConfigMonoid -> ConfigMonoid -> ConfigMonoid
forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault

instance Monoid ConfigMonoid where
  mempty :: ConfigMonoid
mempty = ConfigMonoid
forall a. (Generic a, Monoid' (Rep a)) => a
memptydefault
  mappend :: ConfigMonoid -> ConfigMonoid -> ConfigMonoid
mappend = ConfigMonoid -> ConfigMonoid -> ConfigMonoid
forall a. Semigroup a => a -> a -> a
(<>)

parseConfigMonoid ::
     Path Abs Dir
  -> Value
  -> Yaml.Parser (WithJSONWarnings ConfigMonoid)
parseConfigMonoid :: Path Abs Dir -> Value -> Parser (WithJSONWarnings ConfigMonoid)
parseConfigMonoid = String
-> (Object -> WarningParser ConfigMonoid)
-> Value
-> Parser (WithJSONWarnings ConfigMonoid)
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"ConfigMonoid" ((Object -> WarningParser ConfigMonoid)
 -> Value -> Parser (WithJSONWarnings ConfigMonoid))
-> (Path Abs Dir -> Object -> WarningParser ConfigMonoid)
-> Path Abs Dir
-> Value
-> Parser (WithJSONWarnings ConfigMonoid)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Object -> WarningParser ConfigMonoid
parseConfigMonoidObject

-- | Parse a partial configuration.  Used both to parse both a standalone config

-- file and a project file, so that a sub-parser is not required, which would

-- interfere with warnings for missing fields.

parseConfigMonoidObject :: Path Abs Dir -> Object -> WarningParser ConfigMonoid
parseConfigMonoidObject :: Path Abs Dir -> Object -> WarningParser ConfigMonoid
parseConfigMonoidObject Path Abs Dir
rootDir Object
obj = do
  -- Parsing 'stackRoot' from 'stackRoot'/config.yaml would be nonsensical

  let stackRoot :: First a
stackRoot = Maybe a -> First a
forall a. Maybe a -> First a
First Maybe a
forall a. Maybe a
Nothing
  workDir <- Maybe (Path Rel Dir) -> First (Path Rel Dir)
forall a. Maybe a -> First a
First (Maybe (Path Rel Dir) -> First (Path Rel Dir))
-> WriterT WarningParserMonoid Parser (Maybe (Path Rel Dir))
-> WriterT WarningParserMonoid Parser (First (Path Rel Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text
-> WriterT WarningParserMonoid Parser (Maybe (Path Rel Dir))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidWorkDirName
  buildOpts <- jsonSubWarnings (obj ..:? configMonoidBuildOptsName ..!= mempty)
  dockerOpts <-
    jsonSubWarnings (obj ..:? configMonoidDockerOptsName ..!= mempty)
  nixOpts <- jsonSubWarnings (obj ..:? configMonoidNixOptsName ..!= mempty)
  connectionCount <- First <$> obj ..:? configMonoidConnectionCountName
  hideTHLoading <- FirstTrue <$> obj ..:? configMonoidHideTHLoadingName
  prefixTimestamps <- First <$> obj ..:? configMonoidPrefixTimestampsName

  latestSnapshot <- obj ..:? configMonoidUrlsName >>= \case
    Maybe Value
Nothing -> First Text -> WriterT WarningParserMonoid Parser (First Text)
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (First Text -> WriterT WarningParserMonoid Parser (First Text))
-> First Text -> WriterT WarningParserMonoid Parser (First Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> First Text
forall a. Maybe a -> First a
First Maybe Text
forall a. Maybe a
Nothing
    Just Value
urls -> WarningParser (WithJSONWarnings (First Text))
-> WriterT WarningParserMonoid Parser (First Text)
forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings (WarningParser (WithJSONWarnings (First Text))
 -> WriterT WarningParserMonoid Parser (First Text))
-> WarningParser (WithJSONWarnings (First Text))
-> WriterT WarningParserMonoid Parser (First Text)
forall a b. (a -> b) -> a -> b
$ Parser (WithJSONWarnings (First Text))
-> WarningParser (WithJSONWarnings (First Text))
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT WarningParserMonoid m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser (WithJSONWarnings (First Text))
 -> WarningParser (WithJSONWarnings (First Text)))
-> Parser (WithJSONWarnings (First Text))
-> WarningParser (WithJSONWarnings (First Text))
forall a b. (a -> b) -> a -> b
$ String
-> (Object -> WriterT WarningParserMonoid Parser (First Text))
-> Value
-> Parser (WithJSONWarnings (First Text))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings
      String
"urls"
      (\Object
o -> Maybe Text -> First Text
forall a. Maybe a -> First a
First (Maybe Text -> First Text)
-> WriterT WarningParserMonoid Parser (Maybe Text)
-> WriterT WarningParserMonoid Parser (First Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"latest-snapshot" :: WarningParser (First Text))
      (Value
urls :: Value)

  packageIndex <-
    First <$> jsonSubWarningsT (obj ..:?  configMonoidPackageIndexName)
  systemGHC <- First <$> obj ..:? configMonoidSystemGHCName
  installGHC <- FirstTrue <$> obj ..:? configMonoidInstallGHCName
  installMsys <- First <$> obj ..:? configMonoidInstallMsysName
  skipGHCCheck <- FirstFalse <$> obj ..:? configMonoidSkipGHCCheckName
  skipMsys <- FirstFalse <$> obj ..:? configMonoidSkipMsysName
  msysEnvironment <- First <$> obj ..:? configMonoidMsysEnvironmentName
  requireStackVersion <-
    IntersectingVersionRange . (.versionRangeJSON) <$>
      ( obj ..:? configMonoidRequireStackVersionName
          ..!= VersionRangeJSON anyVersion
      )
  arch <- First <$> obj ..:? configMonoidArchName
  ghcVariant <- First <$> obj ..:? configMonoidGHCVariantName
  ghcBuild <- First <$> obj ..:? configMonoidGHCBuildName
  jobs <- First <$> obj ..:? configMonoidJobsName
  extraIncludeDirs <- map (toFilePath rootDir FilePath.</>) <$>
    obj ..:?  configMonoidExtraIncludeDirsName ..!= []
  extraLibDirs <- map (toFilePath rootDir FilePath.</>) <$>
    obj ..:?  configMonoidExtraLibDirsName ..!= []
  customPreprocessorExts <-
    obj ..:?  configMonoidCustomPreprocessorExtsName ..!= []
  overrideGccPath <- First <$> obj ..:? configMonoidOverrideGccPathName
  overrideHpack <- First <$> obj ..:? configMonoidOverrideHpackName
  hpackForce <- FirstFalse <$> obj ..:? configMonoidHpackForceName
  concurrentTests <- First <$> obj ..:? configMonoidConcurrentTestsName
  localBinPath <- First <$> obj ..:? configMonoidLocalBinPathName
  fileWatchHook <- First <$> obj ..:? configMonoidFileWatchHookName
  (scmInit, templateParameters) <- obj ..:? "templates" >>= \case
    Maybe Object
Nothing -> (First SCM, Map Text Text)
-> WriterT WarningParserMonoid Parser (First SCM, Map Text Text)
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SCM -> First SCM
forall a. Maybe a -> First a
First Maybe SCM
forall a. Maybe a
Nothing,Map Text Text
forall k a. Map k a
M.empty)
    Just Object
tobj -> do
      scmInit <- Object
tobj Object -> Text -> WarningParser (Maybe SCM)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidScmInitName
      params <- tobj ..:? configMonoidTemplateParametersName
      pure (First scmInit,fromMaybe M.empty params)
  compilerCheck <- First <$> obj ..:? configMonoidCompilerCheckName
  compilerRepository <- First <$> (obj ..:? configMonoidCompilerRepositoryName)
  compilerTarget <- First <$> (obj ..:? configMonoidCompilerTargetName)
  compilerBindistPath <-
    First <$> (obj ..:? configMonoidCompilerBindistPathName)

  options <- Map.map (.ghcOptions) <$>
    obj ..:? configMonoidGhcOptionsName ..!= (mempty :: Map GhcOptionKey GhcOptions)

  optionsEverything <-
    case (Map.lookup GOKOldEverything options, Map.lookup GOKEverything options) of
      (Just [Text]
_, Just [Text]
_) ->
        String -> WarningParser [Text]
forall a. String -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot specify both `*` and `$everything` GHC options"
      (Maybe [Text]
Nothing, Just [Text]
x) -> [Text] -> WarningParser [Text]
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
x
      (Just [Text]
x, Maybe [Text]
Nothing) -> do
        WarningParserMonoid -> WriterT WarningParserMonoid Parser ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell WarningParserMonoid
"The `*` ghc-options key is not recommended. Consider using \
             \$locals, or if really needed, $everything"
        [Text] -> WarningParser [Text]
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
x
      (Maybe [Text]
Nothing, Maybe [Text]
Nothing) -> [Text] -> WarningParser [Text]
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

  let ghcOptionsByCat = Map ApplyGhcOptions [Text]
-> MonoidMap ApplyGhcOptions (Dual [Text])
forall a b. Coercible a b => a -> b
coerce (Map ApplyGhcOptions [Text]
 -> MonoidMap ApplyGhcOptions (Dual [Text]))
-> Map ApplyGhcOptions [Text]
-> MonoidMap ApplyGhcOptions (Dual [Text])
forall a b. (a -> b) -> a -> b
$ [(ApplyGhcOptions, [Text])] -> Map ApplyGhcOptions [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (ApplyGhcOptions
AGOEverything, [Text]
optionsEverything)
        , (ApplyGhcOptions
AGOLocals, [Text] -> GhcOptionKey -> Map GhcOptionKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] GhcOptionKey
GOKLocals Map GhcOptionKey [Text]
options)
        , (ApplyGhcOptions
AGOTargets, [Text] -> GhcOptionKey -> Map GhcOptionKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] GhcOptionKey
GOKTargets Map GhcOptionKey [Text]
options)
        ]

      ghcOptionsByName = Map PackageName [Text] -> MonoidMap PackageName (Dual [Text])
forall a b. Coercible a b => a -> b
coerce (Map PackageName [Text] -> MonoidMap PackageName (Dual [Text]))
-> Map PackageName [Text] -> MonoidMap PackageName (Dual [Text])
forall a b. (a -> b) -> a -> b
$ [(PackageName, [Text])] -> Map PackageName [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [(PackageName
name, [Text]
opts) | (GOKPackage PackageName
name, [Text]
opts) <- Map GhcOptionKey [Text] -> [(GhcOptionKey, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toList Map GhcOptionKey [Text]
options]

  cabalConfigOpts' <- obj ..:? configMonoidConfigureOptionsName ..!= mempty
  let cabalConfigOpts = Map CabalConfigKey [Text] -> MonoidMap CabalConfigKey (Dual [Text])
forall a b. Coercible a b => a -> b
coerce (Map CabalConfigKey [Text]
cabalConfigOpts' :: Map CabalConfigKey [Text])
  extraPath <- obj ..:? configMonoidExtraPathName ..!= []
  setupInfoLocations <- obj ..:? configMonoidSetupInfoLocationsName ..!= []
  setupInfoInline <-
    jsonSubWarningsT (obj ..:? configMonoidSetupInfoInlineName) ..!= mempty
  localProgramsBase <- First <$> obj ..:? configMonoidLocalProgramsBaseName
  pvpBounds <- First <$> obj ..:? configMonoidPvpBoundsName
  modifyCodePage <- FirstTrue <$> obj ..:? configMonoidModifyCodePageName
  rebuildGhcOptions <- FirstFalse <$> obj ..:? configMonoidRebuildGhcOptionsName
  applyGhcOptions <- First <$> obj ..:? configMonoidApplyGhcOptionsName
  applyProgOptions <- First <$> obj ..:? configMonoidApplyProgOptionsName
  allowNewer <- First <$> obj ..:? configMonoidAllowNewerName
  allowNewerDeps <- obj ..:? configMonoidAllowNewerDepsName
  defaultInitSnapshot <- First <$> obj ..:? configMonoidDefaultInitSnapshotName
  defaultTemplate <- First <$> obj ..:? configMonoidDefaultTemplateName
  allowDifferentUser <- First <$> obj ..:? configMonoidAllowDifferentUserName
  dumpLogs <- First <$> obj ..:? configMonoidDumpLogsName
  saveHackageCreds <- FirstTrue <$> obj ..:? configMonoidSaveHackageCredsName
  hackageBaseUrl <- First <$> obj ..:? configMonoidHackageBaseUrlName
  configMonoidColorWhenUS <- obj ..:? configMonoidColorWhenUSName
  configMonoidColorWhenGB <- obj ..:? configMonoidColorWhenGBName
  let colorWhen = Maybe ColorWhen -> First ColorWhen
forall a. Maybe a -> First a
First (Maybe ColorWhen -> First ColorWhen)
-> Maybe ColorWhen -> First ColorWhen
forall a b. (a -> b) -> a -> b
$ Maybe ColorWhen
configMonoidColorWhenUS Maybe ColorWhen -> Maybe ColorWhen -> Maybe ColorWhen
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ColorWhen
configMonoidColorWhenGB
  configMonoidStylesUS <- obj ..:? configMonoidStylesUSName
  configMonoidStylesGB <- obj ..:? configMonoidStylesGBName
  let styles = StylesUpdate -> Maybe StylesUpdate -> StylesUpdate
forall a. a -> Maybe a -> a
fromMaybe StylesUpdate
forall a. Monoid a => a
mempty (Maybe StylesUpdate -> StylesUpdate)
-> Maybe StylesUpdate -> StylesUpdate
forall a b. (a -> b) -> a -> b
$ Maybe StylesUpdate
configMonoidStylesUS Maybe StylesUpdate -> Maybe StylesUpdate -> Maybe StylesUpdate
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StylesUpdate
configMonoidStylesGB
  hideSourcePaths <- FirstTrue <$> obj ..:? configMonoidHideSourcePathsName
  recommendStackUpgrade <-
    FirstTrue <$> obj ..:? configMonoidRecommendStackUpgradeName
  notifyIfNixOnPath <- FirstFalse <$> obj ..:? configMonoidNotifyIfNixOnPathName
  notifyIfGhcUntested <-
    FirstFalse <$> obj ..:? configMonoidNotifyIfGhcUntestedName
  notifyIfCabalUntested <-
    FirstFalse <$> obj ..:? configMonoidNotifyIfCabalUntestedName
  notifyIfArchUnknown <-
    FirstTrue <$> obj ..:? configMonoidNotifyIfArchUnknownName
  notifyIfNoRunTests <-
    FirstTrue <$> obj ..:? configMonoidNotifyIfNoRunTestsName
  notifyIfNoRunBenchmarks <-
    FirstTrue <$> obj ..:? configMonoidNotifyIfNoRunBenchmarksName
  notifyIfBaseNotBoot <-
    FirstTrue <$> obj ..:? configMonoidNotifyIfBaseNotBootName
  casaOpts <- jsonSubWarnings (obj ..:? configMonoidCasaOptsName ..!= mempty)
  casaRepoPrefix <- First <$> obj ..:? configMonoidCasaRepoPrefixName
  snapshotLocation <- First <$> obj ..:? configMonoidSnapshotLocationName
  globalHintsLocation <-
    First <$> jsonSubWarningsT (obj ..:? configMonoidGlobalHintsLocationName)
  noRunCompile <- FirstFalse <$> obj ..:? configMonoidNoRunCompileName
  stackDeveloperMode <- First <$> obj ..:? configMonoidStackDeveloperModeName
  pure ConfigMonoid
    { stackRoot
    , workDir
    , buildOpts
    , dockerOpts
    , nixOpts
    , connectionCount
    , hideTHLoading
    , prefixTimestamps
    , latestSnapshot
    , packageIndex
    , systemGHC
    , installGHC
    , installMsys
    , skipGHCCheck
    , skipMsys
    , msysEnvironment
    , compilerCheck
    , compilerRepository
    , compilerTarget
    , compilerBindistPath
    , requireStackVersion
    , arch
    , ghcVariant
    , ghcBuild
    , jobs
    , extraIncludeDirs
    , extraLibDirs
    , customPreprocessorExts
    , overrideGccPath
    , overrideHpack
    , hpackForce
    , concurrentTests
    , localBinPath
    , fileWatchHook
    , templateParameters
    , scmInit
    , ghcOptionsByName
    , ghcOptionsByCat
    , cabalConfigOpts
    , extraPath
    , setupInfoLocations
    , setupInfoInline
    , localProgramsBase
    , pvpBounds
    , modifyCodePage
    , rebuildGhcOptions
    , applyGhcOptions
    , applyProgOptions
    , allowNewer
    , allowNewerDeps
    , defaultInitSnapshot
    , defaultTemplate
    , allowDifferentUser
    , dumpLogs
    , saveHackageCreds
    , hackageBaseUrl
    , colorWhen
    , styles
    , hideSourcePaths
    , recommendStackUpgrade
    , notifyIfNixOnPath
    , notifyIfGhcUntested
    , notifyIfCabalUntested
    , notifyIfArchUnknown
    , notifyIfNoRunTests
    , notifyIfNoRunBenchmarks
    , notifyIfBaseNotBoot
    , casaOpts
    , casaRepoPrefix
    , snapshotLocation
    , globalHintsLocation
    , noRunCompile
    , stackDeveloperMode
    }

configMonoidWorkDirName :: Text
configMonoidWorkDirName :: Text
configMonoidWorkDirName = Text
"work-dir"

configMonoidBuildOptsName :: Text
configMonoidBuildOptsName :: Text
configMonoidBuildOptsName = Text
"build"

configMonoidDockerOptsName :: Text
configMonoidDockerOptsName :: Text
configMonoidDockerOptsName = Text
"docker"

configMonoidNixOptsName :: Text
configMonoidNixOptsName :: Text
configMonoidNixOptsName = Text
"nix"

configMonoidConfigureOptionsName :: Text
configMonoidConfigureOptionsName :: Text
configMonoidConfigureOptionsName = Text
"configure-options"

configMonoidConnectionCountName :: Text
configMonoidConnectionCountName :: Text
configMonoidConnectionCountName = Text
"connection-count"

configMonoidHideTHLoadingName :: Text
configMonoidHideTHLoadingName :: Text
configMonoidHideTHLoadingName = Text
"hide-th-loading"

configMonoidPrefixTimestampsName :: Text
configMonoidPrefixTimestampsName :: Text
configMonoidPrefixTimestampsName = Text
"build-output-timestamps"

configMonoidUrlsName :: Text
configMonoidUrlsName :: Text
configMonoidUrlsName = Text
"urls"

configMonoidPackageIndexName :: Text
configMonoidPackageIndexName :: Text
configMonoidPackageIndexName = Text
"package-index"

configMonoidSystemGHCName :: Text
configMonoidSystemGHCName :: Text
configMonoidSystemGHCName = Text
"system-ghc"

configMonoidInstallGHCName :: Text
configMonoidInstallGHCName :: Text
configMonoidInstallGHCName = Text
"install-ghc"

configMonoidInstallMsysName :: Text
configMonoidInstallMsysName :: Text
configMonoidInstallMsysName = Text
"install-msys"

configMonoidSkipGHCCheckName :: Text
configMonoidSkipGHCCheckName :: Text
configMonoidSkipGHCCheckName = Text
"skip-ghc-check"

configMonoidSkipMsysName :: Text
configMonoidSkipMsysName :: Text
configMonoidSkipMsysName = Text
"skip-msys"

configMonoidMsysEnvironmentName :: Text
configMonoidMsysEnvironmentName :: Text
configMonoidMsysEnvironmentName = Text
"msys-environment"

configMonoidRequireStackVersionName :: Text
configMonoidRequireStackVersionName :: Text
configMonoidRequireStackVersionName = Text
"require-stack-version"

configMonoidArchName :: Text
configMonoidArchName :: Text
configMonoidArchName = Text
"arch"

configMonoidGHCVariantName :: Text
configMonoidGHCVariantName :: Text
configMonoidGHCVariantName = Text
"ghc-variant"

configMonoidGHCBuildName :: Text
configMonoidGHCBuildName :: Text
configMonoidGHCBuildName = Text
"ghc-build"

configMonoidJobsName :: Text
configMonoidJobsName :: Text
configMonoidJobsName = Text
"jobs"

configMonoidExtraIncludeDirsName :: Text
configMonoidExtraIncludeDirsName :: Text
configMonoidExtraIncludeDirsName = Text
"extra-include-dirs"

configMonoidExtraLibDirsName :: Text
configMonoidExtraLibDirsName :: Text
configMonoidExtraLibDirsName = Text
"extra-lib-dirs"

configMonoidCustomPreprocessorExtsName  :: Text
configMonoidCustomPreprocessorExtsName :: Text
configMonoidCustomPreprocessorExtsName  = Text
"custom-preprocessor-extensions"

configMonoidOverrideGccPathName :: Text
configMonoidOverrideGccPathName :: Text
configMonoidOverrideGccPathName = Text
"with-gcc"

configMonoidOverrideHpackName :: Text
configMonoidOverrideHpackName :: Text
configMonoidOverrideHpackName = Text
"with-hpack"

configMonoidHpackForceName :: Text
configMonoidHpackForceName :: Text
configMonoidHpackForceName = Text
"hpack-force"

configMonoidConcurrentTestsName :: Text
configMonoidConcurrentTestsName :: Text
configMonoidConcurrentTestsName = Text
"concurrent-tests"

configMonoidLocalBinPathName :: Text
configMonoidLocalBinPathName :: Text
configMonoidLocalBinPathName = Text
"local-bin-path"

configMonoidFileWatchHookName :: Text
configMonoidFileWatchHookName :: Text
configMonoidFileWatchHookName = Text
"file-watch-hook"

configMonoidScmInitName :: Text
configMonoidScmInitName :: Text
configMonoidScmInitName = Text
"scm-init"

configMonoidTemplateParametersName :: Text
configMonoidTemplateParametersName :: Text
configMonoidTemplateParametersName = Text
"params"

configMonoidCompilerCheckName :: Text
configMonoidCompilerCheckName :: Text
configMonoidCompilerCheckName = Text
"compiler-check"

configMonoidCompilerRepositoryName :: Text
configMonoidCompilerRepositoryName :: Text
configMonoidCompilerRepositoryName = Text
"compiler-repository"

configMonoidCompilerTargetName :: Text
configMonoidCompilerTargetName :: Text
configMonoidCompilerTargetName = Text
"compiler-target"

configMonoidCompilerBindistPathName :: Text
configMonoidCompilerBindistPathName :: Text
configMonoidCompilerBindistPathName = Text
"compiler-bindist-path"

configMonoidGhcOptionsName :: Text
configMonoidGhcOptionsName :: Text
configMonoidGhcOptionsName = Text
"ghc-options"

configMonoidExtraPathName :: Text
configMonoidExtraPathName :: Text
configMonoidExtraPathName = Text
"extra-path"

configMonoidSetupInfoLocationsName :: Text
configMonoidSetupInfoLocationsName :: Text
configMonoidSetupInfoLocationsName = Text
"setup-info-locations"

configMonoidSetupInfoInlineName :: Text
configMonoidSetupInfoInlineName :: Text
configMonoidSetupInfoInlineName = Text
"setup-info"

configMonoidLocalProgramsBaseName :: Text
configMonoidLocalProgramsBaseName :: Text
configMonoidLocalProgramsBaseName = Text
"local-programs-path"

configMonoidPvpBoundsName :: Text
configMonoidPvpBoundsName :: Text
configMonoidPvpBoundsName = Text
"pvp-bounds"

configMonoidModifyCodePageName :: Text
configMonoidModifyCodePageName :: Text
configMonoidModifyCodePageName = Text
"modify-code-page"

configMonoidRebuildGhcOptionsName :: Text
configMonoidRebuildGhcOptionsName :: Text
configMonoidRebuildGhcOptionsName = Text
"rebuild-ghc-options"

configMonoidApplyGhcOptionsName :: Text
configMonoidApplyGhcOptionsName :: Text
configMonoidApplyGhcOptionsName = Text
"apply-ghc-options"

configMonoidApplyProgOptionsName :: Text
configMonoidApplyProgOptionsName :: Text
configMonoidApplyProgOptionsName = Text
"apply-prog-options"

configMonoidAllowNewerName :: Text
configMonoidAllowNewerName :: Text
configMonoidAllowNewerName = Text
"allow-newer"

configMonoidAllowNewerDepsName :: Text
configMonoidAllowNewerDepsName :: Text
configMonoidAllowNewerDepsName = Text
"allow-newer-deps"

configMonoidDefaultInitSnapshotName :: Text
configMonoidDefaultInitSnapshotName :: Text
configMonoidDefaultInitSnapshotName = Text
"default-init-snapshot"

configMonoidDefaultTemplateName :: Text
configMonoidDefaultTemplateName :: Text
configMonoidDefaultTemplateName = Text
"default-template"

configMonoidAllowDifferentUserName :: Text
configMonoidAllowDifferentUserName :: Text
configMonoidAllowDifferentUserName = Text
"allow-different-user"

configMonoidDumpLogsName :: Text
configMonoidDumpLogsName :: Text
configMonoidDumpLogsName = Text
"dump-logs"

configMonoidSaveHackageCredsName :: Text
configMonoidSaveHackageCredsName :: Text
configMonoidSaveHackageCredsName = Text
"save-hackage-creds"

configMonoidHackageBaseUrlName :: Text
configMonoidHackageBaseUrlName :: Text
configMonoidHackageBaseUrlName = Text
"hackage-base-url"

configMonoidColorWhenUSName :: Text
configMonoidColorWhenUSName :: Text
configMonoidColorWhenUSName = Text
"color"

configMonoidColorWhenGBName :: Text
configMonoidColorWhenGBName :: Text
configMonoidColorWhenGBName = Text
"colour"

configMonoidStylesUSName :: Text
configMonoidStylesUSName :: Text
configMonoidStylesUSName = Text
"stack-colors"

configMonoidStylesGBName :: Text
configMonoidStylesGBName :: Text
configMonoidStylesGBName = Text
"stack-colours"

configMonoidHideSourcePathsName :: Text
configMonoidHideSourcePathsName :: Text
configMonoidHideSourcePathsName = Text
"hide-source-paths"

configMonoidRecommendStackUpgradeName :: Text
configMonoidRecommendStackUpgradeName :: Text
configMonoidRecommendStackUpgradeName = Text
"recommend-stack-upgrade"

configMonoidNotifyIfNixOnPathName :: Text
configMonoidNotifyIfNixOnPathName :: Text
configMonoidNotifyIfNixOnPathName = Text
"notify-if-nix-on-path"

configMonoidNotifyIfGhcUntestedName :: Text
configMonoidNotifyIfGhcUntestedName :: Text
configMonoidNotifyIfGhcUntestedName = Text
"notify-if-ghc-untested"

configMonoidNotifyIfCabalUntestedName :: Text
configMonoidNotifyIfCabalUntestedName :: Text
configMonoidNotifyIfCabalUntestedName = Text
"notify-if-cabal-untested"

configMonoidNotifyIfArchUnknownName :: Text
configMonoidNotifyIfArchUnknownName :: Text
configMonoidNotifyIfArchUnknownName = Text
"notify-if-arch-unknown"

configMonoidNotifyIfNoRunTestsName :: Text
configMonoidNotifyIfNoRunTestsName :: Text
configMonoidNotifyIfNoRunTestsName = Text
"notify-if-no-run-tests"

configMonoidNotifyIfNoRunBenchmarksName :: Text
configMonoidNotifyIfNoRunBenchmarksName :: Text
configMonoidNotifyIfNoRunBenchmarksName = Text
"notify-if-no-run-benchmarks"

configMonoidNotifyIfBaseNotBootName :: Text
configMonoidNotifyIfBaseNotBootName :: Text
configMonoidNotifyIfBaseNotBootName = Text
"notify-if-base-not-boot"

configMonoidCasaOptsName :: Text
configMonoidCasaOptsName :: Text
configMonoidCasaOptsName = Text
"casa"

configMonoidCasaRepoPrefixName :: Text
configMonoidCasaRepoPrefixName :: Text
configMonoidCasaRepoPrefixName = Text
"casa-repo-prefix"

configMonoidSnapshotLocationName :: Text
configMonoidSnapshotLocationName :: Text
configMonoidSnapshotLocationName = Text
"snapshot-location-base"

configMonoidGlobalHintsLocationName :: Text
configMonoidGlobalHintsLocationName :: Text
configMonoidGlobalHintsLocationName = Text
"global-hints-location"

configMonoidNoRunCompileName :: Text
configMonoidNoRunCompileName :: Text
configMonoidNoRunCompileName = Text
"script-no-run-compile"

configMonoidStackDeveloperModeName :: Text
configMonoidStackDeveloperModeName :: Text
configMonoidStackDeveloperModeName = Text
"stack-developer-mode"