{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}

-- | The Config type.


module Stack.Types.Config
  (
  -- * Main configuration types and classes

  -- ** HasPlatform & HasStackRoot

    HasPlatform (..)
  , PlatformVariant (..)
  -- ** Runner

  , HasRunner (..)
  , Runner (..)
  , ColorWhen (..)
  , terminalL
  , reExecL
  -- ** Config & HasConfig

  , Config (..)
  , HasConfig (..)
  , askLatestSnapshotUrl
  , configProjectRoot
  -- ** BuildConfig & HasBuildConfig

  , BuildConfig (..)
  , ProjectPackage (..)
  , DepPackage (..)
  , ppRoot
  , ppVersion
  , ppComponents
  , ppGPD
  , stackYamlL
  , projectRootL
  , HasBuildConfig (..)
  -- ** Storage databases

  , UserStorage (..)
  , ProjectStorage (..)
  -- ** GHCVariant & HasGHCVariant

  , GHCVariant (..)
  , ghcVariantName
  , ghcVariantSuffix
  , parseGHCVariant
  , HasGHCVariant (..)
  , snapshotsDir
  -- ** EnvConfig & HasEnvConfig

  , EnvConfig (..)
  , HasSourceMap (..)
  , HasEnvConfig (..)
  , getCompilerPath
  -- * Details

  -- ** ApplyGhcOptions

  , ApplyGhcOptions (..)
  -- ** AllowNewerDeps

  , AllowNewerDeps (..)
  -- ** CabalConfigKey

  , CabalConfigKey (..)
  -- ** ConfigException

  , HpackExecutable (..)
  , ConfigException (..)
  , ConfigPrettyException (..)
  , ParseAbsolutePathException (..)
  , packageIndicesWarning
  -- ** ConfigMonoid

  , ConfigMonoid (..)
  , configMonoidInstallGHCName
  , configMonoidSystemGHCName
  , parseConfigMonoid
  -- ** DumpLogs

  , DumpLogs (..)
  -- ** EnvSettings

  , EnvSettings (..)
  , minimalEnvSettings
  , defaultEnvSettings
  , plainEnvSettings
  -- ** GlobalOpts & GlobalOptsMonoid

  , GlobalOpts (..)
  , GlobalOptsMonoid (..)
  , rslInLogL
  , StackYamlLoc (..)
  , stackYamlLocL
  , LockFileBehavior (..)
  , readLockFileBehavior
  , lockFileBehaviorL
  , defaultLogLevel
  -- ** Project & ProjectAndConfigMonoid

  , Project (..)
  , ProjectConfig (..)
  , Curator (..)
  , ProjectAndConfigMonoid (..)
  , parseProjectAndConfigMonoid
  -- ** PvpBounds

  , PvpBounds (..)
  , PvpBoundsType (..)
  , parsePvpBounds
  -- ** ColorWhen

  , readColorWhen
  -- ** Styles

  , readStyles
  -- ** SCM

  , SCM(..)
  -- * Paths

  , bindirSuffix
  , GlobalInfoSource (..)
  , getProjectWorkDir
  , docDirSuffix
  , extraBinDirs
  , hpcReportDir
  , installationRootDeps
  , installationRootLocal
  , bindirCompilerTools
  , hoogleRoot
  , hoogleDatabasePath
  , packageDatabaseDeps
  , packageDatabaseExtra
  , packageDatabaseLocal
  , platformOnlyRelDir
  , platformGhcRelDir
  , platformGhcVerOnlyRelDir
  , useShaPathOnWindows
  , shaPath
  , shaPathForBytes
  , workDirL
  , ghcInstallHook
  -- * Command-related types

  , AddCommand
  -- ** Eval

  , EvalOpts (..)
  -- ** Exec

  , ExecOpts (..)
  , SpecialExecCmd (..)
  , ExecOptsExtra (..)
  -- ** Setup

  , DownloadInfo (..)
  , VersionedDownloadInfo (..)
  , GHCDownloadInfo (..)
  , SetupInfo (..)
  -- ** Docker entrypoint

  , DockerEntrypoint (..)
  , DockerUser (..)
  , module X
  -- * Lens helpers

  , wantedCompilerVersionL
  , actualCompilerVersionL
  , HasCompiler (..)
  , DumpPackage (..)
  , CompilerPaths (..)
  , GhcPkgExe (..)
  , getGhcPkgExe
  , cpWhich
  , ExtraDirs (..)
  , buildOptsL
  , globalOptsL
  , buildOptsInstallExesL
  , buildOptsMonoidHaddockL
  , buildOptsMonoidTestsL
  , buildOptsMonoidBenchmarksL
  , buildOptsMonoidInstallExesL
  , buildOptsHaddockL
  , globalOptsBuildOptsMonoidL
  , stackRootL
  , stackGlobalConfigL
  , cabalVersionL
  , whichCompilerL
  , envOverrideSettingsL
  , shouldForceGhcColorFlag
  , appropriateGhcColorFlag
  -- * Helper logging functions

  , prettyStackDevL
  -- * Lens reexport

  , view
  , to
  ) where

import           Control.Monad.Writer ( Writer, tell )
import           Control.Monad.Trans.Except ( ExceptT )
import           Crypto.Hash ( hashWith, SHA1 (..) )
import           Pantry.Internal.AesonExtended
                   ( ToJSON, toJSON, FromJSON, FromJSONKey (..), parseJSON
                   , withText, object, (.=), (..:), (...:), (..:?), (..!=)
                   , Value(Bool), withObjectWarnings, WarningParser, Object
                   , jsonSubWarnings, jsonSubWarningsT, jsonSubWarningsTT
                   , WithJSONWarnings (..)
                   , FromJSONKeyFunction (FromJSONKeyTextParser)
                   )
import           Data.Attoparsec.Args ( parseArgs, EscapingMode (Escaping) )
import qualified Data.ByteArray.Encoding as Mem ( convertToBase, Base(Base16) )
import qualified Data.ByteString.Char8 as S8
import           Data.Coerce ( coerce )
import           Data.List ( stripPrefix )
import qualified Data.List.NonEmpty as NonEmpty
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.Set as Set
import qualified Data.Text as T
import           Data.Yaml ( ParseException )
import qualified Data.Yaml as Yaml
import qualified Distribution.License as C
import           Distribution.ModuleName ( ModuleName )
import           Distribution.PackageDescription ( GenericPackageDescription )
import qualified Distribution.PackageDescription as C
import           Distribution.System ( Platform, Arch )
import qualified Distribution.Text
import           Distribution.Version ( anyVersion, mkVersion )
import           Generics.Deriving.Monoid ( memptydefault, mappenddefault )
import           Lens.Micro
import           Options.Applicative ( ReadM )
import qualified Options.Applicative as OA
import qualified Options.Applicative.Types as OA
import           Pantry.Internal ( Storage )
import           Path
import qualified RIO.List as List
import           Stack.Constants
import           Stack.Prelude
import           Stack.Types.Compiler
import           Stack.Types.CompilerBuild
import           Stack.Types.Docker
import           Stack.Types.GhcPkgId
import           Stack.Types.NamedComponent
import           Stack.Types.Nix
import           Stack.Types.Resolver
import           Stack.Types.SourceMap
import           Stack.Types.TemplateName
import           Stack.Types.Version
                   ( IntersectingVersionRange (..), VersionCheck (..)
                   , VersionRange, stackVersion, versionRangeText
                   )
import qualified System.FilePath as FilePath
import           System.PosixCompat.Types ( UserID, GroupID, FileMode )
import           RIO.Process ( ProcessContext, HasProcessContext (..) )
import           Casa.Client ( CasaRepoPrefix )

-- Re-exports

import           Stack.Types.Config.Build as X

-- | Type representing exceptions thrown by functions exported by the

-- "Stack.Config" module.

data ConfigException
  = ParseCustomSnapshotException Text ParseException
  | NoProjectConfigFound (Path Abs Dir) (Maybe Text)
  | UnexpectedArchiveContents [Path Abs Dir] [Path Abs File]
  | UnableToExtractArchive Text (Path Abs File)
  | BadStackVersionException VersionRange
  | NoSuchDirectory FilePath
  | ParseGHCVariantException String
  | BadStackRoot (Path Abs Dir)
  | Won'tCreateStackRootInDirectoryOwnedByDifferentUser (Path Abs Dir) (Path Abs Dir) -- ^ @$STACK_ROOT@, parent dir

  | UserDoesn'tOwnDirectory (Path Abs Dir)
  | ManualGHCVariantSettingsAreIncompatibleWithSystemGHC
  | NixRequiresSystemGhc
  | NoResolverWhenUsingNoProject
  | DuplicateLocalPackageNames ![(PackageName, [PackageLocation])]
  | NoLTSWithMajorVersion Int
  | NoLTSFound
  | MultiplePackageIndices [PackageIndexConfig]
  deriving (Int -> ConfigException -> ShowS
[ConfigException] -> ShowS
ConfigException -> [Char]
(Int -> ConfigException -> ShowS)
-> (ConfigException -> [Char])
-> ([ConfigException] -> ShowS)
-> Show ConfigException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigException -> ShowS
showsPrec :: Int -> ConfigException -> ShowS
$cshow :: ConfigException -> [Char]
show :: ConfigException -> [Char]
$cshowList :: [ConfigException] -> ShowS
showList :: [ConfigException] -> ShowS
Show, Typeable)

instance Exception ConfigException where
    displayException :: ConfigException -> [Char]
displayException (ParseCustomSnapshotException Text
url ParseException
exception) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-8981]\n"
        , [Char]
"Could not parse '"
        , Text -> [Char]
T.unpack Text
url
        , [Char]
"':\n"
        , ParseException -> [Char]
Yaml.prettyPrintParseException ParseException
exception
        , [Char]
"\nSee https://docs.haskellstack.org/en/stable/custom_snapshot/"
        ]
    displayException (NoProjectConfigFound Path Abs Dir
dir Maybe Text
mcmd) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-2206]\n"
        , [Char]
"Unable to find a stack.yaml file in the current directory ("
        , Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir
        , [Char]
") or its ancestors"
        , case Maybe Text
mcmd of
            Maybe Text
Nothing -> [Char]
""
            Just Text
cmd -> [Char]
"\nRecommended action: stack " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
cmd
        ]
    displayException (UnexpectedArchiveContents [Path Abs Dir]
dirs [Path Abs File]
files) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-4964]\n"
        , [Char]
"When unpacking an archive specified in your stack.yaml file, "
        , [Char]
"did not find expected contents. Expected: a single directory. Found: "
        , ([[Char]], [[Char]]) -> [Char]
forall a. Show a => a -> [Char]
show ( (Path Abs Dir -> [Char]) -> [Path Abs Dir] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath (Path Rel Dir -> [Char])
-> (Path Abs Dir -> Path Rel Dir) -> Path Abs Dir -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname) [Path Abs Dir]
dirs
               , (Path Abs File -> [Char]) -> [Path Abs File] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel File -> [Char]
forall b t. Path b t -> [Char]
toFilePath (Path Rel File -> [Char])
-> (Path Abs File -> Path Rel File) -> Path Abs File -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename) [Path Abs File]
files
               )
        ]
    displayException (UnableToExtractArchive Text
url Path Abs File
file) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-2040]\n"
        , [Char]
"Archive extraction failed. Tarballs and zip archives are supported, \
          \couldn't handle the following URL, "
        , Text -> [Char]
T.unpack Text
url
        , [Char]
" downloaded to the file "
        , Path Rel File -> [Char]
forall b t. Path b t -> [Char]
toFilePath (Path Rel File -> [Char]) -> Path Rel File -> [Char]
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
file
        ]
    displayException (BadStackVersionException VersionRange
requiredRange) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-1641]\n"
        , [Char]
"The version of Stack you are using ("
        , Version -> [Char]
forall a. Show a => a -> [Char]
show Version
stackVersion
        , [Char]
") is outside the required\n"
        ,[Char]
"version range specified in stack.yaml ("
        , Text -> [Char]
T.unpack (VersionRange -> Text
versionRangeText VersionRange
requiredRange)
        , [Char]
").\n"
        , [Char]
"You can upgrade Stack by running:\n\n"
        , [Char]
"stack upgrade"
        ]
    displayException (NoSuchDirectory [Char]
dir) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-8773]\n"
        , [Char]
"No directory could be located matching the supplied path: "
        , [Char]
dir
        ]
    displayException (ParseGHCVariantException [Char]
v) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-3938]\n"
        , [Char]
"Invalid ghc-variant value: "
        , [Char]
v
        ]
    displayException (BadStackRoot Path Abs Dir
stackRoot) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-8530]\n"
        , [Char]
"Invalid Stack root: '"
        , Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
stackRoot
        , [Char]
"'. Please provide a valid absolute path."
        ]
    displayException (Won'tCreateStackRootInDirectoryOwnedByDifferentUser Path Abs Dir
envStackRoot Path Abs Dir
parentDir) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-7613]\n"
        , [Char]
"Preventing creation of Stack root '"
        , Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
envStackRoot
        , [Char]
"'. Parent directory '"
        , Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
parentDir
        , [Char]
"' is owned by someone else."
        ]
    displayException (UserDoesn'tOwnDirectory Path Abs Dir
dir) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-8707]\n"
        , [Char]
"You are not the owner of '"
        , Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir
        , [Char]
"'. Aborting to protect file permissions."
        , [Char]
"\nRetry with '--"
        , Text -> [Char]
T.unpack Text
configMonoidAllowDifferentUserName
        , [Char]
"' to disable this precaution."
        ]
    displayException ConfigException
ManualGHCVariantSettingsAreIncompatibleWithSystemGHC = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
        [ Text
"Error: [S-3605]\n"
        , Text
"Stack can only control the "
        , Text
configMonoidGHCVariantName
        , Text
" of its own GHC installations. Please use '--no-"
        , Text
configMonoidSystemGHCName
        , Text
"'."
        ]
    displayException ConfigException
NixRequiresSystemGhc = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
        [ Text
"Error: [S-6816]\n"
        , Text
"Stack's Nix integration is incompatible with '--no-system-ghc'. "
        , Text
"Please use '--"
        , Text
configMonoidSystemGHCName
        , Text
"' or disable the Nix integration."
        ]
    displayException ConfigException
NoResolverWhenUsingNoProject =
        [Char]
"Error: [S-5027]\n"
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"When using the script command, you must provide a resolver argument"
    displayException (DuplicateLocalPackageNames [(PackageName, [PackageLocation])]
pairs) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: [S-5470]\n"
        [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
"The same package name is used in multiple local packages\n"
        [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ((PackageName, [PackageLocation]) -> [Char])
-> [(PackageName, [PackageLocation])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName, [PackageLocation]) -> [Char]
forall {a}. Show a => (PackageName, [a]) -> [Char]
go [(PackageName, [PackageLocation])]
pairs
      where
        go :: (PackageName, [a]) -> [Char]
go (PackageName
name, [a]
dirs) = [[Char]] -> [Char]
unlines
            ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
""
            [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (PackageName -> [Char]
packageNameString PackageName
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" used in:")
            [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
forall a. Show a => a -> [Char]
goLoc [a]
dirs
        goLoc :: a -> [Char]
goLoc a
loc = [Char]
"- " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
loc
    displayException (NoLTSWithMajorVersion Int
n) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-3803]\n"
        , [Char]
"No LTS release found with major version "
        , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
        , [Char]
"."
        ]
    displayException ConfigException
NoLTSFound =
        [Char]
"Error: [S-5472]\n"
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"No LTS releases found."
    displayException (MultiplePackageIndices [PackageIndexConfig]
pics) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-3251]\n"
        , [Char]
"When using the 'package-indices' key to override the default "
        , [Char]
"package index, you must provide exactly one value, received: "
        , [PackageIndexConfig] -> [Char]
forall a. Show a => a -> [Char]
show [PackageIndexConfig]
pics
        , [Char]
"\n"
        , [Char]
packageIndicesWarning
        ]

-- | Type representing \'pretty\' exceptions thrown by functions exported by the

-- "Stack.Config" module.

data ConfigPrettyException
    = ParseConfigFileException !(Path Abs File) !ParseException
    | NoMatchingSnapshot !(NonEmpty SnapName)
    | ResolverMismatch !RawSnapshotLocation String
    | ResolverPartial !RawSnapshotLocation !String
    deriving (Int -> ConfigPrettyException -> ShowS
[ConfigPrettyException] -> ShowS
ConfigPrettyException -> [Char]
(Int -> ConfigPrettyException -> ShowS)
-> (ConfigPrettyException -> [Char])
-> ([ConfigPrettyException] -> ShowS)
-> Show ConfigPrettyException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigPrettyException -> ShowS
showsPrec :: Int -> ConfigPrettyException -> ShowS
$cshow :: ConfigPrettyException -> [Char]
show :: ConfigPrettyException -> [Char]
$cshowList :: [ConfigPrettyException] -> ShowS
showList :: [ConfigPrettyException] -> ShowS
Show, Typeable)

instance Pretty ConfigPrettyException where
    pretty :: ConfigPrettyException -> StyleDoc
pretty (ParseConfigFileException Path Abs File
configFile ParseException
exception) =
        StyleDoc
"[S-6602]"
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
             [ [Char] -> StyleDoc
flow [Char]
"Stack could not load and parse"
             , Style -> StyleDoc -> StyleDoc
style Style
File (Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
configFile)
             , [Char] -> StyleDoc
flow [Char]
"as a YAML configuraton file."
             ]
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
flow [Char]
"While loading and parsing, Stack encountered the following \
                \error:"
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string (ParseException -> [Char]
Yaml.prettyPrintParseException ParseException
exception)
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
             [ [Char] -> StyleDoc
flow [Char]
"For help about the content of Stack's YAML configuration \
                    \files, see (for the most recent release of Stack)"
             ,    Style -> StyleDoc -> StyleDoc
style
                    Style
Url
                    StyleDoc
"http://docs.haskellstack.org/en/stable/yaml_configuration/"
               StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
             ]
    pretty (NoMatchingSnapshot NonEmpty SnapName
names) =
        StyleDoc
"[S-1833]"
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
flow [Char]
"None of the following snapshots provides a compiler matching \
                \your package(s):"
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList ((SnapName -> StyleDoc) -> [SnapName] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc)
-> (SnapName -> [Char]) -> SnapName -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapName -> [Char]
forall a. Show a => a -> [Char]
show) (NonEmpty SnapName -> [SnapName]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty SnapName
names))
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
resolveOptions
    pretty (ResolverMismatch RawSnapshotLocation
resolver [Char]
errDesc) =
        StyleDoc
"[S-6395]"
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
             [ StyleDoc
"Snapshot"
             , Style -> StyleDoc -> StyleDoc
style Style
Url (PrettyRawSnapshotLocation -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty (PrettyRawSnapshotLocation -> StyleDoc)
-> PrettyRawSnapshotLocation -> StyleDoc
forall a b. (a -> b) -> a -> b
$ RawSnapshotLocation -> PrettyRawSnapshotLocation
PrettyRawSnapshotLocation RawSnapshotLocation
resolver)
             , [Char] -> StyleDoc
flow [Char]
"does not have a matching compiler to build some or all of \
                    \your package(s)."
             ]
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
indent Int
4 ([Char] -> StyleDoc
string [Char]
errDesc)
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
resolveOptions
    pretty (ResolverPartial RawSnapshotLocation
resolver [Char]
errDesc) =
        StyleDoc
"[S-2422]"
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
             [ StyleDoc
"Snapshot"
             , Style -> StyleDoc -> StyleDoc
style Style
Url (PrettyRawSnapshotLocation -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty (PrettyRawSnapshotLocation -> StyleDoc)
-> PrettyRawSnapshotLocation -> StyleDoc
forall a b. (a -> b) -> a -> b
$ RawSnapshotLocation -> PrettyRawSnapshotLocation
PrettyRawSnapshotLocation RawSnapshotLocation
resolver)
             , [Char] -> StyleDoc
flow [Char]
"does not have all the packages to match your requirements."
             ]
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
indent Int
4 ([Char] -> StyleDoc
string [Char]
errDesc)
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
resolveOptions

instance Exception ConfigPrettyException

data ParseAbsolutePathException
    = ParseAbsolutePathException String String
    deriving (Int -> ParseAbsolutePathException -> ShowS
[ParseAbsolutePathException] -> ShowS
ParseAbsolutePathException -> [Char]
(Int -> ParseAbsolutePathException -> ShowS)
-> (ParseAbsolutePathException -> [Char])
-> ([ParseAbsolutePathException] -> ShowS)
-> Show ParseAbsolutePathException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseAbsolutePathException -> ShowS
showsPrec :: Int -> ParseAbsolutePathException -> ShowS
$cshow :: ParseAbsolutePathException -> [Char]
show :: ParseAbsolutePathException -> [Char]
$cshowList :: [ParseAbsolutePathException] -> ShowS
showList :: [ParseAbsolutePathException] -> ShowS
Show, Typeable)

instance Exception ParseAbsolutePathException where
    displayException :: ParseAbsolutePathException -> [Char]
displayException (ParseAbsolutePathException [Char]
envVar [Char]
dir) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Error: [S-9437]\n"
        , [Char]
"Failed to parse "
        , [Char]
envVar
        , [Char]
" environment variable (expected absolute directory): "
        , [Char]
dir
        ]

-- | The base environment that almost everything in Stack runs in,

-- based off of parsing command line options in 'GlobalOpts'. Provides

-- logging and process execution.

data Runner = Runner
  { Runner -> GlobalOpts
runnerGlobalOpts :: !GlobalOpts
  , Runner -> Bool
runnerUseColor   :: !Bool
  , Runner -> LogFunc
runnerLogFunc    :: !LogFunc
  , Runner -> Int
runnerTermWidth  :: !Int
  , Runner -> ProcessContext
runnerProcessContext :: !ProcessContext
  }

data ColorWhen = ColorNever | ColorAlways | ColorAuto
    deriving (ColorWhen -> ColorWhen -> Bool
(ColorWhen -> ColorWhen -> Bool)
-> (ColorWhen -> ColorWhen -> Bool) -> Eq ColorWhen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColorWhen -> ColorWhen -> Bool
== :: ColorWhen -> ColorWhen -> Bool
$c/= :: ColorWhen -> ColorWhen -> Bool
/= :: ColorWhen -> ColorWhen -> Bool
Eq, Int -> ColorWhen -> ShowS
[ColorWhen] -> ShowS
ColorWhen -> [Char]
(Int -> ColorWhen -> ShowS)
-> (ColorWhen -> [Char])
-> ([ColorWhen] -> ShowS)
-> Show ColorWhen
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColorWhen -> ShowS
showsPrec :: Int -> ColorWhen -> ShowS
$cshow :: ColorWhen -> [Char]
show :: ColorWhen -> [Char]
$cshowList :: [ColorWhen] -> ShowS
showList :: [ColorWhen] -> ShowS
Show, (forall x. ColorWhen -> Rep ColorWhen x)
-> (forall x. Rep ColorWhen x -> ColorWhen) -> Generic ColorWhen
forall x. Rep ColorWhen x -> ColorWhen
forall x. ColorWhen -> Rep ColorWhen x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColorWhen -> Rep ColorWhen x
from :: forall x. ColorWhen -> Rep ColorWhen x
$cto :: forall x. Rep ColorWhen x -> ColorWhen
to :: forall x. Rep ColorWhen x -> ColorWhen
Generic)

instance FromJSON ColorWhen where
    parseJSON :: Value -> Parser ColorWhen
parseJSON Value
v = do
        [Char]
s <- Value -> Parser [Char]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        case [Char]
s of
            [Char]
"never"  -> ColorWhen -> Parser ColorWhen
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColorWhen
ColorNever
            [Char]
"always" -> ColorWhen -> Parser ColorWhen
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColorWhen
ColorAlways
            [Char]
"auto"   -> ColorWhen -> Parser ColorWhen
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColorWhen
ColorAuto
            [Char]
_ -> [Char] -> Parser ColorWhen
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Unknown color use: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
s [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
". Expected values of " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                       [Char]
"option are 'never', 'always', or 'auto'.")

-- | The top-level Stackage configuration.

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

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

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

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

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

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

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

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

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

         -- console

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

         -- match cabal.

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

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

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

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

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

         -- installation.

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

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

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

         -- command disallows this.

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

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

         ,Config -> Runner
configRunner              :: !Runner
         ,Config -> PantryConfig
configPantryConfig        :: !PantryConfig
         ,Config -> Path Abs Dir
configStackRoot           :: !(Path Abs Dir)
         ,Config -> Maybe AbstractResolver
configResolver            :: !(Maybe AbstractResolver)
         -- ^ Any resolver override from the command line

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

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

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

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

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

         }

-- | A bit of type safety to ensure we're talking to the right database.

newtype UserStorage = UserStorage
  { UserStorage -> Storage
unUserStorage :: Storage
  }

-- | A bit of type safety to ensure we're talking to the right database.

newtype ProjectStorage = ProjectStorage
  { ProjectStorage -> Storage
unProjectStorage :: Storage
  }

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

-- | Which packages do configure opts apply to?

data CabalConfigKey
  = CCKTargets -- ^ See AGOTargets

  | CCKLocals -- ^ See AGOLocals

  | CCKEverything -- ^ See AGOEverything

  | CCKPackage !PackageName -- ^ A specific package

  deriving (Int -> CabalConfigKey -> ShowS
[CabalConfigKey] -> ShowS
CabalConfigKey -> [Char]
(Int -> CabalConfigKey -> ShowS)
-> (CabalConfigKey -> [Char])
-> ([CabalConfigKey] -> ShowS)
-> Show CabalConfigKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalConfigKey -> ShowS
showsPrec :: Int -> CabalConfigKey -> ShowS
$cshow :: CabalConfigKey -> [Char]
show :: CabalConfigKey -> [Char]
$cshowList :: [CabalConfigKey] -> ShowS
showList :: [CabalConfigKey] -> ShowS
Show, ReadPrec [CabalConfigKey]
ReadPrec CabalConfigKey
Int -> ReadS CabalConfigKey
ReadS [CabalConfigKey]
(Int -> ReadS CabalConfigKey)
-> ReadS [CabalConfigKey]
-> ReadPrec CabalConfigKey
-> ReadPrec [CabalConfigKey]
-> Read CabalConfigKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CabalConfigKey
readsPrec :: Int -> ReadS CabalConfigKey
$creadList :: ReadS [CabalConfigKey]
readList :: ReadS [CabalConfigKey]
$creadPrec :: ReadPrec CabalConfigKey
readPrec :: ReadPrec CabalConfigKey
$creadListPrec :: ReadPrec [CabalConfigKey]
readListPrec :: ReadPrec [CabalConfigKey]
Read, CabalConfigKey -> CabalConfigKey -> Bool
(CabalConfigKey -> CabalConfigKey -> Bool)
-> (CabalConfigKey -> CabalConfigKey -> Bool) -> Eq CabalConfigKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CabalConfigKey -> CabalConfigKey -> Bool
== :: CabalConfigKey -> CabalConfigKey -> Bool
$c/= :: CabalConfigKey -> CabalConfigKey -> Bool
/= :: CabalConfigKey -> CabalConfigKey -> Bool
Eq, Eq CabalConfigKey
Eq CabalConfigKey
-> (CabalConfigKey -> CabalConfigKey -> Ordering)
-> (CabalConfigKey -> CabalConfigKey -> Bool)
-> (CabalConfigKey -> CabalConfigKey -> Bool)
-> (CabalConfigKey -> CabalConfigKey -> Bool)
-> (CabalConfigKey -> CabalConfigKey -> Bool)
-> (CabalConfigKey -> CabalConfigKey -> CabalConfigKey)
-> (CabalConfigKey -> CabalConfigKey -> CabalConfigKey)
-> Ord CabalConfigKey
CabalConfigKey -> CabalConfigKey -> Bool
CabalConfigKey -> CabalConfigKey -> Ordering
CabalConfigKey -> CabalConfigKey -> CabalConfigKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CabalConfigKey -> CabalConfigKey -> Ordering
compare :: CabalConfigKey -> CabalConfigKey -> Ordering
$c< :: CabalConfigKey -> CabalConfigKey -> Bool
< :: CabalConfigKey -> CabalConfigKey -> Bool
$c<= :: CabalConfigKey -> CabalConfigKey -> Bool
<= :: CabalConfigKey -> CabalConfigKey -> Bool
$c> :: CabalConfigKey -> CabalConfigKey -> Bool
> :: CabalConfigKey -> CabalConfigKey -> Bool
$c>= :: CabalConfigKey -> CabalConfigKey -> Bool
>= :: CabalConfigKey -> CabalConfigKey -> Bool
$cmax :: CabalConfigKey -> CabalConfigKey -> CabalConfigKey
max :: CabalConfigKey -> CabalConfigKey -> CabalConfigKey
$cmin :: CabalConfigKey -> CabalConfigKey -> CabalConfigKey
min :: CabalConfigKey -> CabalConfigKey -> CabalConfigKey
Ord)
instance FromJSON CabalConfigKey where
  parseJSON :: Value -> Parser CabalConfigKey
parseJSON = [Char]
-> (Text -> Parser CabalConfigKey)
-> Value
-> Parser CabalConfigKey
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"CabalConfigKey" Text -> Parser CabalConfigKey
forall (m :: * -> *).
(Monad m, MonadFail m) =>
Text -> m CabalConfigKey
parseCabalConfigKey
instance FromJSONKey CabalConfigKey where
  fromJSONKey :: FromJSONKeyFunction CabalConfigKey
fromJSONKey = (Text -> Parser CabalConfigKey)
-> FromJSONKeyFunction CabalConfigKey
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser CabalConfigKey
forall (m :: * -> *).
(Monad m, MonadFail m) =>
Text -> m CabalConfigKey
parseCabalConfigKey

parseCabalConfigKey :: (Monad m, MonadFail m) => Text -> m CabalConfigKey
parseCabalConfigKey :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
Text -> m CabalConfigKey
parseCabalConfigKey Text
"$targets" = CabalConfigKey -> m CabalConfigKey
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CabalConfigKey
CCKTargets
parseCabalConfigKey Text
"$locals" = CabalConfigKey -> m CabalConfigKey
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CabalConfigKey
CCKLocals
parseCabalConfigKey Text
"$everything" = CabalConfigKey -> m CabalConfigKey
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CabalConfigKey
CCKEverything
parseCabalConfigKey Text
name =
  case [Char] -> Maybe PackageName
parsePackageName ([Char] -> Maybe PackageName) -> [Char] -> Maybe PackageName
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
name of
    Maybe PackageName
Nothing -> [Char] -> m CabalConfigKey
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m CabalConfigKey) -> [Char] -> m CabalConfigKey
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid CabalConfigKey: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
name
    Just PackageName
x -> CabalConfigKey -> m CabalConfigKey
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalConfigKey -> m CabalConfigKey)
-> CabalConfigKey -> m CabalConfigKey
forall a b. (a -> b) -> a -> b
$ PackageName -> CabalConfigKey
CCKPackage PackageName
x

-- | Which packages do ghc-options on the command line apply to?

data ApplyGhcOptions = AGOTargets -- ^ all local targets

                     | AGOLocals -- ^ all local packages, even non-targets

                     | AGOEverything -- ^ every package

  deriving (Int -> ApplyGhcOptions -> ShowS
[ApplyGhcOptions] -> ShowS
ApplyGhcOptions -> [Char]
(Int -> ApplyGhcOptions -> ShowS)
-> (ApplyGhcOptions -> [Char])
-> ([ApplyGhcOptions] -> ShowS)
-> Show ApplyGhcOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplyGhcOptions -> ShowS
showsPrec :: Int -> ApplyGhcOptions -> ShowS
$cshow :: ApplyGhcOptions -> [Char]
show :: ApplyGhcOptions -> [Char]
$cshowList :: [ApplyGhcOptions] -> ShowS
showList :: [ApplyGhcOptions] -> ShowS
Show, ReadPrec [ApplyGhcOptions]
ReadPrec ApplyGhcOptions
Int -> ReadS ApplyGhcOptions
ReadS [ApplyGhcOptions]
(Int -> ReadS ApplyGhcOptions)
-> ReadS [ApplyGhcOptions]
-> ReadPrec ApplyGhcOptions
-> ReadPrec [ApplyGhcOptions]
-> Read ApplyGhcOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ApplyGhcOptions
readsPrec :: Int -> ReadS ApplyGhcOptions
$creadList :: ReadS [ApplyGhcOptions]
readList :: ReadS [ApplyGhcOptions]
$creadPrec :: ReadPrec ApplyGhcOptions
readPrec :: ReadPrec ApplyGhcOptions
$creadListPrec :: ReadPrec [ApplyGhcOptions]
readListPrec :: ReadPrec [ApplyGhcOptions]
Read, ApplyGhcOptions -> ApplyGhcOptions -> Bool
(ApplyGhcOptions -> ApplyGhcOptions -> Bool)
-> (ApplyGhcOptions -> ApplyGhcOptions -> Bool)
-> Eq ApplyGhcOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
== :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
$c/= :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
/= :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
Eq, Eq ApplyGhcOptions
Eq ApplyGhcOptions
-> (ApplyGhcOptions -> ApplyGhcOptions -> Ordering)
-> (ApplyGhcOptions -> ApplyGhcOptions -> Bool)
-> (ApplyGhcOptions -> ApplyGhcOptions -> Bool)
-> (ApplyGhcOptions -> ApplyGhcOptions -> Bool)
-> (ApplyGhcOptions -> ApplyGhcOptions -> Bool)
-> (ApplyGhcOptions -> ApplyGhcOptions -> ApplyGhcOptions)
-> (ApplyGhcOptions -> ApplyGhcOptions -> ApplyGhcOptions)
-> Ord ApplyGhcOptions
ApplyGhcOptions -> ApplyGhcOptions -> Bool
ApplyGhcOptions -> ApplyGhcOptions -> Ordering
ApplyGhcOptions -> ApplyGhcOptions -> ApplyGhcOptions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ApplyGhcOptions -> ApplyGhcOptions -> Ordering
compare :: ApplyGhcOptions -> ApplyGhcOptions -> Ordering
$c< :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
< :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
$c<= :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
<= :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
$c> :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
> :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
$c>= :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
>= :: ApplyGhcOptions -> ApplyGhcOptions -> Bool
$cmax :: ApplyGhcOptions -> ApplyGhcOptions -> ApplyGhcOptions
max :: ApplyGhcOptions -> ApplyGhcOptions -> ApplyGhcOptions
$cmin :: ApplyGhcOptions -> ApplyGhcOptions -> ApplyGhcOptions
min :: ApplyGhcOptions -> ApplyGhcOptions -> ApplyGhcOptions
Ord, Int -> ApplyGhcOptions
ApplyGhcOptions -> Int
ApplyGhcOptions -> [ApplyGhcOptions]
ApplyGhcOptions -> ApplyGhcOptions
ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions]
ApplyGhcOptions
-> ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions]
(ApplyGhcOptions -> ApplyGhcOptions)
-> (ApplyGhcOptions -> ApplyGhcOptions)
-> (Int -> ApplyGhcOptions)
-> (ApplyGhcOptions -> Int)
-> (ApplyGhcOptions -> [ApplyGhcOptions])
-> (ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions])
-> (ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions])
-> (ApplyGhcOptions
    -> ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions])
-> Enum ApplyGhcOptions
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ApplyGhcOptions -> ApplyGhcOptions
succ :: ApplyGhcOptions -> ApplyGhcOptions
$cpred :: ApplyGhcOptions -> ApplyGhcOptions
pred :: ApplyGhcOptions -> ApplyGhcOptions
$ctoEnum :: Int -> ApplyGhcOptions
toEnum :: Int -> ApplyGhcOptions
$cfromEnum :: ApplyGhcOptions -> Int
fromEnum :: ApplyGhcOptions -> Int
$cenumFrom :: ApplyGhcOptions -> [ApplyGhcOptions]
enumFrom :: ApplyGhcOptions -> [ApplyGhcOptions]
$cenumFromThen :: ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions]
enumFromThen :: ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions]
$cenumFromTo :: ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions]
enumFromTo :: ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions]
$cenumFromThenTo :: ApplyGhcOptions
-> ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions]
enumFromThenTo :: ApplyGhcOptions
-> ApplyGhcOptions -> ApplyGhcOptions -> [ApplyGhcOptions]
Enum, ApplyGhcOptions
ApplyGhcOptions -> ApplyGhcOptions -> Bounded ApplyGhcOptions
forall a. a -> a -> Bounded a
$cminBound :: ApplyGhcOptions
minBound :: ApplyGhcOptions
$cmaxBound :: ApplyGhcOptions
maxBound :: ApplyGhcOptions
Bounded)

instance FromJSON ApplyGhcOptions where
    parseJSON :: Value -> Parser ApplyGhcOptions
parseJSON = [Char]
-> (Text -> Parser ApplyGhcOptions)
-> Value
-> Parser ApplyGhcOptions
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"ApplyGhcOptions" ((Text -> Parser ApplyGhcOptions)
 -> Value -> Parser ApplyGhcOptions)
-> (Text -> Parser ApplyGhcOptions)
-> Value
-> Parser ApplyGhcOptions
forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case Text
t of
            Text
"targets" -> ApplyGhcOptions -> Parser ApplyGhcOptions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplyGhcOptions
AGOTargets
            Text
"locals" -> ApplyGhcOptions -> Parser ApplyGhcOptions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplyGhcOptions
AGOLocals
            Text
"everything" -> ApplyGhcOptions -> Parser ApplyGhcOptions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplyGhcOptions
AGOEverything
            Text
_ -> [Char] -> Parser ApplyGhcOptions
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser ApplyGhcOptions)
-> [Char] -> Parser ApplyGhcOptions
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid ApplyGhcOptions: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t

newtype AllowNewerDeps = AllowNewerDeps [PackageName]
  deriving (Int -> AllowNewerDeps -> ShowS
[AllowNewerDeps] -> ShowS
AllowNewerDeps -> [Char]
(Int -> AllowNewerDeps -> ShowS)
-> (AllowNewerDeps -> [Char])
-> ([AllowNewerDeps] -> ShowS)
-> Show AllowNewerDeps
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllowNewerDeps -> ShowS
showsPrec :: Int -> AllowNewerDeps -> ShowS
$cshow :: AllowNewerDeps -> [Char]
show :: AllowNewerDeps -> [Char]
$cshowList :: [AllowNewerDeps] -> ShowS
showList :: [AllowNewerDeps] -> ShowS
Show, ReadPrec [AllowNewerDeps]
ReadPrec AllowNewerDeps
Int -> ReadS AllowNewerDeps
ReadS [AllowNewerDeps]
(Int -> ReadS AllowNewerDeps)
-> ReadS [AllowNewerDeps]
-> ReadPrec AllowNewerDeps
-> ReadPrec [AllowNewerDeps]
-> Read AllowNewerDeps
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AllowNewerDeps
readsPrec :: Int -> ReadS AllowNewerDeps
$creadList :: ReadS [AllowNewerDeps]
readList :: ReadS [AllowNewerDeps]
$creadPrec :: ReadPrec AllowNewerDeps
readPrec :: ReadPrec AllowNewerDeps
$creadListPrec :: ReadPrec [AllowNewerDeps]
readListPrec :: ReadPrec [AllowNewerDeps]
Read, AllowNewerDeps -> AllowNewerDeps -> Bool
(AllowNewerDeps -> AllowNewerDeps -> Bool)
-> (AllowNewerDeps -> AllowNewerDeps -> Bool) -> Eq AllowNewerDeps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllowNewerDeps -> AllowNewerDeps -> Bool
== :: AllowNewerDeps -> AllowNewerDeps -> Bool
$c/= :: AllowNewerDeps -> AllowNewerDeps -> Bool
/= :: AllowNewerDeps -> AllowNewerDeps -> Bool
Eq, Eq AllowNewerDeps
Eq AllowNewerDeps
-> (AllowNewerDeps -> AllowNewerDeps -> Ordering)
-> (AllowNewerDeps -> AllowNewerDeps -> Bool)
-> (AllowNewerDeps -> AllowNewerDeps -> Bool)
-> (AllowNewerDeps -> AllowNewerDeps -> Bool)
-> (AllowNewerDeps -> AllowNewerDeps -> Bool)
-> (AllowNewerDeps -> AllowNewerDeps -> AllowNewerDeps)
-> (AllowNewerDeps -> AllowNewerDeps -> AllowNewerDeps)
-> Ord AllowNewerDeps
AllowNewerDeps -> AllowNewerDeps -> Bool
AllowNewerDeps -> AllowNewerDeps -> Ordering
AllowNewerDeps -> AllowNewerDeps -> AllowNewerDeps
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AllowNewerDeps -> AllowNewerDeps -> Ordering
compare :: AllowNewerDeps -> AllowNewerDeps -> Ordering
$c< :: AllowNewerDeps -> AllowNewerDeps -> Bool
< :: AllowNewerDeps -> AllowNewerDeps -> Bool
$c<= :: AllowNewerDeps -> AllowNewerDeps -> Bool
<= :: AllowNewerDeps -> AllowNewerDeps -> Bool
$c> :: AllowNewerDeps -> AllowNewerDeps -> Bool
> :: AllowNewerDeps -> AllowNewerDeps -> Bool
$c>= :: AllowNewerDeps -> AllowNewerDeps -> Bool
>= :: AllowNewerDeps -> AllowNewerDeps -> Bool
$cmax :: AllowNewerDeps -> AllowNewerDeps -> AllowNewerDeps
max :: AllowNewerDeps -> AllowNewerDeps -> AllowNewerDeps
$cmin :: AllowNewerDeps -> AllowNewerDeps -> AllowNewerDeps
min :: AllowNewerDeps -> AllowNewerDeps -> AllowNewerDeps
Ord, (forall x. AllowNewerDeps -> Rep AllowNewerDeps x)
-> (forall x. Rep AllowNewerDeps x -> AllowNewerDeps)
-> Generic AllowNewerDeps
forall x. Rep AllowNewerDeps x -> AllowNewerDeps
forall x. AllowNewerDeps -> Rep AllowNewerDeps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AllowNewerDeps -> Rep AllowNewerDeps x
from :: forall x. AllowNewerDeps -> Rep AllowNewerDeps x
$cto :: forall x. Rep AllowNewerDeps x -> AllowNewerDeps
to :: forall x. Rep AllowNewerDeps x -> AllowNewerDeps
Generic)

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

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

instance FromJSON AllowNewerDeps where
  parseJSON :: Value -> Parser AllowNewerDeps
parseJSON = ([[Char]] -> AllowNewerDeps)
-> Parser [[Char]] -> Parser AllowNewerDeps
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([PackageName] -> AllowNewerDeps
AllowNewerDeps ([PackageName] -> AllowNewerDeps)
-> ([[Char]] -> [PackageName]) -> [[Char]] -> AllowNewerDeps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> PackageName) -> [[Char]] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> PackageName
C.mkPackageName) (Parser [[Char]] -> Parser AllowNewerDeps)
-> (Value -> Parser [[Char]]) -> Value -> Parser AllowNewerDeps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [[Char]]
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Which build log files to dump

data DumpLogs
  = DumpNoLogs -- ^ don't dump any logfiles

  | DumpWarningLogs -- ^ dump logfiles containing warnings

  | DumpAllLogs -- ^ dump all logfiles

  deriving (Int -> DumpLogs -> ShowS
[DumpLogs] -> ShowS
DumpLogs -> [Char]
(Int -> DumpLogs -> ShowS)
-> (DumpLogs -> [Char]) -> ([DumpLogs] -> ShowS) -> Show DumpLogs
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DumpLogs -> ShowS
showsPrec :: Int -> DumpLogs -> ShowS
$cshow :: DumpLogs -> [Char]
show :: DumpLogs -> [Char]
$cshowList :: [DumpLogs] -> ShowS
showList :: [DumpLogs] -> ShowS
Show, ReadPrec [DumpLogs]
ReadPrec DumpLogs
Int -> ReadS DumpLogs
ReadS [DumpLogs]
(Int -> ReadS DumpLogs)
-> ReadS [DumpLogs]
-> ReadPrec DumpLogs
-> ReadPrec [DumpLogs]
-> Read DumpLogs
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DumpLogs
readsPrec :: Int -> ReadS DumpLogs
$creadList :: ReadS [DumpLogs]
readList :: ReadS [DumpLogs]
$creadPrec :: ReadPrec DumpLogs
readPrec :: ReadPrec DumpLogs
$creadListPrec :: ReadPrec [DumpLogs]
readListPrec :: ReadPrec [DumpLogs]
Read, DumpLogs -> DumpLogs -> Bool
(DumpLogs -> DumpLogs -> Bool)
-> (DumpLogs -> DumpLogs -> Bool) -> Eq DumpLogs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DumpLogs -> DumpLogs -> Bool
== :: DumpLogs -> DumpLogs -> Bool
$c/= :: DumpLogs -> DumpLogs -> Bool
/= :: DumpLogs -> DumpLogs -> Bool
Eq, Eq DumpLogs
Eq DumpLogs
-> (DumpLogs -> DumpLogs -> Ordering)
-> (DumpLogs -> DumpLogs -> Bool)
-> (DumpLogs -> DumpLogs -> Bool)
-> (DumpLogs -> DumpLogs -> Bool)
-> (DumpLogs -> DumpLogs -> Bool)
-> (DumpLogs -> DumpLogs -> DumpLogs)
-> (DumpLogs -> DumpLogs -> DumpLogs)
-> Ord DumpLogs
DumpLogs -> DumpLogs -> Bool
DumpLogs -> DumpLogs -> Ordering
DumpLogs -> DumpLogs -> DumpLogs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DumpLogs -> DumpLogs -> Ordering
compare :: DumpLogs -> DumpLogs -> Ordering
$c< :: DumpLogs -> DumpLogs -> Bool
< :: DumpLogs -> DumpLogs -> Bool
$c<= :: DumpLogs -> DumpLogs -> Bool
<= :: DumpLogs -> DumpLogs -> Bool
$c> :: DumpLogs -> DumpLogs -> Bool
> :: DumpLogs -> DumpLogs -> Bool
$c>= :: DumpLogs -> DumpLogs -> Bool
>= :: DumpLogs -> DumpLogs -> Bool
$cmax :: DumpLogs -> DumpLogs -> DumpLogs
max :: DumpLogs -> DumpLogs -> DumpLogs
$cmin :: DumpLogs -> DumpLogs -> DumpLogs
min :: DumpLogs -> DumpLogs -> DumpLogs
Ord, Int -> DumpLogs
DumpLogs -> Int
DumpLogs -> [DumpLogs]
DumpLogs -> DumpLogs
DumpLogs -> DumpLogs -> [DumpLogs]
DumpLogs -> DumpLogs -> DumpLogs -> [DumpLogs]
(DumpLogs -> DumpLogs)
-> (DumpLogs -> DumpLogs)
-> (Int -> DumpLogs)
-> (DumpLogs -> Int)
-> (DumpLogs -> [DumpLogs])
-> (DumpLogs -> DumpLogs -> [DumpLogs])
-> (DumpLogs -> DumpLogs -> [DumpLogs])
-> (DumpLogs -> DumpLogs -> DumpLogs -> [DumpLogs])
-> Enum DumpLogs
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DumpLogs -> DumpLogs
succ :: DumpLogs -> DumpLogs
$cpred :: DumpLogs -> DumpLogs
pred :: DumpLogs -> DumpLogs
$ctoEnum :: Int -> DumpLogs
toEnum :: Int -> DumpLogs
$cfromEnum :: DumpLogs -> Int
fromEnum :: DumpLogs -> Int
$cenumFrom :: DumpLogs -> [DumpLogs]
enumFrom :: DumpLogs -> [DumpLogs]
$cenumFromThen :: DumpLogs -> DumpLogs -> [DumpLogs]
enumFromThen :: DumpLogs -> DumpLogs -> [DumpLogs]
$cenumFromTo :: DumpLogs -> DumpLogs -> [DumpLogs]
enumFromTo :: DumpLogs -> DumpLogs -> [DumpLogs]
$cenumFromThenTo :: DumpLogs -> DumpLogs -> DumpLogs -> [DumpLogs]
enumFromThenTo :: DumpLogs -> DumpLogs -> DumpLogs -> [DumpLogs]
Enum, DumpLogs
DumpLogs -> DumpLogs -> Bounded DumpLogs
forall a. a -> a -> Bounded a
$cminBound :: DumpLogs
minBound :: DumpLogs
$cmaxBound :: DumpLogs
maxBound :: DumpLogs
Bounded)

instance FromJSON DumpLogs where
  parseJSON :: Value -> Parser DumpLogs
parseJSON (Bool Bool
True) = DumpLogs -> Parser DumpLogs
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DumpLogs
DumpAllLogs
  parseJSON (Bool Bool
False) = DumpLogs -> Parser DumpLogs
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DumpLogs
DumpNoLogs
  parseJSON Value
v =
    [Char] -> (Text -> Parser DumpLogs) -> Value -> Parser DumpLogs
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText
      [Char]
"DumpLogs"
      (\Text
t ->
          if | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"none" -> DumpLogs -> Parser DumpLogs
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DumpLogs
DumpNoLogs
             | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"warning" -> DumpLogs -> Parser DumpLogs
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DumpLogs
DumpWarningLogs
             | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"all" -> DumpLogs -> Parser DumpLogs
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DumpLogs
DumpAllLogs
             | Bool
otherwise -> [Char] -> Parser DumpLogs
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid DumpLogs: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t))
      Value
v

-- | Controls which version of the environment is used

data EnvSettings = EnvSettings
    { EnvSettings -> Bool
esIncludeLocals :: !Bool
    -- ^ include local project bin directory, GHC_PACKAGE_PATH, etc

    , EnvSettings -> Bool
esIncludeGhcPackagePath :: !Bool
    -- ^ include the GHC_PACKAGE_PATH variable

    , EnvSettings -> Bool
esStackExe :: !Bool
    -- ^ set the STACK_EXE variable to the current executable name

    , EnvSettings -> Bool
esLocaleUtf8 :: !Bool
    -- ^ set the locale to C.UTF-8

    , EnvSettings -> Bool
esKeepGhcRts :: !Bool
    -- ^ if True, keep GHCRTS variable in environment

    }
    deriving (Int -> EnvSettings -> ShowS
[EnvSettings] -> ShowS
EnvSettings -> [Char]
(Int -> EnvSettings -> ShowS)
-> (EnvSettings -> [Char])
-> ([EnvSettings] -> ShowS)
-> Show EnvSettings
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvSettings -> ShowS
showsPrec :: Int -> EnvSettings -> ShowS
$cshow :: EnvSettings -> [Char]
show :: EnvSettings -> [Char]
$cshowList :: [EnvSettings] -> ShowS
showList :: [EnvSettings] -> ShowS
Show, EnvSettings -> EnvSettings -> Bool
(EnvSettings -> EnvSettings -> Bool)
-> (EnvSettings -> EnvSettings -> Bool) -> Eq EnvSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnvSettings -> EnvSettings -> Bool
== :: EnvSettings -> EnvSettings -> Bool
$c/= :: EnvSettings -> EnvSettings -> Bool
/= :: EnvSettings -> EnvSettings -> Bool
Eq, Eq EnvSettings
Eq EnvSettings
-> (EnvSettings -> EnvSettings -> Ordering)
-> (EnvSettings -> EnvSettings -> Bool)
-> (EnvSettings -> EnvSettings -> Bool)
-> (EnvSettings -> EnvSettings -> Bool)
-> (EnvSettings -> EnvSettings -> Bool)
-> (EnvSettings -> EnvSettings -> EnvSettings)
-> (EnvSettings -> EnvSettings -> EnvSettings)
-> Ord EnvSettings
EnvSettings -> EnvSettings -> Bool
EnvSettings -> EnvSettings -> Ordering
EnvSettings -> EnvSettings -> EnvSettings
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EnvSettings -> EnvSettings -> Ordering
compare :: EnvSettings -> EnvSettings -> Ordering
$c< :: EnvSettings -> EnvSettings -> Bool
< :: EnvSettings -> EnvSettings -> Bool
$c<= :: EnvSettings -> EnvSettings -> Bool
<= :: EnvSettings -> EnvSettings -> Bool
$c> :: EnvSettings -> EnvSettings -> Bool
> :: EnvSettings -> EnvSettings -> Bool
$c>= :: EnvSettings -> EnvSettings -> Bool
>= :: EnvSettings -> EnvSettings -> Bool
$cmax :: EnvSettings -> EnvSettings -> EnvSettings
max :: EnvSettings -> EnvSettings -> EnvSettings
$cmin :: EnvSettings -> EnvSettings -> EnvSettings
min :: EnvSettings -> EnvSettings -> EnvSettings
Ord)

type AddCommand =
  ExceptT (RIO Runner ())
          (Writer (OA.Mod OA.CommandFields (RIO Runner (), GlobalOptsMonoid)))
          ()

data ExecOpts = ExecOpts
    { ExecOpts -> SpecialExecCmd
eoCmd :: !SpecialExecCmd
    , ExecOpts -> [[Char]]
eoArgs :: ![String]
    , ExecOpts -> ExecOptsExtra
eoExtra :: !ExecOptsExtra
    } deriving (Int -> ExecOpts -> ShowS
[ExecOpts] -> ShowS
ExecOpts -> [Char]
(Int -> ExecOpts -> ShowS)
-> (ExecOpts -> [Char]) -> ([ExecOpts] -> ShowS) -> Show ExecOpts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecOpts -> ShowS
showsPrec :: Int -> ExecOpts -> ShowS
$cshow :: ExecOpts -> [Char]
show :: ExecOpts -> [Char]
$cshowList :: [ExecOpts] -> ShowS
showList :: [ExecOpts] -> ShowS
Show)

data SpecialExecCmd
    = ExecCmd String
    | ExecRun
    | ExecGhc
    | ExecRunGhc
    deriving (Int -> SpecialExecCmd -> ShowS
[SpecialExecCmd] -> ShowS
SpecialExecCmd -> [Char]
(Int -> SpecialExecCmd -> ShowS)
-> (SpecialExecCmd -> [Char])
-> ([SpecialExecCmd] -> ShowS)
-> Show SpecialExecCmd
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecialExecCmd -> ShowS
showsPrec :: Int -> SpecialExecCmd -> ShowS
$cshow :: SpecialExecCmd -> [Char]
show :: SpecialExecCmd -> [Char]
$cshowList :: [SpecialExecCmd] -> ShowS
showList :: [SpecialExecCmd] -> ShowS
Show, SpecialExecCmd -> SpecialExecCmd -> Bool
(SpecialExecCmd -> SpecialExecCmd -> Bool)
-> (SpecialExecCmd -> SpecialExecCmd -> Bool) -> Eq SpecialExecCmd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecialExecCmd -> SpecialExecCmd -> Bool
== :: SpecialExecCmd -> SpecialExecCmd -> Bool
$c/= :: SpecialExecCmd -> SpecialExecCmd -> Bool
/= :: SpecialExecCmd -> SpecialExecCmd -> Bool
Eq)

data ExecOptsExtra = ExecOptsExtra
  { ExecOptsExtra -> EnvSettings
eoEnvSettings :: !EnvSettings
  , ExecOptsExtra -> [[Char]]
eoPackages :: ![String]
  , ExecOptsExtra -> [[Char]]
eoRtsOptions :: ![String]
  , ExecOptsExtra -> Maybe [Char]
eoCwd :: !(Maybe FilePath)
  }
  deriving (Int -> ExecOptsExtra -> ShowS
[ExecOptsExtra] -> ShowS
ExecOptsExtra -> [Char]
(Int -> ExecOptsExtra -> ShowS)
-> (ExecOptsExtra -> [Char])
-> ([ExecOptsExtra] -> ShowS)
-> Show ExecOptsExtra
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecOptsExtra -> ShowS
showsPrec :: Int -> ExecOptsExtra -> ShowS
$cshow :: ExecOptsExtra -> [Char]
show :: ExecOptsExtra -> [Char]
$cshowList :: [ExecOptsExtra] -> ShowS
showList :: [ExecOptsExtra] -> ShowS
Show)

data EvalOpts = EvalOpts
    { EvalOpts -> [Char]
evalArg :: !String
    , EvalOpts -> ExecOptsExtra
evalExtra :: !ExecOptsExtra
    } deriving (Int -> EvalOpts -> ShowS
[EvalOpts] -> ShowS
EvalOpts -> [Char]
(Int -> EvalOpts -> ShowS)
-> (EvalOpts -> [Char]) -> ([EvalOpts] -> ShowS) -> Show EvalOpts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvalOpts -> ShowS
showsPrec :: Int -> EvalOpts -> ShowS
$cshow :: EvalOpts -> [Char]
show :: EvalOpts -> [Char]
$cshowList :: [EvalOpts] -> ShowS
showList :: [EvalOpts] -> ShowS
Show)

-- | Parsed global command-line options.

data GlobalOpts = GlobalOpts
    { GlobalOpts -> Maybe [Char]
globalReExecVersion :: !(Maybe String) -- ^ Expected re-exec in container version

    , GlobalOpts -> Maybe DockerEntrypoint
globalDockerEntrypoint :: !(Maybe DockerEntrypoint)
      -- ^ Data used when Stack is acting as a Docker entrypoint (internal use only)

    , GlobalOpts -> LogLevel
globalLogLevel     :: !LogLevel -- ^ Log level

    , GlobalOpts -> Bool
globalTimeInLog    :: !Bool -- ^ Whether to include timings in logs.

    , GlobalOpts -> Bool
globalRSLInLog     :: !Bool -- ^ Whether to include raw snapshot layer (RSL) in logs.

    , GlobalOpts -> ConfigMonoid
globalConfigMonoid :: !ConfigMonoid -- ^ Config monoid, for passing into 'loadConfig'

    , GlobalOpts -> Maybe AbstractResolver
globalResolver     :: !(Maybe AbstractResolver) -- ^ Resolver override

    , GlobalOpts -> Maybe WantedCompiler
globalCompiler     :: !(Maybe WantedCompiler) -- ^ Compiler override

    , GlobalOpts -> Bool
globalTerminal     :: !Bool -- ^ We're in a terminal?

    , GlobalOpts -> StylesUpdate
globalStylesUpdate :: !StylesUpdate -- ^ SGR (Ansi) codes for styles

    , GlobalOpts -> Maybe Int
globalTermWidth    :: !(Maybe Int) -- ^ Terminal width override

    , GlobalOpts -> StackYamlLoc
globalStackYaml    :: !StackYamlLoc -- ^ Override project stack.yaml

    , GlobalOpts -> LockFileBehavior
globalLockFileBehavior :: !LockFileBehavior
    } deriving (Int -> GlobalOpts -> ShowS
[GlobalOpts] -> ShowS
GlobalOpts -> [Char]
(Int -> GlobalOpts -> ShowS)
-> (GlobalOpts -> [Char])
-> ([GlobalOpts] -> ShowS)
-> Show GlobalOpts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobalOpts -> ShowS
showsPrec :: Int -> GlobalOpts -> ShowS
$cshow :: GlobalOpts -> [Char]
show :: GlobalOpts -> [Char]
$cshowList :: [GlobalOpts] -> ShowS
showList :: [GlobalOpts] -> ShowS
Show)

rslInLogL :: HasRunner env => SimpleGetter env Bool
rslInLogL :: forall env. HasRunner env => SimpleGetter env Bool
rslInLogL = (GlobalOpts -> Const r GlobalOpts) -> env -> Const r env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL((GlobalOpts -> Const r GlobalOpts) -> env -> Const r env)
-> ((Bool -> Const r Bool) -> GlobalOpts -> Const r GlobalOpts)
-> (Bool -> Const r Bool)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GlobalOpts -> Bool) -> SimpleGetter GlobalOpts Bool
forall s a. (s -> a) -> SimpleGetter s a
to GlobalOpts -> Bool
globalRSLInLog

-- | Location for the project's stack.yaml file.

data StackYamlLoc
    = SYLDefault
    -- ^ Use the standard parent-directory-checking logic

    | SYLOverride !(Path Abs File)
    -- ^ Use a specific stack.yaml file provided

    | SYLNoProject ![PackageIdentifierRevision]
    -- ^ Do not load up a project, just user configuration. Include

    -- the given extra dependencies with the resolver.

    | SYLGlobalProject
    -- ^ Do not look for a project configuration, and use the implicit global.

    deriving Int -> StackYamlLoc -> ShowS
[StackYamlLoc] -> ShowS
StackYamlLoc -> [Char]
(Int -> StackYamlLoc -> ShowS)
-> (StackYamlLoc -> [Char])
-> ([StackYamlLoc] -> ShowS)
-> Show StackYamlLoc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackYamlLoc -> ShowS
showsPrec :: Int -> StackYamlLoc -> ShowS
$cshow :: StackYamlLoc -> [Char]
show :: StackYamlLoc -> [Char]
$cshowList :: [StackYamlLoc] -> ShowS
showList :: [StackYamlLoc] -> ShowS
Show

stackYamlLocL :: HasRunner env => Lens' env StackYamlLoc
stackYamlLocL :: forall env. HasRunner env => Lens' env StackYamlLoc
stackYamlLocL = (GlobalOpts -> f GlobalOpts) -> env -> f env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL((GlobalOpts -> f GlobalOpts) -> env -> f env)
-> ((StackYamlLoc -> f StackYamlLoc) -> GlobalOpts -> f GlobalOpts)
-> (StackYamlLoc -> f StackYamlLoc)
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GlobalOpts -> StackYamlLoc)
-> (GlobalOpts -> StackYamlLoc -> GlobalOpts)
-> Lens GlobalOpts GlobalOpts StackYamlLoc StackYamlLoc
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GlobalOpts -> StackYamlLoc
globalStackYaml (\GlobalOpts
x StackYamlLoc
y -> GlobalOpts
x { globalStackYaml :: StackYamlLoc
globalStackYaml = StackYamlLoc
y })

-- | How to interact with lock files

data LockFileBehavior
  = LFBReadWrite
  -- ^ Read and write lock files

  | LFBReadOnly
  -- ^ Read lock files, but do not write them

  | LFBIgnore
  -- ^ Entirely ignore lock files

  | LFBErrorOnWrite
  -- ^ Error out on trying to write a lock file. This can be used to

  -- ensure that lock files in a repository already ensure

  -- reproducible builds.

  deriving (Int -> LockFileBehavior -> ShowS
[LockFileBehavior] -> ShowS
LockFileBehavior -> [Char]
(Int -> LockFileBehavior -> ShowS)
-> (LockFileBehavior -> [Char])
-> ([LockFileBehavior] -> ShowS)
-> Show LockFileBehavior
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LockFileBehavior -> ShowS
showsPrec :: Int -> LockFileBehavior -> ShowS
$cshow :: LockFileBehavior -> [Char]
show :: LockFileBehavior -> [Char]
$cshowList :: [LockFileBehavior] -> ShowS
showList :: [LockFileBehavior] -> ShowS
Show, Int -> LockFileBehavior
LockFileBehavior -> Int
LockFileBehavior -> [LockFileBehavior]
LockFileBehavior -> LockFileBehavior
LockFileBehavior -> LockFileBehavior -> [LockFileBehavior]
LockFileBehavior
-> LockFileBehavior -> LockFileBehavior -> [LockFileBehavior]
(LockFileBehavior -> LockFileBehavior)
-> (LockFileBehavior -> LockFileBehavior)
-> (Int -> LockFileBehavior)
-> (LockFileBehavior -> Int)
-> (LockFileBehavior -> [LockFileBehavior])
-> (LockFileBehavior -> LockFileBehavior -> [LockFileBehavior])
-> (LockFileBehavior -> LockFileBehavior -> [LockFileBehavior])
-> (LockFileBehavior
    -> LockFileBehavior -> LockFileBehavior -> [LockFileBehavior])
-> Enum LockFileBehavior
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LockFileBehavior -> LockFileBehavior
succ :: LockFileBehavior -> LockFileBehavior
$cpred :: LockFileBehavior -> LockFileBehavior
pred :: LockFileBehavior -> LockFileBehavior
$ctoEnum :: Int -> LockFileBehavior
toEnum :: Int -> LockFileBehavior
$cfromEnum :: LockFileBehavior -> Int
fromEnum :: LockFileBehavior -> Int
$cenumFrom :: LockFileBehavior -> [LockFileBehavior]
enumFrom :: LockFileBehavior -> [LockFileBehavior]
$cenumFromThen :: LockFileBehavior -> LockFileBehavior -> [LockFileBehavior]
enumFromThen :: LockFileBehavior -> LockFileBehavior -> [LockFileBehavior]
$cenumFromTo :: LockFileBehavior -> LockFileBehavior -> [LockFileBehavior]
enumFromTo :: LockFileBehavior -> LockFileBehavior -> [LockFileBehavior]
$cenumFromThenTo :: LockFileBehavior
-> LockFileBehavior -> LockFileBehavior -> [LockFileBehavior]
enumFromThenTo :: LockFileBehavior
-> LockFileBehavior -> LockFileBehavior -> [LockFileBehavior]
Enum, LockFileBehavior
LockFileBehavior -> LockFileBehavior -> Bounded LockFileBehavior
forall a. a -> a -> Bounded a
$cminBound :: LockFileBehavior
minBound :: LockFileBehavior
$cmaxBound :: LockFileBehavior
maxBound :: LockFileBehavior
Bounded)

lockFileBehaviorL :: HasRunner env => SimpleGetter env LockFileBehavior
lockFileBehaviorL :: forall env. HasRunner env => SimpleGetter env LockFileBehavior
lockFileBehaviorL = (GlobalOpts -> Const r GlobalOpts) -> env -> Const r env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL((GlobalOpts -> Const r GlobalOpts) -> env -> Const r env)
-> ((LockFileBehavior -> Const r LockFileBehavior)
    -> GlobalOpts -> Const r GlobalOpts)
-> (LockFileBehavior -> Const r LockFileBehavior)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GlobalOpts -> LockFileBehavior)
-> SimpleGetter GlobalOpts LockFileBehavior
forall s a. (s -> a) -> SimpleGetter s a
to GlobalOpts -> LockFileBehavior
globalLockFileBehavior

-- | Parser for 'LockFileBehavior'

readLockFileBehavior :: ReadM LockFileBehavior
readLockFileBehavior :: ReadM LockFileBehavior
readLockFileBehavior = do
  [Char]
s <- ReadM [Char]
OA.readerAsk
  case [Char] -> Map [Char] LockFileBehavior -> Maybe LockFileBehavior
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
s Map [Char] LockFileBehavior
m of
    Just LockFileBehavior
x -> LockFileBehavior -> ReadM LockFileBehavior
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockFileBehavior
x
    Maybe LockFileBehavior
Nothing -> [Char] -> ReadM LockFileBehavior
forall a. [Char] -> ReadM a
OA.readerError ([Char] -> ReadM LockFileBehavior)
-> [Char] -> ReadM LockFileBehavior
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid lock file behavior, valid options: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
                                [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
", " (Map [Char] LockFileBehavior -> [[Char]]
forall k a. Map k a -> [k]
Map.keys Map [Char] LockFileBehavior
m)
  where
    m :: Map [Char] LockFileBehavior
m = [([Char], LockFileBehavior)] -> Map [Char] LockFileBehavior
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], LockFileBehavior)] -> Map [Char] LockFileBehavior)
-> [([Char], LockFileBehavior)] -> Map [Char] LockFileBehavior
forall a b. (a -> b) -> a -> b
$ (LockFileBehavior -> ([Char], LockFileBehavior))
-> [LockFileBehavior] -> [([Char], LockFileBehavior)]
forall a b. (a -> b) -> [a] -> [b]
map (\LockFileBehavior
x -> (LockFileBehavior -> [Char]
forall {a}. IsString a => LockFileBehavior -> a
render LockFileBehavior
x, LockFileBehavior
x)) [LockFileBehavior
forall a. Bounded a => a
minBound..LockFileBehavior
forall a. Bounded a => a
maxBound]
    render :: LockFileBehavior -> a
render LockFileBehavior
LFBReadWrite = a
"read-write"
    render LockFileBehavior
LFBReadOnly = a
"read-only"
    render LockFileBehavior
LFBIgnore = a
"ignore"
    render LockFileBehavior
LFBErrorOnWrite = a
"error-on-write"

-- | Project configuration information. Not every run of Stack has a

-- true local project; see constructors below.

data ProjectConfig a
    = PCProject a
    -- ^ Normal run: we want a project, and have one. This comes from

    -- either 'SYLDefault' or 'SYLOverride'.

    | PCGlobalProject
    -- ^ No project was found when using 'SYLDefault'. Instead, use

    -- the implicit global.

    | PCNoProject ![PackageIdentifierRevision]
    -- ^ Use a no project run. This comes from 'SYLNoProject'.


-- | Parsed global command-line options monoid.

data GlobalOptsMonoid = GlobalOptsMonoid
    { GlobalOptsMonoid -> First [Char]
globalMonoidReExecVersion :: !(First String) -- ^ Expected re-exec in container version

    , GlobalOptsMonoid -> First DockerEntrypoint
globalMonoidDockerEntrypoint :: !(First DockerEntrypoint)
      -- ^ Data used when Stack is acting as a Docker entrypoint (internal use only)

    , GlobalOptsMonoid -> First LogLevel
globalMonoidLogLevel     :: !(First LogLevel) -- ^ Log level

    , GlobalOptsMonoid -> FirstTrue
globalMonoidTimeInLog    :: !FirstTrue -- ^ Whether to include timings in logs.

    , GlobalOptsMonoid -> FirstFalse
globalMonoidRSLInLog     :: !FirstFalse -- ^ Whether to include raw snapshot layer (RSL) in logs.

    , GlobalOptsMonoid -> ConfigMonoid
globalMonoidConfigMonoid :: !ConfigMonoid -- ^ Config monoid, for passing into 'loadConfig'

    , GlobalOptsMonoid -> First (Unresolved AbstractResolver)
globalMonoidResolver     :: !(First (Unresolved AbstractResolver)) -- ^ Resolver override

    , GlobalOptsMonoid -> First [Char]
globalMonoidResolverRoot :: !(First FilePath) -- ^ root directory for resolver relative path

    , GlobalOptsMonoid -> First WantedCompiler
globalMonoidCompiler     :: !(First WantedCompiler) -- ^ Compiler override

    , GlobalOptsMonoid -> First Bool
globalMonoidTerminal     :: !(First Bool) -- ^ We're in a terminal?

    , GlobalOptsMonoid -> StylesUpdate
globalMonoidStyles       :: !StylesUpdate -- ^ Stack's output styles

    , GlobalOptsMonoid -> First Int
globalMonoidTermWidth    :: !(First Int) -- ^ Terminal width override

    , GlobalOptsMonoid -> First [Char]
globalMonoidStackYaml    :: !(First FilePath) -- ^ Override project stack.yaml

    , GlobalOptsMonoid -> First LockFileBehavior
globalMonoidLockFileBehavior :: !(First LockFileBehavior) -- ^ See 'globalLockFileBehavior'

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

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

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

-- | Default logging level should be something useful but not crazy.

defaultLogLevel :: LogLevel
defaultLogLevel :: LogLevel
defaultLogLevel = LogLevel
LevelInfo

readColorWhen :: ReadM ColorWhen
readColorWhen :: ReadM ColorWhen
readColorWhen = do
    [Char]
s <- ReadM [Char]
OA.readerAsk
    case [Char]
s of
        [Char]
"never" -> ColorWhen -> ReadM ColorWhen
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColorWhen
ColorNever
        [Char]
"always" -> ColorWhen -> ReadM ColorWhen
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColorWhen
ColorAlways
        [Char]
"auto" -> ColorWhen -> ReadM ColorWhen
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColorWhen
ColorAuto
        [Char]
_ -> [Char] -> ReadM ColorWhen
forall a. [Char] -> ReadM a
OA.readerError [Char]
"Expected values of color option are 'never', 'always', or 'auto'."

readStyles :: ReadM StylesUpdate
readStyles :: ReadM StylesUpdate
readStyles = [Char] -> StylesUpdate
parseStylesUpdateFromString ([Char] -> StylesUpdate) -> ReadM [Char] -> ReadM StylesUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM [Char]
OA.readerAsk

-- | A superset of 'Config' adding information on how to build code. The reason

-- for this breakdown is because we will need some of the information from

-- 'Config' in order to determine the values here.

--

-- These are the components which know nothing about local configuration.

data BuildConfig = BuildConfig
    { BuildConfig -> Config
bcConfig     :: !Config
    , BuildConfig -> SMWanted
bcSMWanted :: !SMWanted
    , BuildConfig -> [Path Abs Dir]
bcExtraPackageDBs :: ![Path Abs Dir]
      -- ^ Extra package databases

    , BuildConfig -> Path Abs File
bcStackYaml  :: !(Path Abs File)
      -- ^ Location of the stack.yaml file.

      --

      -- Note: if the STACK_YAML environment variable is used, this may be

      -- different from projectRootL </> "stack.yaml" if a different file

      -- name is used.

    , BuildConfig -> ProjectStorage
bcProjectStorage :: !ProjectStorage
    -- ^ Database connection pool for project Stack database

    , BuildConfig -> Maybe Curator
bcCurator :: !(Maybe Curator)
    }

stackYamlL :: HasBuildConfig env => Lens' env (Path Abs File)
stackYamlL :: forall env. HasBuildConfig env => Lens' env (Path Abs File)
stackYamlL = (BuildConfig -> f BuildConfig) -> env -> f env
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' env BuildConfig
buildConfigL((BuildConfig -> f BuildConfig) -> env -> f env)
-> ((Path Abs File -> f (Path Abs File))
    -> BuildConfig -> f BuildConfig)
-> (Path Abs File -> f (Path Abs File))
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BuildConfig -> Path Abs File)
-> (BuildConfig -> Path Abs File -> BuildConfig)
-> Lens BuildConfig BuildConfig (Path Abs File) (Path Abs File)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BuildConfig -> Path Abs File
bcStackYaml (\BuildConfig
x Path Abs File
y -> BuildConfig
x { bcStackYaml :: Path Abs File
bcStackYaml = Path Abs File
y })

-- | Directory containing the project's stack.yaml file

projectRootL :: HasBuildConfig env => Getting r env (Path Abs Dir)
projectRootL :: forall env r. HasBuildConfig env => Getting r env (Path Abs Dir)
projectRootL = (Path Abs File -> Const r (Path Abs File)) -> env -> Const r env
forall env. HasBuildConfig env => Lens' env (Path Abs File)
Lens' env (Path Abs File)
stackYamlL((Path Abs File -> Const r (Path Abs File)) -> env -> Const r env)
-> ((Path Abs Dir -> Const r (Path Abs Dir))
    -> Path Abs File -> Const r (Path Abs File))
-> (Path Abs Dir -> Const r (Path Abs Dir))
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Path Abs File -> Path Abs Dir)
-> SimpleGetter (Path Abs File) (Path Abs Dir)
forall s a. (s -> a) -> SimpleGetter s a
to Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent

-- | Configuration after the environment has been setup.

data EnvConfig = EnvConfig
    {EnvConfig -> BuildConfig
envConfigBuildConfig :: !BuildConfig
    ,EnvConfig -> BuildOptsCLI
envConfigBuildOptsCLI :: !BuildOptsCLI
    ,EnvConfig -> SourceMap
envConfigSourceMap :: !SourceMap
    ,EnvConfig -> SourceMapHash
envConfigSourceMapHash :: !SourceMapHash
    ,EnvConfig -> CompilerPaths
envConfigCompilerPaths :: !CompilerPaths
    }

ppGPD :: MonadIO m => ProjectPackage -> m GenericPackageDescription
ppGPD :: forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m GenericPackageDescription
ppGPD = IO GenericPackageDescription -> m GenericPackageDescription
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GenericPackageDescription -> m GenericPackageDescription)
-> (ProjectPackage -> IO GenericPackageDescription)
-> ProjectPackage
-> m GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonPackage -> IO GenericPackageDescription
cpGPD (CommonPackage -> IO GenericPackageDescription)
-> (ProjectPackage -> CommonPackage)
-> ProjectPackage
-> IO GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPackage -> CommonPackage
ppCommon

-- | Root directory for the given 'ProjectPackage'

ppRoot :: ProjectPackage -> Path Abs Dir
ppRoot :: ProjectPackage -> Path Abs Dir
ppRoot = Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (ProjectPackage -> Path Abs File)
-> ProjectPackage
-> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPackage -> Path Abs File
ppCabalFP

-- | All components available in the given 'ProjectPackage'

ppComponents :: MonadIO m => ProjectPackage -> m (Set NamedComponent)
ppComponents :: forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m (Set NamedComponent)
ppComponents ProjectPackage
pp = do
  GenericPackageDescription
gpd <- ProjectPackage -> m GenericPackageDescription
forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m GenericPackageDescription
ppGPD ProjectPackage
pp
  Set NamedComponent -> m (Set NamedComponent)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set NamedComponent -> m (Set NamedComponent))
-> Set NamedComponent -> m (Set NamedComponent)
forall a b. (a -> b) -> a -> b
$ [NamedComponent] -> Set NamedComponent
forall a. Ord a => [a] -> Set a
Set.fromList ([NamedComponent] -> Set NamedComponent)
-> [NamedComponent] -> Set NamedComponent
forall a b. (a -> b) -> a -> b
$ [[NamedComponent]] -> [NamedComponent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [NamedComponent]
-> (CondTree ConfVar [Dependency] Library -> [NamedComponent])
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [NamedComponent]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []  ([NamedComponent]
-> CondTree ConfVar [Dependency] Library -> [NamedComponent]
forall a b. a -> b -> a
const [NamedComponent
CLib]) (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
C.condLibrary GenericPackageDescription
gpd)
    , (Text -> NamedComponent)
-> [UnqualComponentName] -> [NamedComponent]
go Text -> NamedComponent
CExe   ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> UnqualComponentName
forall a b. (a, b) -> a
fst ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> UnqualComponentName)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [UnqualComponentName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
C.condExecutables GenericPackageDescription
gpd)
    , (Text -> NamedComponent)
-> [UnqualComponentName] -> [NamedComponent]
go Text -> NamedComponent
CTest  ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> UnqualComponentName
forall a b. (a, b) -> a
fst ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> UnqualComponentName)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [UnqualComponentName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
C.condTestSuites GenericPackageDescription
gpd)
    , (Text -> NamedComponent)
-> [UnqualComponentName] -> [NamedComponent]
go Text -> NamedComponent
CBench ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> UnqualComponentName
forall a b. (a, b) -> a
fst ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> UnqualComponentName)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [UnqualComponentName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
C.condBenchmarks GenericPackageDescription
gpd)
    ]
  where
    go :: (T.Text -> NamedComponent)
       -> [C.UnqualComponentName]
       -> [NamedComponent]
    go :: (Text -> NamedComponent)
-> [UnqualComponentName] -> [NamedComponent]
go Text -> NamedComponent
wrapper = (UnqualComponentName -> NamedComponent)
-> [UnqualComponentName] -> [NamedComponent]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> NamedComponent
wrapper (Text -> NamedComponent)
-> (UnqualComponentName -> Text)
-> UnqualComponentName
-> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text)
-> (UnqualComponentName -> [Char]) -> UnqualComponentName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> [Char]
C.unUnqualComponentName)

-- | Version for the given 'ProjectPackage

ppVersion :: MonadIO m => ProjectPackage -> m Version
ppVersion :: forall (m :: * -> *). MonadIO m => ProjectPackage -> m Version
ppVersion = (GenericPackageDescription -> Version)
-> m GenericPackageDescription -> m Version
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenericPackageDescription -> Version
gpdVersion (m GenericPackageDescription -> m Version)
-> (ProjectPackage -> m GenericPackageDescription)
-> ProjectPackage
-> m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPackage -> m GenericPackageDescription
forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m GenericPackageDescription
ppGPD

-- | A project is a collection of packages. We can have multiple stack.yaml

-- files, but only one of them may contain project information.

data Project = Project
    { Project -> Maybe [Char]
projectUserMsg :: !(Maybe String)
    -- ^ A warning message to display to the user when the auto generated

    -- config may have issues.

    , Project -> [RelFilePath]
projectPackages :: ![RelFilePath]
    -- ^ Packages which are actually part of the project (as opposed

    -- to dependencies).

    , Project -> [RawPackageLocation]
projectDependencies :: ![RawPackageLocation]
    -- ^ Dependencies defined within the stack.yaml file, to be

    -- applied on top of the snapshot.

    , Project -> Map PackageName (Map FlagName Bool)
projectFlags :: !(Map PackageName (Map FlagName Bool))
    -- ^ Flags to be applied on top of the snapshot flags.

    , Project -> RawSnapshotLocation
projectResolver :: !RawSnapshotLocation
    -- ^ How we resolve which @Snapshot@ to use

    , Project -> Maybe WantedCompiler
projectCompiler :: !(Maybe WantedCompiler)
    -- ^ Override the compiler in 'projectResolver'

    , Project -> [[Char]]
projectExtraPackageDBs :: ![FilePath]
    , Project -> Maybe Curator
projectCurator :: !(Maybe Curator)
    -- ^ Extra configuration intended exclusively for usage by the

    -- curator tool. In other words, this is /not/ part of the

    -- documented and exposed Stack API. SUBJECT TO CHANGE.

    , Project -> Set PackageName
projectDropPackages :: !(Set PackageName)
    -- ^ Packages to drop from the 'projectResolver'.

    }
  deriving Int -> Project -> ShowS
[Project] -> ShowS
Project -> [Char]
(Int -> Project -> ShowS)
-> (Project -> [Char]) -> ([Project] -> ShowS) -> Show Project
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Project -> ShowS
showsPrec :: Int -> Project -> ShowS
$cshow :: Project -> [Char]
show :: Project -> [Char]
$cshowList :: [Project] -> ShowS
showList :: [Project] -> ShowS
Show

instance ToJSON Project where
    -- Expanding the constructor fully to ensure we don't miss any fields.

    toJSON :: Project -> Value
toJSON (Project Maybe [Char]
userMsg [RelFilePath]
packages [RawPackageLocation]
extraDeps Map PackageName (Map FlagName Bool)
flags RawSnapshotLocation
resolver Maybe WantedCompiler
mcompiler [[Char]]
extraPackageDBs Maybe Curator
mcurator Set PackageName
drops) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [[Pair]] -> [Pair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [Pair]
-> (WantedCompiler -> [Pair]) -> Maybe WantedCompiler -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\WantedCompiler
cv -> [Key
"compiler" Key -> WantedCompiler -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WantedCompiler
cv]) Maybe WantedCompiler
mcompiler
      , [Pair] -> ([Char] -> [Pair]) -> Maybe [Char] -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\[Char]
msg -> [Key
"user-message" Key -> [Char] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Char]
msg]) Maybe [Char]
userMsg
      , if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
extraPackageDBs then [] else [Key
"extra-package-dbs" Key -> [[Char]] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [[Char]]
extraPackageDBs]
      , if [RawPackageLocation] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RawPackageLocation]
extraDeps then [] else [Key
"extra-deps" Key -> [RawPackageLocation] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [RawPackageLocation]
extraDeps]
      , if Map PackageName (Map FlagName Bool) -> Bool
forall k a. Map k a -> Bool
Map.null Map PackageName (Map FlagName Bool)
flags then [] else [Key
"flags" Key
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Map FlagName Bool -> Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall a b.
(a -> b)
-> Map (CabalString PackageName) a
-> Map (CabalString PackageName) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map FlagName Bool -> Map (CabalString FlagName) Bool
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (Map PackageName (Map FlagName Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap Map PackageName (Map FlagName Bool)
flags)]
      , [Key
"packages" Key -> [RelFilePath] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [RelFilePath]
packages]
      , [Key
"resolver" Key -> RawSnapshotLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= RawSnapshotLocation
resolver]
      , [Pair] -> (Curator -> [Pair]) -> Maybe Curator -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Curator
c -> [Key
"curator" Key -> Curator -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Curator
c]) Maybe Curator
mcurator
      , if Set PackageName -> Bool
forall a. Set a -> Bool
Set.null Set PackageName
drops then [] else [Key
"drop-packages" Key -> Set (CabalString PackageName) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString Set PackageName
drops]
      ]

-- | Extra configuration intended exclusively for usage by the

-- curator tool. In other words, this is /not/ part of the

-- documented and exposed Stack API. SUBJECT TO CHANGE.

data Curator = Curator
  { Curator -> Set PackageName
curatorSkipTest :: !(Set PackageName)
  , Curator -> Set PackageName
curatorExpectTestFailure :: !(Set PackageName)
  , Curator -> Set PackageName
curatorSkipBenchmark :: !(Set PackageName)
  , Curator -> Set PackageName
curatorExpectBenchmarkFailure :: !(Set PackageName)
  , Curator -> Set PackageName
curatorSkipHaddock :: !(Set PackageName)
  , Curator -> Set PackageName
curatorExpectHaddockFailure :: !(Set PackageName)
  }
  deriving Int -> Curator -> ShowS
[Curator] -> ShowS
Curator -> [Char]
(Int -> Curator -> ShowS)
-> (Curator -> [Char]) -> ([Curator] -> ShowS) -> Show Curator
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Curator -> ShowS
showsPrec :: Int -> Curator -> ShowS
$cshow :: Curator -> [Char]
show :: Curator -> [Char]
$cshowList :: [Curator] -> ShowS
showList :: [Curator] -> ShowS
Show
instance ToJSON Curator where
  toJSON :: Curator -> Value
toJSON Curator
c = [Pair] -> Value
object
    [ Key
"skip-test" Key -> Set (CabalString PackageName) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString (Curator -> Set PackageName
curatorSkipTest Curator
c)
    , Key
"expect-test-failure" Key -> Set (CabalString PackageName) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString (Curator -> Set PackageName
curatorExpectTestFailure Curator
c)
    , Key
"skip-bench" Key -> Set (CabalString PackageName) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString (Curator -> Set PackageName
curatorSkipBenchmark Curator
c)
    , Key
"expect-benchmark-failure" Key -> Set (CabalString PackageName) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString (Curator -> Set PackageName
curatorExpectTestFailure Curator
c)
    , Key
"skip-haddock" Key -> Set (CabalString PackageName) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString (Curator -> Set PackageName
curatorSkipHaddock Curator
c)
    , Key
"expect-test-failure" Key -> Set (CabalString PackageName) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString (Curator -> Set PackageName
curatorExpectHaddockFailure Curator
c)
    ]
instance FromJSON (WithJSONWarnings Curator) where
  parseJSON :: Value -> Parser (WithJSONWarnings Curator)
parseJSON = [Char]
-> (Object -> WarningParser Curator)
-> Value
-> Parser (WithJSONWarnings Curator)
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"Curator" ((Object -> WarningParser Curator)
 -> Value -> Parser (WithJSONWarnings Curator))
-> (Object -> WarningParser Curator)
-> Value
-> Parser (WithJSONWarnings Curator)
forall a b. (a -> b) -> a -> b
$ \Object
o -> Set PackageName
-> Set PackageName
-> Set PackageName
-> Set PackageName
-> Set PackageName
-> Set PackageName
-> Curator
Curator
    (Set PackageName
 -> Set PackageName
 -> Set PackageName
 -> Set PackageName
 -> Set PackageName
 -> Set PackageName
 -> Curator)
-> WriterT WarningParserMonoid Parser (Set PackageName)
-> WriterT
     WarningParserMonoid
     Parser
     (Set PackageName
      -> Set PackageName
      -> Set PackageName
      -> Set PackageName
      -> Set PackageName
      -> Curator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set (CabalString PackageName) -> Set PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
-> WriterT WarningParserMonoid Parser (Set PackageName)
forall a b.
(a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CabalString PackageName -> PackageName)
-> Set (CabalString PackageName) -> Set PackageName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString) (Object
o Object
-> Text -> WarningParser (Maybe (Set (CabalString PackageName)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"skip-test" WarningParser (Maybe (Set (CabalString PackageName)))
-> Set (CabalString PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Set (CabalString PackageName)
forall a. Monoid a => a
mempty)
    WriterT
  WarningParserMonoid
  Parser
  (Set PackageName
   -> Set PackageName
   -> Set PackageName
   -> Set PackageName
   -> Set PackageName
   -> Curator)
-> WriterT WarningParserMonoid Parser (Set PackageName)
-> WriterT
     WarningParserMonoid
     Parser
     (Set PackageName
      -> Set PackageName
      -> Set PackageName
      -> Set PackageName
      -> Curator)
forall a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set (CabalString PackageName) -> Set PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
-> WriterT WarningParserMonoid Parser (Set PackageName)
forall a b.
(a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CabalString PackageName -> PackageName)
-> Set (CabalString PackageName) -> Set PackageName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString) (Object
o Object
-> Text -> WarningParser (Maybe (Set (CabalString PackageName)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"expect-test-failure" WarningParser (Maybe (Set (CabalString PackageName)))
-> Set (CabalString PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Set (CabalString PackageName)
forall a. Monoid a => a
mempty)
    WriterT
  WarningParserMonoid
  Parser
  (Set PackageName
   -> Set PackageName
   -> Set PackageName
   -> Set PackageName
   -> Curator)
-> WriterT WarningParserMonoid Parser (Set PackageName)
-> WriterT
     WarningParserMonoid
     Parser
     (Set PackageName -> Set PackageName -> Set PackageName -> Curator)
forall a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set (CabalString PackageName) -> Set PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
-> WriterT WarningParserMonoid Parser (Set PackageName)
forall a b.
(a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CabalString PackageName -> PackageName)
-> Set (CabalString PackageName) -> Set PackageName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString) (Object
o Object
-> Text -> WarningParser (Maybe (Set (CabalString PackageName)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"skip-bench" WarningParser (Maybe (Set (CabalString PackageName)))
-> Set (CabalString PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Set (CabalString PackageName)
forall a. Monoid a => a
mempty)
    WriterT
  WarningParserMonoid
  Parser
  (Set PackageName -> Set PackageName -> Set PackageName -> Curator)
-> WriterT WarningParserMonoid Parser (Set PackageName)
-> WriterT
     WarningParserMonoid
     Parser
     (Set PackageName -> Set PackageName -> Curator)
forall a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set (CabalString PackageName) -> Set PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
-> WriterT WarningParserMonoid Parser (Set PackageName)
forall a b.
(a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CabalString PackageName -> PackageName)
-> Set (CabalString PackageName) -> Set PackageName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString) (Object
o Object
-> Text -> WarningParser (Maybe (Set (CabalString PackageName)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"expect-benchmark-failure" WarningParser (Maybe (Set (CabalString PackageName)))
-> Set (CabalString PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Set (CabalString PackageName)
forall a. Monoid a => a
mempty)
    WriterT
  WarningParserMonoid
  Parser
  (Set PackageName -> Set PackageName -> Curator)
-> WriterT WarningParserMonoid Parser (Set PackageName)
-> WriterT WarningParserMonoid Parser (Set PackageName -> Curator)
forall a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set (CabalString PackageName) -> Set PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
-> WriterT WarningParserMonoid Parser (Set PackageName)
forall a b.
(a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CabalString PackageName -> PackageName)
-> Set (CabalString PackageName) -> Set PackageName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString) (Object
o Object
-> Text -> WarningParser (Maybe (Set (CabalString PackageName)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"skip-haddock" WarningParser (Maybe (Set (CabalString PackageName)))
-> Set (CabalString PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Set (CabalString PackageName)
forall a. Monoid a => a
mempty)
    WriterT WarningParserMonoid Parser (Set PackageName -> Curator)
-> WriterT WarningParserMonoid Parser (Set PackageName)
-> WarningParser Curator
forall a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set (CabalString PackageName) -> Set PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
-> WriterT WarningParserMonoid Parser (Set PackageName)
forall a b.
(a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CabalString PackageName -> PackageName)
-> Set (CabalString PackageName) -> Set PackageName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString) (Object
o Object
-> Text -> WarningParser (Maybe (Set (CabalString PackageName)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"expect-haddock-failure" WarningParser (Maybe (Set (CabalString PackageName)))
-> Set (CabalString PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Set (CabalString PackageName)
forall a. Monoid a => a
mempty)

-- An uninterpreted representation of configuration options.

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

data ConfigMonoid =
  ConfigMonoid
    { ConfigMonoid -> First (Path Abs Dir)
configMonoidStackRoot          :: !(First (Path Abs Dir))
    -- ^ See: 'clStackRoot'

    , ConfigMonoid -> First (Path Rel Dir)
configMonoidWorkDir            :: !(First (Path Rel Dir))
    -- ^ See: 'configWorkDir'.

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

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

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

    , ConfigMonoid -> First Int
configMonoidConnectionCount    :: !(First Int)
    -- ^ See: 'configConnectionCount'

    , ConfigMonoid -> FirstTrue
configMonoidHideTHLoading      :: !FirstTrue
    -- ^ See: 'configHideTHLoading'

    , ConfigMonoid -> First Bool
configMonoidPrefixTimestamps   :: !(First Bool)
    -- ^ See: 'configPrefixTimestamps'

    , ConfigMonoid -> First Text
configMonoidLatestSnapshot     :: !(First Text)
    -- ^ See: 'configLatestSnapshot'

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

    , ConfigMonoid -> First [PackageIndexConfig]
configMonoidPackageIndices     :: !(First [PackageIndexConfig])
    -- ^ Deprecated in favour of package-index

    , ConfigMonoid -> First Bool
configMonoidSystemGHC          :: !(First Bool)
    -- ^ See: 'configSystemGHC'

    ,ConfigMonoid -> FirstTrue
configMonoidInstallGHC          :: !FirstTrue
    -- ^ See: 'configInstallGHC'

    ,ConfigMonoid -> FirstFalse
configMonoidSkipGHCCheck        :: !FirstFalse
    -- ^ See: 'configSkipGHCCheck'

    ,ConfigMonoid -> FirstFalse
configMonoidSkipMsys            :: !FirstFalse
    -- ^ See: 'configSkipMsys'

    ,ConfigMonoid -> First VersionCheck
configMonoidCompilerCheck       :: !(First VersionCheck)
    -- ^ See: 'configCompilerCheck'

    ,ConfigMonoid -> First CompilerRepository
configMonoidCompilerRepository  :: !(First CompilerRepository)
    -- ^ See: 'configCompilerRepository'

    ,ConfigMonoid -> IntersectingVersionRange
configMonoidRequireStackVersion :: !IntersectingVersionRange
    -- ^ See: 'configRequireStackVersion'

    ,ConfigMonoid -> First [Char]
configMonoidArch                :: !(First String)
    -- ^ Used for overriding the platform

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

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

    ,ConfigMonoid -> First Int
configMonoidJobs                :: !(First Int)
    -- ^ See: 'configJobs'

    ,ConfigMonoid -> [[Char]]
configMonoidExtraIncludeDirs    :: ![FilePath]
    -- ^ See: 'configExtraIncludeDirs'

    ,ConfigMonoid -> [[Char]]
configMonoidExtraLibDirs        :: ![FilePath]
    -- ^ See: 'configExtraLibDirs'

    ,ConfigMonoid -> [Text]
configMonoidCustomPreprocessorExts :: ![Text]
    -- ^ See: 'configCustomPreprocessorExts'

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

    ,ConfigMonoid -> First [Char]
configMonoidOverrideHpack       :: !(First FilePath)
    -- ^ Use Hpack executable (overrides bundled Hpack)

    ,ConfigMonoid -> First Bool
configMonoidConcurrentTests     :: !(First Bool)
    -- ^ See: 'configConcurrentTests'

    ,ConfigMonoid -> First [Char]
configMonoidLocalBinPath        :: !(First FilePath)
    -- ^ Used to override the binary installation dir

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

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

    ,ConfigMonoid -> MonoidMap PackageName (Dual [Text])
configMonoidGhcOptionsByName    :: !(MonoidMap PackageName (Monoid.Dual [Text]))
    -- ^ See 'configGhcOptionsByName'. 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])
configMonoidGhcOptionsByCat     :: !(MonoidMap ApplyGhcOptions (Monoid.Dual [Text]))
    -- ^ See 'configGhcOptionsAll'. 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])
configMonoidCabalConfigOpts     :: !(MonoidMap CabalConfigKey (Monoid.Dual [Text]))
    -- ^ See 'configCabalConfigOpts'.

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

    ,ConfigMonoid -> [[Char]]
configMonoidSetupInfoLocations  :: ![String]
    -- ^ See 'configSetupInfoLocations'

    ,ConfigMonoid -> SetupInfo
configMonoidSetupInfoInline     :: !SetupInfo
    -- ^ See 'configSetupInfoInline'

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

    ,ConfigMonoid -> First PvpBounds
configMonoidPvpBounds           :: !(First PvpBounds)
    -- ^ See 'configPvpBounds'

    ,ConfigMonoid -> FirstTrue
configMonoidModifyCodePage      :: !FirstTrue
    -- ^ See 'configModifyCodePage'

    ,ConfigMonoid -> FirstFalse
configMonoidRebuildGhcOptions   :: !FirstFalse
    -- ^ See 'configMonoidRebuildGhcOptions'

    ,ConfigMonoid -> First ApplyGhcOptions
configMonoidApplyGhcOptions     :: !(First ApplyGhcOptions)
    -- ^ See 'configApplyGhcOptions'

    ,ConfigMonoid -> First Bool
configMonoidAllowNewer          :: !(First Bool)
    -- ^ See 'configMonoidAllowNewer'

    ,ConfigMonoid -> Maybe AllowNewerDeps
configMonoidAllowNewerDeps      :: !(Maybe AllowNewerDeps)
    -- ^ See 'configMonoidAllowNewerDeps'

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

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

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

    -- installation.

    , ConfigMonoid -> First DumpLogs
configMonoidDumpLogs           :: !(First DumpLogs)
    -- ^ See 'configDumpLogs'

    , ConfigMonoid -> First Bool
configMonoidSaveHackageCreds   :: !(First Bool)
    -- ^ See 'configSaveHackageCreds'

    , ConfigMonoid -> First Text
configMonoidHackageBaseUrl     :: !(First Text)
    -- ^ See 'configHackageBaseUrl'

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

    , ConfigMonoid -> StylesUpdate
configMonoidStyles             :: !StylesUpdate
    , ConfigMonoid -> FirstTrue
configMonoidHideSourcePaths    :: !FirstTrue
    -- ^ See 'configHideSourcePaths'

    , ConfigMonoid -> FirstTrue
configMonoidRecommendUpgrade   :: !FirstTrue
    -- ^ See 'configRecommendUpgrade'

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

    , ConfigMonoid -> FirstFalse
configMonoidNoRunCompile  :: !FirstFalse
    -- ^ See: 'configNoRunCompile'

    , ConfigMonoid -> First Bool
configMonoidStackDeveloperMode :: !(First Bool)
    -- ^ See 'configStackDeveloperMode'

    }
  deriving (Int -> ConfigMonoid -> ShowS
[ConfigMonoid] -> ShowS
ConfigMonoid -> [Char]
(Int -> ConfigMonoid -> ShowS)
-> (ConfigMonoid -> [Char])
-> ([ConfigMonoid] -> ShowS)
-> Show ConfigMonoid
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigMonoid -> ShowS
showsPrec :: Int -> ConfigMonoid -> ShowS
$cshow :: ConfigMonoid -> [Char]
show :: ConfigMonoid -> [Char]
$cshowList :: [ConfigMonoid] -> ShowS
showList :: [ConfigMonoid] -> ShowS
Show, (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 = [Char]
-> (Object -> WarningParser ConfigMonoid)
-> Value
-> Parser (WithJSONWarnings ConfigMonoid)
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 configMonoidStackRoot :: First a
configMonoidStackRoot = Maybe a -> First a
forall a. Maybe a -> First a
First Maybe a
forall a. Maybe a
Nothing
    First (Path Rel Dir)
configMonoidWorkDir <- 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
    BuildOptsMonoid
configMonoidBuildOpts <- WarningParser (WithJSONWarnings BuildOptsMonoid)
-> WarningParser BuildOptsMonoid
forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings (Object
obj Object
-> Text -> WarningParser (Maybe (WithJSONWarnings BuildOptsMonoid))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidBuildOptsName WarningParser (Maybe (WithJSONWarnings BuildOptsMonoid))
-> WithJSONWarnings BuildOptsMonoid
-> WarningParser (WithJSONWarnings BuildOptsMonoid)
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= WithJSONWarnings BuildOptsMonoid
forall a. Monoid a => a
mempty)
    DockerOptsMonoid
configMonoidDockerOpts <- WarningParser (WithJSONWarnings DockerOptsMonoid)
-> WarningParser DockerOptsMonoid
forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings (Object
obj Object
-> Text
-> WarningParser (Maybe (WithJSONWarnings DockerOptsMonoid))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidDockerOptsName WarningParser (Maybe (WithJSONWarnings DockerOptsMonoid))
-> WithJSONWarnings DockerOptsMonoid
-> WarningParser (WithJSONWarnings DockerOptsMonoid)
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= WithJSONWarnings DockerOptsMonoid
forall a. Monoid a => a
mempty)
    NixOptsMonoid
configMonoidNixOpts <- WarningParser (WithJSONWarnings NixOptsMonoid)
-> WarningParser NixOptsMonoid
forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings (Object
obj Object
-> Text -> WarningParser (Maybe (WithJSONWarnings NixOptsMonoid))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidNixOptsName WarningParser (Maybe (WithJSONWarnings NixOptsMonoid))
-> WithJSONWarnings NixOptsMonoid
-> WarningParser (WithJSONWarnings NixOptsMonoid)
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= WithJSONWarnings NixOptsMonoid
forall a. Monoid a => a
mempty)
    First Int
configMonoidConnectionCount <- Maybe Int -> First Int
forall a. Maybe a -> First a
First (Maybe Int -> First Int)
-> WriterT WarningParserMonoid Parser (Maybe Int)
-> WriterT WarningParserMonoid Parser (First Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidConnectionCountName
    FirstTrue
configMonoidHideTHLoading <- Maybe Bool -> FirstTrue
FirstTrue (Maybe Bool -> FirstTrue)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstTrue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidHideTHLoadingName
    First Bool
configMonoidPrefixTimestamps <- Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidPrefixTimestampsName

    Maybe Value
murls :: Maybe Value <- Object
obj Object -> Text -> WarningParser (Maybe Value)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidUrlsName
    First Text
configMonoidLatestSnapshot <-
      case Maybe Value
murls of
        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
$ [Char]
-> (Object -> WriterT WarningParserMonoid Parser (First Text))
-> Value
-> Parser (WithJSONWarnings (First Text))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings
          [Char]
"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

    First PackageIndexConfig
configMonoidPackageIndex <- Maybe PackageIndexConfig -> First PackageIndexConfig
forall a. Maybe a -> First a
First (Maybe PackageIndexConfig -> First PackageIndexConfig)
-> WriterT WarningParserMonoid Parser (Maybe PackageIndexConfig)
-> WriterT WarningParserMonoid Parser (First PackageIndexConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WarningParser (Maybe (WithJSONWarnings PackageIndexConfig))
-> WriterT WarningParserMonoid Parser (Maybe PackageIndexConfig)
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (Object
obj Object
-> Text
-> WarningParser (Maybe (WithJSONWarnings PackageIndexConfig))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:?  Text
configMonoidPackageIndexName)
    First [PackageIndexConfig]
configMonoidPackageIndices <- Maybe [PackageIndexConfig] -> First [PackageIndexConfig]
forall a. Maybe a -> First a
First (Maybe [PackageIndexConfig] -> First [PackageIndexConfig])
-> WriterT WarningParserMonoid Parser (Maybe [PackageIndexConfig])
-> WriterT WarningParserMonoid Parser (First [PackageIndexConfig])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WarningParser (Maybe [WithJSONWarnings PackageIndexConfig])
-> WriterT WarningParserMonoid Parser (Maybe [PackageIndexConfig])
forall (t :: * -> *) (u :: * -> *) a.
(Traversable t, Traversable u) =>
WarningParser (u (t (WithJSONWarnings a)))
-> WarningParser (u (t a))
jsonSubWarningsTT (Object
obj Object
-> Text
-> WarningParser (Maybe [WithJSONWarnings PackageIndexConfig])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:?  Text
configMonoidPackageIndicesName)
    First Bool
configMonoidSystemGHC <- Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidSystemGHCName
    FirstTrue
configMonoidInstallGHC <- Maybe Bool -> FirstTrue
FirstTrue (Maybe Bool -> FirstTrue)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstTrue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidInstallGHCName
    FirstFalse
configMonoidSkipGHCCheck <- Maybe Bool -> FirstFalse
FirstFalse (Maybe Bool -> FirstFalse)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstFalse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidSkipGHCCheckName
    FirstFalse
configMonoidSkipMsys <- Maybe Bool -> FirstFalse
FirstFalse (Maybe Bool -> FirstFalse)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstFalse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidSkipMsysName
    IntersectingVersionRange
configMonoidRequireStackVersion <- VersionRange -> IntersectingVersionRange
IntersectingVersionRange (VersionRange -> IntersectingVersionRange)
-> (VersionRangeJSON -> VersionRange)
-> VersionRangeJSON
-> IntersectingVersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRangeJSON -> VersionRange
unVersionRangeJSON (VersionRangeJSON -> IntersectingVersionRange)
-> WriterT WarningParserMonoid Parser VersionRangeJSON
-> WriterT WarningParserMonoid Parser IntersectingVersionRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (
                                       Object
obj Object -> Text -> WarningParser (Maybe VersionRangeJSON)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidRequireStackVersionName
                                           WarningParser (Maybe VersionRangeJSON)
-> VersionRangeJSON
-> WriterT WarningParserMonoid Parser VersionRangeJSON
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= VersionRange -> VersionRangeJSON
VersionRangeJSON VersionRange
anyVersion)
    First [Char]
configMonoidArch <- Maybe [Char] -> First [Char]
forall a. Maybe a -> First a
First (Maybe [Char] -> First [Char])
-> WriterT WarningParserMonoid Parser (Maybe [Char])
-> WriterT WarningParserMonoid Parser (First [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe [Char])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidArchName
    First GHCVariant
configMonoidGHCVariant <- Maybe GHCVariant -> First GHCVariant
forall a. Maybe a -> First a
First (Maybe GHCVariant -> First GHCVariant)
-> WriterT WarningParserMonoid Parser (Maybe GHCVariant)
-> WriterT WarningParserMonoid Parser (First GHCVariant)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text -> WriterT WarningParserMonoid Parser (Maybe GHCVariant)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidGHCVariantName
    First CompilerBuild
configMonoidGHCBuild <- Maybe CompilerBuild -> First CompilerBuild
forall a. Maybe a -> First a
First (Maybe CompilerBuild -> First CompilerBuild)
-> WriterT WarningParserMonoid Parser (Maybe CompilerBuild)
-> WriterT WarningParserMonoid Parser (First CompilerBuild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text -> WriterT WarningParserMonoid Parser (Maybe CompilerBuild)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidGHCBuildName
    First Int
configMonoidJobs <- Maybe Int -> First Int
forall a. Maybe a -> First a
First (Maybe Int -> First Int)
-> WriterT WarningParserMonoid Parser (Maybe Int)
-> WriterT WarningParserMonoid Parser (First Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidJobsName
    [[Char]]
configMonoidExtraIncludeDirs <- ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
rootDir [Char] -> ShowS
FilePath.</>) ([[Char]] -> [[Char]])
-> WriterT WarningParserMonoid Parser [[Char]]
-> WriterT WarningParserMonoid Parser [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Object
obj Object -> Text -> WarningParser (Maybe [[Char]])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:?  Text
configMonoidExtraIncludeDirsName WarningParser (Maybe [[Char]])
-> [[Char]] -> WriterT WarningParserMonoid Parser [[Char]]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= []
    [[Char]]
configMonoidExtraLibDirs <- ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
rootDir [Char] -> ShowS
FilePath.</>) ([[Char]] -> [[Char]])
-> WriterT WarningParserMonoid Parser [[Char]]
-> WriterT WarningParserMonoid Parser [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Object
obj Object -> Text -> WarningParser (Maybe [[Char]])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:?  Text
configMonoidExtraLibDirsName WarningParser (Maybe [[Char]])
-> [[Char]] -> WriterT WarningParserMonoid Parser [[Char]]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= []
    [Text]
configMonoidCustomPreprocessorExts <- Object
obj Object -> Text -> WarningParser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:?  Text
configMonoidCustomPreprocessorExtsName WarningParser (Maybe [Text]) -> [Text] -> WarningParser [Text]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= []
    First (Path Abs File)
configMonoidOverrideGccPath <- Maybe (Path Abs File) -> First (Path Abs File)
forall a. Maybe a -> First a
First (Maybe (Path Abs File) -> First (Path Abs File))
-> WriterT WarningParserMonoid Parser (Maybe (Path Abs File))
-> WriterT WarningParserMonoid Parser (First (Path Abs File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text
-> WriterT WarningParserMonoid Parser (Maybe (Path Abs File))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidOverrideGccPathName
    First [Char]
configMonoidOverrideHpack <- Maybe [Char] -> First [Char]
forall a. Maybe a -> First a
First (Maybe [Char] -> First [Char])
-> WriterT WarningParserMonoid Parser (Maybe [Char])
-> WriterT WarningParserMonoid Parser (First [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe [Char])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidOverrideHpackName
    First Bool
configMonoidConcurrentTests <- Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidConcurrentTestsName
    First [Char]
configMonoidLocalBinPath <- Maybe [Char] -> First [Char]
forall a. Maybe a -> First a
First (Maybe [Char] -> First [Char])
-> WriterT WarningParserMonoid Parser (Maybe [Char])
-> WriterT WarningParserMonoid Parser (First [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe [Char])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidLocalBinPathName
    Maybe Object
templates <- Object
obj Object -> Text -> WarningParser (Maybe Object)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"templates"
    (First SCM
configMonoidScmInit,Map Text Text
configMonoidTemplateParameters) <-
      case Maybe Object
templates of
        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
          Maybe SCM
scmInit <- Object
tobj Object -> Text -> WarningParser (Maybe SCM)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidScmInitName
          Maybe (Map Text Text)
params <- Object
tobj Object -> Text -> WarningParser (Maybe (Map Text Text))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidTemplateParametersName
          (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
scmInit,Map Text Text -> Maybe (Map Text Text) -> Map Text Text
forall a. a -> Maybe a -> a
fromMaybe Map Text Text
forall k a. Map k a
M.empty Maybe (Map Text Text)
params)
    First VersionCheck
configMonoidCompilerCheck <- Maybe VersionCheck -> First VersionCheck
forall a. Maybe a -> First a
First (Maybe VersionCheck -> First VersionCheck)
-> WriterT WarningParserMonoid Parser (Maybe VersionCheck)
-> WriterT WarningParserMonoid Parser (First VersionCheck)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text -> WriterT WarningParserMonoid Parser (Maybe VersionCheck)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidCompilerCheckName
    First CompilerRepository
configMonoidCompilerRepository <- Maybe CompilerRepository -> First CompilerRepository
forall a. Maybe a -> First a
First (Maybe CompilerRepository -> First CompilerRepository)
-> WriterT WarningParserMonoid Parser (Maybe CompilerRepository)
-> WriterT WarningParserMonoid Parser (First CompilerRepository)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object
-> Text
-> WriterT WarningParserMonoid Parser (Maybe CompilerRepository)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidCompilerRepositoryName)

    Map GhcOptionKey [Text]
options <- (GhcOptions -> [Text])
-> Map GhcOptionKey GhcOptions -> Map GhcOptionKey [Text]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map GhcOptions -> [Text]
unGhcOptions (Map GhcOptionKey GhcOptions -> Map GhcOptionKey [Text])
-> WriterT WarningParserMonoid Parser (Map GhcOptionKey GhcOptions)
-> WriterT WarningParserMonoid Parser (Map GhcOptionKey [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text -> WarningParser (Maybe (Map GhcOptionKey GhcOptions))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidGhcOptionsName WarningParser (Maybe (Map GhcOptionKey GhcOptions))
-> Map GhcOptionKey GhcOptions
-> WriterT WarningParserMonoid Parser (Map GhcOptionKey GhcOptions)
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map GhcOptionKey GhcOptions
forall a. Monoid a => a
mempty

    [Text]
optionsEverything <-
      case (GhcOptionKey -> Map GhcOptionKey [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GhcOptionKey
GOKOldEverything Map GhcOptionKey [Text]
options, GhcOptionKey -> Map GhcOptionKey [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GhcOptionKey
GOKEverything Map GhcOptionKey [Text]
options) of
        (Just [Text]
_, Just [Text]
_) -> [Char] -> WarningParser [Text]
forall a. [Char] -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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 configMonoidGhcOptionsByCat :: MonoidMap ApplyGhcOptions (Dual [Text])
configMonoidGhcOptionsByCat = 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)
          ]

        configMonoidGhcOptionsByName :: MonoidMap PackageName (Dual [Text])
configMonoidGhcOptionsByName = 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]

    Map CabalConfigKey [Text]
configMonoidCabalConfigOpts' <- Object
obj Object -> Text -> WarningParser (Maybe (Map CabalConfigKey [Text]))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"configure-options" WarningParser (Maybe (Map CabalConfigKey [Text]))
-> Map CabalConfigKey [Text]
-> WarningParser (Map CabalConfigKey [Text])
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map CabalConfigKey [Text]
forall a. Monoid a => a
mempty
    let configMonoidCabalConfigOpts :: MonoidMap CabalConfigKey (Dual [Text])
configMonoidCabalConfigOpts = Map CabalConfigKey [Text] -> MonoidMap CabalConfigKey (Dual [Text])
forall a b. Coercible a b => a -> b
coerce (Map CabalConfigKey [Text]
configMonoidCabalConfigOpts' :: Map CabalConfigKey [Text])

    [Path Abs Dir]
configMonoidExtraPath <- Object
obj Object -> Text -> WarningParser (Maybe [Path Abs Dir])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidExtraPathName WarningParser (Maybe [Path Abs Dir])
-> [Path Abs Dir] -> WarningParser [Path Abs Dir]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= []
    [[Char]]
configMonoidSetupInfoLocations <- Object
obj Object -> Text -> WarningParser (Maybe [[Char]])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidSetupInfoLocationsName WarningParser (Maybe [[Char]])
-> [[Char]] -> WriterT WarningParserMonoid Parser [[Char]]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= []
    SetupInfo
configMonoidSetupInfoInline <- WarningParser (Maybe (WithJSONWarnings SetupInfo))
-> WarningParser (Maybe SetupInfo)
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (Object
obj Object
-> Text -> WarningParser (Maybe (WithJSONWarnings SetupInfo))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidSetupInfoInlineName) WarningParser (Maybe SetupInfo)
-> SetupInfo -> WarningParser SetupInfo
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= SetupInfo
forall a. Monoid a => a
mempty
    First (Path Abs Dir)
configMonoidLocalProgramsBase <- Maybe (Path Abs Dir) -> First (Path Abs Dir)
forall a. Maybe a -> First a
First (Maybe (Path Abs Dir) -> First (Path Abs Dir))
-> WriterT WarningParserMonoid Parser (Maybe (Path Abs Dir))
-> WriterT WarningParserMonoid Parser (First (Path Abs Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text
-> WriterT WarningParserMonoid Parser (Maybe (Path Abs Dir))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidLocalProgramsBaseName
    First PvpBounds
configMonoidPvpBounds <- Maybe PvpBounds -> First PvpBounds
forall a. Maybe a -> First a
First (Maybe PvpBounds -> First PvpBounds)
-> WriterT WarningParserMonoid Parser (Maybe PvpBounds)
-> WriterT WarningParserMonoid Parser (First PvpBounds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text -> WriterT WarningParserMonoid Parser (Maybe PvpBounds)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidPvpBoundsName
    FirstTrue
configMonoidModifyCodePage <- Maybe Bool -> FirstTrue
FirstTrue (Maybe Bool -> FirstTrue)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstTrue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidModifyCodePageName
    FirstFalse
configMonoidRebuildGhcOptions <- Maybe Bool -> FirstFalse
FirstFalse (Maybe Bool -> FirstFalse)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstFalse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidRebuildGhcOptionsName
    First ApplyGhcOptions
configMonoidApplyGhcOptions <- Maybe ApplyGhcOptions -> First ApplyGhcOptions
forall a. Maybe a -> First a
First (Maybe ApplyGhcOptions -> First ApplyGhcOptions)
-> WriterT WarningParserMonoid Parser (Maybe ApplyGhcOptions)
-> WriterT WarningParserMonoid Parser (First ApplyGhcOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text
-> WriterT WarningParserMonoid Parser (Maybe ApplyGhcOptions)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidApplyGhcOptionsName
    First Bool
configMonoidAllowNewer <- Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidAllowNewerName
    Maybe AllowNewerDeps
configMonoidAllowNewerDeps <- Object
obj Object -> Text -> WarningParser (Maybe AllowNewerDeps)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidAllowNewerDepsName
    First TemplateName
configMonoidDefaultTemplate <- Maybe TemplateName -> First TemplateName
forall a. Maybe a -> First a
First (Maybe TemplateName -> First TemplateName)
-> WriterT WarningParserMonoid Parser (Maybe TemplateName)
-> WriterT WarningParserMonoid Parser (First TemplateName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text -> WriterT WarningParserMonoid Parser (Maybe TemplateName)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidDefaultTemplateName
    First Bool
configMonoidAllowDifferentUser <- Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidAllowDifferentUserName
    First DumpLogs
configMonoidDumpLogs <- Maybe DumpLogs -> First DumpLogs
forall a. Maybe a -> First a
First (Maybe DumpLogs -> First DumpLogs)
-> WriterT WarningParserMonoid Parser (Maybe DumpLogs)
-> WriterT WarningParserMonoid Parser (First DumpLogs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text -> WriterT WarningParserMonoid Parser (Maybe DumpLogs)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidDumpLogsName
    First Bool
configMonoidSaveHackageCreds <- Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidSaveHackageCredsName
    First Text
configMonoidHackageBaseUrl <- 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
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidHackageBaseUrlName

    Maybe ColorWhen
configMonoidColorWhenUS <- Object
obj Object -> Text -> WarningParser (Maybe ColorWhen)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidColorWhenUSName
    Maybe ColorWhen
configMonoidColorWhenGB <- Object
obj Object -> Text -> WarningParser (Maybe ColorWhen)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidColorWhenGBName
    let configMonoidColorWhen :: First ColorWhen
configMonoidColorWhen =  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

    Maybe StylesUpdate
configMonoidStylesUS <- Object
obj Object -> Text -> WarningParser (Maybe StylesUpdate)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidStylesUSName
    Maybe StylesUpdate
configMonoidStylesGB <- Object
obj Object -> Text -> WarningParser (Maybe StylesUpdate)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidStylesGBName
    let configMonoidStyles :: StylesUpdate
configMonoidStyles = 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

    FirstTrue
configMonoidHideSourcePaths <- Maybe Bool -> FirstTrue
FirstTrue (Maybe Bool -> FirstTrue)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstTrue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidHideSourcePathsName
    FirstTrue
configMonoidRecommendUpgrade <- Maybe Bool -> FirstTrue
FirstTrue (Maybe Bool -> FirstTrue)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstTrue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidRecommendUpgradeName

    First CasaRepoPrefix
configMonoidCasaRepoPrefix <- Maybe CasaRepoPrefix -> First CasaRepoPrefix
forall a. Maybe a -> First a
First (Maybe CasaRepoPrefix -> First CasaRepoPrefix)
-> WriterT WarningParserMonoid Parser (Maybe CasaRepoPrefix)
-> WriterT WarningParserMonoid Parser (First CasaRepoPrefix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Text
-> WriterT WarningParserMonoid Parser (Maybe CasaRepoPrefix)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidCasaRepoPrefixName
    First Text
configMonoidSnapshotLocation <- 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
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidSnapshotLocationName
    FirstFalse
configMonoidNoRunCompile <- Maybe Bool -> FirstFalse
FirstFalse (Maybe Bool -> FirstFalse)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstFalse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidNoRunCompileName

    First Bool
configMonoidStackDeveloperMode <- Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
configMonoidStackDeveloperModeName

    ConfigMonoid -> WarningParser ConfigMonoid
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigMonoid {[[Char]]
[Text]
[Path Abs Dir]
Maybe AllowNewerDeps
Map Text Text
First Bool
First Int
First [Char]
First [PackageIndexConfig]
First CasaRepoPrefix
First Text
First PackageIndexConfig
First (Path Abs File)
First (Path Abs Dir)
First (Path Rel Dir)
First CompilerBuild
First TemplateName
First VersionCheck
First CompilerRepository
First PvpBounds
First GHCVariant
First SCM
First DumpLogs
First ApplyGhcOptions
First ColorWhen
StylesUpdate
FirstFalse
FirstTrue
MonoidMap PackageName (Dual [Text])
MonoidMap ApplyGhcOptions (Dual [Text])
MonoidMap CabalConfigKey (Dual [Text])
BuildOptsMonoid
NixOptsMonoid
IntersectingVersionRange
DockerOptsMonoid
SetupInfo
forall {a}. First a
configMonoidStackRoot :: First (Path Abs Dir)
configMonoidWorkDir :: First (Path Rel Dir)
configMonoidBuildOpts :: BuildOptsMonoid
configMonoidDockerOpts :: DockerOptsMonoid
configMonoidNixOpts :: NixOptsMonoid
configMonoidConnectionCount :: First Int
configMonoidHideTHLoading :: FirstTrue
configMonoidPrefixTimestamps :: First Bool
configMonoidLatestSnapshot :: First Text
configMonoidPackageIndex :: First PackageIndexConfig
configMonoidPackageIndices :: First [PackageIndexConfig]
configMonoidSystemGHC :: First Bool
configMonoidInstallGHC :: FirstTrue
configMonoidSkipGHCCheck :: FirstFalse
configMonoidSkipMsys :: FirstFalse
configMonoidCompilerCheck :: First VersionCheck
configMonoidCompilerRepository :: First CompilerRepository
configMonoidRequireStackVersion :: IntersectingVersionRange
configMonoidArch :: First [Char]
configMonoidGHCVariant :: First GHCVariant
configMonoidGHCBuild :: First CompilerBuild
configMonoidJobs :: First Int
configMonoidExtraIncludeDirs :: [[Char]]
configMonoidExtraLibDirs :: [[Char]]
configMonoidCustomPreprocessorExts :: [Text]
configMonoidOverrideGccPath :: First (Path Abs File)
configMonoidOverrideHpack :: First [Char]
configMonoidConcurrentTests :: First Bool
configMonoidLocalBinPath :: First [Char]
configMonoidTemplateParameters :: Map Text Text
configMonoidScmInit :: First SCM
configMonoidGhcOptionsByName :: MonoidMap PackageName (Dual [Text])
configMonoidGhcOptionsByCat :: MonoidMap ApplyGhcOptions (Dual [Text])
configMonoidCabalConfigOpts :: MonoidMap CabalConfigKey (Dual [Text])
configMonoidExtraPath :: [Path Abs Dir]
configMonoidSetupInfoLocations :: [[Char]]
configMonoidSetupInfoInline :: SetupInfo
configMonoidLocalProgramsBase :: First (Path Abs Dir)
configMonoidPvpBounds :: First PvpBounds
configMonoidModifyCodePage :: FirstTrue
configMonoidRebuildGhcOptions :: FirstFalse
configMonoidApplyGhcOptions :: First ApplyGhcOptions
configMonoidAllowNewer :: First Bool
configMonoidAllowNewerDeps :: Maybe AllowNewerDeps
configMonoidDefaultTemplate :: First TemplateName
configMonoidAllowDifferentUser :: First Bool
configMonoidDumpLogs :: First DumpLogs
configMonoidSaveHackageCreds :: First Bool
configMonoidHackageBaseUrl :: First Text
configMonoidColorWhen :: First ColorWhen
configMonoidStyles :: StylesUpdate
configMonoidHideSourcePaths :: FirstTrue
configMonoidRecommendUpgrade :: FirstTrue
configMonoidCasaRepoPrefix :: First CasaRepoPrefix
configMonoidSnapshotLocation :: First Text
configMonoidNoRunCompile :: FirstFalse
configMonoidStackDeveloperMode :: First Bool
configMonoidStackRoot :: forall {a}. First a
configMonoidWorkDir :: First (Path Rel Dir)
configMonoidBuildOpts :: BuildOptsMonoid
configMonoidDockerOpts :: DockerOptsMonoid
configMonoidNixOpts :: NixOptsMonoid
configMonoidConnectionCount :: First Int
configMonoidHideTHLoading :: FirstTrue
configMonoidPrefixTimestamps :: First Bool
configMonoidLatestSnapshot :: First Text
configMonoidPackageIndex :: First PackageIndexConfig
configMonoidPackageIndices :: First [PackageIndexConfig]
configMonoidSystemGHC :: First Bool
configMonoidInstallGHC :: FirstTrue
configMonoidSkipGHCCheck :: FirstFalse
configMonoidSkipMsys :: FirstFalse
configMonoidRequireStackVersion :: IntersectingVersionRange
configMonoidArch :: First [Char]
configMonoidGHCVariant :: First GHCVariant
configMonoidGHCBuild :: First CompilerBuild
configMonoidJobs :: First Int
configMonoidExtraIncludeDirs :: [[Char]]
configMonoidExtraLibDirs :: [[Char]]
configMonoidCustomPreprocessorExts :: [Text]
configMonoidOverrideGccPath :: First (Path Abs File)
configMonoidOverrideHpack :: First [Char]
configMonoidConcurrentTests :: First Bool
configMonoidLocalBinPath :: First [Char]
configMonoidScmInit :: First SCM
configMonoidTemplateParameters :: Map Text Text
configMonoidCompilerCheck :: First VersionCheck
configMonoidCompilerRepository :: First CompilerRepository
configMonoidGhcOptionsByCat :: MonoidMap ApplyGhcOptions (Dual [Text])
configMonoidGhcOptionsByName :: MonoidMap PackageName (Dual [Text])
configMonoidCabalConfigOpts :: MonoidMap CabalConfigKey (Dual [Text])
configMonoidExtraPath :: [Path Abs Dir]
configMonoidSetupInfoLocations :: [[Char]]
configMonoidSetupInfoInline :: SetupInfo
configMonoidLocalProgramsBase :: First (Path Abs Dir)
configMonoidPvpBounds :: First PvpBounds
configMonoidModifyCodePage :: FirstTrue
configMonoidRebuildGhcOptions :: FirstFalse
configMonoidApplyGhcOptions :: First ApplyGhcOptions
configMonoidAllowNewer :: First Bool
configMonoidAllowNewerDeps :: Maybe AllowNewerDeps
configMonoidDefaultTemplate :: First TemplateName
configMonoidAllowDifferentUser :: First Bool
configMonoidDumpLogs :: First DumpLogs
configMonoidSaveHackageCreds :: First Bool
configMonoidHackageBaseUrl :: First Text
configMonoidColorWhen :: First ColorWhen
configMonoidStyles :: StylesUpdate
configMonoidHideSourcePaths :: FirstTrue
configMonoidRecommendUpgrade :: FirstTrue
configMonoidCasaRepoPrefix :: First CasaRepoPrefix
configMonoidSnapshotLocation :: First Text
configMonoidNoRunCompile :: FirstFalse
configMonoidStackDeveloperMode :: First Bool
..}

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"

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"

-- Deprecated in favour of package-index

configMonoidPackageIndicesName :: Text
configMonoidPackageIndicesName :: Text
configMonoidPackageIndicesName = Text
"package-indices"

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

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

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

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

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"

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

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

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"

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"

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

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

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"

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

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

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

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

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

packageIndicesWarning :: String
packageIndicesWarning :: [Char]
packageIndicesWarning =
    [Char]
"The 'package-indices' key is deprecated in favour of 'package-index'."

resolveOptions :: StyleDoc
resolveOptions :: StyleDoc
resolveOptions =
     [Char] -> StyleDoc
flow [Char]
"This may be resolved by:"
  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList
       [ [StyleDoc] -> StyleDoc
fillSep
           [ StyleDoc
"Using"
           , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--omit-packages"
           , StyleDoc
"to exclude mismatching package(s)."
           ]
       , [StyleDoc] -> StyleDoc
fillSep
           [ StyleDoc
"Using"
           , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--resolver"
           , StyleDoc
"to specify a matching snapshot/resolver."
           ]
       ]

-- | 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 Config -> Text
configLatestSnapshot

-- | @".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 Config -> Path Rel Dir
configWorkDir (\Config
x Path Rel Dir
y -> Config
x { configWorkDir :: Path Rel Dir
configWorkDir = Path Rel Dir
y })

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

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

-- | Per-project work dir

getProjectWorkDir :: (HasBuildConfig env, MonadReader env m) => m (Path Abs Dir)
getProjectWorkDir :: forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir = do
    Path Abs Dir
root    <- Getting (Path Abs Dir) env (Path Abs Dir) -> m (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)
forall env r. HasBuildConfig env => Getting r env (Path Abs Dir)
projectRootL
    Path Rel Dir
workDir <- Getting (Path Rel Dir) env (Path Rel Dir) -> m (Path Rel Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Rel Dir) env (Path Rel Dir)
forall env. HasConfig env => Lens' env (Path Rel Dir)
Lens' env (Path Rel Dir)
workDirL
    Path Abs Dir -> m (Path Abs Dir)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir
root Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
workDir)

-- | Relative directory for the platform identifier

platformOnlyRelDir
    :: (MonadReader env m, HasPlatform env, MonadThrow m)
    => m (Path Rel Dir)
platformOnlyRelDir :: forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, MonadThrow m) =>
m (Path Rel Dir)
platformOnlyRelDir = do
    Platform
platform <- Getting Platform env Platform -> m Platform
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Platform env Platform
forall env. HasPlatform env => Lens' env Platform
Lens' env Platform
platformL
    PlatformVariant
platformVariant <- Getting PlatformVariant env PlatformVariant -> m PlatformVariant
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PlatformVariant env PlatformVariant
forall env. HasPlatform env => Lens' env PlatformVariant
Lens' env PlatformVariant
platformVariantL
    [Char] -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir (Platform -> [Char]
forall a. Pretty a => a -> [Char]
Distribution.Text.display Platform
platform [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PlatformVariant -> [Char]
platformVariantSuffix PlatformVariant
platformVariant)

-- | Directory containing snapshots

snapshotsDir :: (MonadReader env m, HasEnvConfig env, MonadThrow m) => m (Path Abs Dir)
snapshotsDir :: forall env (m :: * -> *).
(MonadReader env m, HasEnvConfig env, MonadThrow m) =>
m (Path Abs Dir)
snapshotsDir = do
    Path Abs Dir
root <- Getting (Path Abs Dir) env (Path Abs Dir) -> m (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)
forall s. HasConfig s => Lens' s (Path Abs Dir)
Lens' env (Path Abs Dir)
stackRootL
    Path Rel Dir
platform <- m (Path Rel Dir)
forall env (m :: * -> *).
(MonadReader env m, HasEnvConfig env, MonadThrow m) =>
m (Path Rel Dir)
platformGhcRelDir
    Path Abs Dir -> m (Path Abs Dir)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir -> m (Path Abs Dir))
-> Path Abs Dir -> m (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirSnapshots Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
platform

-- | Installation root for dependencies

installationRootDeps :: (HasEnvConfig env) => RIO env (Path Abs Dir)
installationRootDeps :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps = do
    Path Abs Dir
root <- 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)
forall s. HasConfig s => Lens' s (Path Abs Dir)
Lens' env (Path Abs Dir)
stackRootL
    -- TODO: also useShaPathOnWindows here, once #1173 is resolved.

    Path Rel Dir
psc <- RIO env (Path Rel Dir)
forall env. HasEnvConfig env => RIO env (Path Rel Dir)
platformSnapAndCompilerRel
    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 -> RIO env (Path Abs Dir))
-> Path Abs Dir -> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirSnapshots Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
psc

-- | Installation root for locals

installationRootLocal :: (HasEnvConfig env) => RIO env (Path Abs Dir)
installationRootLocal :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal = do
    Path Abs Dir
workDir <- RIO env (Path Abs Dir)
forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir
    Path Rel Dir
psc <- Path Rel Dir -> RIO env (Path Rel Dir)
forall (m :: * -> *).
MonadThrow m =>
Path Rel Dir -> m (Path Rel Dir)
useShaPathOnWindows (Path Rel Dir -> RIO env (Path Rel Dir))
-> RIO env (Path Rel Dir) -> RIO env (Path Rel Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RIO env (Path Rel Dir)
forall env. HasEnvConfig env => RIO env (Path Rel Dir)
platformSnapAndCompilerRel
    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 -> RIO env (Path Abs Dir))
-> Path Abs Dir -> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
workDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirInstall Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
psc

-- | Installation root for compiler tools

bindirCompilerTools :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir)
bindirCompilerTools :: forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
m (Path Abs Dir)
bindirCompilerTools = do
    Config
config <- Getting Config env Config -> m 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
    Path Rel Dir
platform <- m (Path Rel Dir)
forall env (m :: * -> *).
(MonadReader env m, HasEnvConfig env, MonadThrow m) =>
m (Path Rel Dir)
platformGhcRelDir
    ActualCompiler
compilerVersion <- Getting ActualCompiler env ActualCompiler -> m ActualCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ActualCompiler env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
SimpleGetter env ActualCompiler
actualCompilerVersionL
    Path Rel Dir
compiler <- [Char] -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir ([Char] -> m (Path Rel Dir)) -> [Char] -> m (Path Rel Dir)
forall a b. (a -> b) -> a -> b
$ ActualCompiler -> [Char]
compilerVersionString ActualCompiler
compilerVersion
    Path Abs Dir -> m (Path Abs Dir)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir -> m (Path Abs Dir))
-> Path Abs Dir -> m (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$
        ((Path Abs Dir -> Const (Path Abs Dir) (Path Abs Dir))
 -> Config -> Const (Path Abs Dir) Config)
-> Config -> Path Abs Dir
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Path Abs Dir -> Const (Path Abs Dir) (Path Abs Dir))
-> Config -> Const (Path Abs Dir) Config
forall s. HasConfig s => Lens' s (Path Abs Dir)
Lens' Config (Path Abs Dir)
stackRootL Config
config Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>
        Path Rel Dir
relDirCompilerTools Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>
        Path Rel Dir
platform Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>
        Path Rel Dir
compiler Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>
        Path Rel Dir
bindirSuffix

-- | Hoogle directory.

hoogleRoot :: (HasEnvConfig env) => RIO env (Path Abs Dir)
hoogleRoot :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
hoogleRoot = do
    Path Abs Dir
workDir <- RIO env (Path Abs Dir)
forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir
    Path Rel Dir
psc <- Path Rel Dir -> RIO env (Path Rel Dir)
forall (m :: * -> *).
MonadThrow m =>
Path Rel Dir -> m (Path Rel Dir)
useShaPathOnWindows (Path Rel Dir -> RIO env (Path Rel Dir))
-> RIO env (Path Rel Dir) -> RIO env (Path Rel Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RIO env (Path Rel Dir)
forall env. HasEnvConfig env => RIO env (Path Rel Dir)
platformSnapAndCompilerRel
    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 -> RIO env (Path Abs Dir))
-> Path Abs Dir -> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
workDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirHoogle Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
psc

-- | Get the hoogle database path.

hoogleDatabasePath :: (HasEnvConfig env) => RIO env (Path Abs File)
hoogleDatabasePath :: forall env. HasEnvConfig env => RIO env (Path Abs File)
hoogleDatabasePath = do
    Path Abs Dir
dir <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
hoogleRoot
    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
dir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileDatabaseHoo)

-- | Path for platform followed by snapshot name followed by compiler

-- name.

platformSnapAndCompilerRel
    :: (HasEnvConfig env)
    => RIO env (Path Rel Dir)
platformSnapAndCompilerRel :: forall env. HasEnvConfig env => RIO env (Path Rel Dir)
platformSnapAndCompilerRel = do
    Path Rel Dir
platform <- RIO env (Path Rel Dir)
forall env (m :: * -> *).
(MonadReader env m, HasEnvConfig env, MonadThrow m) =>
m (Path Rel Dir)
platformGhcRelDir
    SourceMapHash
smh <- Getting SourceMapHash env SourceMapHash -> RIO env SourceMapHash
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting SourceMapHash env SourceMapHash -> RIO env SourceMapHash)
-> Getting SourceMapHash env SourceMapHash -> RIO env SourceMapHash
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const SourceMapHash EnvConfig)
-> env -> Const SourceMapHash env
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL((EnvConfig -> Const SourceMapHash EnvConfig)
 -> env -> Const SourceMapHash env)
-> ((SourceMapHash -> Const SourceMapHash SourceMapHash)
    -> EnvConfig -> Const SourceMapHash EnvConfig)
-> Getting SourceMapHash env SourceMapHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EnvConfig -> SourceMapHash)
-> SimpleGetter EnvConfig SourceMapHash
forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMapHash
envConfigSourceMapHash
    Path Rel Dir
name <- SourceMapHash -> RIO env (Path Rel Dir)
forall (m :: * -> *).
MonadThrow m =>
SourceMapHash -> m (Path Rel Dir)
smRelDir SourceMapHash
smh
    Path Rel Dir
ghc <- RIO env (Path Rel Dir)
forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
m (Path Rel Dir)
compilerVersionDir
    Path Rel Dir -> RIO env (Path Rel Dir)
forall (m :: * -> *).
MonadThrow m =>
Path Rel Dir -> m (Path Rel Dir)
useShaPathOnWindows (Path Rel Dir
platform Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
name Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
ghc)

-- | Relative directory for the platform and GHC identifier

platformGhcRelDir
    :: (MonadReader env m, HasEnvConfig env, MonadThrow m)
    => m (Path Rel Dir)
platformGhcRelDir :: forall env (m :: * -> *).
(MonadReader env m, HasEnvConfig env, MonadThrow m) =>
m (Path Rel Dir)
platformGhcRelDir = do
    CompilerPaths
cp <- Getting CompilerPaths env CompilerPaths -> m CompilerPaths
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CompilerPaths env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsL
    let cbSuffix :: [Char]
cbSuffix = CompilerBuild -> [Char]
compilerBuildSuffix (CompilerBuild -> [Char]) -> CompilerBuild -> [Char]
forall a b. (a -> b) -> a -> b
$ CompilerPaths -> CompilerBuild
cpBuild CompilerPaths
cp
    [Char]
verOnly <- m [Char]
forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, HasGHCVariant env) =>
m [Char]
platformGhcVerOnlyRelDirStr
    [Char] -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir ([[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat [ [Char]
verOnly, [Char]
cbSuffix ])

-- | Relative directory for the platform and GHC identifier without GHC bindist build

platformGhcVerOnlyRelDir
    :: (MonadReader env m, HasPlatform env, HasGHCVariant env, MonadThrow m)
    => m (Path Rel Dir)
platformGhcVerOnlyRelDir :: forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, HasGHCVariant env,
 MonadThrow m) =>
m (Path Rel Dir)
platformGhcVerOnlyRelDir =
    [Char] -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir ([Char] -> m (Path Rel Dir)) -> m [Char] -> m (Path Rel Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m [Char]
forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, HasGHCVariant env) =>
m [Char]
platformGhcVerOnlyRelDirStr

-- | Relative directory for the platform and GHC identifier without GHC bindist build

-- (before parsing into a Path)

platformGhcVerOnlyRelDirStr
    :: (MonadReader env m, HasPlatform env, HasGHCVariant env)
    => m FilePath
platformGhcVerOnlyRelDirStr :: forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, HasGHCVariant env) =>
m [Char]
platformGhcVerOnlyRelDirStr = do
    Platform
platform <- Getting Platform env Platform -> m Platform
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Platform env Platform
forall env. HasPlatform env => Lens' env Platform
Lens' env Platform
platformL
    PlatformVariant
platformVariant <- Getting PlatformVariant env PlatformVariant -> m PlatformVariant
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PlatformVariant env PlatformVariant
forall env. HasPlatform env => Lens' env PlatformVariant
Lens' env PlatformVariant
platformVariantL
    GHCVariant
ghcVariant <- Getting GHCVariant env GHCVariant -> m GHCVariant
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting GHCVariant env GHCVariant
forall env. HasGHCVariant env => SimpleGetter env GHCVariant
SimpleGetter env GHCVariant
ghcVariantL
    [Char] -> m [Char]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> m [Char]) -> [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat [ Platform -> [Char]
forall a. Pretty a => a -> [Char]
Distribution.Text.display Platform
platform
                     , PlatformVariant -> [Char]
platformVariantSuffix PlatformVariant
platformVariant
                     , GHCVariant -> [Char]
ghcVariantSuffix GHCVariant
ghcVariant ]

-- | This is an attempt to shorten Stack paths on Windows to decrease our

-- chances of hitting 260 symbol path limit. The idea is to calculate

-- SHA1 hash of the path used on other architectures, encode with base

-- 16 and take first 8 symbols of it.

useShaPathOnWindows :: MonadThrow m => Path Rel Dir -> m (Path Rel Dir)
useShaPathOnWindows :: forall (m :: * -> *).
MonadThrow m =>
Path Rel Dir -> m (Path Rel Dir)
useShaPathOnWindows
  | Bool
osIsWindows = Path Rel Dir -> m (Path Rel Dir)
forall t (m :: * -> *).
(IsPath Rel t, MonadThrow m) =>
Path Rel t -> m (Path Rel t)
shaPath
  | Bool
otherwise = Path Rel Dir -> m (Path Rel Dir)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

shaPath :: (IsPath Rel t, MonadThrow m) => Path Rel t -> m (Path Rel t)
shaPath :: forall t (m :: * -> *).
(IsPath Rel t, MonadThrow m) =>
Path Rel t -> m (Path Rel t)
shaPath = ByteString -> m (Path Rel t)
forall t (m :: * -> *).
(IsPath Rel t, MonadThrow m) =>
ByteString -> m (Path Rel t)
shaPathForBytes (ByteString -> m (Path Rel t))
-> (Path Rel t -> ByteString) -> Path Rel t -> m (Path Rel t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (Path Rel t -> Text) -> Path Rel t -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> (Path Rel t -> [Char]) -> Path Rel t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel t -> [Char]
forall b t. Path b t -> [Char]
toFilePath

shaPathForBytes :: (IsPath Rel t, MonadThrow m) => ByteString -> m (Path Rel t)
shaPathForBytes :: forall t (m :: * -> *).
(IsPath Rel t, MonadThrow m) =>
ByteString -> m (Path Rel t)
shaPathForBytes
    = [Char] -> m (Path Rel t)
forall b t (m :: * -> *).
(IsPath b t, MonadThrow m) =>
[Char] -> m (Path b t)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel t)
parsePath ([Char] -> m (Path Rel t))
-> (ByteString -> [Char]) -> ByteString -> m (Path Rel t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
S8.unpack (ByteString -> [Char])
-> (ByteString -> ByteString) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
S8.take Int
8
    (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
Mem.convertToBase Base
Mem.Base16 (Digest SHA1 -> ByteString)
-> (ByteString -> Digest SHA1) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA1 -> ByteString -> Digest SHA1
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
SHA1

-- TODO: Move something like this into the path package. Consider

-- subsuming path-io's 'AnyPath'?

class IsPath b t where
  parsePath :: MonadThrow m => FilePath -> m (Path b t)

instance IsPath Abs Dir where parsePath :: forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs Dir)
parsePath = [Char] -> m (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs Dir)
parseAbsDir
instance IsPath Rel Dir where parsePath :: forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parsePath = [Char] -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir
instance IsPath Abs File where parsePath :: forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parsePath = [Char] -> m (Path Abs File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parseAbsFile
instance IsPath Rel File where parsePath :: forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parsePath = [Char] -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile

compilerVersionDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Rel Dir)
compilerVersionDir :: forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
m (Path Rel Dir)
compilerVersionDir = do
    ActualCompiler
compilerVersion <- Getting ActualCompiler env ActualCompiler -> m ActualCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ActualCompiler env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
SimpleGetter env ActualCompiler
actualCompilerVersionL
    [Char] -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir ([Char] -> m (Path Rel Dir)) -> [Char] -> m (Path Rel Dir)
forall a b. (a -> b) -> a -> b
$ case ActualCompiler
compilerVersion of
        ACGhc Version
version -> Version -> [Char]
versionString Version
version
        ACGhcGit {} -> ActualCompiler -> [Char]
compilerVersionString ActualCompiler
compilerVersion

-- | Package database for installing dependencies into

packageDatabaseDeps :: (HasEnvConfig env) => RIO env (Path Abs Dir)
packageDatabaseDeps :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseDeps = do
    Path Abs Dir
root <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps
    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 -> RIO env (Path Abs Dir))
-> Path Abs Dir -> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirPkgdb

-- | Package database for installing local packages into

packageDatabaseLocal :: (HasEnvConfig env) => RIO env (Path Abs Dir)
packageDatabaseLocal :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseLocal = do
    Path Abs Dir
root <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
    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 -> RIO env (Path Abs Dir))
-> Path Abs Dir -> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirPkgdb

-- | Extra package databases

packageDatabaseExtra :: (MonadReader env m, HasEnvConfig env) => m [Path Abs Dir]
packageDatabaseExtra :: forall env (m :: * -> *).
(MonadReader env m, HasEnvConfig env) =>
m [Path Abs Dir]
packageDatabaseExtra = Getting [Path Abs Dir] env [Path Abs Dir] -> m [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] -> m [Path Abs Dir])
-> Getting [Path Abs Dir] env [Path Abs Dir] -> m [Path Abs Dir]
forall a b. (a -> b) -> a -> b
$ (BuildConfig -> Const [Path Abs Dir] BuildConfig)
-> env -> Const [Path Abs Dir] env
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' env BuildConfig
buildConfigL((BuildConfig -> Const [Path Abs Dir] BuildConfig)
 -> env -> Const [Path Abs Dir] env)
-> (([Path Abs Dir] -> Const [Path Abs Dir] [Path Abs Dir])
    -> BuildConfig -> Const [Path Abs Dir] BuildConfig)
-> Getting [Path Abs Dir] env [Path Abs Dir]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BuildConfig -> [Path Abs Dir])
-> SimpleGetter BuildConfig [Path Abs Dir]
forall s a. (s -> a) -> SimpleGetter s a
to BuildConfig -> [Path Abs Dir]
bcExtraPackageDBs

-- | Where do we get information on global packages for loading up a

-- 'LoadedSnapshot'?

data GlobalInfoSource
  = GISSnapshotHints
  -- ^ Accept the hints in the snapshot definition

  | GISCompiler ActualCompiler
  -- ^ Look up the actual information in the installed compiler


-- | Where HPC reports and tix files get stored.

hpcReportDir :: (HasEnvConfig env)
             => RIO env (Path Abs Dir)
hpcReportDir :: forall env. HasEnvConfig env => RIO env (Path Abs Dir)
hpcReportDir = do
   Path Abs Dir
root <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
   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 -> RIO env (Path Abs Dir))
-> Path Abs Dir -> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirHpc

-- | Get the extra bin directories (for the PATH). Puts more local first

--

-- Bool indicates whether or not to include the locals

extraBinDirs :: (HasEnvConfig env)
             => RIO env (Bool -> [Path Abs Dir])
extraBinDirs :: forall env. HasEnvConfig env => RIO env (Bool -> [Path Abs Dir])
extraBinDirs = do
    Path Abs Dir
deps <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps
    Path Abs Dir
local' <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
    Path Abs Dir
tools <- RIO env (Path Abs Dir)
forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
m (Path Abs Dir)
bindirCompilerTools
    (Bool -> [Path Abs Dir]) -> RIO env (Bool -> [Path Abs Dir])
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bool -> [Path Abs Dir]) -> RIO env (Bool -> [Path Abs Dir]))
-> (Bool -> [Path Abs Dir]) -> RIO env (Bool -> [Path Abs Dir])
forall a b. (a -> b) -> a -> b
$ \Bool
locals -> if Bool
locals
        then [Path Abs Dir
local' Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindirSuffix, Path Abs Dir
deps Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindirSuffix, Path Abs Dir
tools]
        else [Path Abs Dir
deps Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindirSuffix, Path Abs Dir
tools]

minimalEnvSettings :: EnvSettings
minimalEnvSettings :: EnvSettings
minimalEnvSettings =
    EnvSettings
    { esIncludeLocals :: Bool
esIncludeLocals = Bool
False
    , esIncludeGhcPackagePath :: Bool
esIncludeGhcPackagePath = Bool
False
    , esStackExe :: Bool
esStackExe = Bool
False
    , esLocaleUtf8 :: Bool
esLocaleUtf8 = Bool
False
    , esKeepGhcRts :: Bool
esKeepGhcRts = Bool
False
    }

-- | Default @EnvSettings@ which includes locals and GHC_PACKAGE_PATH.

--

-- Note that this also passes through the GHCRTS environment variable.

-- See https://github.com/commercialhaskell/stack/issues/3444

defaultEnvSettings :: EnvSettings
defaultEnvSettings :: EnvSettings
defaultEnvSettings = EnvSettings
    { esIncludeLocals :: Bool
esIncludeLocals = Bool
True
    , esIncludeGhcPackagePath :: Bool
esIncludeGhcPackagePath = Bool
True
    , esStackExe :: Bool
esStackExe = Bool
True
    , esLocaleUtf8 :: Bool
esLocaleUtf8 = Bool
False
    , esKeepGhcRts :: Bool
esKeepGhcRts = Bool
True
    }

-- | Environment settings which do not embellish the environment

--

-- Note that this also passes through the GHCRTS environment variable.

-- See https://github.com/commercialhaskell/stack/issues/3444

plainEnvSettings :: EnvSettings
plainEnvSettings :: EnvSettings
plainEnvSettings = EnvSettings
    { esIncludeLocals :: Bool
esIncludeLocals = Bool
False
    , esIncludeGhcPackagePath :: Bool
esIncludeGhcPackagePath = Bool
False
    , esStackExe :: Bool
esStackExe = Bool
False
    , esLocaleUtf8 :: Bool
esLocaleUtf8 = Bool
False
    , esKeepGhcRts :: Bool
esKeepGhcRts = Bool
True
    }

-- | Get the path for the given compiler ignoring any local binaries.

--

-- https://github.com/commercialhaskell/stack/issues/1052

getCompilerPath :: HasCompiler env => RIO env (Path Abs File)
getCompilerPath :: forall env. HasCompiler env => RIO env (Path Abs File)
getCompilerPath = Getting (Path Abs File) env (Path Abs File)
-> RIO env (Path Abs File)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Path Abs File) env (Path Abs File)
 -> RIO env (Path Abs File))
-> Getting (Path Abs File) env (Path Abs File)
-> RIO env (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Getting (Path Abs File) env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsLGetting (Path Abs File) env CompilerPaths
-> ((Path Abs File -> Const (Path Abs File) (Path Abs File))
    -> CompilerPaths -> Const (Path Abs File) CompilerPaths)
-> Getting (Path Abs File) env (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompilerPaths -> Path Abs File)
-> SimpleGetter CompilerPaths (Path Abs File)
forall s a. (s -> a) -> SimpleGetter s a
to CompilerPaths -> Path Abs File
cpCompiler

data ProjectAndConfigMonoid
  = ProjectAndConfigMonoid !Project !ConfigMonoid

parseProjectAndConfigMonoid :: Path Abs Dir -> Value -> Yaml.Parser (WithJSONWarnings (IO ProjectAndConfigMonoid))
parseProjectAndConfigMonoid :: Path Abs Dir
-> Value -> Parser (WithJSONWarnings (IO ProjectAndConfigMonoid))
parseProjectAndConfigMonoid Path Abs Dir
rootDir =
    [Char]
-> (Object -> WarningParser (IO ProjectAndConfigMonoid))
-> Value
-> Parser (WithJSONWarnings (IO ProjectAndConfigMonoid))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"ProjectAndConfigMonoid" ((Object -> WarningParser (IO ProjectAndConfigMonoid))
 -> Value -> Parser (WithJSONWarnings (IO ProjectAndConfigMonoid)))
-> (Object -> WarningParser (IO ProjectAndConfigMonoid))
-> Value
-> Parser (WithJSONWarnings (IO ProjectAndConfigMonoid))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [RelFilePath]
packages <- Object
o Object -> Text -> WarningParser (Maybe [RelFilePath])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"packages" WarningParser (Maybe [RelFilePath])
-> [RelFilePath] -> WarningParser [RelFilePath]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= [Text -> RelFilePath
RelFilePath Text
"."]
        [Unresolved (NonEmpty RawPackageLocation)]
deps <- WarningParser
  (Maybe
     [WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))])
-> WarningParser (Maybe [Unresolved (NonEmpty RawPackageLocation)])
forall (t :: * -> *) (u :: * -> *) a.
(Traversable t, Traversable u) =>
WarningParser (u (t (WithJSONWarnings a)))
-> WarningParser (u (t a))
jsonSubWarningsTT (Object
o Object
-> Text
-> WarningParser
     (Maybe
        [WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"extra-deps") WarningParser (Maybe [Unresolved (NonEmpty RawPackageLocation)])
-> [Unresolved (NonEmpty RawPackageLocation)]
-> WarningParser [Unresolved (NonEmpty RawPackageLocation)]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= []
        Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
flags' <- Object
o Object
-> Text
-> WarningParser
     (Maybe
        (Map (CabalString PackageName) (Map (CabalString FlagName) Bool)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"flags" WarningParser
  (Maybe
     (Map (CabalString PackageName) (Map (CabalString FlagName) Bool)))
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> WarningParser
     (Map (CabalString PackageName) (Map (CabalString FlagName) Bool))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall a. Monoid a => a
mempty
        let flags :: Map PackageName (Map FlagName Bool)
flags = Map (CabalString FlagName) Bool -> Map FlagName Bool
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap (Map (CabalString FlagName) Bool -> Map FlagName Bool)
-> Map PackageName (Map (CabalString FlagName) Bool)
-> Map PackageName (Map FlagName Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> Map PackageName (Map (CabalString FlagName) Bool)
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap
                    (Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
flags' :: Map (CabalString PackageName) (Map (CabalString FlagName) Bool))

        Unresolved RawSnapshotLocation
resolver <- WarningParser (WithJSONWarnings (Unresolved RawSnapshotLocation))
-> WarningParser (Unresolved RawSnapshotLocation)
forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings (WarningParser (WithJSONWarnings (Unresolved RawSnapshotLocation))
 -> WarningParser (Unresolved RawSnapshotLocation))
-> WarningParser
     (WithJSONWarnings (Unresolved RawSnapshotLocation))
-> WarningParser (Unresolved RawSnapshotLocation)
forall a b. (a -> b) -> a -> b
$ Object
o Object
-> [Text]
-> WarningParser
     (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a. FromJSON a => Object -> [Text] -> WarningParser a
...: [Text
"snapshot", Text
"resolver"]
        Maybe WantedCompiler
mcompiler <- Object
o Object -> Text -> WarningParser (Maybe WantedCompiler)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"compiler"
        Maybe [Char]
msg <- Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe [Char])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"user-message"
        ConfigMonoid
config <- Path Abs Dir -> Object -> WarningParser ConfigMonoid
parseConfigMonoidObject Path Abs Dir
rootDir Object
o
        [[Char]]
extraPackageDBs <- Object
o Object -> Text -> WarningParser (Maybe [[Char]])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"extra-package-dbs" WarningParser (Maybe [[Char]])
-> [[Char]] -> WriterT WarningParserMonoid Parser [[Char]]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= []
        Maybe Curator
mcurator <- WarningParser (Maybe (WithJSONWarnings Curator))
-> WarningParser (Maybe Curator)
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (Object
o Object -> Text -> WarningParser (Maybe (WithJSONWarnings Curator))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"curator")
        Set (CabalString PackageName)
drops <- Object
o Object
-> Text -> WarningParser (Maybe (Set (CabalString PackageName)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"drop-packages" WarningParser (Maybe (Set (CabalString PackageName)))
-> Set (CabalString PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Set (CabalString PackageName)
forall a. Monoid a => a
mempty
        IO ProjectAndConfigMonoid
-> WarningParser (IO ProjectAndConfigMonoid)
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO ProjectAndConfigMonoid
 -> WarningParser (IO ProjectAndConfigMonoid))
-> IO ProjectAndConfigMonoid
-> WarningParser (IO ProjectAndConfigMonoid)
forall a b. (a -> b) -> a -> b
$ do
          [NonEmpty RawPackageLocation]
deps' <- (Unresolved (NonEmpty RawPackageLocation)
 -> IO (NonEmpty RawPackageLocation))
-> [Unresolved (NonEmpty RawPackageLocation)]
-> IO [NonEmpty RawPackageLocation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe (Path Abs Dir)
-> Unresolved (NonEmpty RawPackageLocation)
-> IO (NonEmpty RawPackageLocation)
forall (m :: * -> *) a.
MonadIO m =>
Maybe (Path Abs Dir) -> Unresolved a -> m a
resolvePaths (Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
rootDir)) [Unresolved (NonEmpty RawPackageLocation)]
deps
          RawSnapshotLocation
resolver' <- Maybe (Path Abs Dir)
-> Unresolved RawSnapshotLocation -> IO RawSnapshotLocation
forall (m :: * -> *) a.
MonadIO m =>
Maybe (Path Abs Dir) -> Unresolved a -> m a
resolvePaths (Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
rootDir) Unresolved RawSnapshotLocation
resolver
          let project :: Project
project = Project
                  { projectUserMsg :: Maybe [Char]
projectUserMsg = Maybe [Char]
msg
                  , projectResolver :: RawSnapshotLocation
projectResolver = RawSnapshotLocation
resolver'
                  , projectCompiler :: Maybe WantedCompiler
projectCompiler = Maybe WantedCompiler
mcompiler -- FIXME make sure resolver' isn't SLCompiler

                  , projectExtraPackageDBs :: [[Char]]
projectExtraPackageDBs = [[Char]]
extraPackageDBs
                  , projectPackages :: [RelFilePath]
projectPackages = [RelFilePath]
packages
                  , projectDependencies :: [RawPackageLocation]
projectDependencies = (NonEmpty RawPackageLocation -> [RawPackageLocation])
-> [NonEmpty RawPackageLocation] -> [RawPackageLocation]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty RawPackageLocation -> [RawPackageLocation]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([NonEmpty RawPackageLocation]
deps' :: [NonEmpty RawPackageLocation])
                  , projectFlags :: Map PackageName (Map FlagName Bool)
projectFlags = Map PackageName (Map FlagName Bool)
flags
                  , projectCurator :: Maybe Curator
projectCurator = Maybe Curator
mcurator
                  , projectDropPackages :: Set PackageName
projectDropPackages = (CabalString PackageName -> PackageName)
-> Set (CabalString PackageName) -> Set PackageName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString Set (CabalString PackageName)
drops
                  }
          ProjectAndConfigMonoid -> IO ProjectAndConfigMonoid
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectAndConfigMonoid -> IO ProjectAndConfigMonoid)
-> ProjectAndConfigMonoid -> IO ProjectAndConfigMonoid
forall a b. (a -> b) -> a -> b
$ Project -> ConfigMonoid -> ProjectAndConfigMonoid
ProjectAndConfigMonoid Project
project ConfigMonoid
config

-- | A software control system.

data SCM = Git
  deriving (Int -> SCM -> ShowS
[SCM] -> ShowS
SCM -> [Char]
(Int -> SCM -> ShowS)
-> (SCM -> [Char]) -> ([SCM] -> ShowS) -> Show SCM
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SCM -> ShowS
showsPrec :: Int -> SCM -> ShowS
$cshow :: SCM -> [Char]
show :: SCM -> [Char]
$cshowList :: [SCM] -> ShowS
showList :: [SCM] -> ShowS
Show)

instance FromJSON SCM where
    parseJSON :: Value -> Parser SCM
parseJSON Value
v = do
        [Char]
s <- Value -> Parser [Char]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        case [Char]
s of
            [Char]
"git" -> SCM -> Parser SCM
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SCM
Git
            [Char]
_ -> [Char] -> Parser SCM
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Unknown or unsupported SCM: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
s)

instance ToJSON SCM where
    toJSON :: SCM -> Value
toJSON SCM
Git = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"git" :: Text)

-- | A variant of the platform, used to differentiate Docker builds from host

data PlatformVariant = PlatformVariantNone
                     | PlatformVariant String

-- | Render a platform variant to a String suffix.

platformVariantSuffix :: PlatformVariant -> String
platformVariantSuffix :: PlatformVariant -> [Char]
platformVariantSuffix PlatformVariant
PlatformVariantNone = [Char]
""
platformVariantSuffix (PlatformVariant [Char]
v) = [Char]
"-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
v

-- | Specialized variant of GHC (e.g. libgmp4 or integer-simple)

data GHCVariant
    = GHCStandard
    -- ^ Standard bindist

    | GHCIntegerSimple
    -- ^ Bindist that uses integer-simple

    | GHCNativeBignum
    -- ^ Bindist that uses the Haskell-native big-integer backend

    | GHCCustom String
    -- ^ Other bindists

    deriving (Int -> GHCVariant -> ShowS
[GHCVariant] -> ShowS
GHCVariant -> [Char]
(Int -> GHCVariant -> ShowS)
-> (GHCVariant -> [Char])
-> ([GHCVariant] -> ShowS)
-> Show GHCVariant
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GHCVariant -> ShowS
showsPrec :: Int -> GHCVariant -> ShowS
$cshow :: GHCVariant -> [Char]
show :: GHCVariant -> [Char]
$cshowList :: [GHCVariant] -> ShowS
showList :: [GHCVariant] -> ShowS
Show)

instance FromJSON GHCVariant where
    -- Strange structuring is to give consistent error messages

    parseJSON :: Value -> Parser GHCVariant
parseJSON =
        [Char] -> (Text -> Parser GHCVariant) -> Value -> Parser GHCVariant
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText
            [Char]
"GHCVariant"
            ((SomeException -> Parser GHCVariant)
-> (GHCVariant -> Parser GHCVariant)
-> Either SomeException GHCVariant
-> Parser GHCVariant
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Parser GHCVariant
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser GHCVariant)
-> (SomeException -> [Char]) -> SomeException -> Parser GHCVariant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
forall a. Show a => a -> [Char]
show) GHCVariant -> Parser GHCVariant
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException GHCVariant -> Parser GHCVariant)
-> (Text -> Either SomeException GHCVariant)
-> Text
-> Parser GHCVariant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either SomeException GHCVariant
forall (m :: * -> *). MonadThrow m => [Char] -> m GHCVariant
parseGHCVariant ([Char] -> Either SomeException GHCVariant)
-> (Text -> [Char]) -> Text -> Either SomeException GHCVariant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack)

-- | Render a GHC variant to a String.

ghcVariantName :: GHCVariant -> String
ghcVariantName :: GHCVariant -> [Char]
ghcVariantName GHCVariant
GHCStandard = [Char]
"standard"
ghcVariantName GHCVariant
GHCIntegerSimple = [Char]
"integersimple"
ghcVariantName GHCVariant
GHCNativeBignum = [Char]
"int-native"
ghcVariantName (GHCCustom [Char]
name) = [Char]
"custom-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name

-- | Render a GHC variant to a String suffix.

ghcVariantSuffix :: GHCVariant -> String
ghcVariantSuffix :: GHCVariant -> [Char]
ghcVariantSuffix GHCVariant
GHCStandard = [Char]
""
ghcVariantSuffix GHCVariant
v = [Char]
"-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ GHCVariant -> [Char]
ghcVariantName GHCVariant
v

-- | Parse GHC variant from a String.

parseGHCVariant :: (MonadThrow m) => String -> m GHCVariant
parseGHCVariant :: forall (m :: * -> *). MonadThrow m => [Char] -> m GHCVariant
parseGHCVariant [Char]
s =
    case [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"custom-" [Char]
s of
        Just [Char]
name -> GHCVariant -> m GHCVariant
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> GHCVariant
GHCCustom [Char]
name)
        Maybe [Char]
Nothing
          | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" -> GHCVariant -> m GHCVariant
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCVariant
GHCStandard
          | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"standard" -> GHCVariant -> m GHCVariant
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCVariant
GHCStandard
          | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"integersimple" -> GHCVariant -> m GHCVariant
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCVariant
GHCIntegerSimple
          | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"int-native" -> GHCVariant -> m GHCVariant
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCVariant
GHCNativeBignum
          | Bool
otherwise -> GHCVariant -> m GHCVariant
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> GHCVariant
GHCCustom [Char]
s)

-- | Build of the compiler distribution (e.g. standard, gmp4, tinfo6)

-- | Information for a file to download.

data DownloadInfo = DownloadInfo
    { DownloadInfo -> Text
downloadInfoUrl :: Text
      -- ^ URL or absolute file path

    , DownloadInfo -> Maybe Int
downloadInfoContentLength :: Maybe Int
    , DownloadInfo -> Maybe ByteString
downloadInfoSha1 :: Maybe ByteString
    , DownloadInfo -> Maybe ByteString
downloadInfoSha256 :: Maybe ByteString
    } deriving (Int -> DownloadInfo -> ShowS
[DownloadInfo] -> ShowS
DownloadInfo -> [Char]
(Int -> DownloadInfo -> ShowS)
-> (DownloadInfo -> [Char])
-> ([DownloadInfo] -> ShowS)
-> Show DownloadInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DownloadInfo -> ShowS
showsPrec :: Int -> DownloadInfo -> ShowS
$cshow :: DownloadInfo -> [Char]
show :: DownloadInfo -> [Char]
$cshowList :: [DownloadInfo] -> ShowS
showList :: [DownloadInfo] -> ShowS
Show)

instance FromJSON (WithJSONWarnings DownloadInfo) where
    parseJSON :: Value -> Parser (WithJSONWarnings DownloadInfo)
parseJSON = [Char]
-> (Object -> WarningParser DownloadInfo)
-> Value
-> Parser (WithJSONWarnings DownloadInfo)
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"DownloadInfo" Object -> WarningParser DownloadInfo
parseDownloadInfoFromObject

-- | Parse JSON in existing object for 'DownloadInfo'

parseDownloadInfoFromObject :: Object -> WarningParser DownloadInfo
parseDownloadInfoFromObject :: Object -> WarningParser DownloadInfo
parseDownloadInfoFromObject Object
o = do
    Text
url <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url"
    Maybe Int
contentLength <- Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"content-length"
    Maybe Text
sha1TextMay <- Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha1"
    Maybe Text
sha256TextMay <- Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
    DownloadInfo -> WarningParser DownloadInfo
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        DownloadInfo
        { downloadInfoUrl :: Text
downloadInfoUrl = Text
url
        , downloadInfoContentLength :: Maybe Int
downloadInfoContentLength = Maybe Int
contentLength
        , downloadInfoSha1 :: Maybe ByteString
downloadInfoSha1 = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8 Maybe Text
sha1TextMay
        , downloadInfoSha256 :: Maybe ByteString
downloadInfoSha256 = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8 Maybe Text
sha256TextMay
        }

data VersionedDownloadInfo = VersionedDownloadInfo
    { VersionedDownloadInfo -> Version
vdiVersion :: Version
    , VersionedDownloadInfo -> DownloadInfo
vdiDownloadInfo :: DownloadInfo
    }
    deriving Int -> VersionedDownloadInfo -> ShowS
[VersionedDownloadInfo] -> ShowS
VersionedDownloadInfo -> [Char]
(Int -> VersionedDownloadInfo -> ShowS)
-> (VersionedDownloadInfo -> [Char])
-> ([VersionedDownloadInfo] -> ShowS)
-> Show VersionedDownloadInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionedDownloadInfo -> ShowS
showsPrec :: Int -> VersionedDownloadInfo -> ShowS
$cshow :: VersionedDownloadInfo -> [Char]
show :: VersionedDownloadInfo -> [Char]
$cshowList :: [VersionedDownloadInfo] -> ShowS
showList :: [VersionedDownloadInfo] -> ShowS
Show

instance FromJSON (WithJSONWarnings VersionedDownloadInfo) where
    parseJSON :: Value -> Parser (WithJSONWarnings VersionedDownloadInfo)
parseJSON = [Char]
-> (Object -> WarningParser VersionedDownloadInfo)
-> Value
-> Parser (WithJSONWarnings VersionedDownloadInfo)
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"VersionedDownloadInfo" ((Object -> WarningParser VersionedDownloadInfo)
 -> Value -> Parser (WithJSONWarnings VersionedDownloadInfo))
-> (Object -> WarningParser VersionedDownloadInfo)
-> Value
-> Parser (WithJSONWarnings VersionedDownloadInfo)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        CabalString Version
version <- Object
o Object -> Text -> WarningParser (CabalString Version)
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"version"
        DownloadInfo
downloadInfo <- Object -> WarningParser DownloadInfo
parseDownloadInfoFromObject Object
o
        VersionedDownloadInfo -> WarningParser VersionedDownloadInfo
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionedDownloadInfo
            { vdiVersion :: Version
vdiVersion = Version
version
            , vdiDownloadInfo :: DownloadInfo
vdiDownloadInfo = DownloadInfo
downloadInfo
            }

data GHCDownloadInfo = GHCDownloadInfo
    { GHCDownloadInfo -> [Text]
gdiConfigureOpts :: [Text]
    , GHCDownloadInfo -> Map Text Text
gdiConfigureEnv :: Map Text Text
    , GHCDownloadInfo -> DownloadInfo
gdiDownloadInfo :: DownloadInfo
    }
    deriving Int -> GHCDownloadInfo -> ShowS
[GHCDownloadInfo] -> ShowS
GHCDownloadInfo -> [Char]
(Int -> GHCDownloadInfo -> ShowS)
-> (GHCDownloadInfo -> [Char])
-> ([GHCDownloadInfo] -> ShowS)
-> Show GHCDownloadInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GHCDownloadInfo -> ShowS
showsPrec :: Int -> GHCDownloadInfo -> ShowS
$cshow :: GHCDownloadInfo -> [Char]
show :: GHCDownloadInfo -> [Char]
$cshowList :: [GHCDownloadInfo] -> ShowS
showList :: [GHCDownloadInfo] -> ShowS
Show

instance FromJSON (WithJSONWarnings GHCDownloadInfo) where
    parseJSON :: Value -> Parser (WithJSONWarnings GHCDownloadInfo)
parseJSON = [Char]
-> (Object -> WarningParser GHCDownloadInfo)
-> Value
-> Parser (WithJSONWarnings GHCDownloadInfo)
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"GHCDownloadInfo" ((Object -> WarningParser GHCDownloadInfo)
 -> Value -> Parser (WithJSONWarnings GHCDownloadInfo))
-> (Object -> WarningParser GHCDownloadInfo)
-> Value
-> Parser (WithJSONWarnings GHCDownloadInfo)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [Text]
configureOpts <- Object
o Object -> Text -> WarningParser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"configure-opts" WarningParser (Maybe [Text]) -> [Text] -> WarningParser [Text]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= [Text]
forall a. Monoid a => a
mempty
        Map Text Text
configureEnv <- Object
o Object -> Text -> WarningParser (Maybe (Map Text Text))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"configure-env" WarningParser (Maybe (Map Text Text))
-> Map Text Text -> WarningParser (Map Text Text)
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map Text Text
forall a. Monoid a => a
mempty
        DownloadInfo
downloadInfo <- Object -> WarningParser DownloadInfo
parseDownloadInfoFromObject Object
o
        GHCDownloadInfo -> WarningParser GHCDownloadInfo
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCDownloadInfo
            { gdiConfigureOpts :: [Text]
gdiConfigureOpts = [Text]
configureOpts
            , gdiConfigureEnv :: Map Text Text
gdiConfigureEnv = Map Text Text
configureEnv
            , gdiDownloadInfo :: DownloadInfo
gdiDownloadInfo = DownloadInfo
downloadInfo
            }

data SetupInfo = SetupInfo
    { SetupInfo -> Maybe DownloadInfo
siSevenzExe :: Maybe DownloadInfo
    , SetupInfo -> Maybe DownloadInfo
siSevenzDll :: Maybe DownloadInfo
    , SetupInfo -> Map Text VersionedDownloadInfo
siMsys2 :: Map Text VersionedDownloadInfo
    , SetupInfo -> Map Text (Map Version GHCDownloadInfo)
siGHCs :: Map Text (Map Version GHCDownloadInfo)
    , SetupInfo -> Map Text (Map Version DownloadInfo)
siStack :: Map Text (Map Version DownloadInfo)
    }
    deriving Int -> SetupInfo -> ShowS
[SetupInfo] -> ShowS
SetupInfo -> [Char]
(Int -> SetupInfo -> ShowS)
-> (SetupInfo -> [Char])
-> ([SetupInfo] -> ShowS)
-> Show SetupInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetupInfo -> ShowS
showsPrec :: Int -> SetupInfo -> ShowS
$cshow :: SetupInfo -> [Char]
show :: SetupInfo -> [Char]
$cshowList :: [SetupInfo] -> ShowS
showList :: [SetupInfo] -> ShowS
Show

instance FromJSON (WithJSONWarnings SetupInfo) where
    parseJSON :: Value -> Parser (WithJSONWarnings SetupInfo)
parseJSON = [Char]
-> (Object -> WarningParser SetupInfo)
-> Value
-> Parser (WithJSONWarnings SetupInfo)
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"SetupInfo" ((Object -> WarningParser SetupInfo)
 -> Value -> Parser (WithJSONWarnings SetupInfo))
-> (Object -> WarningParser SetupInfo)
-> Value
-> Parser (WithJSONWarnings SetupInfo)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Maybe DownloadInfo
siSevenzExe <- WarningParser (Maybe (WithJSONWarnings DownloadInfo))
-> WarningParser (Maybe DownloadInfo)
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (Object
o Object
-> Text -> WarningParser (Maybe (WithJSONWarnings DownloadInfo))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sevenzexe-info")
        Maybe DownloadInfo
siSevenzDll <- WarningParser (Maybe (WithJSONWarnings DownloadInfo))
-> WarningParser (Maybe DownloadInfo)
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (Object
o Object
-> Text -> WarningParser (Maybe (WithJSONWarnings DownloadInfo))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sevenzdll-info")
        Map Text VersionedDownloadInfo
siMsys2 <- WarningParser (Map Text (WithJSONWarnings VersionedDownloadInfo))
-> WarningParser (Map Text VersionedDownloadInfo)
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (Object
o Object
-> Text
-> WarningParser
     (Maybe (Map Text (WithJSONWarnings VersionedDownloadInfo)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"msys2" WarningParser
  (Maybe (Map Text (WithJSONWarnings VersionedDownloadInfo)))
-> Map Text (WithJSONWarnings VersionedDownloadInfo)
-> WarningParser
     (Map Text (WithJSONWarnings VersionedDownloadInfo))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map Text (WithJSONWarnings VersionedDownloadInfo)
forall a. Monoid a => a
mempty)
        ((Map (CabalString Version) GHCDownloadInfo
 -> Map Version GHCDownloadInfo)
-> Map Text (Map (CabalString Version) GHCDownloadInfo)
-> Map Text (Map Version GHCDownloadInfo)
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map (CabalString Version) GHCDownloadInfo
-> Map Version GHCDownloadInfo
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap -> Map Text (Map Version GHCDownloadInfo)
siGHCs) <- WarningParser
  (Map
     Text
     (Map (CabalString Version) (WithJSONWarnings GHCDownloadInfo)))
-> WarningParser
     (Map Text (Map (CabalString Version) GHCDownloadInfo))
forall (t :: * -> *) (u :: * -> *) a.
(Traversable t, Traversable u) =>
WarningParser (u (t (WithJSONWarnings a)))
-> WarningParser (u (t a))
jsonSubWarningsTT (Object
o Object
-> Text
-> WarningParser
     (Maybe
        (Map
           Text
           (Map (CabalString Version) (WithJSONWarnings GHCDownloadInfo))))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"ghc" WarningParser
  (Maybe
     (Map
        Text
        (Map (CabalString Version) (WithJSONWarnings GHCDownloadInfo))))
-> Map
     Text (Map (CabalString Version) (WithJSONWarnings GHCDownloadInfo))
-> WarningParser
     (Map
        Text
        (Map (CabalString Version) (WithJSONWarnings GHCDownloadInfo)))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map
  Text (Map (CabalString Version) (WithJSONWarnings GHCDownloadInfo))
forall a. Monoid a => a
mempty)
        ((Map (CabalString Version) DownloadInfo
 -> Map Version DownloadInfo)
-> Map Text (Map (CabalString Version) DownloadInfo)
-> Map Text (Map Version DownloadInfo)
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map (CabalString Version) DownloadInfo -> Map Version DownloadInfo
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap -> Map Text (Map Version DownloadInfo)
siStack) <- WarningParser
  (Map
     Text (Map (CabalString Version) (WithJSONWarnings DownloadInfo)))
-> WarningParser
     (Map Text (Map (CabalString Version) DownloadInfo))
forall (t :: * -> *) (u :: * -> *) a.
(Traversable t, Traversable u) =>
WarningParser (u (t (WithJSONWarnings a)))
-> WarningParser (u (t a))
jsonSubWarningsTT (Object
o Object
-> Text
-> WarningParser
     (Maybe
        (Map
           Text (Map (CabalString Version) (WithJSONWarnings DownloadInfo))))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"stack" WarningParser
  (Maybe
     (Map
        Text (Map (CabalString Version) (WithJSONWarnings DownloadInfo))))
-> Map
     Text (Map (CabalString Version) (WithJSONWarnings DownloadInfo))
-> WarningParser
     (Map
        Text (Map (CabalString Version) (WithJSONWarnings DownloadInfo)))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map
  Text (Map (CabalString Version) (WithJSONWarnings DownloadInfo))
forall a. Monoid a => a
mempty)
        SetupInfo -> WarningParser SetupInfo
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SetupInfo {Maybe DownloadInfo
Map Text (Map Version GHCDownloadInfo)
Map Text (Map Version DownloadInfo)
Map Text VersionedDownloadInfo
siSevenzExe :: Maybe DownloadInfo
siSevenzDll :: Maybe DownloadInfo
siMsys2 :: Map Text VersionedDownloadInfo
siGHCs :: Map Text (Map Version GHCDownloadInfo)
siStack :: Map Text (Map Version DownloadInfo)
siSevenzExe :: Maybe DownloadInfo
siSevenzDll :: Maybe DownloadInfo
siMsys2 :: Map Text VersionedDownloadInfo
siGHCs :: Map Text (Map Version GHCDownloadInfo)
siStack :: Map Text (Map Version DownloadInfo)
..}

-- | For the @siGHCs@ field maps are deeply merged.

-- For all fields the values from the first @SetupInfo@ win.

instance Semigroup SetupInfo where
    SetupInfo
l <> :: SetupInfo -> SetupInfo -> SetupInfo
<> SetupInfo
r =
        SetupInfo
        { siSevenzExe :: Maybe DownloadInfo
siSevenzExe = SetupInfo -> Maybe DownloadInfo
siSevenzExe SetupInfo
l Maybe DownloadInfo -> Maybe DownloadInfo -> Maybe DownloadInfo
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SetupInfo -> Maybe DownloadInfo
siSevenzExe SetupInfo
r
        , siSevenzDll :: Maybe DownloadInfo
siSevenzDll = SetupInfo -> Maybe DownloadInfo
siSevenzDll SetupInfo
l Maybe DownloadInfo -> Maybe DownloadInfo -> Maybe DownloadInfo
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SetupInfo -> Maybe DownloadInfo
siSevenzDll SetupInfo
r
        , siMsys2 :: Map Text VersionedDownloadInfo
siMsys2 = SetupInfo -> Map Text VersionedDownloadInfo
siMsys2 SetupInfo
l Map Text VersionedDownloadInfo
-> Map Text VersionedDownloadInfo -> Map Text VersionedDownloadInfo
forall a. Semigroup a => a -> a -> a
<> SetupInfo -> Map Text VersionedDownloadInfo
siMsys2 SetupInfo
r
        , siGHCs :: Map Text (Map Version GHCDownloadInfo)
siGHCs = (Map Version GHCDownloadInfo
 -> Map Version GHCDownloadInfo -> Map Version GHCDownloadInfo)
-> Map Text (Map Version GHCDownloadInfo)
-> Map Text (Map Version GHCDownloadInfo)
-> Map Text (Map Version GHCDownloadInfo)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map Version GHCDownloadInfo
-> Map Version GHCDownloadInfo -> Map Version GHCDownloadInfo
forall a. Semigroup a => a -> a -> a
(<>) (SetupInfo -> Map Text (Map Version GHCDownloadInfo)
siGHCs SetupInfo
l) (SetupInfo -> Map Text (Map Version GHCDownloadInfo)
siGHCs SetupInfo
r)
        , siStack :: Map Text (Map Version DownloadInfo)
siStack = (Map Version DownloadInfo
 -> Map Version DownloadInfo -> Map Version DownloadInfo)
-> Map Text (Map Version DownloadInfo)
-> Map Text (Map Version DownloadInfo)
-> Map Text (Map Version DownloadInfo)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map Version DownloadInfo
-> Map Version DownloadInfo -> Map Version DownloadInfo
forall a. Semigroup a => a -> a -> a
(<>) (SetupInfo -> Map Text (Map Version DownloadInfo)
siStack SetupInfo
l) (SetupInfo -> Map Text (Map Version DownloadInfo)
siStack SetupInfo
r) }

instance Monoid SetupInfo where
    mempty :: SetupInfo
mempty =
        SetupInfo
        { siSevenzExe :: Maybe DownloadInfo
siSevenzExe = Maybe DownloadInfo
forall a. Maybe a
Nothing
        , siSevenzDll :: Maybe DownloadInfo
siSevenzDll = Maybe DownloadInfo
forall a. Maybe a
Nothing
        , siMsys2 :: Map Text VersionedDownloadInfo
siMsys2 = Map Text VersionedDownloadInfo
forall k a. Map k a
Map.empty
        , siGHCs :: Map Text (Map Version GHCDownloadInfo)
siGHCs = Map Text (Map Version GHCDownloadInfo)
forall k a. Map k a
Map.empty
        , siStack :: Map Text (Map Version DownloadInfo)
siStack = Map Text (Map Version DownloadInfo)
forall k a. Map k a
Map.empty
        }
    mappend :: SetupInfo -> SetupInfo -> SetupInfo
mappend = SetupInfo -> SetupInfo -> SetupInfo
forall a. Semigroup a => a -> a -> a
(<>)

-- | How PVP bounds should be added to .cabal files

data PvpBoundsType
  = PvpBoundsNone
  | PvpBoundsUpper
  | PvpBoundsLower
  | PvpBoundsBoth
  deriving (Int -> PvpBoundsType -> ShowS
[PvpBoundsType] -> ShowS
PvpBoundsType -> [Char]
(Int -> PvpBoundsType -> ShowS)
-> (PvpBoundsType -> [Char])
-> ([PvpBoundsType] -> ShowS)
-> Show PvpBoundsType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PvpBoundsType -> ShowS
showsPrec :: Int -> PvpBoundsType -> ShowS
$cshow :: PvpBoundsType -> [Char]
show :: PvpBoundsType -> [Char]
$cshowList :: [PvpBoundsType] -> ShowS
showList :: [PvpBoundsType] -> ShowS
Show, ReadPrec [PvpBoundsType]
ReadPrec PvpBoundsType
Int -> ReadS PvpBoundsType
ReadS [PvpBoundsType]
(Int -> ReadS PvpBoundsType)
-> ReadS [PvpBoundsType]
-> ReadPrec PvpBoundsType
-> ReadPrec [PvpBoundsType]
-> Read PvpBoundsType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PvpBoundsType
readsPrec :: Int -> ReadS PvpBoundsType
$creadList :: ReadS [PvpBoundsType]
readList :: ReadS [PvpBoundsType]
$creadPrec :: ReadPrec PvpBoundsType
readPrec :: ReadPrec PvpBoundsType
$creadListPrec :: ReadPrec [PvpBoundsType]
readListPrec :: ReadPrec [PvpBoundsType]
Read, PvpBoundsType -> PvpBoundsType -> Bool
(PvpBoundsType -> PvpBoundsType -> Bool)
-> (PvpBoundsType -> PvpBoundsType -> Bool) -> Eq PvpBoundsType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PvpBoundsType -> PvpBoundsType -> Bool
== :: PvpBoundsType -> PvpBoundsType -> Bool
$c/= :: PvpBoundsType -> PvpBoundsType -> Bool
/= :: PvpBoundsType -> PvpBoundsType -> Bool
Eq, Typeable, Eq PvpBoundsType
Eq PvpBoundsType
-> (PvpBoundsType -> PvpBoundsType -> Ordering)
-> (PvpBoundsType -> PvpBoundsType -> Bool)
-> (PvpBoundsType -> PvpBoundsType -> Bool)
-> (PvpBoundsType -> PvpBoundsType -> Bool)
-> (PvpBoundsType -> PvpBoundsType -> Bool)
-> (PvpBoundsType -> PvpBoundsType -> PvpBoundsType)
-> (PvpBoundsType -> PvpBoundsType -> PvpBoundsType)
-> Ord PvpBoundsType
PvpBoundsType -> PvpBoundsType -> Bool
PvpBoundsType -> PvpBoundsType -> Ordering
PvpBoundsType -> PvpBoundsType -> PvpBoundsType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PvpBoundsType -> PvpBoundsType -> Ordering
compare :: PvpBoundsType -> PvpBoundsType -> Ordering
$c< :: PvpBoundsType -> PvpBoundsType -> Bool
< :: PvpBoundsType -> PvpBoundsType -> Bool
$c<= :: PvpBoundsType -> PvpBoundsType -> Bool
<= :: PvpBoundsType -> PvpBoundsType -> Bool
$c> :: PvpBoundsType -> PvpBoundsType -> Bool
> :: PvpBoundsType -> PvpBoundsType -> Bool
$c>= :: PvpBoundsType -> PvpBoundsType -> Bool
>= :: PvpBoundsType -> PvpBoundsType -> Bool
$cmax :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
max :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
$cmin :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
min :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
Ord, Int -> PvpBoundsType
PvpBoundsType -> Int
PvpBoundsType -> [PvpBoundsType]
PvpBoundsType -> PvpBoundsType
PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
PvpBoundsType -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
(PvpBoundsType -> PvpBoundsType)
-> (PvpBoundsType -> PvpBoundsType)
-> (Int -> PvpBoundsType)
-> (PvpBoundsType -> Int)
-> (PvpBoundsType -> [PvpBoundsType])
-> (PvpBoundsType -> PvpBoundsType -> [PvpBoundsType])
-> (PvpBoundsType -> PvpBoundsType -> [PvpBoundsType])
-> (PvpBoundsType
    -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType])
-> Enum PvpBoundsType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PvpBoundsType -> PvpBoundsType
succ :: PvpBoundsType -> PvpBoundsType
$cpred :: PvpBoundsType -> PvpBoundsType
pred :: PvpBoundsType -> PvpBoundsType
$ctoEnum :: Int -> PvpBoundsType
toEnum :: Int -> PvpBoundsType
$cfromEnum :: PvpBoundsType -> Int
fromEnum :: PvpBoundsType -> Int
$cenumFrom :: PvpBoundsType -> [PvpBoundsType]
enumFrom :: PvpBoundsType -> [PvpBoundsType]
$cenumFromThen :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
enumFromThen :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
$cenumFromTo :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
enumFromTo :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
$cenumFromThenTo :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
enumFromThenTo :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
Enum, PvpBoundsType
PvpBoundsType -> PvpBoundsType -> Bounded PvpBoundsType
forall a. a -> a -> Bounded a
$cminBound :: PvpBoundsType
minBound :: PvpBoundsType
$cmaxBound :: PvpBoundsType
maxBound :: PvpBoundsType
Bounded)

data PvpBounds = PvpBounds
  { PvpBounds -> PvpBoundsType
pbType :: !PvpBoundsType
  , PvpBounds -> Bool
pbAsRevision :: !Bool
  }
  deriving (Int -> PvpBounds -> ShowS
[PvpBounds] -> ShowS
PvpBounds -> [Char]
(Int -> PvpBounds -> ShowS)
-> (PvpBounds -> [Char])
-> ([PvpBounds] -> ShowS)
-> Show PvpBounds
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PvpBounds -> ShowS
showsPrec :: Int -> PvpBounds -> ShowS
$cshow :: PvpBounds -> [Char]
show :: PvpBounds -> [Char]
$cshowList :: [PvpBounds] -> ShowS
showList :: [PvpBounds] -> ShowS
Show, ReadPrec [PvpBounds]
ReadPrec PvpBounds
Int -> ReadS PvpBounds
ReadS [PvpBounds]
(Int -> ReadS PvpBounds)
-> ReadS [PvpBounds]
-> ReadPrec PvpBounds
-> ReadPrec [PvpBounds]
-> Read PvpBounds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PvpBounds
readsPrec :: Int -> ReadS PvpBounds
$creadList :: ReadS [PvpBounds]
readList :: ReadS [PvpBounds]
$creadPrec :: ReadPrec PvpBounds
readPrec :: ReadPrec PvpBounds
$creadListPrec :: ReadPrec [PvpBounds]
readListPrec :: ReadPrec [PvpBounds]
Read, PvpBounds -> PvpBounds -> Bool
(PvpBounds -> PvpBounds -> Bool)
-> (PvpBounds -> PvpBounds -> Bool) -> Eq PvpBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PvpBounds -> PvpBounds -> Bool
== :: PvpBounds -> PvpBounds -> Bool
$c/= :: PvpBounds -> PvpBounds -> Bool
/= :: PvpBounds -> PvpBounds -> Bool
Eq, Typeable, Eq PvpBounds
Eq PvpBounds
-> (PvpBounds -> PvpBounds -> Ordering)
-> (PvpBounds -> PvpBounds -> Bool)
-> (PvpBounds -> PvpBounds -> Bool)
-> (PvpBounds -> PvpBounds -> Bool)
-> (PvpBounds -> PvpBounds -> Bool)
-> (PvpBounds -> PvpBounds -> PvpBounds)
-> (PvpBounds -> PvpBounds -> PvpBounds)
-> Ord PvpBounds
PvpBounds -> PvpBounds -> Bool
PvpBounds -> PvpBounds -> Ordering
PvpBounds -> PvpBounds -> PvpBounds
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PvpBounds -> PvpBounds -> Ordering
compare :: PvpBounds -> PvpBounds -> Ordering
$c< :: PvpBounds -> PvpBounds -> Bool
< :: PvpBounds -> PvpBounds -> Bool
$c<= :: PvpBounds -> PvpBounds -> Bool
<= :: PvpBounds -> PvpBounds -> Bool
$c> :: PvpBounds -> PvpBounds -> Bool
> :: PvpBounds -> PvpBounds -> Bool
$c>= :: PvpBounds -> PvpBounds -> Bool
>= :: PvpBounds -> PvpBounds -> Bool
$cmax :: PvpBounds -> PvpBounds -> PvpBounds
max :: PvpBounds -> PvpBounds -> PvpBounds
$cmin :: PvpBounds -> PvpBounds -> PvpBounds
min :: PvpBounds -> PvpBounds -> PvpBounds
Ord)

pvpBoundsText :: PvpBoundsType -> Text
pvpBoundsText :: PvpBoundsType -> Text
pvpBoundsText PvpBoundsType
PvpBoundsNone = Text
"none"
pvpBoundsText PvpBoundsType
PvpBoundsUpper = Text
"upper"
pvpBoundsText PvpBoundsType
PvpBoundsLower = Text
"lower"
pvpBoundsText PvpBoundsType
PvpBoundsBoth = Text
"both"

parsePvpBounds :: Text -> Either String PvpBounds
parsePvpBounds :: Text -> Either [Char] PvpBounds
parsePvpBounds Text
t = Either [Char] PvpBounds
-> (PvpBounds -> Either [Char] PvpBounds)
-> Maybe PvpBounds
-> Either [Char] PvpBounds
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either [Char] PvpBounds
err PvpBounds -> Either [Char] PvpBounds
forall a b. b -> Either a b
Right (Maybe PvpBounds -> Either [Char] PvpBounds)
-> Maybe PvpBounds -> Either [Char] PvpBounds
forall a b. (a -> b) -> a -> b
$ do
    (Text
t', Bool
asRevision) <-
      case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
t of
        (Text
x, Text
"") -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
x, Bool
False)
        (Text
x, Text
"-revision") -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
x, Bool
True)
        (Text, Text)
_ -> Maybe (Text, Bool)
forall a. Maybe a
Nothing
    PvpBoundsType
x <- Text -> Map Text PvpBoundsType -> Maybe PvpBoundsType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
t' Map Text PvpBoundsType
m
    PvpBounds -> Maybe PvpBounds
forall a. a -> Maybe a
Just PvpBounds
      { pbType :: PvpBoundsType
pbType = PvpBoundsType
x
      , pbAsRevision :: Bool
pbAsRevision = Bool
asRevision
      }
  where
    m :: Map Text PvpBoundsType
m = [(Text, PvpBoundsType)] -> Map Text PvpBoundsType
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, PvpBoundsType)] -> Map Text PvpBoundsType)
-> [(Text, PvpBoundsType)] -> Map Text PvpBoundsType
forall a b. (a -> b) -> a -> b
$ (PvpBoundsType -> (Text, PvpBoundsType))
-> [PvpBoundsType] -> [(Text, PvpBoundsType)]
forall a b. (a -> b) -> [a] -> [b]
map (PvpBoundsType -> Text
pvpBoundsText (PvpBoundsType -> Text)
-> (PvpBoundsType -> PvpBoundsType)
-> PvpBoundsType
-> (Text, PvpBoundsType)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PvpBoundsType -> PvpBoundsType
forall a. a -> a
id) [PvpBoundsType
forall a. Bounded a => a
minBound..PvpBoundsType
forall a. Bounded a => a
maxBound]
    err :: Either [Char] PvpBounds
err = [Char] -> Either [Char] PvpBounds
forall a b. a -> Either a b
Left ([Char] -> Either [Char] PvpBounds)
-> [Char] -> Either [Char] PvpBounds
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid PVP bounds: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t

instance ToJSON PvpBounds where
  toJSON :: PvpBounds -> Value
toJSON (PvpBounds PvpBoundsType
typ Bool
asRevision) =
    Text -> Value
forall a. ToJSON a => a -> Value
toJSON (PvpBoundsType -> Text
pvpBoundsText PvpBoundsType
typ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
asRevision then Text
"-revision" else Text
""))
instance FromJSON PvpBounds where
  parseJSON :: Value -> Parser PvpBounds
parseJSON = [Char] -> (Text -> Parser PvpBounds) -> Value -> Parser PvpBounds
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"PvpBounds" (([Char] -> Parser PvpBounds)
-> (PvpBounds -> Parser PvpBounds)
-> Either [Char] PvpBounds
-> Parser PvpBounds
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Parser PvpBounds
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail PvpBounds -> Parser PvpBounds
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] PvpBounds -> Parser PvpBounds)
-> (Text -> Either [Char] PvpBounds) -> Text -> Parser PvpBounds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] PvpBounds
parsePvpBounds)

-- | Data passed into Docker container for the Docker entrypoint's use

newtype DockerEntrypoint = DockerEntrypoint
    { DockerEntrypoint -> Maybe DockerUser
deUser :: Maybe DockerUser
      -- ^ UID/GID/etc of host user, if we wish to perform UID/GID switch in container

    } deriving (ReadPrec [DockerEntrypoint]
ReadPrec DockerEntrypoint
Int -> ReadS DockerEntrypoint
ReadS [DockerEntrypoint]
(Int -> ReadS DockerEntrypoint)
-> ReadS [DockerEntrypoint]
-> ReadPrec DockerEntrypoint
-> ReadPrec [DockerEntrypoint]
-> Read DockerEntrypoint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DockerEntrypoint
readsPrec :: Int -> ReadS DockerEntrypoint
$creadList :: ReadS [DockerEntrypoint]
readList :: ReadS [DockerEntrypoint]
$creadPrec :: ReadPrec DockerEntrypoint
readPrec :: ReadPrec DockerEntrypoint
$creadListPrec :: ReadPrec [DockerEntrypoint]
readListPrec :: ReadPrec [DockerEntrypoint]
Read,Int -> DockerEntrypoint -> ShowS
[DockerEntrypoint] -> ShowS
DockerEntrypoint -> [Char]
(Int -> DockerEntrypoint -> ShowS)
-> (DockerEntrypoint -> [Char])
-> ([DockerEntrypoint] -> ShowS)
-> Show DockerEntrypoint
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DockerEntrypoint -> ShowS
showsPrec :: Int -> DockerEntrypoint -> ShowS
$cshow :: DockerEntrypoint -> [Char]
show :: DockerEntrypoint -> [Char]
$cshowList :: [DockerEntrypoint] -> ShowS
showList :: [DockerEntrypoint] -> ShowS
Show)

-- | Docker host user info

data DockerUser = DockerUser
    { DockerUser -> UserID
duUid :: UserID -- ^ uid

    , DockerUser -> GroupID
duGid :: GroupID -- ^ gid

    , DockerUser -> [GroupID]
duGroups :: [GroupID] -- ^ Supplemental groups

    , DockerUser -> FileMode
duUmask :: FileMode -- ^ File creation mask }

    } deriving (ReadPrec [DockerUser]
ReadPrec DockerUser
Int -> ReadS DockerUser
ReadS [DockerUser]
(Int -> ReadS DockerUser)
-> ReadS [DockerUser]
-> ReadPrec DockerUser
-> ReadPrec [DockerUser]
-> Read DockerUser
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DockerUser
readsPrec :: Int -> ReadS DockerUser
$creadList :: ReadS [DockerUser]
readList :: ReadS [DockerUser]
$creadPrec :: ReadPrec DockerUser
readPrec :: ReadPrec DockerUser
$creadListPrec :: ReadPrec [DockerUser]
readListPrec :: ReadPrec [DockerUser]
Read,Int -> DockerUser -> ShowS
[DockerUser] -> ShowS
DockerUser -> [Char]
(Int -> DockerUser -> ShowS)
-> (DockerUser -> [Char])
-> ([DockerUser] -> ShowS)
-> Show DockerUser
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DockerUser -> ShowS
showsPrec :: Int -> DockerUser -> ShowS
$cshow :: DockerUser -> [Char]
show :: DockerUser -> [Char]
$cshowList :: [DockerUser] -> ShowS
showList :: [DockerUser] -> ShowS
Show)

data GhcOptionKey
  = GOKOldEverything
  | GOKEverything
  | GOKLocals
  | GOKTargets
  | GOKPackage !PackageName
  deriving (GhcOptionKey -> GhcOptionKey -> Bool
(GhcOptionKey -> GhcOptionKey -> Bool)
-> (GhcOptionKey -> GhcOptionKey -> Bool) -> Eq GhcOptionKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcOptionKey -> GhcOptionKey -> Bool
== :: GhcOptionKey -> GhcOptionKey -> Bool
$c/= :: GhcOptionKey -> GhcOptionKey -> Bool
/= :: GhcOptionKey -> GhcOptionKey -> Bool
Eq, Eq GhcOptionKey
Eq GhcOptionKey
-> (GhcOptionKey -> GhcOptionKey -> Ordering)
-> (GhcOptionKey -> GhcOptionKey -> Bool)
-> (GhcOptionKey -> GhcOptionKey -> Bool)
-> (GhcOptionKey -> GhcOptionKey -> Bool)
-> (GhcOptionKey -> GhcOptionKey -> Bool)
-> (GhcOptionKey -> GhcOptionKey -> GhcOptionKey)
-> (GhcOptionKey -> GhcOptionKey -> GhcOptionKey)
-> Ord GhcOptionKey
GhcOptionKey -> GhcOptionKey -> Bool
GhcOptionKey -> GhcOptionKey -> Ordering
GhcOptionKey -> GhcOptionKey -> GhcOptionKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GhcOptionKey -> GhcOptionKey -> Ordering
compare :: GhcOptionKey -> GhcOptionKey -> Ordering
$c< :: GhcOptionKey -> GhcOptionKey -> Bool
< :: GhcOptionKey -> GhcOptionKey -> Bool
$c<= :: GhcOptionKey -> GhcOptionKey -> Bool
<= :: GhcOptionKey -> GhcOptionKey -> Bool
$c> :: GhcOptionKey -> GhcOptionKey -> Bool
> :: GhcOptionKey -> GhcOptionKey -> Bool
$c>= :: GhcOptionKey -> GhcOptionKey -> Bool
>= :: GhcOptionKey -> GhcOptionKey -> Bool
$cmax :: GhcOptionKey -> GhcOptionKey -> GhcOptionKey
max :: GhcOptionKey -> GhcOptionKey -> GhcOptionKey
$cmin :: GhcOptionKey -> GhcOptionKey -> GhcOptionKey
min :: GhcOptionKey -> GhcOptionKey -> GhcOptionKey
Ord)

instance FromJSONKey GhcOptionKey where
  fromJSONKey :: FromJSONKeyFunction GhcOptionKey
fromJSONKey = (Text -> Parser GhcOptionKey) -> FromJSONKeyFunction GhcOptionKey
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser GhcOptionKey) -> FromJSONKeyFunction GhcOptionKey)
-> (Text -> Parser GhcOptionKey)
-> FromJSONKeyFunction GhcOptionKey
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text
t of
      Text
"*" -> GhcOptionKey -> Parser GhcOptionKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GhcOptionKey
GOKOldEverything
      Text
"$everything" -> GhcOptionKey -> Parser GhcOptionKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GhcOptionKey
GOKEverything
      Text
"$locals" -> GhcOptionKey -> Parser GhcOptionKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GhcOptionKey
GOKLocals
      Text
"$targets" -> GhcOptionKey -> Parser GhcOptionKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GhcOptionKey
GOKTargets
      Text
_ ->
        case [Char] -> Maybe PackageName
parsePackageName ([Char] -> Maybe PackageName) -> [Char] -> Maybe PackageName
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t of
          Maybe PackageName
Nothing -> [Char] -> Parser GhcOptionKey
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser GhcOptionKey) -> [Char] -> Parser GhcOptionKey
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid package name: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t
          Just PackageName
x -> GhcOptionKey -> Parser GhcOptionKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GhcOptionKey -> Parser GhcOptionKey)
-> GhcOptionKey -> Parser GhcOptionKey
forall a b. (a -> b) -> a -> b
$ PackageName -> GhcOptionKey
GOKPackage PackageName
x
  fromJSONKeyList :: FromJSONKeyFunction [GhcOptionKey]
fromJSONKeyList = (Text -> Parser [GhcOptionKey])
-> FromJSONKeyFunction [GhcOptionKey]
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser [GhcOptionKey])
 -> FromJSONKeyFunction [GhcOptionKey])
-> (Text -> Parser [GhcOptionKey])
-> FromJSONKeyFunction [GhcOptionKey]
forall a b. (a -> b) -> a -> b
$ \Text
_ -> [Char] -> Parser [GhcOptionKey]
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"GhcOptionKey.fromJSONKeyList"

newtype GhcOptions = GhcOptions { GhcOptions -> [Text]
unGhcOptions :: [Text] }

instance FromJSON GhcOptions where
  parseJSON :: Value -> Parser GhcOptions
parseJSON = [Char] -> (Text -> Parser GhcOptions) -> Value -> Parser GhcOptions
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"GhcOptions" ((Text -> Parser GhcOptions) -> Value -> Parser GhcOptions)
-> (Text -> Parser GhcOptions) -> Value -> Parser GhcOptions
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case EscapingMode -> Text -> Either [Char] [[Char]]
parseArgs EscapingMode
Escaping Text
t of
      Left [Char]
e -> [Char] -> Parser GhcOptions
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
e
      Right [[Char]]
opts -> GhcOptions -> Parser GhcOptions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GhcOptions -> Parser GhcOptions)
-> GhcOptions -> Parser GhcOptions
forall a b. (a -> b) -> a -> b
$ [Text] -> GhcOptions
GhcOptions ([Text] -> GhcOptions) -> [Text] -> GhcOptions
forall a b. (a -> b) -> a -> b
$ ([Char] -> Text) -> [[Char]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Text
T.pack [[Char]]
opts

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

-- Lens classes

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


-- | Class for environment values which have a Platform

class HasPlatform env where
    platformL :: Lens' env Platform
    default platformL :: HasConfig env => Lens' env Platform
    platformL = (Config -> f Config) -> env -> f env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL((Config -> f Config) -> env -> f env)
-> ((Platform -> f Platform) -> Config -> f Config)
-> (Platform -> f Platform)
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Platform -> f Platform) -> Config -> f Config
forall env. HasPlatform env => Lens' env Platform
Lens' Config Platform
platformL
    {-# INLINE platformL #-}
    platformVariantL :: Lens' env PlatformVariant
    default platformVariantL :: HasConfig env => Lens' env PlatformVariant
    platformVariantL = (Config -> f Config) -> env -> f env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL((Config -> f Config) -> env -> f env)
-> ((PlatformVariant -> f PlatformVariant) -> Config -> f Config)
-> (PlatformVariant -> f PlatformVariant)
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PlatformVariant -> f PlatformVariant) -> Config -> f Config
forall env. HasPlatform env => Lens' env PlatformVariant
Lens' Config PlatformVariant
platformVariantL
    {-# INLINE platformVariantL #-}

-- | Class for environment values which have a GHCVariant

class HasGHCVariant env where
    ghcVariantL :: SimpleGetter env GHCVariant
    default ghcVariantL :: HasConfig env => SimpleGetter env GHCVariant
    ghcVariantL = (Config -> Const r Config) -> env -> Const r env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL((Config -> Const r Config) -> env -> Const r env)
-> ((GHCVariant -> Const r GHCVariant) -> Config -> Const r Config)
-> (GHCVariant -> Const r GHCVariant)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GHCVariant -> Const r GHCVariant) -> Config -> Const r Config
forall env. HasGHCVariant env => SimpleGetter env GHCVariant
SimpleGetter Config GHCVariant
ghcVariantL
    {-# INLINE ghcVariantL #-}

-- | Class for environment values which have a 'Runner'.

class (HasProcessContext env, HasLogFunc env) => HasRunner env where
  runnerL :: Lens' env Runner
instance HasLogFunc Runner where
  logFuncL :: Lens' Runner LogFunc
logFuncL = (Runner -> LogFunc)
-> (Runner -> LogFunc -> Runner) -> Lens' Runner LogFunc
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Runner -> LogFunc
runnerLogFunc (\Runner
x LogFunc
y -> Runner
x { runnerLogFunc :: LogFunc
runnerLogFunc = LogFunc
y })
instance HasProcessContext Runner where
  processContextL :: Lens' Runner ProcessContext
processContextL = (Runner -> ProcessContext)
-> (Runner -> ProcessContext -> Runner)
-> Lens' Runner ProcessContext
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Runner -> ProcessContext
runnerProcessContext (\Runner
x ProcessContext
y -> Runner
x { runnerProcessContext :: ProcessContext
runnerProcessContext = ProcessContext
y })
instance HasRunner Runner where
  runnerL :: Lens' Runner Runner
runnerL = (Runner -> f Runner) -> Runner -> f Runner
forall a. a -> a
id
instance HasStylesUpdate Runner where
  stylesUpdateL :: Lens' Runner StylesUpdate
stylesUpdateL = (GlobalOpts -> f GlobalOpts) -> Runner -> f Runner
forall env. HasRunner env => Lens' env GlobalOpts
Lens' Runner GlobalOpts
globalOptsL((GlobalOpts -> f GlobalOpts) -> Runner -> f Runner)
-> ((StylesUpdate -> f StylesUpdate) -> GlobalOpts -> f GlobalOpts)
-> (StylesUpdate -> f StylesUpdate)
-> Runner
-> f Runner
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (GlobalOpts -> StylesUpdate)
-> (GlobalOpts -> StylesUpdate -> GlobalOpts)
-> Lens GlobalOpts GlobalOpts StylesUpdate StylesUpdate
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GlobalOpts -> StylesUpdate
globalStylesUpdate (\GlobalOpts
x StylesUpdate
y -> GlobalOpts
x { globalStylesUpdate :: StylesUpdate
globalStylesUpdate = StylesUpdate
y })
instance HasTerm Runner where
  useColorL :: Lens' Runner Bool
useColorL = (Runner -> Bool) -> (Runner -> Bool -> Runner) -> Lens' Runner Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Runner -> Bool
runnerUseColor (\Runner
x Bool
y -> Runner
x { runnerUseColor :: Bool
runnerUseColor = Bool
y })
  termWidthL :: Lens' Runner Int
termWidthL = (Runner -> Int) -> (Runner -> Int -> Runner) -> Lens' Runner Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Runner -> Int
runnerTermWidth (\Runner
x Int
y -> Runner
x { runnerTermWidth :: Int
runnerTermWidth = Int
y })

globalOptsL :: HasRunner env => Lens' env GlobalOpts
globalOptsL :: forall env. HasRunner env => Lens' env GlobalOpts
globalOptsL = (Runner -> f Runner) -> env -> f env
forall env. HasRunner env => Lens' env Runner
Lens' env Runner
runnerL((Runner -> f Runner) -> env -> f env)
-> ((GlobalOpts -> f GlobalOpts) -> Runner -> f Runner)
-> (GlobalOpts -> f GlobalOpts)
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Runner -> GlobalOpts)
-> (Runner -> GlobalOpts -> Runner) -> Lens' Runner GlobalOpts
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Runner -> GlobalOpts
runnerGlobalOpts (\Runner
x GlobalOpts
y -> Runner
x { runnerGlobalOpts :: GlobalOpts
runnerGlobalOpts = GlobalOpts
y })

-- | 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
    default configL :: HasBuildConfig env => Lens' env Config
    configL = (BuildConfig -> f BuildConfig) -> env -> f env
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' env BuildConfig
buildConfigL((BuildConfig -> f BuildConfig) -> env -> f env)
-> ((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> (Config -> f Config)
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BuildConfig -> Config)
-> (BuildConfig -> Config -> BuildConfig)
-> Lens BuildConfig BuildConfig Config Config
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BuildConfig -> Config
bcConfig (\BuildConfig
x Config
y -> BuildConfig
x { bcConfig :: Config
bcConfig = Config
y })
    {-# INLINE configL #-}

class HasConfig env => HasBuildConfig env where
    buildConfigL :: Lens' env BuildConfig
    default buildConfigL :: HasEnvConfig env => Lens' env BuildConfig
    buildConfigL = (EnvConfig -> f EnvConfig) -> env -> f env
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL((EnvConfig -> f EnvConfig) -> env -> f env)
-> ((BuildConfig -> f BuildConfig) -> EnvConfig -> f EnvConfig)
-> (BuildConfig -> f BuildConfig)
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EnvConfig -> BuildConfig)
-> (EnvConfig -> BuildConfig -> EnvConfig)
-> Lens EnvConfig EnvConfig BuildConfig BuildConfig
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
        EnvConfig -> BuildConfig
envConfigBuildConfig
        (\EnvConfig
x BuildConfig
y -> EnvConfig
x { envConfigBuildConfig :: BuildConfig
envConfigBuildConfig = BuildConfig
y })

class (HasBuildConfig env, HasSourceMap env, HasCompiler env) => HasEnvConfig env where
    envConfigL :: Lens' env EnvConfig

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

-- Lens instances

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


instance HasPlatform (Platform,PlatformVariant) where
    platformL :: Lens' (Platform, PlatformVariant) Platform
platformL = (Platform -> f Platform)
-> (Platform, PlatformVariant) -> f (Platform, PlatformVariant)
forall s t a b. Field1 s t a b => Lens s t a b
Lens' (Platform, PlatformVariant) Platform
_1
    platformVariantL :: Lens' (Platform, PlatformVariant) PlatformVariant
platformVariantL = (PlatformVariant -> f PlatformVariant)
-> (Platform, PlatformVariant) -> f (Platform, PlatformVariant)
forall s t a b. Field2 s t a b => Lens s t a b
Lens' (Platform, PlatformVariant) PlatformVariant
_2
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 HasPlatform BuildConfig
instance HasPlatform EnvConfig

instance HasGHCVariant GHCVariant where
    ghcVariantL :: SimpleGetter GHCVariant GHCVariant
ghcVariantL = (GHCVariant -> Const r GHCVariant)
-> GHCVariant -> Const r GHCVariant
forall a. a -> a
id
    {-# INLINE ghcVariantL #-}
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 HasGHCVariant BuildConfig
instance HasGHCVariant EnvConfig

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 HasProcessContext BuildConfig where
    processContextL :: Lens' BuildConfig ProcessContext
processContextL = (Config -> f Config) -> BuildConfig -> f BuildConfig
forall env. HasConfig env => Lens' env Config
Lens BuildConfig BuildConfig Config Config
configL((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> ((ProcessContext -> f ProcessContext) -> Config -> f Config)
-> (ProcessContext -> f ProcessContext)
-> BuildConfig
-> f BuildConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ProcessContext -> f ProcessContext) -> Config -> f Config
forall env. HasProcessContext env => Lens' env ProcessContext
Lens' Config ProcessContext
processContextL
instance HasProcessContext EnvConfig where
    processContextL :: Lens' EnvConfig ProcessContext
processContextL = (Config -> f Config) -> EnvConfig -> f EnvConfig
forall env. HasConfig env => Lens' env Config
Lens' EnvConfig Config
configL((Config -> f Config) -> EnvConfig -> f EnvConfig)
-> ((ProcessContext -> f ProcessContext) -> Config -> f Config)
-> (ProcessContext -> f ProcessContext)
-> EnvConfig
-> f EnvConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ProcessContext -> f ProcessContext) -> Config -> f Config
forall env. HasProcessContext env => Lens' env ProcessContext
Lens' Config ProcessContext
processContextL

instance 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 HasPantryConfig BuildConfig where
    pantryConfigL :: Lens' BuildConfig PantryConfig
pantryConfigL = (Config -> f Config) -> BuildConfig -> f BuildConfig
forall env. HasConfig env => Lens' env Config
Lens BuildConfig BuildConfig Config Config
configL((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> ((PantryConfig -> f PantryConfig) -> Config -> f Config)
-> (PantryConfig -> f PantryConfig)
-> BuildConfig
-> f BuildConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PantryConfig -> f PantryConfig) -> Config -> f Config
forall env. HasPantryConfig env => Lens' env PantryConfig
Lens' Config PantryConfig
pantryConfigL
instance HasPantryConfig EnvConfig where
    pantryConfigL :: Lens' EnvConfig PantryConfig
pantryConfigL = (Config -> f Config) -> EnvConfig -> f EnvConfig
forall env. HasConfig env => Lens' env Config
Lens' EnvConfig Config
configL((Config -> f Config) -> EnvConfig -> f EnvConfig)
-> ((PantryConfig -> f PantryConfig) -> Config -> f Config)
-> (PantryConfig -> f PantryConfig)
-> EnvConfig
-> f EnvConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PantryConfig -> f PantryConfig) -> Config -> f Config
forall env. HasPantryConfig env => Lens' env PantryConfig
Lens' Config PantryConfig
pantryConfigL

instance HasConfig Config where
    configL :: Lens' Config Config
configL = (Config -> f Config) -> Config -> f Config
forall a. a -> a
id
    {-# INLINE configL #-}
instance HasConfig BuildConfig where
    configL :: Lens BuildConfig BuildConfig Config Config
configL = (BuildConfig -> Config)
-> (BuildConfig -> Config -> BuildConfig)
-> Lens BuildConfig BuildConfig Config Config
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BuildConfig -> Config
bcConfig (\BuildConfig
x Config
y -> BuildConfig
x { bcConfig :: Config
bcConfig = Config
y })
instance HasConfig EnvConfig

instance HasBuildConfig BuildConfig where
    buildConfigL :: Lens' BuildConfig BuildConfig
buildConfigL = (BuildConfig -> f BuildConfig) -> BuildConfig -> f BuildConfig
forall a. a -> a
id
    {-# INLINE buildConfigL #-}
instance HasBuildConfig EnvConfig

instance HasCompiler EnvConfig where
    compilerPathsL :: SimpleGetter EnvConfig CompilerPaths
compilerPathsL = (EnvConfig -> CompilerPaths)
-> SimpleGetter EnvConfig CompilerPaths
forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> CompilerPaths
envConfigCompilerPaths
instance HasEnvConfig EnvConfig where
    envConfigL :: Lens' EnvConfig EnvConfig
envConfigL = (EnvConfig -> f EnvConfig) -> EnvConfig -> f EnvConfig
forall a. a -> a
id
    {-# INLINE envConfigL #-}

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 HasRunner BuildConfig where
  runnerL :: Lens' BuildConfig Runner
runnerL = (Config -> f Config) -> BuildConfig -> f BuildConfig
forall env. HasConfig env => Lens' env Config
Lens BuildConfig BuildConfig Config Config
configL((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> ((Runner -> f Runner) -> Config -> f Config)
-> (Runner -> f Runner)
-> BuildConfig
-> f BuildConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
Lens' Config Runner
runnerL
instance HasRunner EnvConfig where
  runnerL :: Lens' EnvConfig Runner
runnerL = (Config -> f Config) -> EnvConfig -> f EnvConfig
forall env. HasConfig env => Lens' env Config
Lens' EnvConfig Config
configL((Config -> f Config) -> EnvConfig -> f EnvConfig)
-> ((Runner -> f Runner) -> Config -> f Config)
-> (Runner -> f Runner)
-> EnvConfig
-> f EnvConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
Lens' Config Runner
runnerL

instance 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 HasLogFunc BuildConfig where
  logFuncL :: Lens' BuildConfig LogFunc
logFuncL = (Runner -> f Runner) -> BuildConfig -> f BuildConfig
forall env. HasRunner env => Lens' env Runner
Lens' BuildConfig Runner
runnerL((Runner -> f Runner) -> BuildConfig -> f BuildConfig)
-> ((LogFunc -> f LogFunc) -> Runner -> f Runner)
-> (LogFunc -> f LogFunc)
-> BuildConfig
-> f BuildConfig
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 HasLogFunc EnvConfig where
  logFuncL :: Lens' EnvConfig LogFunc
logFuncL = (Runner -> f Runner) -> EnvConfig -> f EnvConfig
forall env. HasRunner env => Lens' env Runner
Lens' EnvConfig Runner
runnerL((Runner -> f Runner) -> EnvConfig -> f EnvConfig)
-> ((LogFunc -> f LogFunc) -> Runner -> f Runner)
-> (LogFunc -> f LogFunc)
-> EnvConfig
-> f EnvConfig
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 HasStylesUpdate BuildConfig where
  stylesUpdateL :: Lens' BuildConfig StylesUpdate
stylesUpdateL = (Runner -> f Runner) -> BuildConfig -> f BuildConfig
forall env. HasRunner env => Lens' env Runner
Lens' BuildConfig Runner
runnerL((Runner -> f Runner) -> BuildConfig -> f BuildConfig)
-> ((StylesUpdate -> f StylesUpdate) -> Runner -> f Runner)
-> (StylesUpdate -> f StylesUpdate)
-> BuildConfig
-> f BuildConfig
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 HasStylesUpdate EnvConfig where
  stylesUpdateL :: Lens' EnvConfig StylesUpdate
stylesUpdateL = (Runner -> f Runner) -> EnvConfig -> f EnvConfig
forall env. HasRunner env => Lens' env Runner
Lens' EnvConfig Runner
runnerL((Runner -> f Runner) -> EnvConfig -> f EnvConfig)
-> ((StylesUpdate -> f StylesUpdate) -> Runner -> f Runner)
-> (StylesUpdate -> f StylesUpdate)
-> EnvConfig
-> f EnvConfig
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
instance HasTerm BuildConfig where
  useColorL :: Lens' BuildConfig Bool
useColorL = (Runner -> f Runner) -> BuildConfig -> f BuildConfig
forall env. HasRunner env => Lens' env Runner
Lens' BuildConfig Runner
runnerL((Runner -> f Runner) -> BuildConfig -> f BuildConfig)
-> ((Bool -> f Bool) -> Runner -> f Runner)
-> (Bool -> f Bool)
-> BuildConfig
-> f BuildConfig
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' BuildConfig Int
termWidthL = (Runner -> f Runner) -> BuildConfig -> f BuildConfig
forall env. HasRunner env => Lens' env Runner
Lens' BuildConfig Runner
runnerL((Runner -> f Runner) -> BuildConfig -> f BuildConfig)
-> ((Int -> f Int) -> Runner -> f Runner)
-> (Int -> f Int)
-> BuildConfig
-> f BuildConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> f Int) -> Runner -> f Runner
forall env. HasTerm env => Lens' env Int
Lens' Runner Int
termWidthL
instance HasTerm EnvConfig where
  useColorL :: Lens' EnvConfig Bool
useColorL = (Runner -> f Runner) -> EnvConfig -> f EnvConfig
forall env. HasRunner env => Lens' env Runner
Lens' EnvConfig Runner
runnerL((Runner -> f Runner) -> EnvConfig -> f EnvConfig)
-> ((Bool -> f Bool) -> Runner -> f Runner)
-> (Bool -> f Bool)
-> EnvConfig
-> f EnvConfig
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' EnvConfig Int
termWidthL = (Runner -> f Runner) -> EnvConfig -> f EnvConfig
forall env. HasRunner env => Lens' env Runner
Lens' EnvConfig Runner
runnerL((Runner -> f Runner) -> EnvConfig -> f EnvConfig)
-> ((Int -> f Int) -> Runner -> f Runner)
-> (Int -> f Int)
-> EnvConfig
-> f EnvConfig
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 (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 })

-- | The compiler specified by the @SnapshotDef@. This may be

-- different from the actual compiler used!

wantedCompilerVersionL :: HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionL :: forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionL = (BuildConfig -> Const r BuildConfig) -> s -> Const r s
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' s BuildConfig
buildConfigL((BuildConfig -> Const r BuildConfig) -> s -> Const r s)
-> ((WantedCompiler -> Const r WantedCompiler)
    -> BuildConfig -> Const r BuildConfig)
-> (WantedCompiler -> Const r WantedCompiler)
-> s
-> Const r s
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BuildConfig -> WantedCompiler)
-> SimpleGetter BuildConfig WantedCompiler
forall s a. (s -> a) -> SimpleGetter s a
to (SMWanted -> WantedCompiler
smwCompiler (SMWanted -> WantedCompiler)
-> (BuildConfig -> SMWanted) -> BuildConfig -> WantedCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> SMWanted
bcSMWanted)

-- | Location of the ghc-pkg executable

newtype GhcPkgExe = GhcPkgExe (Path Abs File)
  deriving Int -> GhcPkgExe -> ShowS
[GhcPkgExe] -> ShowS
GhcPkgExe -> [Char]
(Int -> GhcPkgExe -> ShowS)
-> (GhcPkgExe -> [Char])
-> ([GhcPkgExe] -> ShowS)
-> Show GhcPkgExe
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhcPkgExe -> ShowS
showsPrec :: Int -> GhcPkgExe -> ShowS
$cshow :: GhcPkgExe -> [Char]
show :: GhcPkgExe -> [Char]
$cshowList :: [GhcPkgExe] -> ShowS
showList :: [GhcPkgExe] -> ShowS
Show

-- | Get the 'GhcPkgExe' from a 'HasCompiler' environment

getGhcPkgExe :: HasCompiler env => RIO env GhcPkgExe
getGhcPkgExe :: forall env. HasCompiler env => RIO env GhcPkgExe
getGhcPkgExe = Getting GhcPkgExe env GhcPkgExe -> RIO env GhcPkgExe
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting GhcPkgExe env GhcPkgExe -> RIO env GhcPkgExe)
-> Getting GhcPkgExe env GhcPkgExe -> RIO env GhcPkgExe
forall a b. (a -> b) -> a -> b
$ Getting GhcPkgExe env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsLGetting GhcPkgExe env CompilerPaths
-> ((GhcPkgExe -> Const GhcPkgExe GhcPkgExe)
    -> CompilerPaths -> Const GhcPkgExe CompilerPaths)
-> Getting GhcPkgExe env GhcPkgExe
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompilerPaths -> GhcPkgExe)
-> SimpleGetter CompilerPaths GhcPkgExe
forall s a. (s -> a) -> SimpleGetter s a
to CompilerPaths -> GhcPkgExe
cpPkg

-- | Dump information for a single package

data DumpPackage = DumpPackage
    { DumpPackage -> GhcPkgId
dpGhcPkgId :: !GhcPkgId
    , DumpPackage -> PackageIdentifier
dpPackageIdent :: !PackageIdentifier
    , DumpPackage -> Maybe PackageIdentifier
dpParentLibIdent :: !(Maybe PackageIdentifier)
    , DumpPackage -> Maybe License
dpLicense :: !(Maybe C.License)
    , DumpPackage -> [[Char]]
dpLibDirs :: ![FilePath]
    , DumpPackage -> [Text]
dpLibraries :: ![Text]
    , DumpPackage -> Bool
dpHasExposedModules :: !Bool
    , DumpPackage -> Set ModuleName
dpExposedModules :: !(Set ModuleName)
    , DumpPackage -> [GhcPkgId]
dpDepends :: ![GhcPkgId]
    , DumpPackage -> [[Char]]
dpHaddockInterfaces :: ![FilePath]
    , DumpPackage -> Maybe [Char]
dpHaddockHtml :: !(Maybe FilePath)
    , DumpPackage -> Bool
dpIsExposed :: !Bool
    }
    deriving (Int -> DumpPackage -> ShowS
[DumpPackage] -> ShowS
DumpPackage -> [Char]
(Int -> DumpPackage -> ShowS)
-> (DumpPackage -> [Char])
-> ([DumpPackage] -> ShowS)
-> Show DumpPackage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DumpPackage -> ShowS
showsPrec :: Int -> DumpPackage -> ShowS
$cshow :: DumpPackage -> [Char]
show :: DumpPackage -> [Char]
$cshowList :: [DumpPackage] -> ShowS
showList :: [DumpPackage] -> ShowS
Show, ReadPrec [DumpPackage]
ReadPrec DumpPackage
Int -> ReadS DumpPackage
ReadS [DumpPackage]
(Int -> ReadS DumpPackage)
-> ReadS [DumpPackage]
-> ReadPrec DumpPackage
-> ReadPrec [DumpPackage]
-> Read DumpPackage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DumpPackage
readsPrec :: Int -> ReadS DumpPackage
$creadList :: ReadS [DumpPackage]
readList :: ReadS [DumpPackage]
$creadPrec :: ReadPrec DumpPackage
readPrec :: ReadPrec DumpPackage
$creadListPrec :: ReadPrec [DumpPackage]
readListPrec :: ReadPrec [DumpPackage]
Read, DumpPackage -> DumpPackage -> Bool
(DumpPackage -> DumpPackage -> Bool)
-> (DumpPackage -> DumpPackage -> Bool) -> Eq DumpPackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DumpPackage -> DumpPackage -> Bool
== :: DumpPackage -> DumpPackage -> Bool
$c/= :: DumpPackage -> DumpPackage -> Bool
/= :: DumpPackage -> DumpPackage -> Bool
Eq)

-- | Paths on the filesystem for the compiler we're using

data CompilerPaths = CompilerPaths
  { CompilerPaths -> ActualCompiler
cpCompilerVersion :: !ActualCompiler
  , CompilerPaths -> Arch
cpArch :: !Arch
  , CompilerPaths -> CompilerBuild
cpBuild :: !CompilerBuild
  , CompilerPaths -> Path Abs File
cpCompiler :: !(Path Abs File)
  -- | ghc-pkg or equivalent

  , CompilerPaths -> GhcPkgExe
cpPkg :: !GhcPkgExe
  -- | runghc

  , CompilerPaths -> Path Abs File
cpInterpreter :: !(Path Abs File)
  -- | haddock, in 'IO' to allow deferring the lookup

  , CompilerPaths -> Path Abs File
cpHaddock :: !(Path Abs File)
  -- | Is this a Stack-sandboxed installation?

  , CompilerPaths -> Bool
cpSandboxed :: !Bool
  , CompilerPaths -> Version
cpCabalVersion :: !Version
  -- ^ This is the version of Cabal that Stack will use to compile Setup.hs files

  -- in the build process.

  --

  -- Note that this is not necessarily the same version as the one that Stack

  -- depends on as a library and which is displayed when running

  -- @stack ls dependencies | grep Cabal@ in the Stack project.

  , CompilerPaths -> Path Abs Dir
cpGlobalDB :: !(Path Abs Dir)
  -- ^ Global package database

  , CompilerPaths -> ByteString
cpGhcInfo :: !ByteString
  -- ^ Output of @ghc --info@

  , CompilerPaths -> Map PackageName DumpPackage
cpGlobalDump :: !(Map PackageName DumpPackage)
  }
  deriving Int -> CompilerPaths -> ShowS
[CompilerPaths] -> ShowS
CompilerPaths -> [Char]
(Int -> CompilerPaths -> ShowS)
-> (CompilerPaths -> [Char])
-> ([CompilerPaths] -> ShowS)
-> Show CompilerPaths
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompilerPaths -> ShowS
showsPrec :: Int -> CompilerPaths -> ShowS
$cshow :: CompilerPaths -> [Char]
show :: CompilerPaths -> [Char]
$cshowList :: [CompilerPaths] -> ShowS
showList :: [CompilerPaths] -> ShowS
Show

cpWhich :: (MonadReader env m, HasCompiler env) => m WhichCompiler
cpWhich :: forall env (m :: * -> *).
(MonadReader env m, HasCompiler env) =>
m WhichCompiler
cpWhich = Getting WhichCompiler env WhichCompiler -> m WhichCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting WhichCompiler env WhichCompiler -> m WhichCompiler)
-> Getting WhichCompiler env WhichCompiler -> m WhichCompiler
forall a b. (a -> b) -> a -> b
$ Getting WhichCompiler env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsLGetting WhichCompiler env CompilerPaths
-> ((WhichCompiler -> Const WhichCompiler WhichCompiler)
    -> CompilerPaths -> Const WhichCompiler CompilerPaths)
-> Getting WhichCompiler env WhichCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompilerPaths -> WhichCompiler)
-> SimpleGetter CompilerPaths WhichCompiler
forall s a. (s -> a) -> SimpleGetter s a
to (ActualCompiler -> WhichCompiler
whichCompiler(ActualCompiler -> WhichCompiler)
-> (CompilerPaths -> ActualCompiler)
-> CompilerPaths
-> WhichCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CompilerPaths -> ActualCompiler
cpCompilerVersion)

data ExtraDirs = ExtraDirs
    { ExtraDirs -> [Path Abs Dir]
edBins :: ![Path Abs Dir]
    , ExtraDirs -> [Path Abs Dir]
edInclude :: ![Path Abs Dir]
    , ExtraDirs -> [Path Abs Dir]
edLib :: ![Path Abs Dir]
    } deriving (Int -> ExtraDirs -> ShowS
[ExtraDirs] -> ShowS
ExtraDirs -> [Char]
(Int -> ExtraDirs -> ShowS)
-> (ExtraDirs -> [Char])
-> ([ExtraDirs] -> ShowS)
-> Show ExtraDirs
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtraDirs -> ShowS
showsPrec :: Int -> ExtraDirs -> ShowS
$cshow :: ExtraDirs -> [Char]
show :: ExtraDirs -> [Char]
$cshowList :: [ExtraDirs] -> ShowS
showList :: [ExtraDirs] -> ShowS
Show, (forall x. ExtraDirs -> Rep ExtraDirs x)
-> (forall x. Rep ExtraDirs x -> ExtraDirs) -> Generic ExtraDirs
forall x. Rep ExtraDirs x -> ExtraDirs
forall x. ExtraDirs -> Rep ExtraDirs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExtraDirs -> Rep ExtraDirs x
from :: forall x. ExtraDirs -> Rep ExtraDirs x
$cto :: forall x. Rep ExtraDirs x -> ExtraDirs
to :: forall x. Rep ExtraDirs x -> ExtraDirs
Generic)
instance Semigroup ExtraDirs where
    <> :: ExtraDirs -> ExtraDirs -> ExtraDirs
(<>) = ExtraDirs -> ExtraDirs -> ExtraDirs
forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault
instance Monoid ExtraDirs where
    mempty :: ExtraDirs
mempty = ExtraDirs
forall a. (Generic a, Monoid' (Rep a)) => a
memptydefault
    mappend :: ExtraDirs -> ExtraDirs -> ExtraDirs
mappend = ExtraDirs -> ExtraDirs -> ExtraDirs
forall a. Semigroup a => a -> a -> a
(<>)

-- | An environment which ensures that the given compiler is available

-- on the PATH

class HasCompiler env where
  compilerPathsL :: SimpleGetter env CompilerPaths
instance HasCompiler CompilerPaths where
  compilerPathsL :: SimpleGetter CompilerPaths CompilerPaths
compilerPathsL = (CompilerPaths -> Const r CompilerPaths)
-> CompilerPaths -> Const r CompilerPaths
forall a. a -> a
id

class HasSourceMap env where
  sourceMapL :: Lens' env SourceMap
instance HasSourceMap EnvConfig where
  sourceMapL :: Lens' EnvConfig SourceMap
sourceMapL = (EnvConfig -> SourceMap)
-> (EnvConfig -> SourceMap -> EnvConfig)
-> Lens' EnvConfig SourceMap
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EnvConfig -> SourceMap
envConfigSourceMap (\EnvConfig
x SourceMap
y -> EnvConfig
x { envConfigSourceMap :: SourceMap
envConfigSourceMap = SourceMap
y })

-- | The version of the compiler which will actually be used. May be

-- different than that specified in the 'SnapshotDef' and returned

-- by 'wantedCompilerVersionL'.

actualCompilerVersionL :: HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL :: forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL = (SourceMap -> Const r SourceMap) -> env -> Const r env
forall env. HasSourceMap env => Lens' env SourceMap
Lens' env SourceMap
sourceMapL((SourceMap -> Const r SourceMap) -> env -> Const r env)
-> ((ActualCompiler -> Const r ActualCompiler)
    -> SourceMap -> Const r SourceMap)
-> (ActualCompiler -> Const r ActualCompiler)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SourceMap -> ActualCompiler)
-> SimpleGetter SourceMap ActualCompiler
forall s a. (s -> a) -> SimpleGetter s a
to SourceMap -> ActualCompiler
smCompiler

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

buildOptsMonoidHaddockL :: Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidHaddockL :: Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidHaddockL = (BuildOptsMonoid -> Maybe Bool)
-> (BuildOptsMonoid -> Maybe Bool -> BuildOptsMonoid)
-> Lens' BuildOptsMonoid (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (FirstFalse -> Maybe Bool
getFirstFalse (FirstFalse -> Maybe Bool)
-> (BuildOptsMonoid -> FirstFalse) -> BuildOptsMonoid -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildOptsMonoid -> FirstFalse
buildMonoidHaddock)
                            (\BuildOptsMonoid
buildMonoid Maybe Bool
t -> BuildOptsMonoid
buildMonoid {buildMonoidHaddock :: FirstFalse
buildMonoidHaddock = Maybe Bool -> FirstFalse
FirstFalse Maybe Bool
t})

buildOptsMonoidTestsL :: Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidTestsL :: Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidTestsL = (BuildOptsMonoid -> Maybe Bool)
-> (BuildOptsMonoid -> Maybe Bool -> BuildOptsMonoid)
-> Lens' BuildOptsMonoid (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (FirstFalse -> Maybe Bool
getFirstFalse (FirstFalse -> Maybe Bool)
-> (BuildOptsMonoid -> FirstFalse) -> BuildOptsMonoid -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildOptsMonoid -> FirstFalse
buildMonoidTests)
                            (\BuildOptsMonoid
buildMonoid Maybe Bool
t -> BuildOptsMonoid
buildMonoid {buildMonoidTests :: FirstFalse
buildMonoidTests = Maybe Bool -> FirstFalse
FirstFalse Maybe Bool
t})

buildOptsMonoidBenchmarksL :: Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidBenchmarksL :: Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidBenchmarksL = (BuildOptsMonoid -> Maybe Bool)
-> (BuildOptsMonoid -> Maybe Bool -> BuildOptsMonoid)
-> Lens' BuildOptsMonoid (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (FirstFalse -> Maybe Bool
getFirstFalse (FirstFalse -> Maybe Bool)
-> (BuildOptsMonoid -> FirstFalse) -> BuildOptsMonoid -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildOptsMonoid -> FirstFalse
buildMonoidBenchmarks)
                            (\BuildOptsMonoid
buildMonoid Maybe Bool
t -> BuildOptsMonoid
buildMonoid {buildMonoidBenchmarks :: FirstFalse
buildMonoidBenchmarks = Maybe Bool -> FirstFalse
FirstFalse Maybe Bool
t})

buildOptsMonoidInstallExesL :: Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidInstallExesL :: Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidInstallExesL =
  (BuildOptsMonoid -> Maybe Bool)
-> (BuildOptsMonoid -> Maybe Bool -> BuildOptsMonoid)
-> Lens' BuildOptsMonoid (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (FirstFalse -> Maybe Bool
getFirstFalse (FirstFalse -> Maybe Bool)
-> (BuildOptsMonoid -> FirstFalse) -> BuildOptsMonoid -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildOptsMonoid -> FirstFalse
buildMonoidInstallExes)
       (\BuildOptsMonoid
buildMonoid Maybe Bool
t -> BuildOptsMonoid
buildMonoid {buildMonoidInstallExes :: FirstFalse
buildMonoidInstallExes = Maybe Bool -> FirstFalse
FirstFalse Maybe Bool
t})

buildOptsInstallExesL :: Lens' BuildOpts Bool
buildOptsInstallExesL :: Lens' BuildOpts Bool
buildOptsInstallExesL =
  (BuildOpts -> Bool)
-> (BuildOpts -> Bool -> BuildOpts) -> Lens' BuildOpts Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BuildOpts -> Bool
boptsInstallExes
       (\BuildOpts
bopts Bool
t -> BuildOpts
bopts {boptsInstallExes :: Bool
boptsInstallExes = Bool
t})

buildOptsHaddockL :: Lens' BuildOpts Bool
buildOptsHaddockL :: Lens' BuildOpts Bool
buildOptsHaddockL =
  (BuildOpts -> Bool)
-> (BuildOpts -> Bool -> BuildOpts) -> Lens' BuildOpts Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BuildOpts -> Bool
boptsHaddock
       (\BuildOpts
bopts Bool
t -> BuildOpts
bopts {boptsHaddock :: Bool
boptsHaddock = Bool
t})

globalOptsBuildOptsMonoidL :: Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidL :: Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidL =
  (GlobalOpts -> ConfigMonoid)
-> (GlobalOpts -> ConfigMonoid -> GlobalOpts)
-> Lens GlobalOpts GlobalOpts ConfigMonoid ConfigMonoid
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    GlobalOpts -> ConfigMonoid
globalConfigMonoid
    (\GlobalOpts
x ConfigMonoid
y -> GlobalOpts
x { globalConfigMonoid :: ConfigMonoid
globalConfigMonoid = ConfigMonoid
y })
  ((ConfigMonoid -> f ConfigMonoid) -> GlobalOpts -> f GlobalOpts)
-> ((BuildOptsMonoid -> f BuildOptsMonoid)
    -> ConfigMonoid -> f ConfigMonoid)
-> (BuildOptsMonoid -> f BuildOptsMonoid)
-> GlobalOpts
-> f GlobalOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (ConfigMonoid -> BuildOptsMonoid)
-> (ConfigMonoid -> BuildOptsMonoid -> ConfigMonoid)
-> Lens ConfigMonoid ConfigMonoid BuildOptsMonoid BuildOptsMonoid
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    ConfigMonoid -> BuildOptsMonoid
configMonoidBuildOpts
    (\ConfigMonoid
x BuildOptsMonoid
y -> ConfigMonoid
x { configMonoidBuildOpts :: BuildOptsMonoid
configMonoidBuildOpts = BuildOptsMonoid
y })

cabalVersionL :: HasCompiler env => SimpleGetter env Version
cabalVersionL :: forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL = Getting r env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsLGetting r env CompilerPaths
-> ((Version -> Const r Version)
    -> CompilerPaths -> Const r CompilerPaths)
-> (Version -> Const r Version)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompilerPaths -> Version) -> SimpleGetter CompilerPaths Version
forall s a. (s -> a) -> SimpleGetter s a
to CompilerPaths -> Version
cpCabalVersion

whichCompilerL :: Getting r ActualCompiler WhichCompiler
whichCompilerL :: forall r. Getting r ActualCompiler WhichCompiler
whichCompilerL = (ActualCompiler -> WhichCompiler)
-> forall r. Getting r ActualCompiler WhichCompiler
forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> WhichCompiler
whichCompiler

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

shouldForceGhcColorFlag :: (HasRunner env, HasEnvConfig env)
                        => RIO env Bool
shouldForceGhcColorFlag :: forall env. (HasRunner env, HasEnvConfig env) => RIO env Bool
shouldForceGhcColorFlag = do
    Bool
canDoColor <- (Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
2, Int
1]) (Version -> Bool)
-> (ActualCompiler -> Version) -> ActualCompiler -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActualCompiler -> Version
getGhcVersion
              (ActualCompiler -> Bool) -> RIO env ActualCompiler -> RIO env Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting ActualCompiler env ActualCompiler -> RIO env ActualCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ActualCompiler env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
SimpleGetter env ActualCompiler
actualCompilerVersionL
    Bool
shouldDoColor <- Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool env Bool
forall env. HasTerm env => Lens' env Bool
Lens' env Bool
useColorL
    Bool -> RIO env Bool
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> RIO env Bool) -> Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$ Bool
canDoColor Bool -> Bool -> Bool
&& Bool
shouldDoColor

appropriateGhcColorFlag :: (HasRunner env, HasEnvConfig env)
                        => RIO env (Maybe String)
appropriateGhcColorFlag :: forall env.
(HasRunner env, HasEnvConfig env) =>
RIO env (Maybe [Char])
appropriateGhcColorFlag = Bool -> Maybe [Char]
f (Bool -> Maybe [Char]) -> RIO env Bool -> RIO env (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO env Bool
forall env. (HasRunner env, HasEnvConfig env) => RIO env Bool
shouldForceGhcColorFlag
  where f :: Bool -> Maybe [Char]
f Bool
True = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ghcColorForceFlag
        f Bool
False = Maybe [Char]
forall a. Maybe a
Nothing

-- | See 'globalTerminal'

terminalL :: HasRunner env => Lens' env Bool
terminalL :: forall env. HasRunner env => Lens' env Bool
terminalL = (GlobalOpts -> f GlobalOpts) -> env -> f env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL((GlobalOpts -> f GlobalOpts) -> env -> f env)
-> ((Bool -> f Bool) -> GlobalOpts -> f GlobalOpts)
-> (Bool -> f Bool)
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GlobalOpts -> Bool)
-> (GlobalOpts -> Bool -> GlobalOpts)
-> Lens GlobalOpts GlobalOpts Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GlobalOpts -> Bool
globalTerminal (\GlobalOpts
x Bool
y -> GlobalOpts
x { globalTerminal :: Bool
globalTerminal = Bool
y })

-- | See 'globalReExecVersion'

reExecL :: HasRunner env => SimpleGetter env Bool
reExecL :: forall env. HasRunner env => SimpleGetter env Bool
reExecL = (GlobalOpts -> Const r GlobalOpts) -> env -> Const r env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL((GlobalOpts -> Const r GlobalOpts) -> env -> Const r env)
-> ((Bool -> Const r Bool) -> GlobalOpts -> Const r GlobalOpts)
-> (Bool -> Const r Bool)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GlobalOpts -> Bool) -> SimpleGetter GlobalOpts Bool
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Char] -> Bool)
-> (GlobalOpts -> Maybe [Char]) -> GlobalOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalOpts -> Maybe [Char]
globalReExecVersion)

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