{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

-- | Project configuration, implementation in terms of legacy types.
module Distribution.Client.ProjectConfig.Legacy
  ( -- Project config skeletons
    ProjectConfigSkeleton
  , parseProject
  , instantiateProjectConfigSkeletonFetchingCompiler
  , instantiateProjectConfigSkeletonWithCompiler
  , singletonProjectConfigSkeleton
  , projectSkeletonImports

    -- * Project config in terms of legacy types
  , LegacyProjectConfig
  , parseLegacyProjectConfig
  , showLegacyProjectConfig

    -- * Conversion to and from legacy config types
  , commandLineFlagsToProjectConfig
  , convertLegacyProjectConfig
  , convertLegacyGlobalConfig
  , convertToLegacyProjectConfig

    -- * Internals, just for tests
  , parsePackageLocationTokenQ
  , renderPackageLocationToken
  ) where

import Data.Coerce (coerce)
import Distribution.Client.Compat.Prelude

import Distribution.Types.Flag (FlagName, parsecFlagAssignment)

import Distribution.Client.ProjectConfig.Types
import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..))
import Distribution.Client.Types.Repo (LocalRepo (..), RemoteRepo (..), emptyRemoteRepo, normaliseFileNoIndexURI)
import Distribution.Client.Types.RepoName (RepoName (..), unRepoName)
import Distribution.Client.Types.SourceRepo (SourceRepoList, sourceRepositoryPackageGrammar)

import Distribution.Client.Config
  ( SavedConfig (..)
  , postProcessRepo
  , remoteRepoFields
  )

import Distribution.Client.CmdInstall.ClientInstallFlags
  ( ClientInstallFlags (..)
  , clientInstallOptions
  , defaultClientInstallFlags
  )

import Distribution.Compat.Lens (toListOf, view)

import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.ProjectConfigPath

import Distribution.Client.NixStyleOptions (NixStyleFlags (..))
import Distribution.Client.ProjectFlags (ProjectFlags (..), defaultProjectFlags, projectFlagsOptions)
import Distribution.Client.Setup
  ( ConfigExFlags (..)
  , GlobalFlags (..)
  , InstallFlags (..)
  , configureExOptions
  , defaultConfigExFlags
  , defaultInstallFlags
  , globalCommand
  , installOptions
  )
import Distribution.FieldGrammar
import Distribution.Package
import Distribution.PackageDescription
  ( Condition (..)
  , ConfVar (..)
  , FlagAssignment
  , dispFlagAssignment
  )
import Distribution.PackageDescription.Configuration (simplifyWithSysParams)
import Distribution.Simple.Compiler
  ( CompilerInfo (..)
  , DebugInfoLevel (..)
  , OptimisationLevel (..)
  , interpretPackageDB
  )
import Distribution.Simple.InstallDirs (CopyDest (NoCopyDest))
import Distribution.Simple.LocalBuildInfo
  ( fromPathTemplate
  , toPathTemplate
  )
import Distribution.Simple.Program
  ( knownPrograms
  , programName
  )
import Distribution.Simple.Program.Db
  ( ProgramDb
  , defaultProgramDb
  )
import Distribution.Simple.Setup
  ( BenchmarkFlags (..)
  , CommonSetupFlags (..)
  , ConfigFlags (..)
  , DumpBuildInfo (DumpBuildInfo, NoDumpBuildInfo)
  , Flag (..)
  , HaddockFlags (..)
  , TestFlags (..)
  , benchmarkOptions'
  , configureOptions
  , defaultBenchmarkFlags
  , defaultHaddockFlags
  , defaultTestFlags
  , fromFlagOrDefault
  , haddockOptions
  , installDirsOptions
  , programDbPaths'
  , readPackageDb
  , showPackageDb
  , splitArgs
  , testOptions'
  , toFlag
  )
import Distribution.Simple.Utils
  ( debug
  , lowercase
  )
import Distribution.Types.CondTree
  ( CondBranch (..)
  , CondTree (..)
  , ignoreConditions
  , mapTreeConds
  , traverseCondTreeC
  , traverseCondTreeV
  )
import Distribution.Types.SourceRepo (RepoType)
import Distribution.Utils.NubList
  ( fromNubList
  , overNubList
  , toNubList
  )

import Distribution.Client.HttpUtils
import Distribution.Client.ParseUtils
import Distribution.Client.ReplFlags (multiReplOption)
import Distribution.Deprecated.ParseUtils
  ( PError (..)
  , PWarning (..)
  , ParseResult (..)
  , commaNewLineListFieldParsec
  , newLineListField
  , parseFail
  , parseHaskellString
  , parseTokenQ
  , showToken
  , simpleFieldParsec
  , syntaxError
  )
import qualified Distribution.Deprecated.ParseUtils as ParseUtils
import Distribution.Deprecated.ReadP
  ( ReadP
  , (+++)
  )
import qualified Distribution.Deprecated.ReadP as Parse
import Distribution.Fields.ConfVar (parseConditionConfVarFromClause)
import Distribution.Parsec (ParsecParser, parsecToken)
import Distribution.Simple.Command
  ( CommandUI (commandOptions)
  , OptionField (..)
  , ShowOrParseArgs (..)
  , option
  , reqArg'
  )
import Distribution.System (Arch, OS, buildOS)
import Distribution.Types.PackageVersionConstraint
  ( PackageVersionConstraint
  )
import Distribution.Utils.Path hiding
  ( (<.>)
  , (</>)
  )

import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as Map
import qualified Data.Set as Set
import Network.URI (URI (..), nullURIAuth, parseURI)
import System.Directory (createDirectoryIfMissing, makeAbsolute)
import System.FilePath (isAbsolute, isPathSeparator, makeValid, splitFileName, (</>))
import Text.PrettyPrint
  ( Doc
  , render
  , ($+$)
  )
import qualified Text.PrettyPrint as Disp

------------------------------------------------------------------
-- Handle extended project config files with conditionals and imports.
--

-- | ProjectConfigSkeleton is a tree of conditional blocks and imports wrapping a config. It can be finalized by providing the conditional resolution info
-- and then resolving and downloading the imports
type ProjectConfigSkeleton = CondTree ConfVar [ProjectConfigPath] ProjectConfig

singletonProjectConfigSkeleton :: ProjectConfig -> ProjectConfigSkeleton
singletonProjectConfigSkeleton :: ProjectConfig -> ProjectConfigSkeleton
singletonProjectConfigSkeleton ProjectConfig
x = ProjectConfig
-> [ProjectConfigPath]
-> [CondBranch ConfVar [ProjectConfigPath] ProjectConfig]
-> ProjectConfigSkeleton
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode ProjectConfig
x [ProjectConfigPath]
forall a. Monoid a => a
mempty [CondBranch ConfVar [ProjectConfigPath] ProjectConfig]
forall a. Monoid a => a
mempty

instantiateProjectConfigSkeletonFetchingCompiler :: Monad m => m (OS, Arch, CompilerInfo) -> FlagAssignment -> ProjectConfigSkeleton -> m ProjectConfig
instantiateProjectConfigSkeletonFetchingCompiler :: forall (m :: * -> *).
Monad m =>
m (OS, Arch, CompilerInfo)
-> FlagAssignment -> ProjectConfigSkeleton -> m ProjectConfig
instantiateProjectConfigSkeletonFetchingCompiler m (OS, Arch, CompilerInfo)
fetch FlagAssignment
flags ProjectConfigSkeleton
skel
  | [ConfVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Getting (DList ConfVar) ProjectConfigSkeleton ConfVar
-> ProjectConfigSkeleton -> [ConfVar]
forall a s. Getting (DList a) s a -> s -> [a]
toListOf Getting (DList ConfVar) ProjectConfigSkeleton ConfVar
forall v c a w (f :: * -> *).
Applicative f =>
LensLike f (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV ProjectConfigSkeleton
skel) = ProjectConfig -> m ProjectConfig
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectConfig -> m ProjectConfig)
-> ProjectConfig -> m ProjectConfig
forall a b. (a -> b) -> a -> b
$ (ProjectConfig, [ProjectConfigPath]) -> ProjectConfig
forall a b. (a, b) -> a
fst (ProjectConfigSkeleton -> (ProjectConfig, [ProjectConfigPath])
forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
ignoreConditions ProjectConfigSkeleton
skel)
  | Bool
otherwise = do
      (OS
os, Arch
arch, CompilerInfo
impl) <- m (OS, Arch, CompilerInfo)
fetch
      ProjectConfig -> m ProjectConfig
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectConfig -> m ProjectConfig)
-> ProjectConfig -> m ProjectConfig
forall a b. (a -> b) -> a -> b
$ OS
-> Arch
-> CompilerInfo
-> FlagAssignment
-> ProjectConfigSkeleton
-> ProjectConfig
instantiateProjectConfigSkeletonWithCompiler OS
os Arch
arch CompilerInfo
impl FlagAssignment
flags ProjectConfigSkeleton
skel

instantiateProjectConfigSkeletonWithCompiler :: OS -> Arch -> CompilerInfo -> FlagAssignment -> ProjectConfigSkeleton -> ProjectConfig
instantiateProjectConfigSkeletonWithCompiler :: OS
-> Arch
-> CompilerInfo
-> FlagAssignment
-> ProjectConfigSkeleton
-> ProjectConfig
instantiateProjectConfigSkeletonWithCompiler OS
os Arch
arch CompilerInfo
impl FlagAssignment
_flags ProjectConfigSkeleton
skel = CondTree FlagName [ProjectConfigPath] ProjectConfig
-> ProjectConfig
go (CondTree FlagName [ProjectConfigPath] ProjectConfig
 -> ProjectConfig)
-> CondTree FlagName [ProjectConfigPath] ProjectConfig
-> ProjectConfig
forall a b. (a -> b) -> a -> b
$ (Condition ConfVar -> Condition FlagName)
-> ProjectConfigSkeleton
-> CondTree FlagName [ProjectConfigPath] ProjectConfig
forall v w c a.
(Condition v -> Condition w) -> CondTree v c a -> CondTree w c a
mapTreeConds ((Condition FlagName, [FlagName]) -> Condition FlagName
forall a b. (a, b) -> a
fst ((Condition FlagName, [FlagName]) -> Condition FlagName)
-> (Condition ConfVar -> (Condition FlagName, [FlagName]))
-> Condition ConfVar
-> Condition FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OS
-> Arch
-> CompilerInfo
-> Condition ConfVar
-> (Condition FlagName, [FlagName])
simplifyWithSysParams OS
os Arch
arch CompilerInfo
impl) ProjectConfigSkeleton
skel
  where
    go
      :: CondTree
          FlagName
          [ProjectConfigPath]
          ProjectConfig
      -> ProjectConfig
    go :: CondTree FlagName [ProjectConfigPath] ProjectConfig
-> ProjectConfig
go (CondNode ProjectConfig
l [ProjectConfigPath]
_imps [CondBranch FlagName [ProjectConfigPath] ProjectConfig]
ts) =
      let branches :: [ProjectConfig]
branches = (CondBranch FlagName [ProjectConfigPath] ProjectConfig
 -> [ProjectConfig])
-> [CondBranch FlagName [ProjectConfigPath] ProjectConfig]
-> [ProjectConfig]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondBranch FlagName [ProjectConfigPath] ProjectConfig
-> [ProjectConfig]
processBranch [CondBranch FlagName [ProjectConfigPath] ProjectConfig]
ts
       in ProjectConfig
l ProjectConfig -> ProjectConfig -> ProjectConfig
forall a. Semigroup a => a -> a -> a
<> [ProjectConfig] -> ProjectConfig
forall a. Monoid a => [a] -> a
mconcat [ProjectConfig]
branches
    processBranch :: CondBranch FlagName [ProjectConfigPath] ProjectConfig
-> [ProjectConfig]
processBranch (CondBranch Condition FlagName
cnd CondTree FlagName [ProjectConfigPath] ProjectConfig
t Maybe (CondTree FlagName [ProjectConfigPath] ProjectConfig)
mf) = case Condition FlagName
cnd of
      (Lit Bool
True) -> [CondTree FlagName [ProjectConfigPath] ProjectConfig
-> ProjectConfig
go CondTree FlagName [ProjectConfigPath] ProjectConfig
t]
      (Lit Bool
False) -> [ProjectConfig]
-> (CondTree FlagName [ProjectConfigPath] ProjectConfig
    -> [ProjectConfig])
-> Maybe (CondTree FlagName [ProjectConfigPath] ProjectConfig)
-> [ProjectConfig]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([]) ((ProjectConfig -> [ProjectConfig] -> [ProjectConfig]
forall a. a -> [a] -> [a]
: []) (ProjectConfig -> [ProjectConfig])
-> (CondTree FlagName [ProjectConfigPath] ProjectConfig
    -> ProjectConfig)
-> CondTree FlagName [ProjectConfigPath] ProjectConfig
-> [ProjectConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree FlagName [ProjectConfigPath] ProjectConfig
-> ProjectConfig
go) Maybe (CondTree FlagName [ProjectConfigPath] ProjectConfig)
mf
      Condition FlagName
_ -> String -> [ProjectConfig]
forall a. HasCallStack => String -> a
error (String -> [ProjectConfig]) -> String -> [ProjectConfig]
forall a b. (a -> b) -> a -> b
$ String
"unable to process condition: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Condition FlagName -> String
forall a. Show a => a -> String
show Condition FlagName
cnd -- TODO it would be nice if there were a pretty printer

projectSkeletonImports :: ProjectConfigSkeleton -> [ProjectConfigPath]
projectSkeletonImports :: ProjectConfigSkeleton -> [ProjectConfigPath]
projectSkeletonImports = Getting
  [ProjectConfigPath] ProjectConfigSkeleton [ProjectConfigPath]
-> ProjectConfigSkeleton -> [ProjectConfigPath]
forall a s. Getting a s a -> s -> a
view Getting
  [ProjectConfigPath] ProjectConfigSkeleton [ProjectConfigPath]
forall v c a d (f :: * -> *).
Applicative f =>
LensLike f (CondTree v c a) (CondTree v d a) c d
traverseCondTreeC

-- | Parses a project from its root config file, typically cabal.project.
parseProject
  :: FilePath
  -- ^ The root of the project configuration, typically cabal.project
  -> FilePath
  -> HttpTransport
  -> Verbosity
  -> ProjectConfigToParse
  -- ^ The contents of the file to parse
  -> IO (ParseResult ProjectConfigSkeleton)
parseProject :: String
-> String
-> HttpTransport
-> Verbosity
-> ProjectConfigToParse
-> IO (ParseResult ProjectConfigSkeleton)
parseProject String
rootPath String
cacheDir HttpTransport
httpTransport Verbosity
verbosity ProjectConfigToParse
configToParse = do
  let (String
dir, String
projectFileName) = String -> (String, String)
splitFileName String
rootPath
  String
projectDir <- String -> IO String
makeAbsolute String
dir
  ProjectConfigPath
projectPath <- String -> ProjectConfigPath -> IO ProjectConfigPath
canonicalizeConfigPath String
projectDir (NonEmpty String -> ProjectConfigPath
ProjectConfigPath (NonEmpty String -> ProjectConfigPath)
-> NonEmpty String -> ProjectConfigPath
forall a b. (a -> b) -> a -> b
$ String
projectFileName String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [])
  String
-> HttpTransport
-> Verbosity
-> String
-> ProjectConfigPath
-> ProjectConfigToParse
-> IO (ParseResult ProjectConfigSkeleton)
parseProjectSkeleton String
cacheDir HttpTransport
httpTransport Verbosity
verbosity String
projectDir ProjectConfigPath
projectPath ProjectConfigToParse
configToParse

parseProjectSkeleton
  :: FilePath
  -> HttpTransport
  -> Verbosity
  -> FilePath
  -- ^ The directory of the project configuration, typically the directory of cabal.project
  -> ProjectConfigPath
  -- ^ The path of the file being parsed, either the root or an import
  -> ProjectConfigToParse
  -- ^ The contents of the file to parse
  -> IO (ParseResult ProjectConfigSkeleton)
parseProjectSkeleton :: String
-> HttpTransport
-> Verbosity
-> String
-> ProjectConfigPath
-> ProjectConfigToParse
-> IO (ParseResult ProjectConfigSkeleton)
parseProjectSkeleton String
cacheDir HttpTransport
httpTransport Verbosity
verbosity String
projectDir ProjectConfigPath
source (ProjectConfigToParse ByteString
bs) =
  (Bool -> ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton
sanityWalkPCS Bool
False (ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton)
-> ParseResult ProjectConfigSkeleton
-> ParseResult ProjectConfigSkeleton
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (ParseResult ProjectConfigSkeleton
 -> ParseResult ProjectConfigSkeleton)
-> IO (ParseResult ProjectConfigSkeleton)
-> IO (ParseResult ProjectConfigSkeleton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Field] -> IO (ParseResult ProjectConfigSkeleton))
-> ParseResult [Field] -> IO (ParseResult ProjectConfigSkeleton)
forall a b.
(a -> IO (ParseResult b)) -> ParseResult a -> IO (ParseResult b)
liftPR ([Field] -> [Field] -> IO (ParseResult ProjectConfigSkeleton)
go []) (ByteString -> ParseResult [Field]
ParseUtils.readFields ByteString
bs)
  where
    go :: [ParseUtils.Field] -> [ParseUtils.Field] -> IO (ParseResult ProjectConfigSkeleton)
    go :: [Field] -> [Field] -> IO (ParseResult ProjectConfigSkeleton)
go [Field]
acc (Field
x : [Field]
xs) = case Field
x of
      (ParseUtils.F Int
_ String
"import" String
importLoc) -> do
        let importLocPath :: ProjectConfigPath
importLocPath = String
importLoc String -> ProjectConfigPath -> ProjectConfigPath
`consProjectConfigPath` ProjectConfigPath
source

        -- Once we canonicalize the import path, we can check for cyclical imports
        ProjectConfigPath
normLocPath <- String -> ProjectConfigPath -> IO ProjectConfigPath
canonicalizeConfigPath String
projectDir ProjectConfigPath
importLocPath

        Verbosity -> String -> IO ()
debug Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\nimport path, normalized\n=======================\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
render (ProjectConfigPath -> Doc
docProjectConfigPath ProjectConfigPath
normLocPath)

        if ProjectConfigPath -> Bool
isCyclicConfigPath ProjectConfigPath
normLocPath
          then ParseResult ProjectConfigSkeleton
-> IO (ParseResult ProjectConfigSkeleton)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult ProjectConfigSkeleton
 -> IO (ParseResult ProjectConfigSkeleton))
-> (PError -> ParseResult ProjectConfigSkeleton)
-> PError
-> IO (ParseResult ProjectConfigSkeleton)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PError -> ParseResult ProjectConfigSkeleton
forall a. PError -> ParseResult a
parseFail (PError -> IO (ParseResult ProjectConfigSkeleton))
-> PError -> IO (ParseResult ProjectConfigSkeleton)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int -> PError
ParseUtils.FromString (Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ ProjectConfigPath -> Doc
cyclicalImportMsg ProjectConfigPath
normLocPath) Maybe Int
forall a. Maybe a
Nothing
          else do
            ProjectConfigPath
normSource <- String -> ProjectConfigPath -> IO ProjectConfigPath
canonicalizeConfigPath String
projectDir ProjectConfigPath
source
            let fs :: ParseResult (CondTree v [ProjectConfigPath] ProjectConfig)
fs = (\ProjectConfig
z -> ProjectConfig
-> [ProjectConfigPath]
-> [CondBranch v [ProjectConfigPath] ProjectConfig]
-> CondTree v [ProjectConfigPath] ProjectConfig
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode ProjectConfig
z [ProjectConfigPath
normLocPath] [CondBranch v [ProjectConfigPath] ProjectConfig]
forall a. Monoid a => a
mempty) (ProjectConfig -> CondTree v [ProjectConfigPath] ProjectConfig)
-> ParseResult ProjectConfig
-> ParseResult (CondTree v [ProjectConfigPath] ProjectConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectConfigPath -> [Field] -> ParseResult ProjectConfig
fieldsToConfig ProjectConfigPath
normSource ([Field] -> [Field]
forall a. [a] -> [a]
reverse [Field]
acc)
            ParseResult ProjectConfigSkeleton
res <- String
-> HttpTransport
-> Verbosity
-> String
-> ProjectConfigPath
-> ProjectConfigToParse
-> IO (ParseResult ProjectConfigSkeleton)
parseProjectSkeleton String
cacheDir HttpTransport
httpTransport Verbosity
verbosity String
projectDir ProjectConfigPath
importLocPath (ProjectConfigToParse -> IO (ParseResult ProjectConfigSkeleton))
-> (ByteString -> ProjectConfigToParse)
-> ByteString
-> IO (ParseResult ProjectConfigSkeleton)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ProjectConfigToParse
ProjectConfigToParse (ByteString -> IO (ParseResult ProjectConfigSkeleton))
-> IO ByteString -> IO (ParseResult ProjectConfigSkeleton)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectConfigPath -> IO ByteString
fetchImportConfig ProjectConfigPath
normLocPath
            ParseResult ProjectConfigSkeleton
rest <- [Field] -> [Field] -> IO (ParseResult ProjectConfigSkeleton)
go [] [Field]
xs
            ParseResult ProjectConfigSkeleton
-> IO (ParseResult ProjectConfigSkeleton)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult ProjectConfigSkeleton
 -> IO (ParseResult ProjectConfigSkeleton))
-> ([ParseResult ProjectConfigSkeleton]
    -> ParseResult ProjectConfigSkeleton)
-> [ParseResult ProjectConfigSkeleton]
-> IO (ParseResult ProjectConfigSkeleton)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ProjectConfigSkeleton] -> ProjectConfigSkeleton)
-> ParseResult [ProjectConfigSkeleton]
-> ParseResult ProjectConfigSkeleton
forall a b. (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ProjectConfigSkeleton] -> ProjectConfigSkeleton
forall a. Monoid a => [a] -> a
mconcat (ParseResult [ProjectConfigSkeleton]
 -> ParseResult ProjectConfigSkeleton)
-> ([ParseResult ProjectConfigSkeleton]
    -> ParseResult [ProjectConfigSkeleton])
-> [ParseResult ProjectConfigSkeleton]
-> ParseResult ProjectConfigSkeleton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParseResult ProjectConfigSkeleton]
-> ParseResult [ProjectConfigSkeleton]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([ParseResult ProjectConfigSkeleton]
 -> IO (ParseResult ProjectConfigSkeleton))
-> [ParseResult ProjectConfigSkeleton]
-> IO (ParseResult ProjectConfigSkeleton)
forall a b. (a -> b) -> a -> b
$ [ParseResult ProjectConfigSkeleton
forall {v}.
ParseResult (CondTree v [ProjectConfigPath] ProjectConfig)
fs, ParseResult ProjectConfigSkeleton
res, ParseResult ProjectConfigSkeleton
rest]
      (ParseUtils.Section Int
l String
"if" String
p [Field]
xs') -> do
        ParseResult ProjectConfigSkeleton
subpcs <- [Field] -> [Field] -> IO (ParseResult ProjectConfigSkeleton)
go [] [Field]
xs'
        let fs :: ParseResult ProjectConfigSkeleton
fs = ProjectConfig -> ProjectConfigSkeleton
singletonProjectConfigSkeleton (ProjectConfig -> ProjectConfigSkeleton)
-> ParseResult ProjectConfig -> ParseResult ProjectConfigSkeleton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectConfigPath -> [Field] -> ParseResult ProjectConfig
fieldsToConfig ProjectConfigPath
source ([Field] -> [Field]
forall a. [a] -> [a]
reverse [Field]
acc)
        (ParseResult (Maybe ProjectConfigSkeleton)
elseClauses, ParseResult ProjectConfigSkeleton
rest) <- [Field]
-> IO
     (ParseResult (Maybe ProjectConfigSkeleton),
      ParseResult ProjectConfigSkeleton)
parseElseClauses [Field]
xs
        let condNode :: ParseResult ProjectConfigSkeleton
condNode =
              (\Condition ConfVar
c ProjectConfigSkeleton
pcs Maybe ProjectConfigSkeleton
e -> ProjectConfig
-> [ProjectConfigPath]
-> [CondBranch ConfVar [ProjectConfigPath] ProjectConfig]
-> ProjectConfigSkeleton
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode ProjectConfig
forall a. Monoid a => a
mempty [ProjectConfigPath]
forall a. Monoid a => a
mempty [Condition ConfVar
-> ProjectConfigSkeleton
-> Maybe ProjectConfigSkeleton
-> CondBranch ConfVar [ProjectConfigPath] ProjectConfig
forall v c a.
Condition v
-> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a
CondBranch Condition ConfVar
c ProjectConfigSkeleton
pcs Maybe ProjectConfigSkeleton
e])
                (Condition ConfVar
 -> ProjectConfigSkeleton
 -> Maybe ProjectConfigSkeleton
 -> ProjectConfigSkeleton)
-> ParseResult (Condition ConfVar)
-> ParseResult
     (ProjectConfigSkeleton
      -> Maybe ProjectConfigSkeleton -> ProjectConfigSkeleton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                -- we rewrap as as a section so the readFields lexer of the conditional parser doesn't get confused
                Int
-> Either ParseError (Condition ConfVar)
-> ParseResult (Condition ConfVar)
forall {a} {a}. Show a => Int -> Either a a -> ParseResult a
adaptParseError Int
l (ByteString -> Either ParseError (Condition ConfVar)
parseConditionConfVarFromClause (ByteString -> Either ParseError (Condition ConfVar))
-> (String -> ByteString)
-> String
-> Either ParseError (Condition ConfVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> Either ParseError (Condition ConfVar))
-> String -> Either ParseError (Condition ConfVar)
forall a b. (a -> b) -> a -> b
$ String
"if(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
p String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")")
                ParseResult
  (ProjectConfigSkeleton
   -> Maybe ProjectConfigSkeleton -> ProjectConfigSkeleton)
-> ParseResult ProjectConfigSkeleton
-> ParseResult
     (Maybe ProjectConfigSkeleton -> ProjectConfigSkeleton)
forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParseResult ProjectConfigSkeleton
subpcs
                ParseResult (Maybe ProjectConfigSkeleton -> ProjectConfigSkeleton)
-> ParseResult (Maybe ProjectConfigSkeleton)
-> ParseResult ProjectConfigSkeleton
forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParseResult (Maybe ProjectConfigSkeleton)
elseClauses
        ParseResult ProjectConfigSkeleton
-> IO (ParseResult ProjectConfigSkeleton)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult ProjectConfigSkeleton
 -> IO (ParseResult ProjectConfigSkeleton))
-> ([ParseResult ProjectConfigSkeleton]
    -> ParseResult ProjectConfigSkeleton)
-> [ParseResult ProjectConfigSkeleton]
-> IO (ParseResult ProjectConfigSkeleton)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ProjectConfigSkeleton] -> ProjectConfigSkeleton)
-> ParseResult [ProjectConfigSkeleton]
-> ParseResult ProjectConfigSkeleton
forall a b. (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ProjectConfigSkeleton] -> ProjectConfigSkeleton
forall a. Monoid a => [a] -> a
mconcat (ParseResult [ProjectConfigSkeleton]
 -> ParseResult ProjectConfigSkeleton)
-> ([ParseResult ProjectConfigSkeleton]
    -> ParseResult [ProjectConfigSkeleton])
-> [ParseResult ProjectConfigSkeleton]
-> ParseResult ProjectConfigSkeleton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParseResult ProjectConfigSkeleton]
-> ParseResult [ProjectConfigSkeleton]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([ParseResult ProjectConfigSkeleton]
 -> IO (ParseResult ProjectConfigSkeleton))
-> [ParseResult ProjectConfigSkeleton]
-> IO (ParseResult ProjectConfigSkeleton)
forall a b. (a -> b) -> a -> b
$ [ParseResult ProjectConfigSkeleton
fs, ParseResult ProjectConfigSkeleton
condNode, ParseResult ProjectConfigSkeleton
rest]
      Field
_ -> [Field] -> [Field] -> IO (ParseResult ProjectConfigSkeleton)
go (Field
x Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
: [Field]
acc) [Field]
xs
    go [Field]
acc [] = do
      ProjectConfigPath
normSource <- String -> ProjectConfigPath -> IO ProjectConfigPath
canonicalizeConfigPath String
projectDir ProjectConfigPath
source
      ParseResult ProjectConfigSkeleton
-> IO (ParseResult ProjectConfigSkeleton)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult ProjectConfigSkeleton
 -> IO (ParseResult ProjectConfigSkeleton))
-> ([Field] -> ParseResult ProjectConfigSkeleton)
-> [Field]
-> IO (ParseResult ProjectConfigSkeleton)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectConfig -> ProjectConfigSkeleton)
-> ParseResult ProjectConfig -> ParseResult ProjectConfigSkeleton
forall a b. (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProjectConfig -> ProjectConfigSkeleton
singletonProjectConfigSkeleton (ParseResult ProjectConfig -> ParseResult ProjectConfigSkeleton)
-> ([Field] -> ParseResult ProjectConfig)
-> [Field]
-> ParseResult ProjectConfigSkeleton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfigPath -> [Field] -> ParseResult ProjectConfig
fieldsToConfig ProjectConfigPath
normSource ([Field] -> IO (ParseResult ProjectConfigSkeleton))
-> [Field] -> IO (ParseResult ProjectConfigSkeleton)
forall a b. (a -> b) -> a -> b
$ [Field] -> [Field]
forall a. [a] -> [a]
reverse [Field]
acc

    parseElseClauses :: [ParseUtils.Field] -> IO (ParseResult (Maybe ProjectConfigSkeleton), ParseResult ProjectConfigSkeleton)
    parseElseClauses :: [Field]
-> IO
     (ParseResult (Maybe ProjectConfigSkeleton),
      ParseResult ProjectConfigSkeleton)
parseElseClauses [Field]
x = case [Field]
x of
      (ParseUtils.Section Int
_l String
"else" String
_p [Field]
xs' : [Field]
xs) -> do
        ParseResult ProjectConfigSkeleton
subpcs <- [Field] -> [Field] -> IO (ParseResult ProjectConfigSkeleton)
go [] [Field]
xs'
        ParseResult ProjectConfigSkeleton
rest <- [Field] -> [Field] -> IO (ParseResult ProjectConfigSkeleton)
go [] [Field]
xs
        (ParseResult (Maybe ProjectConfigSkeleton),
 ParseResult ProjectConfigSkeleton)
-> IO
     (ParseResult (Maybe ProjectConfigSkeleton),
      ParseResult ProjectConfigSkeleton)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectConfigSkeleton -> Maybe ProjectConfigSkeleton
forall a. a -> Maybe a
Just (ProjectConfigSkeleton -> Maybe ProjectConfigSkeleton)
-> ParseResult ProjectConfigSkeleton
-> ParseResult (Maybe ProjectConfigSkeleton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseResult ProjectConfigSkeleton
subpcs, ParseResult ProjectConfigSkeleton
rest)
      (ParseUtils.Section Int
l String
"elif" String
p [Field]
xs' : [Field]
xs) -> do
        ParseResult ProjectConfigSkeleton
subpcs <- [Field] -> [Field] -> IO (ParseResult ProjectConfigSkeleton)
go [] [Field]
xs'
        (ParseResult (Maybe ProjectConfigSkeleton)
elseClauses, ParseResult ProjectConfigSkeleton
rest) <- [Field]
-> IO
     (ParseResult (Maybe ProjectConfigSkeleton),
      ParseResult ProjectConfigSkeleton)
parseElseClauses [Field]
xs
        let condNode :: ParseResult ProjectConfigSkeleton
condNode =
              (\Condition ConfVar
c ProjectConfigSkeleton
pcs Maybe ProjectConfigSkeleton
e -> ProjectConfig
-> [ProjectConfigPath]
-> [CondBranch ConfVar [ProjectConfigPath] ProjectConfig]
-> ProjectConfigSkeleton
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode ProjectConfig
forall a. Monoid a => a
mempty [ProjectConfigPath]
forall a. Monoid a => a
mempty [Condition ConfVar
-> ProjectConfigSkeleton
-> Maybe ProjectConfigSkeleton
-> CondBranch ConfVar [ProjectConfigPath] ProjectConfig
forall v c a.
Condition v
-> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a
CondBranch Condition ConfVar
c ProjectConfigSkeleton
pcs Maybe ProjectConfigSkeleton
e])
                (Condition ConfVar
 -> ProjectConfigSkeleton
 -> Maybe ProjectConfigSkeleton
 -> ProjectConfigSkeleton)
-> ParseResult (Condition ConfVar)
-> ParseResult
     (ProjectConfigSkeleton
      -> Maybe ProjectConfigSkeleton -> ProjectConfigSkeleton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Either ParseError (Condition ConfVar)
-> ParseResult (Condition ConfVar)
forall {a} {a}. Show a => Int -> Either a a -> ParseResult a
adaptParseError Int
l (ByteString -> Either ParseError (Condition ConfVar)
parseConditionConfVarFromClause (ByteString -> Either ParseError (Condition ConfVar))
-> (String -> ByteString)
-> String
-> Either ParseError (Condition ConfVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> Either ParseError (Condition ConfVar))
-> String -> Either ParseError (Condition ConfVar)
forall a b. (a -> b) -> a -> b
$ String
"else(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
p String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")")
                ParseResult
  (ProjectConfigSkeleton
   -> Maybe ProjectConfigSkeleton -> ProjectConfigSkeleton)
-> ParseResult ProjectConfigSkeleton
-> ParseResult
     (Maybe ProjectConfigSkeleton -> ProjectConfigSkeleton)
forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParseResult ProjectConfigSkeleton
subpcs
                ParseResult (Maybe ProjectConfigSkeleton -> ProjectConfigSkeleton)
-> ParseResult (Maybe ProjectConfigSkeleton)
-> ParseResult ProjectConfigSkeleton
forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParseResult (Maybe ProjectConfigSkeleton)
elseClauses
        (ParseResult (Maybe ProjectConfigSkeleton),
 ParseResult ProjectConfigSkeleton)
-> IO
     (ParseResult (Maybe ProjectConfigSkeleton),
      ParseResult ProjectConfigSkeleton)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectConfigSkeleton -> Maybe ProjectConfigSkeleton
forall a. a -> Maybe a
Just (ProjectConfigSkeleton -> Maybe ProjectConfigSkeleton)
-> ParseResult ProjectConfigSkeleton
-> ParseResult (Maybe ProjectConfigSkeleton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseResult ProjectConfigSkeleton
condNode, ParseResult ProjectConfigSkeleton
rest)
      [Field]
_ -> (\ParseResult ProjectConfigSkeleton
r -> (Maybe ProjectConfigSkeleton
-> ParseResult (Maybe ProjectConfigSkeleton)
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ProjectConfigSkeleton
forall a. Maybe a
Nothing, ParseResult ProjectConfigSkeleton
r)) (ParseResult ProjectConfigSkeleton
 -> (ParseResult (Maybe ProjectConfigSkeleton),
     ParseResult ProjectConfigSkeleton))
-> IO (ParseResult ProjectConfigSkeleton)
-> IO
     (ParseResult (Maybe ProjectConfigSkeleton),
      ParseResult ProjectConfigSkeleton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field] -> [Field] -> IO (ParseResult ProjectConfigSkeleton)
go [] [Field]
x

    -- We want a normalized path for @fieldsToConfig@. This eventually surfaces
    -- in solver rejection messages and build messages "this build was affected
    -- by the following (project) config files" so we want all paths shown there
    -- to be relative to the directory of the project, not relative to the file
    -- they were imported from.
    fieldsToConfig :: ProjectConfigPath -> [ParseUtils.Field] -> ParseResult ProjectConfig
    fieldsToConfig :: ProjectConfigPath -> [Field] -> ParseResult ProjectConfig
fieldsToConfig ProjectConfigPath
sourceConfigPath [Field]
xs =
      ProjectConfigPath -> ProjectConfig -> ProjectConfig
addProvenance ProjectConfigPath
sourceConfigPath (ProjectConfig -> ProjectConfig)
-> (LegacyProjectConfig -> ProjectConfig)
-> LegacyProjectConfig
-> ProjectConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyProjectConfig -> ProjectConfig
convertLegacyProjectConfig
        (LegacyProjectConfig -> ProjectConfig)
-> ParseResult LegacyProjectConfig -> ParseResult ProjectConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectConfigPath -> [Field] -> ParseResult LegacyProjectConfig
parseLegacyProjectConfigFields ProjectConfigPath
sourceConfigPath [Field]
xs

    addProvenance :: ProjectConfigPath -> ProjectConfig -> ProjectConfig
    addProvenance :: ProjectConfigPath -> ProjectConfig -> ProjectConfig
addProvenance ProjectConfigPath
sourcePath ProjectConfig
x = ProjectConfig
x{projectConfigProvenance = Set.singleton $ Explicit sourcePath}

    adaptParseError :: Int -> Either a a -> ParseResult a
adaptParseError Int
_ (Right a
x) = a -> ParseResult a
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    adaptParseError Int
l (Left a
e) = PError -> ParseResult a
forall a. PError -> ParseResult a
parseFail (PError -> ParseResult a) -> PError -> ParseResult a
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int -> PError
ParseUtils.FromString (a -> String
forall a. Show a => a -> String
show a
e) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
l)

    liftPR :: (a -> IO (ParseResult b)) -> ParseResult a -> IO (ParseResult b)
    liftPR :: forall a b.
(a -> IO (ParseResult b)) -> ParseResult a -> IO (ParseResult b)
liftPR a -> IO (ParseResult b)
f (ParseOk [PWarning]
ws a
x) = ParseResult b -> ParseResult b
forall {a}. ParseResult a -> ParseResult a
addWarnings (ParseResult b -> ParseResult b)
-> IO (ParseResult b) -> IO (ParseResult b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> IO (ParseResult b)
f a
x
      where
        addWarnings :: ParseResult a -> ParseResult a
addWarnings (ParseOk [PWarning]
ws' a
x') = [PWarning] -> a -> ParseResult a
forall a. [PWarning] -> a -> ParseResult a
ParseOk ([PWarning]
ws' [PWarning] -> [PWarning] -> [PWarning]
forall a. [a] -> [a] -> [a]
++ [PWarning]
ws) a
x'
        addWarnings ParseResult a
x' = ParseResult a
x'
    liftPR a -> IO (ParseResult b)
_ (ParseFailed PError
e) = ParseResult b -> IO (ParseResult b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult b -> IO (ParseResult b))
-> ParseResult b -> IO (ParseResult b)
forall a b. (a -> b) -> a -> b
$ PError -> ParseResult b
forall a. PError -> ParseResult a
ParseFailed PError
e

    fetchImportConfig :: ProjectConfigPath -> IO BS.ByteString
    fetchImportConfig :: ProjectConfigPath -> IO ByteString
fetchImportConfig (ProjectConfigPath (String
pci :| [String]
_)) = do
      Verbosity -> String -> IO ()
debug Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"fetching import: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pci
      String -> IO ByteString
fetch String
pci

    fetch :: FilePath -> IO BS.ByteString
    fetch :: String -> IO ByteString
fetch String
pci = case String -> Maybe URI
parseURI String
pci of
      Just URI
uri -> do
        let fp :: String
fp = String
cacheDir String -> String -> String
</> (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char -> Bool
isPathSeparator Char
x then Char
'_' else Char
x) (String -> String
makeValid (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ URI -> String
forall a. Show a => a -> String
show URI
uri)
        Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
cacheDir
        DownloadResult
_ <- HttpTransport -> Verbosity -> URI -> String -> IO DownloadResult
downloadURI HttpTransport
httpTransport Verbosity
verbosity URI
uri String
fp
        String -> IO ByteString
BS.readFile String
fp
      Maybe URI
Nothing ->
        String -> IO ByteString
BS.readFile (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$
          if String -> Bool
isAbsolute String
pci then String
pci else String -> String
forall a b. Coercible a b => a -> b
coerce String
projectDir String -> String -> String
</> String
pci

    modifiesCompiler :: ProjectConfig -> Bool
    modifiesCompiler :: ProjectConfig -> Bool
modifiesCompiler ProjectConfig
pc = (ProjectConfigShared -> Flag CompilerFlavor) -> Bool
forall {a}. Eq a => (ProjectConfigShared -> Flag a) -> Bool
isSet ProjectConfigShared -> Flag CompilerFlavor
projectConfigHcFlavor Bool -> Bool -> Bool
|| (ProjectConfigShared -> Flag String) -> Bool
forall {a}. Eq a => (ProjectConfigShared -> Flag a) -> Bool
isSet ProjectConfigShared -> Flag String
projectConfigHcPath Bool -> Bool -> Bool
|| (ProjectConfigShared -> Flag String) -> Bool
forall {a}. Eq a => (ProjectConfigShared -> Flag a) -> Bool
isSet ProjectConfigShared -> Flag String
projectConfigHcPkg
      where
        isSet :: (ProjectConfigShared -> Flag a) -> Bool
isSet ProjectConfigShared -> Flag a
f = ProjectConfigShared -> Flag a
f (ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
pc) Flag a -> Flag a -> Bool
forall a. Eq a => a -> a -> Bool
/= Flag a
forall a. Flag a
NoFlag

    sanityWalkPCS :: Bool -> ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton
    sanityWalkPCS :: Bool -> ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton
sanityWalkPCS Bool
underConditional t :: ProjectConfigSkeleton
t@(CondNode ProjectConfig
d [ProjectConfigPath]
_c [CondBranch ConfVar [ProjectConfigPath] ProjectConfig]
comps)
      | Bool
underConditional Bool -> Bool -> Bool
&& ProjectConfig -> Bool
modifiesCompiler ProjectConfig
d = PError -> ParseResult ProjectConfigSkeleton
forall a. PError -> ParseResult a
parseFail (PError -> ParseResult ProjectConfigSkeleton)
-> PError -> ParseResult ProjectConfigSkeleton
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int -> PError
ParseUtils.FromString String
"Cannot set compiler in a conditional clause of a cabal project file" Maybe Int
forall a. Maybe a
Nothing
      | Bool
otherwise = (CondBranch ConfVar [ProjectConfigPath] ProjectConfig
 -> ParseResult ())
-> [CondBranch ConfVar [ProjectConfigPath] ProjectConfig]
-> ParseResult ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CondBranch ConfVar [ProjectConfigPath] ProjectConfig
-> ParseResult ()
sanityWalkBranch [CondBranch ConfVar [ProjectConfigPath] ProjectConfig]
comps ParseResult ()
-> ParseResult ProjectConfigSkeleton
-> ParseResult ProjectConfigSkeleton
forall a b. ParseResult a -> ParseResult b -> ParseResult b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectConfigSkeleton
t

    sanityWalkBranch :: CondBranch ConfVar [ProjectConfigPath] ProjectConfig -> ParseResult ()
    sanityWalkBranch :: CondBranch ConfVar [ProjectConfigPath] ProjectConfig
-> ParseResult ()
sanityWalkBranch (CondBranch Condition ConfVar
_c ProjectConfigSkeleton
t Maybe ProjectConfigSkeleton
f) = (ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton)
-> Maybe ProjectConfigSkeleton -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool -> ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton
sanityWalkPCS Bool
True) Maybe ProjectConfigSkeleton
f ParseResult ()
-> ParseResult ProjectConfigSkeleton
-> ParseResult ProjectConfigSkeleton
forall a b. ParseResult a -> ParseResult b -> ParseResult b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton
sanityWalkPCS Bool
True ProjectConfigSkeleton
t ParseResult ProjectConfigSkeleton
-> ParseResult () -> ParseResult ()
forall a b. ParseResult a -> ParseResult b -> ParseResult b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParseResult ()
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

------------------------------------------------------------------
-- Representing the project config file in terms of legacy types
--

-- | We already have parsers\/pretty-printers for almost all the fields in the
-- project config file, but they're in terms of the types used for the command
-- line flags for Setup.hs or cabal commands. We don't want to redefine them
-- all, at least not yet so for the moment we use the parsers at the old types
-- and use conversion functions.
--
-- Ultimately if\/when this project-based approach becomes the default then we
-- can redefine the parsers directly for the new types.
data LegacyProjectConfig = LegacyProjectConfig
  { LegacyProjectConfig -> [String]
legacyPackages :: [String]
  , LegacyProjectConfig -> [String]
legacyPackagesOptional :: [String]
  , LegacyProjectConfig -> [SourceRepoList]
legacyPackagesRepo :: [SourceRepoList]
  , LegacyProjectConfig -> [PackageVersionConstraint]
legacyPackagesNamed :: [PackageVersionConstraint]
  , LegacyProjectConfig -> LegacySharedConfig
legacySharedConfig :: LegacySharedConfig
  , LegacyProjectConfig -> LegacyPackageConfig
legacyAllConfig :: LegacyPackageConfig
  , LegacyProjectConfig -> LegacyPackageConfig
legacyLocalConfig :: LegacyPackageConfig
  , LegacyProjectConfig -> MapMappend PackageName LegacyPackageConfig
legacySpecificConfig :: MapMappend PackageName LegacyPackageConfig
  }
  deriving (Int -> LegacyProjectConfig -> String -> String
[LegacyProjectConfig] -> String -> String
LegacyProjectConfig -> String
(Int -> LegacyProjectConfig -> String -> String)
-> (LegacyProjectConfig -> String)
-> ([LegacyProjectConfig] -> String -> String)
-> Show LegacyProjectConfig
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> LegacyProjectConfig -> String -> String
showsPrec :: Int -> LegacyProjectConfig -> String -> String
$cshow :: LegacyProjectConfig -> String
show :: LegacyProjectConfig -> String
$cshowList :: [LegacyProjectConfig] -> String -> String
showList :: [LegacyProjectConfig] -> String -> String
Show, (forall x. LegacyProjectConfig -> Rep LegacyProjectConfig x)
-> (forall x. Rep LegacyProjectConfig x -> LegacyProjectConfig)
-> Generic LegacyProjectConfig
forall x. Rep LegacyProjectConfig x -> LegacyProjectConfig
forall x. LegacyProjectConfig -> Rep LegacyProjectConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LegacyProjectConfig -> Rep LegacyProjectConfig x
from :: forall x. LegacyProjectConfig -> Rep LegacyProjectConfig x
$cto :: forall x. Rep LegacyProjectConfig x -> LegacyProjectConfig
to :: forall x. Rep LegacyProjectConfig x -> LegacyProjectConfig
Generic)

instance Monoid LegacyProjectConfig where
  mempty :: LegacyProjectConfig
mempty = LegacyProjectConfig
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: LegacyProjectConfig -> LegacyProjectConfig -> LegacyProjectConfig
mappend = LegacyProjectConfig -> LegacyProjectConfig -> LegacyProjectConfig
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup LegacyProjectConfig where
  <> :: LegacyProjectConfig -> LegacyProjectConfig -> LegacyProjectConfig
(<>) = LegacyProjectConfig -> LegacyProjectConfig -> LegacyProjectConfig
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

data LegacyPackageConfig = LegacyPackageConfig
  { LegacyPackageConfig -> ConfigFlags
legacyConfigureFlags :: ConfigFlags
  , LegacyPackageConfig -> InstallFlags
legacyInstallPkgFlags :: InstallFlags
  , LegacyPackageConfig -> HaddockFlags
legacyHaddockFlags :: HaddockFlags
  , LegacyPackageConfig -> TestFlags
legacyTestFlags :: TestFlags
  , LegacyPackageConfig -> BenchmarkFlags
legacyBenchmarkFlags :: BenchmarkFlags
  }
  deriving (Int -> LegacyPackageConfig -> String -> String
[LegacyPackageConfig] -> String -> String
LegacyPackageConfig -> String
(Int -> LegacyPackageConfig -> String -> String)
-> (LegacyPackageConfig -> String)
-> ([LegacyPackageConfig] -> String -> String)
-> Show LegacyPackageConfig
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> LegacyPackageConfig -> String -> String
showsPrec :: Int -> LegacyPackageConfig -> String -> String
$cshow :: LegacyPackageConfig -> String
show :: LegacyPackageConfig -> String
$cshowList :: [LegacyPackageConfig] -> String -> String
showList :: [LegacyPackageConfig] -> String -> String
Show, (forall x. LegacyPackageConfig -> Rep LegacyPackageConfig x)
-> (forall x. Rep LegacyPackageConfig x -> LegacyPackageConfig)
-> Generic LegacyPackageConfig
forall x. Rep LegacyPackageConfig x -> LegacyPackageConfig
forall x. LegacyPackageConfig -> Rep LegacyPackageConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LegacyPackageConfig -> Rep LegacyPackageConfig x
from :: forall x. LegacyPackageConfig -> Rep LegacyPackageConfig x
$cto :: forall x. Rep LegacyPackageConfig x -> LegacyPackageConfig
to :: forall x. Rep LegacyPackageConfig x -> LegacyPackageConfig
Generic)

instance Monoid LegacyPackageConfig where
  mempty :: LegacyPackageConfig
mempty = LegacyPackageConfig
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: LegacyPackageConfig -> LegacyPackageConfig -> LegacyPackageConfig
mappend = LegacyPackageConfig -> LegacyPackageConfig -> LegacyPackageConfig
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup LegacyPackageConfig where
  <> :: LegacyPackageConfig -> LegacyPackageConfig -> LegacyPackageConfig
(<>) = LegacyPackageConfig -> LegacyPackageConfig -> LegacyPackageConfig
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

data LegacySharedConfig = LegacySharedConfig
  { LegacySharedConfig -> GlobalFlags
legacyGlobalFlags :: GlobalFlags
  , LegacySharedConfig -> ConfigFlags
legacyConfigureShFlags :: ConfigFlags
  , LegacySharedConfig -> ConfigExFlags
legacyConfigureExFlags :: ConfigExFlags
  , LegacySharedConfig -> InstallFlags
legacyInstallFlags :: InstallFlags
  , LegacySharedConfig -> ClientInstallFlags
legacyClientInstallFlags :: ClientInstallFlags
  , LegacySharedConfig -> ProjectFlags
legacyProjectFlags :: ProjectFlags
  , LegacySharedConfig -> Flag Bool
legacyMultiRepl :: Flag Bool
  }
  deriving (Int -> LegacySharedConfig -> String -> String
[LegacySharedConfig] -> String -> String
LegacySharedConfig -> String
(Int -> LegacySharedConfig -> String -> String)
-> (LegacySharedConfig -> String)
-> ([LegacySharedConfig] -> String -> String)
-> Show LegacySharedConfig
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> LegacySharedConfig -> String -> String
showsPrec :: Int -> LegacySharedConfig -> String -> String
$cshow :: LegacySharedConfig -> String
show :: LegacySharedConfig -> String
$cshowList :: [LegacySharedConfig] -> String -> String
showList :: [LegacySharedConfig] -> String -> String
Show, (forall x. LegacySharedConfig -> Rep LegacySharedConfig x)
-> (forall x. Rep LegacySharedConfig x -> LegacySharedConfig)
-> Generic LegacySharedConfig
forall x. Rep LegacySharedConfig x -> LegacySharedConfig
forall x. LegacySharedConfig -> Rep LegacySharedConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LegacySharedConfig -> Rep LegacySharedConfig x
from :: forall x. LegacySharedConfig -> Rep LegacySharedConfig x
$cto :: forall x. Rep LegacySharedConfig x -> LegacySharedConfig
to :: forall x. Rep LegacySharedConfig x -> LegacySharedConfig
Generic)

instance Monoid LegacySharedConfig where
  mempty :: LegacySharedConfig
mempty = LegacySharedConfig
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: LegacySharedConfig -> LegacySharedConfig -> LegacySharedConfig
mappend = LegacySharedConfig -> LegacySharedConfig -> LegacySharedConfig
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup LegacySharedConfig where
  <> :: LegacySharedConfig -> LegacySharedConfig -> LegacySharedConfig
(<>) = LegacySharedConfig -> LegacySharedConfig -> LegacySharedConfig
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

------------------------------------------------------------------
-- Converting from and to the legacy types
--

-- | Convert configuration from the @cabal configure@ or @cabal build@ command
-- line into a 'ProjectConfig' value that can combined with configuration from
-- other sources.
--
-- At the moment this uses the legacy command line flag types. See
-- 'LegacyProjectConfig' for an explanation.
commandLineFlagsToProjectConfig
  :: GlobalFlags
  -> NixStyleFlags a
  -> ClientInstallFlags
  -> ProjectConfig
commandLineFlagsToProjectConfig :: forall a.
GlobalFlags
-> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig
commandLineFlagsToProjectConfig GlobalFlags
globalFlags NixStyleFlags{a
TestFlags
HaddockFlags
ConfigFlags
BenchmarkFlags
ProjectFlags
InstallFlags
ConfigExFlags
configFlags :: ConfigFlags
configExFlags :: ConfigExFlags
installFlags :: InstallFlags
haddockFlags :: HaddockFlags
testFlags :: TestFlags
benchmarkFlags :: BenchmarkFlags
projectFlags :: ProjectFlags
extraFlags :: a
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
extraFlags :: forall a. NixStyleFlags a -> a
..} ClientInstallFlags
clientInstallFlags =
  ProjectConfig
forall a. Monoid a => a
mempty
    { projectConfigBuildOnly =
        convertLegacyBuildOnlyFlags
          globalFlags
          configFlags
          installFlags
          clientInstallFlags
          haddockFlags
          testFlags
          benchmarkFlags
    , projectConfigShared =
        convertLegacyAllPackageFlags
          globalFlags
          configFlags
          configExFlags
          installFlags
          projectFlags
          NoFlag
    , projectConfigLocalPackages = localConfig
    , projectConfigAllPackages = allConfig
    }
  where
    (PackageConfig
localConfig, PackageConfig
allConfig) =
      PackageConfig -> (PackageConfig, PackageConfig)
splitConfig
        ( ConfigFlags
-> InstallFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> PackageConfig
convertLegacyPerPackageFlags
            ConfigFlags
configFlags
            InstallFlags
installFlags
            HaddockFlags
haddockFlags
            TestFlags
testFlags
            BenchmarkFlags
benchmarkFlags
        )
    -- split the package config (from command line arguments) into
    -- those applied to all packages and those to local only.
    --
    -- for now we will just copy over the ProgramPaths/Extra into
    -- the AllPackages.  The LocalPackages do not inherit them from
    -- AllPackages, and as such need to retain them.
    --
    -- The general decision rule for what to put into allConfig
    -- into localConfig is the following:
    --
    -- - anything that is host/toolchain/env specific should be applied
    --   to all packages, as packagesets have to be host/toolchain/env
    --   consistent.
    -- - anything else should be in the local config and could potentially
    --   be lifted into all-packages vial the `package *` cabal.project
    --   section.
    --
    splitConfig :: PackageConfig -> (PackageConfig, PackageConfig)
    splitConfig :: PackageConfig -> (PackageConfig, PackageConfig)
splitConfig PackageConfig
pc =
      ( PackageConfig
pc
      , PackageConfig
forall a. Monoid a => a
mempty
          { packageConfigProgramPaths = packageConfigProgramPaths pc
          , packageConfigProgramPathExtra = packageConfigProgramPathExtra pc
          , -- Some flags to haddock should be passed to dependencies
            packageConfigDocumentation = packageConfigDocumentation pc
          , packageConfigHaddockHoogle = packageConfigHaddockHoogle pc
          , packageConfigHaddockHtml = packageConfigHaddockHtml pc
          , packageConfigHaddockInternal = packageConfigHaddockInternal pc
          , packageConfigHaddockQuickJump = packageConfigHaddockQuickJump pc
          , packageConfigHaddockLinkedSource = packageConfigHaddockLinkedSource pc
          , packageConfigHaddockUseUnicode = packageConfigHaddockUseUnicode pc
          }
      )

-- | Convert from the types currently used for the user-wide Cabal config
-- file into the 'ProjectConfig' type.
--
-- Only a subset of the 'ProjectConfig' can be represented in the user-wide
-- config. In particular it does not include packages that are in the project,
-- and it also doesn't support package-specific configuration (only
-- configuration that applies to all packages).
convertLegacyGlobalConfig :: SavedConfig -> ProjectConfig
convertLegacyGlobalConfig :: SavedConfig -> ProjectConfig
convertLegacyGlobalConfig
  SavedConfig
    { savedGlobalFlags :: SavedConfig -> GlobalFlags
savedGlobalFlags = GlobalFlags
globalFlags
    , savedInstallFlags :: SavedConfig -> InstallFlags
savedInstallFlags = InstallFlags
installFlags
    , savedClientInstallFlags :: SavedConfig -> ClientInstallFlags
savedClientInstallFlags = ClientInstallFlags
clientInstallFlags
    , savedConfigureFlags :: SavedConfig -> ConfigFlags
savedConfigureFlags = ConfigFlags
configFlags
    , savedConfigureExFlags :: SavedConfig -> ConfigExFlags
savedConfigureExFlags = ConfigExFlags
configExFlags
    , savedUserInstallDirs :: SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs = InstallDirs (Flag PathTemplate)
_
    , savedGlobalInstallDirs :: SavedConfig -> InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs = InstallDirs (Flag PathTemplate)
_
    , savedUploadFlags :: SavedConfig -> UploadFlags
savedUploadFlags = UploadFlags
_
    , savedReportFlags :: SavedConfig -> ReportFlags
savedReportFlags = ReportFlags
_
    , savedHaddockFlags :: SavedConfig -> HaddockFlags
savedHaddockFlags = HaddockFlags
haddockFlags
    , savedTestFlags :: SavedConfig -> TestFlags
savedTestFlags = TestFlags
testFlags
    , savedBenchmarkFlags :: SavedConfig -> BenchmarkFlags
savedBenchmarkFlags = BenchmarkFlags
benchmarkFlags
    , savedProjectFlags :: SavedConfig -> ProjectFlags
savedProjectFlags = ProjectFlags
projectFlags
    , savedReplMulti :: SavedConfig -> Flag Bool
savedReplMulti = Flag Bool
replMulti
    } =
    ProjectConfig
forall a. Monoid a => a
mempty
      { projectConfigBuildOnly = configBuildOnly
      , projectConfigShared = configShared
      , projectConfigAllPackages = configAllPackages
      }
    where
      -- TODO: [code cleanup] eliminate use of default*Flags here and specify the
      -- defaults in the various resolve functions in terms of the new types.
      configExFlags' :: ConfigExFlags
configExFlags' = ConfigExFlags
defaultConfigExFlags ConfigExFlags -> ConfigExFlags -> ConfigExFlags
forall a. Semigroup a => a -> a -> a
<> ConfigExFlags
configExFlags
      installFlags' :: InstallFlags
installFlags' = InstallFlags
defaultInstallFlags InstallFlags -> InstallFlags -> InstallFlags
forall a. Semigroup a => a -> a -> a
<> InstallFlags
installFlags
      clientInstallFlags' :: ClientInstallFlags
clientInstallFlags' = ClientInstallFlags
defaultClientInstallFlags ClientInstallFlags -> ClientInstallFlags -> ClientInstallFlags
forall a. Semigroup a => a -> a -> a
<> ClientInstallFlags
clientInstallFlags
      haddockFlags' :: HaddockFlags
haddockFlags' = HaddockFlags
defaultHaddockFlags HaddockFlags -> HaddockFlags -> HaddockFlags
forall a. Semigroup a => a -> a -> a
<> HaddockFlags
haddockFlags
      testFlags' :: TestFlags
testFlags' = TestFlags
defaultTestFlags TestFlags -> TestFlags -> TestFlags
forall a. Semigroup a => a -> a -> a
<> TestFlags
testFlags
      benchmarkFlags' :: BenchmarkFlags
benchmarkFlags' = BenchmarkFlags
defaultBenchmarkFlags BenchmarkFlags -> BenchmarkFlags -> BenchmarkFlags
forall a. Semigroup a => a -> a -> a
<> BenchmarkFlags
benchmarkFlags
      projectFlags' :: ProjectFlags
projectFlags' = ProjectFlags
defaultProjectFlags ProjectFlags -> ProjectFlags -> ProjectFlags
forall a. Semigroup a => a -> a -> a
<> ProjectFlags
projectFlags

      configAllPackages :: PackageConfig
configAllPackages =
        ConfigFlags
-> InstallFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> PackageConfig
convertLegacyPerPackageFlags
          ConfigFlags
configFlags
          InstallFlags
installFlags'
          HaddockFlags
haddockFlags'
          TestFlags
testFlags'
          BenchmarkFlags
benchmarkFlags'
      configShared :: ProjectConfigShared
configShared =
        GlobalFlags
-> ConfigFlags
-> ConfigExFlags
-> InstallFlags
-> ProjectFlags
-> Flag Bool
-> ProjectConfigShared
convertLegacyAllPackageFlags
          GlobalFlags
globalFlags
          ConfigFlags
configFlags
          ConfigExFlags
configExFlags'
          InstallFlags
installFlags'
          ProjectFlags
projectFlags'
          Flag Bool
replMulti
      configBuildOnly :: ProjectConfigBuildOnly
configBuildOnly =
        GlobalFlags
-> ConfigFlags
-> InstallFlags
-> ClientInstallFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> ProjectConfigBuildOnly
convertLegacyBuildOnlyFlags
          GlobalFlags
globalFlags
          ConfigFlags
configFlags
          InstallFlags
installFlags'
          ClientInstallFlags
clientInstallFlags'
          HaddockFlags
haddockFlags'
          TestFlags
testFlags'
          BenchmarkFlags
benchmarkFlags'

-- | Convert the project config from the legacy types to the 'ProjectConfig'
-- and associated types. See 'LegacyProjectConfig' for an explanation of the
-- approach.
convertLegacyProjectConfig :: LegacyProjectConfig -> ProjectConfig
convertLegacyProjectConfig :: LegacyProjectConfig -> ProjectConfig
convertLegacyProjectConfig
  LegacyProjectConfig
    { [String]
legacyPackages :: LegacyProjectConfig -> [String]
legacyPackages :: [String]
legacyPackages
    , [String]
legacyPackagesOptional :: LegacyProjectConfig -> [String]
legacyPackagesOptional :: [String]
legacyPackagesOptional
    , [SourceRepoList]
legacyPackagesRepo :: LegacyProjectConfig -> [SourceRepoList]
legacyPackagesRepo :: [SourceRepoList]
legacyPackagesRepo
    , [PackageVersionConstraint]
legacyPackagesNamed :: LegacyProjectConfig -> [PackageVersionConstraint]
legacyPackagesNamed :: [PackageVersionConstraint]
legacyPackagesNamed
    , legacySharedConfig :: LegacyProjectConfig -> LegacySharedConfig
legacySharedConfig =
      LegacySharedConfig
        GlobalFlags
globalFlags
        ConfigFlags
configShFlags
        ConfigExFlags
configExFlags
        InstallFlags
installSharedFlags
        ClientInstallFlags
clientInstallFlags
        ProjectFlags
projectFlags
        Flag Bool
multiRepl
    , LegacyPackageConfig
legacyAllConfig :: LegacyProjectConfig -> LegacyPackageConfig
legacyAllConfig :: LegacyPackageConfig
legacyAllConfig
    , legacyLocalConfig :: LegacyProjectConfig -> LegacyPackageConfig
legacyLocalConfig =
      LegacyPackageConfig
        ConfigFlags
configFlags
        InstallFlags
installPerPkgFlags
        HaddockFlags
haddockFlags
        TestFlags
testFlags
        BenchmarkFlags
benchmarkFlags
    , MapMappend PackageName LegacyPackageConfig
legacySpecificConfig :: LegacyProjectConfig -> MapMappend PackageName LegacyPackageConfig
legacySpecificConfig :: MapMappend PackageName LegacyPackageConfig
legacySpecificConfig
    } =
    ProjectConfig
      { projectPackages :: [String]
projectPackages = [String]
legacyPackages
      , projectPackagesOptional :: [String]
projectPackagesOptional = [String]
legacyPackagesOptional
      , projectPackagesRepo :: [SourceRepoList]
projectPackagesRepo = [SourceRepoList]
legacyPackagesRepo
      , projectPackagesNamed :: [PackageVersionConstraint]
projectPackagesNamed = [PackageVersionConstraint]
legacyPackagesNamed
      , projectConfigBuildOnly :: ProjectConfigBuildOnly
projectConfigBuildOnly = ProjectConfigBuildOnly
configBuildOnly
      , projectConfigShared :: ProjectConfigShared
projectConfigShared = ProjectConfigShared
configPackagesShared
      , projectConfigProvenance :: Set ProjectConfigProvenance
projectConfigProvenance = Set ProjectConfigProvenance
forall a. Monoid a => a
mempty
      , projectConfigAllPackages :: PackageConfig
projectConfigAllPackages = PackageConfig
configAllPackages
      , projectConfigLocalPackages :: PackageConfig
projectConfigLocalPackages = PackageConfig
configLocalPackages
      , projectConfigSpecificPackage :: MapMappend PackageName PackageConfig
projectConfigSpecificPackage = (LegacyPackageConfig -> PackageConfig)
-> MapMappend PackageName LegacyPackageConfig
-> MapMappend PackageName PackageConfig
forall a b.
(a -> b) -> MapMappend PackageName a -> MapMappend PackageName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LegacyPackageConfig -> PackageConfig
perPackage MapMappend PackageName LegacyPackageConfig
legacySpecificConfig
      }
    where
      configAllPackages :: PackageConfig
configAllPackages = ConfigFlags
-> InstallFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> PackageConfig
convertLegacyPerPackageFlags ConfigFlags
g InstallFlags
i HaddockFlags
h TestFlags
t BenchmarkFlags
b
        where
          LegacyPackageConfig ConfigFlags
g InstallFlags
i HaddockFlags
h TestFlags
t BenchmarkFlags
b = LegacyPackageConfig
legacyAllConfig
      configLocalPackages :: PackageConfig
configLocalPackages =
        ConfigFlags
-> InstallFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> PackageConfig
convertLegacyPerPackageFlags
          ConfigFlags
configFlags
          InstallFlags
installPerPkgFlags
          HaddockFlags
haddockFlags
          TestFlags
testFlags
          BenchmarkFlags
benchmarkFlags
      configPackagesShared :: ProjectConfigShared
configPackagesShared =
        GlobalFlags
-> ConfigFlags
-> ConfigExFlags
-> InstallFlags
-> ProjectFlags
-> Flag Bool
-> ProjectConfigShared
convertLegacyAllPackageFlags
          GlobalFlags
globalFlags
          (ConfigFlags
configFlags ConfigFlags -> ConfigFlags -> ConfigFlags
forall a. Semigroup a => a -> a -> a
<> ConfigFlags
configShFlags)
          ConfigExFlags
configExFlags
          InstallFlags
installSharedFlags
          ProjectFlags
projectFlags
          Flag Bool
multiRepl
      configBuildOnly :: ProjectConfigBuildOnly
configBuildOnly =
        GlobalFlags
-> ConfigFlags
-> InstallFlags
-> ClientInstallFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> ProjectConfigBuildOnly
convertLegacyBuildOnlyFlags
          GlobalFlags
globalFlags
          ConfigFlags
configShFlags
          InstallFlags
installSharedFlags
          ClientInstallFlags
clientInstallFlags
          HaddockFlags
haddockFlags
          TestFlags
testFlags
          BenchmarkFlags
benchmarkFlags

      perPackage :: LegacyPackageConfig -> PackageConfig
perPackage
        ( LegacyPackageConfig
            ConfigFlags
perPkgConfigFlags
            InstallFlags
perPkgInstallFlags
            HaddockFlags
perPkgHaddockFlags
            TestFlags
perPkgTestFlags
            BenchmarkFlags
perPkgBenchmarkFlags
          ) =
          ConfigFlags
-> InstallFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> PackageConfig
convertLegacyPerPackageFlags
            ConfigFlags
perPkgConfigFlags
            InstallFlags
perPkgInstallFlags
            HaddockFlags
perPkgHaddockFlags
            TestFlags
perPkgTestFlags
            BenchmarkFlags
perPkgBenchmarkFlags

-- | Helper used by other conversion functions that returns the
-- 'ProjectConfigShared' subset of the 'ProjectConfig'.
convertLegacyAllPackageFlags
  :: GlobalFlags
  -> ConfigFlags
  -> ConfigExFlags
  -> InstallFlags
  -> ProjectFlags
  -> Flag Bool
  -> ProjectConfigShared
convertLegacyAllPackageFlags :: GlobalFlags
-> ConfigFlags
-> ConfigExFlags
-> InstallFlags
-> ProjectFlags
-> Flag Bool
-> ProjectConfigShared
convertLegacyAllPackageFlags GlobalFlags
globalFlags ConfigFlags
configFlags ConfigExFlags
configExFlags InstallFlags
installFlags ProjectFlags
projectFlags Flag Bool
projectConfigMultiRepl =
  ProjectConfigShared{[Maybe PackageDBCWD]
[(UserConstraint, ConstraintSource)]
[PackageVersionConstraint]
Maybe AllowOlder
Maybe AllowNewer
Flag Bool
Flag Int
Flag String
Flag Version
Flag PathTemplate
Flag CompilerFlavor
Flag OnlyConstrained
Flag AllowBootLibInstalls
Flag StrongFlags
Flag PreferOldest
Flag IndependentGoals
Flag MinimizeConflictSet
Flag FineGrainedConflicts
Flag CountConflicts
Flag ReorderGoals
Flag PreSolver
Flag TotalIndexState
Flag ActiveRepos
Flag WriteGhcEnvironmentFilesPolicy
InstallDirs (Flag PathTemplate)
NubList String
NubList LocalRepo
NubList RemoteRepo
projectConfigHcFlavor :: Flag CompilerFlavor
projectConfigHcPath :: Flag String
projectConfigHcPkg :: Flag String
projectConfigMultiRepl :: Flag Bool
projectConfigConfigFile :: Flag String
projectConfigRemoteRepos :: NubList RemoteRepo
projectConfigLocalNoIndexRepos :: NubList LocalRepo
projectConfigActiveRepos :: Flag ActiveRepos
projectConfigProgPathExtra :: NubList String
projectConfigStoreDir :: Flag String
projectConfigPackageDBs :: [Maybe PackageDBCWD]
projectConfigHcFlavor :: Flag CompilerFlavor
projectConfigHcPath :: Flag String
projectConfigHcPkg :: Flag String
projectConfigInstallDirs :: InstallDirs (Flag PathTemplate)
projectConfigDistDir :: Flag String
projectConfigCabalVersion :: Flag Version
projectConfigConstraints :: [(UserConstraint, ConstraintSource)]
projectConfigPreferences :: [PackageVersionConstraint]
projectConfigSolver :: Flag PreSolver
projectConfigAllowOlder :: Maybe AllowOlder
projectConfigAllowNewer :: Maybe AllowNewer
projectConfigWriteGhcEnvironmentFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy
projectConfigHaddockIndex :: Flag PathTemplate
projectConfigIndexState :: Flag TotalIndexState
projectConfigMaxBackjumps :: Flag Int
projectConfigReorderGoals :: Flag ReorderGoals
projectConfigCountConflicts :: Flag CountConflicts
projectConfigFineGrainedConflicts :: Flag FineGrainedConflicts
projectConfigMinimizeConflictSet :: Flag MinimizeConflictSet
projectConfigPerComponent :: Flag Bool
projectConfigIndependentGoals :: Flag IndependentGoals
projectConfigPreferOldest :: Flag PreferOldest
projectConfigStrongFlags :: Flag StrongFlags
projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls
projectConfigOnlyConstrained :: Flag OnlyConstrained
projectConfigProjectDir :: Flag String
projectConfigProjectFile :: Flag String
projectConfigIgnoreProject :: Flag Bool
projectConfigDistDir :: Flag String
projectConfigConfigFile :: Flag String
projectConfigProjectDir :: Flag String
projectConfigProjectFile :: Flag String
projectConfigIgnoreProject :: Flag Bool
projectConfigHaddockIndex :: Flag PathTemplate
projectConfigInstallDirs :: InstallDirs (Flag PathTemplate)
projectConfigPackageDBs :: [Maybe PackageDBCWD]
projectConfigRemoteRepos :: NubList RemoteRepo
projectConfigLocalNoIndexRepos :: NubList LocalRepo
projectConfigActiveRepos :: Flag ActiveRepos
projectConfigIndexState :: Flag TotalIndexState
projectConfigStoreDir :: Flag String
projectConfigConstraints :: [(UserConstraint, ConstraintSource)]
projectConfigPreferences :: [PackageVersionConstraint]
projectConfigCabalVersion :: Flag Version
projectConfigSolver :: Flag PreSolver
projectConfigAllowOlder :: Maybe AllowOlder
projectConfigAllowNewer :: Maybe AllowNewer
projectConfigWriteGhcEnvironmentFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy
projectConfigMaxBackjumps :: Flag Int
projectConfigReorderGoals :: Flag ReorderGoals
projectConfigCountConflicts :: Flag CountConflicts
projectConfigFineGrainedConflicts :: Flag FineGrainedConflicts
projectConfigMinimizeConflictSet :: Flag MinimizeConflictSet
projectConfigStrongFlags :: Flag StrongFlags
projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls
projectConfigOnlyConstrained :: Flag OnlyConstrained
projectConfigPerComponent :: Flag Bool
projectConfigIndependentGoals :: Flag IndependentGoals
projectConfigPreferOldest :: Flag PreferOldest
projectConfigProgPathExtra :: NubList String
projectConfigMultiRepl :: Flag Bool
..}
  where
    GlobalFlags
      { globalConfigFile :: GlobalFlags -> Flag String
globalConfigFile = Flag String
projectConfigConfigFile
      , globalRemoteRepos :: GlobalFlags -> NubList RemoteRepo
globalRemoteRepos = NubList RemoteRepo
projectConfigRemoteRepos
      , globalLocalNoIndexRepos :: GlobalFlags -> NubList LocalRepo
globalLocalNoIndexRepos = NubList LocalRepo
projectConfigLocalNoIndexRepos
      , globalActiveRepos :: GlobalFlags -> Flag ActiveRepos
globalActiveRepos = Flag ActiveRepos
projectConfigActiveRepos
      , globalProgPathExtra :: GlobalFlags -> NubList String
globalProgPathExtra = NubList String
projectConfigProgPathExtra
      , globalStoreDir :: GlobalFlags -> Flag String
globalStoreDir = Flag String
projectConfigStoreDir
      } = GlobalFlags
globalFlags

    projectConfigPackageDBs :: [Maybe PackageDBCWD]
projectConfigPackageDBs = ((Maybe PackageDB -> Maybe PackageDBCWD)
-> [Maybe PackageDB] -> [Maybe PackageDBCWD]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe PackageDB -> Maybe PackageDBCWD)
 -> [Maybe PackageDB] -> [Maybe PackageDBCWD])
-> ((PackageDB -> PackageDBCWD)
    -> Maybe PackageDB -> Maybe PackageDBCWD)
-> (PackageDB -> PackageDBCWD)
-> [Maybe PackageDB]
-> [Maybe PackageDBCWD]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageDB -> PackageDBCWD)
-> Maybe PackageDB -> Maybe PackageDBCWD
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDB -> PackageDBCWD
interpretPackageDB Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Maybe a
Nothing) [Maybe PackageDB]
projectConfigPackageDBs_

    ConfigFlags
      { configCommonFlags :: ConfigFlags -> CommonSetupFlags
configCommonFlags = CommonSetupFlags
commonFlags
      , configHcFlavor :: ConfigFlags -> Flag CompilerFlavor
configHcFlavor = Flag CompilerFlavor
projectConfigHcFlavor
      , configHcPath :: ConfigFlags -> Flag String
configHcPath = Flag String
projectConfigHcPath
      , configHcPkg :: ConfigFlags -> Flag String
configHcPkg = Flag String
projectConfigHcPkg
      , -- configProgramPathExtra    = projectConfigProgPathExtra DELETE ME
      configInstallDirs :: ConfigFlags -> InstallDirs (Flag PathTemplate)
configInstallDirs = InstallDirs (Flag PathTemplate)
projectConfigInstallDirs
      , -- configUserInstall         = projectConfigUserInstall,
      configPackageDBs :: ConfigFlags -> [Maybe PackageDB]
configPackageDBs = [Maybe PackageDB]
projectConfigPackageDBs_
      } = ConfigFlags
configFlags

    CommonSetupFlags
      { setupDistPref :: CommonSetupFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
setupDistPref = Flag (SymbolicPath Pkg ('Dir Dist))
projectConfigAbsoluteDistDir
      } = CommonSetupFlags
commonFlags

    projectConfigDistDir :: Flag String
projectConfigDistDir = (SymbolicPath Pkg ('Dir Dist) -> String)
-> Flag (SymbolicPath Pkg ('Dir Dist)) -> Flag String
forall a b. (a -> b) -> Flag a -> Flag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Dist) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath Flag (SymbolicPath Pkg ('Dir Dist))
projectConfigAbsoluteDistDir

    ConfigExFlags
      { configCabalVersion :: ConfigExFlags -> Flag Version
configCabalVersion = Flag Version
projectConfigCabalVersion
      , configExConstraints :: ConfigExFlags -> [(UserConstraint, ConstraintSource)]
configExConstraints = [(UserConstraint, ConstraintSource)]
projectConfigConstraints
      , configPreferences :: ConfigExFlags -> [PackageVersionConstraint]
configPreferences = [PackageVersionConstraint]
projectConfigPreferences
      , configSolver :: ConfigExFlags -> Flag PreSolver
configSolver = Flag PreSolver
projectConfigSolver
      , configAllowOlder :: ConfigExFlags -> Maybe AllowOlder
configAllowOlder = Maybe AllowOlder
projectConfigAllowOlder
      , configAllowNewer :: ConfigExFlags -> Maybe AllowNewer
configAllowNewer = Maybe AllowNewer
projectConfigAllowNewer
      , configWriteGhcEnvironmentFilesPolicy :: ConfigExFlags -> Flag WriteGhcEnvironmentFilesPolicy
configWriteGhcEnvironmentFilesPolicy =
        Flag WriteGhcEnvironmentFilesPolicy
projectConfigWriteGhcEnvironmentFilesPolicy
      } = ConfigExFlags
configExFlags

    InstallFlags
      { installHaddockIndex :: InstallFlags -> Flag PathTemplate
installHaddockIndex = Flag PathTemplate
projectConfigHaddockIndex
      , -- installReinstall          = projectConfigReinstall,
      -- installAvoidReinstalls    = projectConfigAvoidReinstalls,
      -- installOverrideReinstall  = projectConfigOverrideReinstall,
      installIndexState :: InstallFlags -> Flag TotalIndexState
installIndexState = Flag TotalIndexState
projectConfigIndexState
      , installMaxBackjumps :: InstallFlags -> Flag Int
installMaxBackjumps = Flag Int
projectConfigMaxBackjumps
      , -- installUpgradeDeps        = projectConfigUpgradeDeps,
      installReorderGoals :: InstallFlags -> Flag ReorderGoals
installReorderGoals = Flag ReorderGoals
projectConfigReorderGoals
      , installCountConflicts :: InstallFlags -> Flag CountConflicts
installCountConflicts = Flag CountConflicts
projectConfigCountConflicts
      , installFineGrainedConflicts :: InstallFlags -> Flag FineGrainedConflicts
installFineGrainedConflicts = Flag FineGrainedConflicts
projectConfigFineGrainedConflicts
      , installMinimizeConflictSet :: InstallFlags -> Flag MinimizeConflictSet
installMinimizeConflictSet = Flag MinimizeConflictSet
projectConfigMinimizeConflictSet
      , installPerComponent :: InstallFlags -> Flag Bool
installPerComponent = Flag Bool
projectConfigPerComponent
      , installIndependentGoals :: InstallFlags -> Flag IndependentGoals
installIndependentGoals = Flag IndependentGoals
projectConfigIndependentGoals
      , installPreferOldest :: InstallFlags -> Flag PreferOldest
installPreferOldest = Flag PreferOldest
projectConfigPreferOldest
      , -- installShadowPkgs         = projectConfigShadowPkgs,
      installStrongFlags :: InstallFlags -> Flag StrongFlags
installStrongFlags = Flag StrongFlags
projectConfigStrongFlags
      , installAllowBootLibInstalls :: InstallFlags -> Flag AllowBootLibInstalls
installAllowBootLibInstalls = Flag AllowBootLibInstalls
projectConfigAllowBootLibInstalls
      , installOnlyConstrained :: InstallFlags -> Flag OnlyConstrained
installOnlyConstrained = Flag OnlyConstrained
projectConfigOnlyConstrained
      } = InstallFlags
installFlags

    ProjectFlags
      { flagProjectDir :: ProjectFlags -> Flag String
flagProjectDir = Flag String
projectConfigProjectDir
      , flagProjectFile :: ProjectFlags -> Flag String
flagProjectFile = Flag String
projectConfigProjectFile
      , flagIgnoreProject :: ProjectFlags -> Flag Bool
flagIgnoreProject = Flag Bool
projectConfigIgnoreProject
      } = ProjectFlags
projectFlags

-- | Helper used by other conversion functions that returns the
-- 'PackageConfig' subset of the 'ProjectConfig'.
convertLegacyPerPackageFlags
  :: ConfigFlags
  -> InstallFlags
  -> HaddockFlags
  -> TestFlags
  -> BenchmarkFlags
  -> PackageConfig
convertLegacyPerPackageFlags :: ConfigFlags
-> InstallFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> PackageConfig
convertLegacyPerPackageFlags
  ConfigFlags
configFlags
  InstallFlags
installFlags
  HaddockFlags
haddockFlags
  TestFlags
testFlags
  BenchmarkFlags
benchmarkFlags =
    PackageConfig{[String]
[PathTemplate]
Flag Bool
Flag String
Flag PathTemplate
Flag DumpBuildInfo
Flag ProfDetailLevel
Flag DebugInfoLevel
Flag OptimisationLevel
Flag TestShowDetails
Flag HaddockTarget
NubList String
FlagAssignment
MapMappend String [String]
MapLast String String
packageConfigProgramPaths :: MapLast String String
packageConfigProgramPathExtra :: NubList String
packageConfigDocumentation :: Flag Bool
packageConfigHaddockHoogle :: Flag Bool
packageConfigHaddockHtml :: Flag Bool
packageConfigHaddockInternal :: Flag Bool
packageConfigHaddockQuickJump :: Flag Bool
packageConfigHaddockLinkedSource :: Flag Bool
packageConfigHaddockUseUnicode :: Flag Bool
packageConfigProgramPathExtra :: NubList String
packageConfigVanillaLib :: Flag Bool
packageConfigProfLib :: Flag Bool
packageConfigSharedLib :: Flag Bool
packageConfigStaticLib :: Flag Bool
packageConfigDynExe :: Flag Bool
packageConfigFullyStaticExe :: Flag Bool
packageConfigProfExe :: Flag Bool
packageConfigProf :: Flag Bool
packageConfigProfShared :: Flag Bool
packageConfigProfDetail :: Flag ProfDetailLevel
packageConfigProfLibDetail :: Flag ProfDetailLevel
packageConfigConfigureArgs :: [String]
packageConfigOptimization :: Flag OptimisationLevel
packageConfigProgPrefix :: Flag PathTemplate
packageConfigProgSuffix :: Flag PathTemplate
packageConfigGHCiLib :: Flag Bool
packageConfigSplitSections :: Flag Bool
packageConfigSplitObjs :: Flag Bool
packageConfigStripExes :: Flag Bool
packageConfigStripLibs :: Flag Bool
packageConfigFlagAssignment :: FlagAssignment
packageConfigTests :: Flag Bool
packageConfigBenchmarks :: Flag Bool
packageConfigDebugInfo :: Flag DebugInfoLevel
packageConfigDumpBuildInfo :: Flag DumpBuildInfo
packageConfigRelocatable :: Flag Bool
packageConfigExtraLibDirs :: [String]
packageConfigExtraLibDirsStatic :: [String]
packageConfigExtraFrameworkDirs :: [String]
packageConfigExtraIncludeDirs :: [String]
packageConfigProgramPaths :: MapLast String String
packageConfigProgramArgs :: MapMappend String [String]
packageConfigCoverage :: Flag Bool
packageConfigDocumentation :: Flag Bool
packageConfigRunTests :: Flag Bool
packageConfigHaddockHoogle :: Flag Bool
packageConfigHaddockHtml :: Flag Bool
packageConfigHaddockHtmlLocation :: Flag String
packageConfigHaddockForeignLibs :: Flag Bool
packageConfigHaddockForHackage :: Flag HaddockTarget
packageConfigHaddockExecutables :: Flag Bool
packageConfigHaddockTestSuites :: Flag Bool
packageConfigHaddockBenchmarks :: Flag Bool
packageConfigHaddockInternal :: Flag Bool
packageConfigHaddockCss :: Flag String
packageConfigHaddockLinkedSource :: Flag Bool
packageConfigHaddockQuickJump :: Flag Bool
packageConfigHaddockHscolourCss :: Flag String
packageConfigHaddockContents :: Flag PathTemplate
packageConfigHaddockIndex :: Flag PathTemplate
packageConfigHaddockBaseUrl :: Flag String
packageConfigHaddockResourcesDir :: Flag String
packageConfigHaddockOutputDir :: Flag String
packageConfigHaddockUseUnicode :: Flag Bool
packageConfigTestHumanLog :: Flag PathTemplate
packageConfigTestMachineLog :: Flag PathTemplate
packageConfigTestShowDetails :: Flag TestShowDetails
packageConfigTestKeepTix :: Flag Bool
packageConfigTestWrapper :: Flag String
packageConfigTestFailWhenNoTestSuites :: Flag Bool
packageConfigTestTestOptions :: [PathTemplate]
packageConfigBenchmarkOptions :: [PathTemplate]
packageConfigProgramArgs :: MapMappend String [String]
packageConfigFlagAssignment :: FlagAssignment
packageConfigVanillaLib :: Flag Bool
packageConfigSharedLib :: Flag Bool
packageConfigStaticLib :: Flag Bool
packageConfigDynExe :: Flag Bool
packageConfigFullyStaticExe :: Flag Bool
packageConfigProf :: Flag Bool
packageConfigProfLib :: Flag Bool
packageConfigProfShared :: Flag Bool
packageConfigProfExe :: Flag Bool
packageConfigProfDetail :: Flag ProfDetailLevel
packageConfigProfLibDetail :: Flag ProfDetailLevel
packageConfigConfigureArgs :: [String]
packageConfigOptimization :: Flag OptimisationLevel
packageConfigProgPrefix :: Flag PathTemplate
packageConfigProgSuffix :: Flag PathTemplate
packageConfigExtraLibDirs :: [String]
packageConfigExtraLibDirsStatic :: [String]
packageConfigExtraFrameworkDirs :: [String]
packageConfigExtraIncludeDirs :: [String]
packageConfigGHCiLib :: Flag Bool
packageConfigSplitSections :: Flag Bool
packageConfigSplitObjs :: Flag Bool
packageConfigStripExes :: Flag Bool
packageConfigStripLibs :: Flag Bool
packageConfigTests :: Flag Bool
packageConfigBenchmarks :: Flag Bool
packageConfigCoverage :: Flag Bool
packageConfigRelocatable :: Flag Bool
packageConfigDebugInfo :: Flag DebugInfoLevel
packageConfigDumpBuildInfo :: Flag DumpBuildInfo
packageConfigRunTests :: Flag Bool
packageConfigHaddockHtmlLocation :: Flag String
packageConfigHaddockForeignLibs :: Flag Bool
packageConfigHaddockExecutables :: Flag Bool
packageConfigHaddockTestSuites :: Flag Bool
packageConfigHaddockBenchmarks :: Flag Bool
packageConfigHaddockCss :: Flag String
packageConfigHaddockHscolourCss :: Flag String
packageConfigHaddockContents :: Flag PathTemplate
packageConfigHaddockIndex :: Flag PathTemplate
packageConfigHaddockBaseUrl :: Flag String
packageConfigHaddockResourcesDir :: Flag String
packageConfigHaddockOutputDir :: Flag String
packageConfigHaddockForHackage :: Flag HaddockTarget
packageConfigTestHumanLog :: Flag PathTemplate
packageConfigTestMachineLog :: Flag PathTemplate
packageConfigTestShowDetails :: Flag TestShowDetails
packageConfigTestKeepTix :: Flag Bool
packageConfigTestWrapper :: Flag String
packageConfigTestFailWhenNoTestSuites :: Flag Bool
packageConfigTestTestOptions :: [PathTemplate]
packageConfigBenchmarkOptions :: [PathTemplate]
..}
    where
      ConfigFlags
        { [(String, String)]
configProgramPaths :: [(String, String)]
configProgramPaths :: ConfigFlags -> [(String, String)]
configProgramPaths
        , [(String, [String])]
configProgramArgs :: [(String, [String])]
configProgramArgs :: ConfigFlags -> [(String, [String])]
configProgramArgs
        , configProgramPathExtra :: ConfigFlags -> NubList String
configProgramPathExtra = NubList String
packageConfigProgramPathExtra
        , configVanillaLib :: ConfigFlags -> Flag Bool
configVanillaLib = Flag Bool
packageConfigVanillaLib
        , configProfLib :: ConfigFlags -> Flag Bool
configProfLib = Flag Bool
packageConfigProfLib
        , configSharedLib :: ConfigFlags -> Flag Bool
configSharedLib = Flag Bool
packageConfigSharedLib
        , configStaticLib :: ConfigFlags -> Flag Bool
configStaticLib = Flag Bool
packageConfigStaticLib
        , configDynExe :: ConfigFlags -> Flag Bool
configDynExe = Flag Bool
packageConfigDynExe
        , configFullyStaticExe :: ConfigFlags -> Flag Bool
configFullyStaticExe = Flag Bool
packageConfigFullyStaticExe
        , configProfExe :: ConfigFlags -> Flag Bool
configProfExe = Flag Bool
packageConfigProfExe
        , configProf :: ConfigFlags -> Flag Bool
configProf = Flag Bool
packageConfigProf
        , configProfShared :: ConfigFlags -> Flag Bool
configProfShared = Flag Bool
packageConfigProfShared
        , configProfDetail :: ConfigFlags -> Flag ProfDetailLevel
configProfDetail = Flag ProfDetailLevel
packageConfigProfDetail
        , configProfLibDetail :: ConfigFlags -> Flag ProfDetailLevel
configProfLibDetail = Flag ProfDetailLevel
packageConfigProfLibDetail
        , configConfigureArgs :: ConfigFlags -> [String]
configConfigureArgs = [String]
packageConfigConfigureArgs
        , configOptimization :: ConfigFlags -> Flag OptimisationLevel
configOptimization = Flag OptimisationLevel
packageConfigOptimization
        , configProgPrefix :: ConfigFlags -> Flag PathTemplate
configProgPrefix = Flag PathTemplate
packageConfigProgPrefix
        , configProgSuffix :: ConfigFlags -> Flag PathTemplate
configProgSuffix = Flag PathTemplate
packageConfigProgSuffix
        , configGHCiLib :: ConfigFlags -> Flag Bool
configGHCiLib = Flag Bool
packageConfigGHCiLib
        , configSplitSections :: ConfigFlags -> Flag Bool
configSplitSections = Flag Bool
packageConfigSplitSections
        , configSplitObjs :: ConfigFlags -> Flag Bool
configSplitObjs = Flag Bool
packageConfigSplitObjs
        , configStripExes :: ConfigFlags -> Flag Bool
configStripExes = Flag Bool
packageConfigStripExes
        , configStripLibs :: ConfigFlags -> Flag Bool
configStripLibs = Flag Bool
packageConfigStripLibs
        , configConfigurationsFlags :: ConfigFlags -> FlagAssignment
configConfigurationsFlags = FlagAssignment
packageConfigFlagAssignment
        , configTests :: ConfigFlags -> Flag Bool
configTests = Flag Bool
packageConfigTests
        , configBenchmarks :: ConfigFlags -> Flag Bool
configBenchmarks = Flag Bool
packageConfigBenchmarks
        , configCoverage :: ConfigFlags -> Flag Bool
configCoverage = Flag Bool
coverage
        , configLibCoverage :: ConfigFlags -> Flag Bool
configLibCoverage = Flag Bool
libcoverage -- deprecated
        , configDebugInfo :: ConfigFlags -> Flag DebugInfoLevel
configDebugInfo = Flag DebugInfoLevel
packageConfigDebugInfo
        , configDumpBuildInfo :: ConfigFlags -> Flag DumpBuildInfo
configDumpBuildInfo = Flag DumpBuildInfo
packageConfigDumpBuildInfo
        , configRelocatable :: ConfigFlags -> Flag Bool
configRelocatable = Flag Bool
packageConfigRelocatable
        , configCoverageFor :: ConfigFlags -> Flag [UnitId]
configCoverageFor = Flag [UnitId]
_
        } = ConfigFlags
configFlags
      packageConfigExtraLibDirs :: [String]
packageConfigExtraLibDirs = (SymbolicPath Pkg ('Dir Lib) -> String)
-> [SymbolicPath Pkg ('Dir Lib)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Lib) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath ([SymbolicPath Pkg ('Dir Lib)] -> [String])
-> [SymbolicPath Pkg ('Dir Lib)] -> [String]
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirs ConfigFlags
configFlags
      packageConfigExtraLibDirsStatic :: [String]
packageConfigExtraLibDirsStatic = (SymbolicPath Pkg ('Dir Lib) -> String)
-> [SymbolicPath Pkg ('Dir Lib)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Lib) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath ([SymbolicPath Pkg ('Dir Lib)] -> [String])
-> [SymbolicPath Pkg ('Dir Lib)] -> [String]
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirsStatic ConfigFlags
configFlags
      packageConfigExtraFrameworkDirs :: [String]
packageConfigExtraFrameworkDirs = (SymbolicPath Pkg ('Dir Framework) -> String)
-> [SymbolicPath Pkg ('Dir Framework)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Framework) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath ([SymbolicPath Pkg ('Dir Framework)] -> [String])
-> [SymbolicPath Pkg ('Dir Framework)] -> [String]
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> [SymbolicPath Pkg ('Dir Framework)]
configExtraFrameworkDirs ConfigFlags
configFlags
      packageConfigExtraIncludeDirs :: [String]
packageConfigExtraIncludeDirs = (SymbolicPath Pkg ('Dir Include) -> String)
-> [SymbolicPath Pkg ('Dir Include)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Include) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath ([SymbolicPath Pkg ('Dir Include)] -> [String])
-> [SymbolicPath Pkg ('Dir Include)] -> [String]
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> [SymbolicPath Pkg ('Dir Include)]
configExtraIncludeDirs ConfigFlags
configFlags
      packageConfigProgramPaths :: MapLast String String
packageConfigProgramPaths = Map String String -> MapLast String String
forall k v. Map k v -> MapLast k v
MapLast ([(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, String)]
configProgramPaths)
      packageConfigProgramArgs :: MapMappend String [String]
packageConfigProgramArgs = Map String [String] -> MapMappend String [String]
forall k v. Map k v -> MapMappend k v
MapMappend (([String] -> [String] -> [String])
-> [(String, [String])] -> Map String [String]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) [(String, [String])]
configProgramArgs)

      packageConfigCoverage :: Flag Bool
packageConfigCoverage = Flag Bool
coverage Flag Bool -> Flag Bool -> Flag Bool
forall a. Semigroup a => a -> a -> a
<> Flag Bool
libcoverage
      -- TODO: defer this merging to the resolve phase

      InstallFlags
        { installDocumentation :: InstallFlags -> Flag Bool
installDocumentation = Flag Bool
packageConfigDocumentation
        , installRunTests :: InstallFlags -> Flag Bool
installRunTests = Flag Bool
packageConfigRunTests
        } = InstallFlags
installFlags

      HaddockFlags
        { haddockHoogle :: HaddockFlags -> Flag Bool
haddockHoogle = Flag Bool
packageConfigHaddockHoogle
        , haddockHtml :: HaddockFlags -> Flag Bool
haddockHtml = Flag Bool
packageConfigHaddockHtml
        , haddockHtmlLocation :: HaddockFlags -> Flag String
haddockHtmlLocation = Flag String
packageConfigHaddockHtmlLocation
        , haddockForeignLibs :: HaddockFlags -> Flag Bool
haddockForeignLibs = Flag Bool
packageConfigHaddockForeignLibs
        , haddockForHackage :: HaddockFlags -> Flag HaddockTarget
haddockForHackage = Flag HaddockTarget
packageConfigHaddockForHackage
        , haddockExecutables :: HaddockFlags -> Flag Bool
haddockExecutables = Flag Bool
packageConfigHaddockExecutables
        , haddockTestSuites :: HaddockFlags -> Flag Bool
haddockTestSuites = Flag Bool
packageConfigHaddockTestSuites
        , haddockBenchmarks :: HaddockFlags -> Flag Bool
haddockBenchmarks = Flag Bool
packageConfigHaddockBenchmarks
        , haddockInternal :: HaddockFlags -> Flag Bool
haddockInternal = Flag Bool
packageConfigHaddockInternal
        , haddockCss :: HaddockFlags -> Flag String
haddockCss = Flag String
packageConfigHaddockCss
        , haddockLinkedSource :: HaddockFlags -> Flag Bool
haddockLinkedSource = Flag Bool
packageConfigHaddockLinkedSource
        , haddockQuickJump :: HaddockFlags -> Flag Bool
haddockQuickJump = Flag Bool
packageConfigHaddockQuickJump
        , haddockHscolourCss :: HaddockFlags -> Flag String
haddockHscolourCss = Flag String
packageConfigHaddockHscolourCss
        , haddockContents :: HaddockFlags -> Flag PathTemplate
haddockContents = Flag PathTemplate
packageConfigHaddockContents
        , haddockIndex :: HaddockFlags -> Flag PathTemplate
haddockIndex = Flag PathTemplate
packageConfigHaddockIndex
        , haddockBaseUrl :: HaddockFlags -> Flag String
haddockBaseUrl = Flag String
packageConfigHaddockBaseUrl
        , haddockResourcesDir :: HaddockFlags -> Flag String
haddockResourcesDir = Flag String
packageConfigHaddockResourcesDir
        , haddockOutputDir :: HaddockFlags -> Flag String
haddockOutputDir = Flag String
packageConfigHaddockOutputDir
        , haddockUseUnicode :: HaddockFlags -> Flag Bool
haddockUseUnicode = Flag Bool
packageConfigHaddockUseUnicode
        } = HaddockFlags
haddockFlags

      TestFlags
        { testHumanLog :: TestFlags -> Flag PathTemplate
testHumanLog = Flag PathTemplate
packageConfigTestHumanLog
        , testMachineLog :: TestFlags -> Flag PathTemplate
testMachineLog = Flag PathTemplate
packageConfigTestMachineLog
        , testShowDetails :: TestFlags -> Flag TestShowDetails
testShowDetails = Flag TestShowDetails
packageConfigTestShowDetails
        , testKeepTix :: TestFlags -> Flag Bool
testKeepTix = Flag Bool
packageConfigTestKeepTix
        , testWrapper :: TestFlags -> Flag String
testWrapper = Flag String
packageConfigTestWrapper
        , testFailWhenNoTestSuites :: TestFlags -> Flag Bool
testFailWhenNoTestSuites = Flag Bool
packageConfigTestFailWhenNoTestSuites
        , testOptions :: TestFlags -> [PathTemplate]
testOptions = [PathTemplate]
packageConfigTestTestOptions
        } = TestFlags
testFlags

      BenchmarkFlags
        { benchmarkOptions :: BenchmarkFlags -> [PathTemplate]
benchmarkOptions = [PathTemplate]
packageConfigBenchmarkOptions
        } = BenchmarkFlags
benchmarkFlags

-- | Helper used by other conversion functions that returns the
-- 'ProjectConfigBuildOnly' subset of the 'ProjectConfig'.
convertLegacyBuildOnlyFlags
  :: GlobalFlags
  -> ConfigFlags
  -> InstallFlags
  -> ClientInstallFlags
  -> HaddockFlags
  -> TestFlags
  -> BenchmarkFlags
  -> ProjectConfigBuildOnly
convertLegacyBuildOnlyFlags :: GlobalFlags
-> ConfigFlags
-> InstallFlags
-> ClientInstallFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> ProjectConfigBuildOnly
convertLegacyBuildOnlyFlags
  GlobalFlags
globalFlags
  ConfigFlags
configFlags
  InstallFlags
installFlags
  ClientInstallFlags
clientInstallFlags
  HaddockFlags
haddockFlags
  TestFlags
_
  BenchmarkFlags
_ =
    ProjectConfigBuildOnly{Flag Bool
Flag String
Flag (Maybe Int)
Flag PathTemplate
Flag Verbosity
Flag ReportLevel
NubList PathTemplate
ClientInstallFlags
projectConfigClientInstallFlags :: ClientInstallFlags
projectConfigCacheDir :: Flag String
projectConfigLogsDir :: Flag String
projectConfigHttpTransport :: Flag String
projectConfigIgnoreExpiry :: Flag Bool
projectConfigVerbosity :: Flag Verbosity
projectConfigDryRun :: Flag Bool
projectConfigOnlyDownload :: Flag Bool
projectConfigOnlyDeps :: Flag Bool
projectConfigSummaryFile :: NubList PathTemplate
projectConfigLogFile :: Flag PathTemplate
projectConfigBuildReports :: Flag ReportLevel
projectConfigReportPlanningFailure :: Flag Bool
projectConfigSymlinkBinDir :: Flag String
projectConfigNumJobs :: Flag (Maybe Int)
projectConfigUseSemaphore :: Flag Bool
projectConfigKeepGoing :: Flag Bool
projectConfigOfflineMode :: Flag Bool
projectConfigKeepTempFiles :: Flag Bool
projectConfigVerbosity :: Flag Verbosity
projectConfigDryRun :: Flag Bool
projectConfigOnlyDeps :: Flag Bool
projectConfigOnlyDownload :: Flag Bool
projectConfigSummaryFile :: NubList PathTemplate
projectConfigLogFile :: Flag PathTemplate
projectConfigBuildReports :: Flag ReportLevel
projectConfigReportPlanningFailure :: Flag Bool
projectConfigSymlinkBinDir :: Flag String
projectConfigNumJobs :: Flag (Maybe Int)
projectConfigUseSemaphore :: Flag Bool
projectConfigKeepGoing :: Flag Bool
projectConfigOfflineMode :: Flag Bool
projectConfigKeepTempFiles :: Flag Bool
projectConfigHttpTransport :: Flag String
projectConfigIgnoreExpiry :: Flag Bool
projectConfigCacheDir :: Flag String
projectConfigLogsDir :: Flag String
projectConfigClientInstallFlags :: ClientInstallFlags
..}
    where
      projectConfigClientInstallFlags :: ClientInstallFlags
projectConfigClientInstallFlags = ClientInstallFlags
clientInstallFlags
      GlobalFlags
        { globalCacheDir :: GlobalFlags -> Flag String
globalCacheDir = Flag String
projectConfigCacheDir
        , globalLogsDir :: GlobalFlags -> Flag String
globalLogsDir = Flag String
projectConfigLogsDir
        , globalHttpTransport :: GlobalFlags -> Flag String
globalHttpTransport = Flag String
projectConfigHttpTransport
        , globalIgnoreExpiry :: GlobalFlags -> Flag Bool
globalIgnoreExpiry = Flag Bool
projectConfigIgnoreExpiry
        } = GlobalFlags
globalFlags

      ConfigFlags
        { configCommonFlags :: ConfigFlags -> CommonSetupFlags
configCommonFlags = CommonSetupFlags
commonFlags
        } = ConfigFlags
configFlags

      CommonSetupFlags
        { setupVerbosity :: CommonSetupFlags -> Flag Verbosity
setupVerbosity = Flag Verbosity
projectConfigVerbosity
        } = CommonSetupFlags
commonFlags

      InstallFlags
        { installDryRun :: InstallFlags -> Flag Bool
installDryRun = Flag Bool
projectConfigDryRun
        , installOnlyDownload :: InstallFlags -> Flag Bool
installOnlyDownload = Flag Bool
projectConfigOnlyDownload
        , installOnly :: InstallFlags -> Flag Bool
installOnly = Flag Bool
_
        , installOnlyDeps :: InstallFlags -> Flag Bool
installOnlyDeps = Flag Bool
projectConfigOnlyDeps
        , installRootCmd :: InstallFlags -> Flag String
installRootCmd = Flag String
_
        , installSummaryFile :: InstallFlags -> NubList PathTemplate
installSummaryFile = NubList PathTemplate
projectConfigSummaryFile
        , installLogFile :: InstallFlags -> Flag PathTemplate
installLogFile = Flag PathTemplate
projectConfigLogFile
        , installBuildReports :: InstallFlags -> Flag ReportLevel
installBuildReports = Flag ReportLevel
projectConfigBuildReports
        , installReportPlanningFailure :: InstallFlags -> Flag Bool
installReportPlanningFailure = Flag Bool
projectConfigReportPlanningFailure
        , installSymlinkBinDir :: InstallFlags -> Flag String
installSymlinkBinDir = Flag String
projectConfigSymlinkBinDir
        , installNumJobs :: InstallFlags -> Flag (Maybe Int)
installNumJobs = Flag (Maybe Int)
projectConfigNumJobs
        , installUseSemaphore :: InstallFlags -> Flag Bool
installUseSemaphore = Flag Bool
projectConfigUseSemaphore
        , installKeepGoing :: InstallFlags -> Flag Bool
installKeepGoing = Flag Bool
projectConfigKeepGoing
        , installOfflineMode :: InstallFlags -> Flag Bool
installOfflineMode = Flag Bool
projectConfigOfflineMode
        } = InstallFlags
installFlags

      HaddockFlags
        { haddockKeepTempFiles :: HaddockFlags -> Flag Bool
haddockKeepTempFiles = Flag Bool
projectConfigKeepTempFiles -- TODO: this ought to live elsewhere
        } = HaddockFlags
haddockFlags

convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig
convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig
convertToLegacyProjectConfig
  projectConfig :: ProjectConfig
projectConfig@ProjectConfig
    { [String]
projectPackages :: ProjectConfig -> [String]
projectPackages :: [String]
projectPackages
    , [String]
projectPackagesOptional :: ProjectConfig -> [String]
projectPackagesOptional :: [String]
projectPackagesOptional
    , [SourceRepoList]
projectPackagesRepo :: ProjectConfig -> [SourceRepoList]
projectPackagesRepo :: [SourceRepoList]
projectPackagesRepo
    , [PackageVersionConstraint]
projectPackagesNamed :: ProjectConfig -> [PackageVersionConstraint]
projectPackagesNamed :: [PackageVersionConstraint]
projectPackagesNamed
    , PackageConfig
projectConfigAllPackages :: ProjectConfig -> PackageConfig
projectConfigAllPackages :: PackageConfig
projectConfigAllPackages
    , PackageConfig
projectConfigLocalPackages :: ProjectConfig -> PackageConfig
projectConfigLocalPackages :: PackageConfig
projectConfigLocalPackages
    , MapMappend PackageName PackageConfig
projectConfigSpecificPackage :: ProjectConfig -> MapMappend PackageName PackageConfig
projectConfigSpecificPackage :: MapMappend PackageName PackageConfig
projectConfigSpecificPackage
    } =
    LegacyProjectConfig
      { legacyPackages :: [String]
legacyPackages = [String]
projectPackages
      , legacyPackagesOptional :: [String]
legacyPackagesOptional = [String]
projectPackagesOptional
      , legacyPackagesRepo :: [SourceRepoList]
legacyPackagesRepo = [SourceRepoList]
projectPackagesRepo
      , legacyPackagesNamed :: [PackageVersionConstraint]
legacyPackagesNamed = [PackageVersionConstraint]
projectPackagesNamed
      , legacySharedConfig :: LegacySharedConfig
legacySharedConfig = ProjectConfig -> LegacySharedConfig
convertToLegacySharedConfig ProjectConfig
projectConfig
      , legacyAllConfig :: LegacyPackageConfig
legacyAllConfig =
          PackageConfig -> LegacyPackageConfig
convertToLegacyPerPackageConfig
            PackageConfig
projectConfigAllPackages
      , legacyLocalConfig :: LegacyPackageConfig
legacyLocalConfig =
          ProjectConfig -> LegacyPackageConfig
convertToLegacyAllPackageConfig ProjectConfig
projectConfig
            LegacyPackageConfig -> LegacyPackageConfig -> LegacyPackageConfig
forall a. Semigroup a => a -> a -> a
<> PackageConfig -> LegacyPackageConfig
convertToLegacyPerPackageConfig
              PackageConfig
projectConfigLocalPackages
      , legacySpecificConfig :: MapMappend PackageName LegacyPackageConfig
legacySpecificConfig =
          (PackageConfig -> LegacyPackageConfig)
-> MapMappend PackageName PackageConfig
-> MapMappend PackageName LegacyPackageConfig
forall a b.
(a -> b) -> MapMappend PackageName a -> MapMappend PackageName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            PackageConfig -> LegacyPackageConfig
convertToLegacyPerPackageConfig
            MapMappend PackageName PackageConfig
projectConfigSpecificPackage
      }

convertToLegacySharedConfig :: ProjectConfig -> LegacySharedConfig
convertToLegacySharedConfig :: ProjectConfig -> LegacySharedConfig
convertToLegacySharedConfig
  ProjectConfig
    { projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly = ProjectConfigBuildOnly{Flag Bool
Flag String
Flag (Maybe Int)
Flag PathTemplate
Flag Verbosity
Flag ReportLevel
NubList PathTemplate
ClientInstallFlags
projectConfigVerbosity :: ProjectConfigBuildOnly -> Flag Verbosity
projectConfigDryRun :: ProjectConfigBuildOnly -> Flag Bool
projectConfigOnlyDeps :: ProjectConfigBuildOnly -> Flag Bool
projectConfigOnlyDownload :: ProjectConfigBuildOnly -> Flag Bool
projectConfigSummaryFile :: ProjectConfigBuildOnly -> NubList PathTemplate
projectConfigLogFile :: ProjectConfigBuildOnly -> Flag PathTemplate
projectConfigBuildReports :: ProjectConfigBuildOnly -> Flag ReportLevel
projectConfigReportPlanningFailure :: ProjectConfigBuildOnly -> Flag Bool
projectConfigSymlinkBinDir :: ProjectConfigBuildOnly -> Flag String
projectConfigNumJobs :: ProjectConfigBuildOnly -> Flag (Maybe Int)
projectConfigUseSemaphore :: ProjectConfigBuildOnly -> Flag Bool
projectConfigKeepGoing :: ProjectConfigBuildOnly -> Flag Bool
projectConfigOfflineMode :: ProjectConfigBuildOnly -> Flag Bool
projectConfigKeepTempFiles :: ProjectConfigBuildOnly -> Flag Bool
projectConfigHttpTransport :: ProjectConfigBuildOnly -> Flag String
projectConfigIgnoreExpiry :: ProjectConfigBuildOnly -> Flag Bool
projectConfigCacheDir :: ProjectConfigBuildOnly -> Flag String
projectConfigLogsDir :: ProjectConfigBuildOnly -> Flag String
projectConfigClientInstallFlags :: ProjectConfigBuildOnly -> ClientInstallFlags
projectConfigVerbosity :: Flag Verbosity
projectConfigDryRun :: Flag Bool
projectConfigOnlyDeps :: Flag Bool
projectConfigOnlyDownload :: Flag Bool
projectConfigSummaryFile :: NubList PathTemplate
projectConfigLogFile :: Flag PathTemplate
projectConfigBuildReports :: Flag ReportLevel
projectConfigReportPlanningFailure :: Flag Bool
projectConfigSymlinkBinDir :: Flag String
projectConfigNumJobs :: Flag (Maybe Int)
projectConfigUseSemaphore :: Flag Bool
projectConfigKeepGoing :: Flag Bool
projectConfigOfflineMode :: Flag Bool
projectConfigKeepTempFiles :: Flag Bool
projectConfigHttpTransport :: Flag String
projectConfigIgnoreExpiry :: Flag Bool
projectConfigCacheDir :: Flag String
projectConfigLogsDir :: Flag String
projectConfigClientInstallFlags :: ClientInstallFlags
..}
    , projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared = ProjectConfigShared{[Maybe PackageDBCWD]
[(UserConstraint, ConstraintSource)]
[PackageVersionConstraint]
Maybe AllowOlder
Maybe AllowNewer
Flag Bool
Flag Int
Flag String
Flag Version
Flag PathTemplate
Flag CompilerFlavor
Flag OnlyConstrained
Flag AllowBootLibInstalls
Flag StrongFlags
Flag PreferOldest
Flag IndependentGoals
Flag MinimizeConflictSet
Flag FineGrainedConflicts
Flag CountConflicts
Flag ReorderGoals
Flag PreSolver
Flag TotalIndexState
Flag ActiveRepos
Flag WriteGhcEnvironmentFilesPolicy
InstallDirs (Flag PathTemplate)
NubList String
NubList LocalRepo
NubList RemoteRepo
projectConfigHcFlavor :: ProjectConfigShared -> Flag CompilerFlavor
projectConfigHcPath :: ProjectConfigShared -> Flag String
projectConfigHcPkg :: ProjectConfigShared -> Flag String
projectConfigDistDir :: ProjectConfigShared -> Flag String
projectConfigConfigFile :: ProjectConfigShared -> Flag String
projectConfigProjectDir :: ProjectConfigShared -> Flag String
projectConfigProjectFile :: ProjectConfigShared -> Flag String
projectConfigIgnoreProject :: ProjectConfigShared -> Flag Bool
projectConfigHaddockIndex :: ProjectConfigShared -> Flag PathTemplate
projectConfigInstallDirs :: ProjectConfigShared -> InstallDirs (Flag PathTemplate)
projectConfigPackageDBs :: ProjectConfigShared -> [Maybe PackageDBCWD]
projectConfigRemoteRepos :: ProjectConfigShared -> NubList RemoteRepo
projectConfigLocalNoIndexRepos :: ProjectConfigShared -> NubList LocalRepo
projectConfigActiveRepos :: ProjectConfigShared -> Flag ActiveRepos
projectConfigIndexState :: ProjectConfigShared -> Flag TotalIndexState
projectConfigStoreDir :: ProjectConfigShared -> Flag String
projectConfigConstraints :: ProjectConfigShared -> [(UserConstraint, ConstraintSource)]
projectConfigPreferences :: ProjectConfigShared -> [PackageVersionConstraint]
projectConfigCabalVersion :: ProjectConfigShared -> Flag Version
projectConfigSolver :: ProjectConfigShared -> Flag PreSolver
projectConfigAllowOlder :: ProjectConfigShared -> Maybe AllowOlder
projectConfigAllowNewer :: ProjectConfigShared -> Maybe AllowNewer
projectConfigWriteGhcEnvironmentFilesPolicy :: ProjectConfigShared -> Flag WriteGhcEnvironmentFilesPolicy
projectConfigMaxBackjumps :: ProjectConfigShared -> Flag Int
projectConfigReorderGoals :: ProjectConfigShared -> Flag ReorderGoals
projectConfigCountConflicts :: ProjectConfigShared -> Flag CountConflicts
projectConfigFineGrainedConflicts :: ProjectConfigShared -> Flag FineGrainedConflicts
projectConfigMinimizeConflictSet :: ProjectConfigShared -> Flag MinimizeConflictSet
projectConfigStrongFlags :: ProjectConfigShared -> Flag StrongFlags
projectConfigAllowBootLibInstalls :: ProjectConfigShared -> Flag AllowBootLibInstalls
projectConfigOnlyConstrained :: ProjectConfigShared -> Flag OnlyConstrained
projectConfigPerComponent :: ProjectConfigShared -> Flag Bool
projectConfigIndependentGoals :: ProjectConfigShared -> Flag IndependentGoals
projectConfigPreferOldest :: ProjectConfigShared -> Flag PreferOldest
projectConfigProgPathExtra :: ProjectConfigShared -> NubList String
projectConfigMultiRepl :: ProjectConfigShared -> Flag Bool
projectConfigDistDir :: Flag String
projectConfigConfigFile :: Flag String
projectConfigProjectDir :: Flag String
projectConfigProjectFile :: Flag String
projectConfigIgnoreProject :: Flag Bool
projectConfigHcFlavor :: Flag CompilerFlavor
projectConfigHcPath :: Flag String
projectConfigHcPkg :: Flag String
projectConfigHaddockIndex :: Flag PathTemplate
projectConfigInstallDirs :: InstallDirs (Flag PathTemplate)
projectConfigPackageDBs :: [Maybe PackageDBCWD]
projectConfigRemoteRepos :: NubList RemoteRepo
projectConfigLocalNoIndexRepos :: NubList LocalRepo
projectConfigActiveRepos :: Flag ActiveRepos
projectConfigIndexState :: Flag TotalIndexState
projectConfigStoreDir :: Flag String
projectConfigConstraints :: [(UserConstraint, ConstraintSource)]
projectConfigPreferences :: [PackageVersionConstraint]
projectConfigCabalVersion :: Flag Version
projectConfigSolver :: Flag PreSolver
projectConfigAllowOlder :: Maybe AllowOlder
projectConfigAllowNewer :: Maybe AllowNewer
projectConfigWriteGhcEnvironmentFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy
projectConfigMaxBackjumps :: Flag Int
projectConfigReorderGoals :: Flag ReorderGoals
projectConfigCountConflicts :: Flag CountConflicts
projectConfigFineGrainedConflicts :: Flag FineGrainedConflicts
projectConfigMinimizeConflictSet :: Flag MinimizeConflictSet
projectConfigStrongFlags :: Flag StrongFlags
projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls
projectConfigOnlyConstrained :: Flag OnlyConstrained
projectConfigPerComponent :: Flag Bool
projectConfigIndependentGoals :: Flag IndependentGoals
projectConfigPreferOldest :: Flag PreferOldest
projectConfigProgPathExtra :: NubList String
projectConfigMultiRepl :: Flag Bool
..}
    , projectConfigAllPackages :: ProjectConfig -> PackageConfig
projectConfigAllPackages =
      PackageConfig
        { Flag Bool
packageConfigDocumentation :: PackageConfig -> Flag Bool
packageConfigDocumentation :: Flag Bool
packageConfigDocumentation
        }
    } =
    LegacySharedConfig
      { legacyGlobalFlags :: GlobalFlags
legacyGlobalFlags = GlobalFlags
globalFlags
      , legacyConfigureShFlags :: ConfigFlags
legacyConfigureShFlags = ConfigFlags
configFlags
      , legacyConfigureExFlags :: ConfigExFlags
legacyConfigureExFlags = ConfigExFlags
configExFlags
      , legacyInstallFlags :: InstallFlags
legacyInstallFlags = InstallFlags
installFlags
      , legacyClientInstallFlags :: ClientInstallFlags
legacyClientInstallFlags = ClientInstallFlags
projectConfigClientInstallFlags
      , legacyProjectFlags :: ProjectFlags
legacyProjectFlags = ProjectFlags
projectFlags
      , legacyMultiRepl :: Flag Bool
legacyMultiRepl = Flag Bool
projectConfigMultiRepl
      }
    where
      globalFlags :: GlobalFlags
globalFlags =
        GlobalFlags
          { globalVersion :: Flag Bool
globalVersion = Flag Bool
forall a. Monoid a => a
mempty
          , globalNumericVersion :: Flag Bool
globalNumericVersion = Flag Bool
forall a. Monoid a => a
mempty
          , globalConfigFile :: Flag String
globalConfigFile = Flag String
projectConfigConfigFile
          , globalConstraintsFile :: Flag String
globalConstraintsFile = Flag String
forall a. Monoid a => a
mempty
          , globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos = NubList RemoteRepo
projectConfigRemoteRepos
          , globalCacheDir :: Flag String
globalCacheDir = Flag String
projectConfigCacheDir
          , globalLocalNoIndexRepos :: NubList LocalRepo
globalLocalNoIndexRepos = NubList LocalRepo
projectConfigLocalNoIndexRepos
          , globalActiveRepos :: Flag ActiveRepos
globalActiveRepos = Flag ActiveRepos
projectConfigActiveRepos
          , globalLogsDir :: Flag String
globalLogsDir = Flag String
projectConfigLogsDir
          , globalIgnoreExpiry :: Flag Bool
globalIgnoreExpiry = Flag Bool
projectConfigIgnoreExpiry
          , globalHttpTransport :: Flag String
globalHttpTransport = Flag String
projectConfigHttpTransport
          , globalNix :: Flag Bool
globalNix = Flag Bool
forall a. Monoid a => a
mempty
          , globalStoreDir :: Flag String
globalStoreDir = Flag String
projectConfigStoreDir
          , globalProgPathExtra :: NubList String
globalProgPathExtra = NubList String
projectConfigProgPathExtra
          }

      commonFlags :: CommonSetupFlags
commonFlags =
        CommonSetupFlags
forall a. Monoid a => a
mempty
          { setupVerbosity = projectConfigVerbosity
          , setupDistPref = fmap makeSymbolicPath $ projectConfigDistDir
          }

      configFlags :: ConfigFlags
configFlags =
        ConfigFlags
forall a. Monoid a => a
mempty
          { configCommonFlags = commonFlags
          , configPackageDBs = fmap (fmap (fmap unsafeMakeSymbolicPath)) projectConfigPackageDBs
          , configInstallDirs = projectConfigInstallDirs
          }

      configExFlags :: ConfigExFlags
configExFlags =
        ConfigExFlags
          { configCabalVersion :: Flag Version
configCabalVersion = Flag Version
projectConfigCabalVersion
          , configAppend :: Flag Bool
configAppend = Flag Bool
forall a. Monoid a => a
mempty
          , configBackup :: Flag Bool
configBackup = Flag Bool
forall a. Monoid a => a
mempty
          , configExConstraints :: [(UserConstraint, ConstraintSource)]
configExConstraints = [(UserConstraint, ConstraintSource)]
projectConfigConstraints
          , configPreferences :: [PackageVersionConstraint]
configPreferences = [PackageVersionConstraint]
projectConfigPreferences
          , configSolver :: Flag PreSolver
configSolver = Flag PreSolver
projectConfigSolver
          , configAllowOlder :: Maybe AllowOlder
configAllowOlder = Maybe AllowOlder
projectConfigAllowOlder
          , configAllowNewer :: Maybe AllowNewer
configAllowNewer = Maybe AllowNewer
projectConfigAllowNewer
          , configWriteGhcEnvironmentFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy
configWriteGhcEnvironmentFilesPolicy =
              Flag WriteGhcEnvironmentFilesPolicy
projectConfigWriteGhcEnvironmentFilesPolicy
          }

      installFlags :: InstallFlags
installFlags =
        InstallFlags
          { installDocumentation :: Flag Bool
installDocumentation = Flag Bool
packageConfigDocumentation
          , installHaddockIndex :: Flag PathTemplate
installHaddockIndex = Flag PathTemplate
projectConfigHaddockIndex
          , installDest :: Flag CopyDest
installDest = CopyDest -> Flag CopyDest
forall a. a -> Flag a
Flag CopyDest
NoCopyDest
          , installDryRun :: Flag Bool
installDryRun = Flag Bool
projectConfigDryRun
          , installOnlyDownload :: Flag Bool
installOnlyDownload = Flag Bool
projectConfigOnlyDownload
          , installReinstall :: Flag Bool
installReinstall = Flag Bool
forall a. Monoid a => a
mempty -- projectConfigReinstall,
          , installAvoidReinstalls :: Flag AvoidReinstalls
installAvoidReinstalls = Flag AvoidReinstalls
forall a. Monoid a => a
mempty -- projectConfigAvoidReinstalls,
          , installOverrideReinstall :: Flag Bool
installOverrideReinstall = Flag Bool
forall a. Monoid a => a
mempty -- projectConfigOverrideReinstall,
          , installMaxBackjumps :: Flag Int
installMaxBackjumps = Flag Int
projectConfigMaxBackjumps
          , installUpgradeDeps :: Flag Bool
installUpgradeDeps = Flag Bool
forall a. Monoid a => a
mempty -- projectConfigUpgradeDeps,
          , installReorderGoals :: Flag ReorderGoals
installReorderGoals = Flag ReorderGoals
projectConfigReorderGoals
          , installCountConflicts :: Flag CountConflicts
installCountConflicts = Flag CountConflicts
projectConfigCountConflicts
          , installFineGrainedConflicts :: Flag FineGrainedConflicts
installFineGrainedConflicts = Flag FineGrainedConflicts
projectConfigFineGrainedConflicts
          , installMinimizeConflictSet :: Flag MinimizeConflictSet
installMinimizeConflictSet = Flag MinimizeConflictSet
projectConfigMinimizeConflictSet
          , installIndependentGoals :: Flag IndependentGoals
installIndependentGoals = Flag IndependentGoals
projectConfigIndependentGoals
          , installPreferOldest :: Flag PreferOldest
installPreferOldest = Flag PreferOldest
projectConfigPreferOldest
          , installShadowPkgs :: Flag ShadowPkgs
installShadowPkgs = Flag ShadowPkgs
forall a. Monoid a => a
mempty -- projectConfigShadowPkgs,
          , installStrongFlags :: Flag StrongFlags
installStrongFlags = Flag StrongFlags
projectConfigStrongFlags
          , installAllowBootLibInstalls :: Flag AllowBootLibInstalls
installAllowBootLibInstalls = Flag AllowBootLibInstalls
projectConfigAllowBootLibInstalls
          , installOnlyConstrained :: Flag OnlyConstrained
installOnlyConstrained = Flag OnlyConstrained
projectConfigOnlyConstrained
          , installOnly :: Flag Bool
installOnly = Flag Bool
forall a. Monoid a => a
mempty
          , installOnlyDeps :: Flag Bool
installOnlyDeps = Flag Bool
projectConfigOnlyDeps
          , installIndexState :: Flag TotalIndexState
installIndexState = Flag TotalIndexState
projectConfigIndexState
          , installRootCmd :: Flag String
installRootCmd = Flag String
forall a. Monoid a => a
mempty -- no longer supported
          , installSummaryFile :: NubList PathTemplate
installSummaryFile = NubList PathTemplate
projectConfigSummaryFile
          , installLogFile :: Flag PathTemplate
installLogFile = Flag PathTemplate
projectConfigLogFile
          , installBuildReports :: Flag ReportLevel
installBuildReports = Flag ReportLevel
projectConfigBuildReports
          , installReportPlanningFailure :: Flag Bool
installReportPlanningFailure = Flag Bool
projectConfigReportPlanningFailure
          , installSymlinkBinDir :: Flag String
installSymlinkBinDir = Flag String
projectConfigSymlinkBinDir
          , installPerComponent :: Flag Bool
installPerComponent = Flag Bool
projectConfigPerComponent
          , installNumJobs :: Flag (Maybe Int)
installNumJobs = Flag (Maybe Int)
projectConfigNumJobs
          , installUseSemaphore :: Flag Bool
installUseSemaphore = Flag Bool
projectConfigUseSemaphore
          , installKeepGoing :: Flag Bool
installKeepGoing = Flag Bool
projectConfigKeepGoing
          , installRunTests :: Flag Bool
installRunTests = Flag Bool
forall a. Monoid a => a
mempty
          , installOfflineMode :: Flag Bool
installOfflineMode = Flag Bool
projectConfigOfflineMode
          }

      projectFlags :: ProjectFlags
projectFlags =
        ProjectFlags
          { flagProjectDir :: Flag String
flagProjectDir = Flag String
projectConfigProjectDir
          , flagProjectFile :: Flag String
flagProjectFile = Flag String
projectConfigProjectFile
          , flagIgnoreProject :: Flag Bool
flagIgnoreProject = Flag Bool
projectConfigIgnoreProject
          }

convertToLegacyAllPackageConfig :: ProjectConfig -> LegacyPackageConfig
convertToLegacyAllPackageConfig :: ProjectConfig -> LegacyPackageConfig
convertToLegacyAllPackageConfig
  ProjectConfig
    { projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly = ProjectConfigBuildOnly{Flag Bool
Flag String
Flag (Maybe Int)
Flag PathTemplate
Flag Verbosity
Flag ReportLevel
NubList PathTemplate
ClientInstallFlags
projectConfigVerbosity :: ProjectConfigBuildOnly -> Flag Verbosity
projectConfigDryRun :: ProjectConfigBuildOnly -> Flag Bool
projectConfigOnlyDeps :: ProjectConfigBuildOnly -> Flag Bool
projectConfigOnlyDownload :: ProjectConfigBuildOnly -> Flag Bool
projectConfigSummaryFile :: ProjectConfigBuildOnly -> NubList PathTemplate
projectConfigLogFile :: ProjectConfigBuildOnly -> Flag PathTemplate
projectConfigBuildReports :: ProjectConfigBuildOnly -> Flag ReportLevel
projectConfigReportPlanningFailure :: ProjectConfigBuildOnly -> Flag Bool
projectConfigSymlinkBinDir :: ProjectConfigBuildOnly -> Flag String
projectConfigNumJobs :: ProjectConfigBuildOnly -> Flag (Maybe Int)
projectConfigUseSemaphore :: ProjectConfigBuildOnly -> Flag Bool
projectConfigKeepGoing :: ProjectConfigBuildOnly -> Flag Bool
projectConfigOfflineMode :: ProjectConfigBuildOnly -> Flag Bool
projectConfigKeepTempFiles :: ProjectConfigBuildOnly -> Flag Bool
projectConfigHttpTransport :: ProjectConfigBuildOnly -> Flag String
projectConfigIgnoreExpiry :: ProjectConfigBuildOnly -> Flag Bool
projectConfigCacheDir :: ProjectConfigBuildOnly -> Flag String
projectConfigLogsDir :: ProjectConfigBuildOnly -> Flag String
projectConfigClientInstallFlags :: ProjectConfigBuildOnly -> ClientInstallFlags
projectConfigVerbosity :: Flag Verbosity
projectConfigDryRun :: Flag Bool
projectConfigOnlyDeps :: Flag Bool
projectConfigOnlyDownload :: Flag Bool
projectConfigSummaryFile :: NubList PathTemplate
projectConfigLogFile :: Flag PathTemplate
projectConfigBuildReports :: Flag ReportLevel
projectConfigReportPlanningFailure :: Flag Bool
projectConfigSymlinkBinDir :: Flag String
projectConfigNumJobs :: Flag (Maybe Int)
projectConfigUseSemaphore :: Flag Bool
projectConfigKeepGoing :: Flag Bool
projectConfigOfflineMode :: Flag Bool
projectConfigKeepTempFiles :: Flag Bool
projectConfigHttpTransport :: Flag String
projectConfigIgnoreExpiry :: Flag Bool
projectConfigCacheDir :: Flag String
projectConfigLogsDir :: Flag String
projectConfigClientInstallFlags :: ClientInstallFlags
..}
    , projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared = ProjectConfigShared{[Maybe PackageDBCWD]
[(UserConstraint, ConstraintSource)]
[PackageVersionConstraint]
Maybe AllowOlder
Maybe AllowNewer
Flag Bool
Flag Int
Flag String
Flag Version
Flag PathTemplate
Flag CompilerFlavor
Flag OnlyConstrained
Flag AllowBootLibInstalls
Flag StrongFlags
Flag PreferOldest
Flag IndependentGoals
Flag MinimizeConflictSet
Flag FineGrainedConflicts
Flag CountConflicts
Flag ReorderGoals
Flag PreSolver
Flag TotalIndexState
Flag ActiveRepos
Flag WriteGhcEnvironmentFilesPolicy
InstallDirs (Flag PathTemplate)
NubList String
NubList LocalRepo
NubList RemoteRepo
projectConfigHcFlavor :: ProjectConfigShared -> Flag CompilerFlavor
projectConfigHcPath :: ProjectConfigShared -> Flag String
projectConfigHcPkg :: ProjectConfigShared -> Flag String
projectConfigDistDir :: ProjectConfigShared -> Flag String
projectConfigConfigFile :: ProjectConfigShared -> Flag String
projectConfigProjectDir :: ProjectConfigShared -> Flag String
projectConfigProjectFile :: ProjectConfigShared -> Flag String
projectConfigIgnoreProject :: ProjectConfigShared -> Flag Bool
projectConfigHaddockIndex :: ProjectConfigShared -> Flag PathTemplate
projectConfigInstallDirs :: ProjectConfigShared -> InstallDirs (Flag PathTemplate)
projectConfigPackageDBs :: ProjectConfigShared -> [Maybe PackageDBCWD]
projectConfigRemoteRepos :: ProjectConfigShared -> NubList RemoteRepo
projectConfigLocalNoIndexRepos :: ProjectConfigShared -> NubList LocalRepo
projectConfigActiveRepos :: ProjectConfigShared -> Flag ActiveRepos
projectConfigIndexState :: ProjectConfigShared -> Flag TotalIndexState
projectConfigStoreDir :: ProjectConfigShared -> Flag String
projectConfigConstraints :: ProjectConfigShared -> [(UserConstraint, ConstraintSource)]
projectConfigPreferences :: ProjectConfigShared -> [PackageVersionConstraint]
projectConfigCabalVersion :: ProjectConfigShared -> Flag Version
projectConfigSolver :: ProjectConfigShared -> Flag PreSolver
projectConfigAllowOlder :: ProjectConfigShared -> Maybe AllowOlder
projectConfigAllowNewer :: ProjectConfigShared -> Maybe AllowNewer
projectConfigWriteGhcEnvironmentFilesPolicy :: ProjectConfigShared -> Flag WriteGhcEnvironmentFilesPolicy
projectConfigMaxBackjumps :: ProjectConfigShared -> Flag Int
projectConfigReorderGoals :: ProjectConfigShared -> Flag ReorderGoals
projectConfigCountConflicts :: ProjectConfigShared -> Flag CountConflicts
projectConfigFineGrainedConflicts :: ProjectConfigShared -> Flag FineGrainedConflicts
projectConfigMinimizeConflictSet :: ProjectConfigShared -> Flag MinimizeConflictSet
projectConfigStrongFlags :: ProjectConfigShared -> Flag StrongFlags
projectConfigAllowBootLibInstalls :: ProjectConfigShared -> Flag AllowBootLibInstalls
projectConfigOnlyConstrained :: ProjectConfigShared -> Flag OnlyConstrained
projectConfigPerComponent :: ProjectConfigShared -> Flag Bool
projectConfigIndependentGoals :: ProjectConfigShared -> Flag IndependentGoals
projectConfigPreferOldest :: ProjectConfigShared -> Flag PreferOldest
projectConfigProgPathExtra :: ProjectConfigShared -> NubList String
projectConfigMultiRepl :: ProjectConfigShared -> Flag Bool
projectConfigDistDir :: Flag String
projectConfigConfigFile :: Flag String
projectConfigProjectDir :: Flag String
projectConfigProjectFile :: Flag String
projectConfigIgnoreProject :: Flag Bool
projectConfigHcFlavor :: Flag CompilerFlavor
projectConfigHcPath :: Flag String
projectConfigHcPkg :: Flag String
projectConfigHaddockIndex :: Flag PathTemplate
projectConfigInstallDirs :: InstallDirs (Flag PathTemplate)
projectConfigPackageDBs :: [Maybe PackageDBCWD]
projectConfigRemoteRepos :: NubList RemoteRepo
projectConfigLocalNoIndexRepos :: NubList LocalRepo
projectConfigActiveRepos :: Flag ActiveRepos
projectConfigIndexState :: Flag TotalIndexState
projectConfigStoreDir :: Flag String
projectConfigConstraints :: [(UserConstraint, ConstraintSource)]
projectConfigPreferences :: [PackageVersionConstraint]
projectConfigCabalVersion :: Flag Version
projectConfigSolver :: Flag PreSolver
projectConfigAllowOlder :: Maybe AllowOlder
projectConfigAllowNewer :: Maybe AllowNewer
projectConfigWriteGhcEnvironmentFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy
projectConfigMaxBackjumps :: Flag Int
projectConfigReorderGoals :: Flag ReorderGoals
projectConfigCountConflicts :: Flag CountConflicts
projectConfigFineGrainedConflicts :: Flag FineGrainedConflicts
projectConfigMinimizeConflictSet :: Flag MinimizeConflictSet
projectConfigStrongFlags :: Flag StrongFlags
projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls
projectConfigOnlyConstrained :: Flag OnlyConstrained
projectConfigPerComponent :: Flag Bool
projectConfigIndependentGoals :: Flag IndependentGoals
projectConfigPreferOldest :: Flag PreferOldest
projectConfigProgPathExtra :: NubList String
projectConfigMultiRepl :: Flag Bool
..}
    } =
    LegacyPackageConfig
      { legacyConfigureFlags :: ConfigFlags
legacyConfigureFlags = ConfigFlags
configFlags
      , legacyInstallPkgFlags :: InstallFlags
legacyInstallPkgFlags = InstallFlags
forall a. Monoid a => a
mempty
      , legacyHaddockFlags :: HaddockFlags
legacyHaddockFlags = HaddockFlags
haddockFlags
      , legacyTestFlags :: TestFlags
legacyTestFlags = TestFlags
forall a. Monoid a => a
mempty
      , legacyBenchmarkFlags :: BenchmarkFlags
legacyBenchmarkFlags = BenchmarkFlags
forall a. Monoid a => a
mempty
      }
    where
      commonFlags :: CommonSetupFlags
commonFlags =
        CommonSetupFlags
forall a. Monoid a => a
mempty

      configFlags :: ConfigFlags
configFlags =
        ConfigFlags
          { configCommonFlags :: CommonSetupFlags
configCommonFlags = CommonSetupFlags
commonFlags
          , configPrograms_ :: Option' (Last' ProgramDb)
configPrograms_ = Option' (Last' ProgramDb)
forall a. Monoid a => a
mempty
          , configProgramPaths :: [(String, String)]
configProgramPaths = [(String, String)]
forall a. Monoid a => a
mempty
          , configProgramArgs :: [(String, [String])]
configProgramArgs = [(String, [String])]
forall a. Monoid a => a
mempty
          , configProgramPathExtra :: NubList String
configProgramPathExtra = NubList String
forall a. Monoid a => a
mempty
          , configHcFlavor :: Flag CompilerFlavor
configHcFlavor = Flag CompilerFlavor
projectConfigHcFlavor
          , configHcPath :: Flag String
configHcPath = Flag String
projectConfigHcPath
          , configHcPkg :: Flag String
configHcPkg = Flag String
projectConfigHcPkg
          , configInstantiateWith :: [(ModuleName, Module)]
configInstantiateWith = [(ModuleName, Module)]
forall a. Monoid a => a
mempty
          , configVanillaLib :: Flag Bool
configVanillaLib = Flag Bool
forall a. Monoid a => a
mempty
          , configProfLib :: Flag Bool
configProfLib = Flag Bool
forall a. Monoid a => a
mempty
          , configSharedLib :: Flag Bool
configSharedLib = Flag Bool
forall a. Monoid a => a
mempty
          , configStaticLib :: Flag Bool
configStaticLib = Flag Bool
forall a. Monoid a => a
mempty
          , configDynExe :: Flag Bool
configDynExe = Flag Bool
forall a. Monoid a => a
mempty
          , configFullyStaticExe :: Flag Bool
configFullyStaticExe = Flag Bool
forall a. Monoid a => a
mempty
          , configProfExe :: Flag Bool
configProfExe = Flag Bool
forall a. Monoid a => a
mempty
          , configProf :: Flag Bool
configProf = Flag Bool
forall a. Monoid a => a
mempty
          , configProfShared :: Flag Bool
configProfShared = Flag Bool
forall a. Monoid a => a
mempty
          , configProfDetail :: Flag ProfDetailLevel
configProfDetail = Flag ProfDetailLevel
forall a. Monoid a => a
mempty
          , configProfLibDetail :: Flag ProfDetailLevel
configProfLibDetail = Flag ProfDetailLevel
forall a. Monoid a => a
mempty
          , configConfigureArgs :: [String]
configConfigureArgs = [String]
forall a. Monoid a => a
mempty
          , configOptimization :: Flag OptimisationLevel
configOptimization = Flag OptimisationLevel
forall a. Monoid a => a
mempty
          , configProgPrefix :: Flag PathTemplate
configProgPrefix = Flag PathTemplate
forall a. Monoid a => a
mempty
          , configProgSuffix :: Flag PathTemplate
configProgSuffix = Flag PathTemplate
forall a. Monoid a => a
mempty
          , configInstallDirs :: InstallDirs (Flag PathTemplate)
configInstallDirs = InstallDirs (Flag PathTemplate)
projectConfigInstallDirs
          , configScratchDir :: Flag String
configScratchDir = Flag String
forall a. Monoid a => a
mempty
          , configUserInstall :: Flag Bool
configUserInstall = Flag Bool
forall a. Monoid a => a
mempty -- projectConfigUserInstall,
          , configPackageDBs :: [Maybe PackageDB]
configPackageDBs = [Maybe PackageDB]
forall a. Monoid a => a
mempty
          , configGHCiLib :: Flag Bool
configGHCiLib = Flag Bool
forall a. Monoid a => a
mempty
          , configSplitSections :: Flag Bool
configSplitSections = Flag Bool
forall a. Monoid a => a
mempty
          , configSplitObjs :: Flag Bool
configSplitObjs = Flag Bool
forall a. Monoid a => a
mempty
          , configStripExes :: Flag Bool
configStripExes = Flag Bool
forall a. Monoid a => a
mempty
          , configStripLibs :: Flag Bool
configStripLibs = Flag Bool
forall a. Monoid a => a
mempty
          , configExtraLibDirs :: [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirs = [SymbolicPath Pkg ('Dir Lib)]
forall a. Monoid a => a
mempty
          , configExtraLibDirsStatic :: [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirsStatic = [SymbolicPath Pkg ('Dir Lib)]
forall a. Monoid a => a
mempty
          , configExtraFrameworkDirs :: [SymbolicPath Pkg ('Dir Framework)]
configExtraFrameworkDirs = [SymbolicPath Pkg ('Dir Framework)]
forall a. Monoid a => a
mempty
          , configConstraints :: [PackageVersionConstraint]
configConstraints = [PackageVersionConstraint]
forall a. Monoid a => a
mempty
          , configDependencies :: [GivenComponent]
configDependencies = [GivenComponent]
forall a. Monoid a => a
mempty
          , configPromisedDependencies :: [PromisedComponent]
configPromisedDependencies = [PromisedComponent]
forall a. Monoid a => a
mempty
          , configExtraIncludeDirs :: [SymbolicPath Pkg ('Dir Include)]
configExtraIncludeDirs = [SymbolicPath Pkg ('Dir Include)]
forall a. Monoid a => a
mempty
          , configDeterministic :: Flag Bool
configDeterministic = Flag Bool
forall a. Monoid a => a
mempty
          , configIPID :: Flag String
configIPID = Flag String
forall a. Monoid a => a
mempty
          , configCID :: Flag ComponentId
configCID = Flag ComponentId
forall a. Monoid a => a
mempty
          , configConfigurationsFlags :: FlagAssignment
configConfigurationsFlags = FlagAssignment
forall a. Monoid a => a
mempty
          , configTests :: Flag Bool
configTests = Flag Bool
forall a. Monoid a => a
mempty
          , configCoverage :: Flag Bool
configCoverage = Flag Bool
forall a. Monoid a => a
mempty -- TODO: don't merge
          , configLibCoverage :: Flag Bool
configLibCoverage = Flag Bool
forall a. Monoid a => a
mempty -- TODO: don't merge
          , configExactConfiguration :: Flag Bool
configExactConfiguration = Flag Bool
forall a. Monoid a => a
mempty
          , configBenchmarks :: Flag Bool
configBenchmarks = Flag Bool
forall a. Monoid a => a
mempty
          , configFlagError :: Flag String
configFlagError = Flag String
forall a. Monoid a => a
mempty -- TODO: ???
          , configRelocatable :: Flag Bool
configRelocatable = Flag Bool
forall a. Monoid a => a
mempty
          , configDebugInfo :: Flag DebugInfoLevel
configDebugInfo = Flag DebugInfoLevel
forall a. Monoid a => a
mempty
          , configUseResponseFiles :: Flag Bool
configUseResponseFiles = Flag Bool
forall a. Monoid a => a
mempty
          , configDumpBuildInfo :: Flag DumpBuildInfo
configDumpBuildInfo = Flag DumpBuildInfo
forall a. Monoid a => a
mempty
          , configAllowDependingOnPrivateLibs :: Flag Bool
configAllowDependingOnPrivateLibs = Flag Bool
forall a. Monoid a => a
mempty
          , configCoverageFor :: Flag [UnitId]
configCoverageFor = Flag [UnitId]
forall a. Monoid a => a
mempty
          , configIgnoreBuildTools :: Flag Bool
configIgnoreBuildTools = Flag Bool
forall a. Monoid a => a
mempty
          }

      haddockFlags :: HaddockFlags
haddockFlags =
        HaddockFlags
forall a. Monoid a => a
mempty
          { haddockKeepTempFiles = projectConfigKeepTempFiles
          }

convertToLegacyPerPackageConfig :: PackageConfig -> LegacyPackageConfig
convertToLegacyPerPackageConfig :: PackageConfig -> LegacyPackageConfig
convertToLegacyPerPackageConfig PackageConfig{[String]
[PathTemplate]
Flag Bool
Flag String
Flag PathTemplate
Flag DumpBuildInfo
Flag ProfDetailLevel
Flag DebugInfoLevel
Flag OptimisationLevel
Flag TestShowDetails
Flag HaddockTarget
NubList String
FlagAssignment
MapMappend String [String]
MapLast String String
packageConfigProgramPaths :: PackageConfig -> MapLast String String
packageConfigProgramPathExtra :: PackageConfig -> NubList String
packageConfigDocumentation :: PackageConfig -> Flag Bool
packageConfigHaddockHoogle :: PackageConfig -> Flag Bool
packageConfigHaddockHtml :: PackageConfig -> Flag Bool
packageConfigHaddockInternal :: PackageConfig -> Flag Bool
packageConfigHaddockQuickJump :: PackageConfig -> Flag Bool
packageConfigHaddockLinkedSource :: PackageConfig -> Flag Bool
packageConfigHaddockUseUnicode :: PackageConfig -> Flag Bool
packageConfigProgramArgs :: PackageConfig -> MapMappend String [String]
packageConfigFlagAssignment :: PackageConfig -> FlagAssignment
packageConfigVanillaLib :: PackageConfig -> Flag Bool
packageConfigSharedLib :: PackageConfig -> Flag Bool
packageConfigStaticLib :: PackageConfig -> Flag Bool
packageConfigDynExe :: PackageConfig -> Flag Bool
packageConfigFullyStaticExe :: PackageConfig -> Flag Bool
packageConfigProf :: PackageConfig -> Flag Bool
packageConfigProfLib :: PackageConfig -> Flag Bool
packageConfigProfShared :: PackageConfig -> Flag Bool
packageConfigProfExe :: PackageConfig -> Flag Bool
packageConfigProfDetail :: PackageConfig -> Flag ProfDetailLevel
packageConfigProfLibDetail :: PackageConfig -> Flag ProfDetailLevel
packageConfigConfigureArgs :: PackageConfig -> [String]
packageConfigOptimization :: PackageConfig -> Flag OptimisationLevel
packageConfigProgPrefix :: PackageConfig -> Flag PathTemplate
packageConfigProgSuffix :: PackageConfig -> Flag PathTemplate
packageConfigExtraLibDirs :: PackageConfig -> [String]
packageConfigExtraLibDirsStatic :: PackageConfig -> [String]
packageConfigExtraFrameworkDirs :: PackageConfig -> [String]
packageConfigExtraIncludeDirs :: PackageConfig -> [String]
packageConfigGHCiLib :: PackageConfig -> Flag Bool
packageConfigSplitSections :: PackageConfig -> Flag Bool
packageConfigSplitObjs :: PackageConfig -> Flag Bool
packageConfigStripExes :: PackageConfig -> Flag Bool
packageConfigStripLibs :: PackageConfig -> Flag Bool
packageConfigTests :: PackageConfig -> Flag Bool
packageConfigBenchmarks :: PackageConfig -> Flag Bool
packageConfigCoverage :: PackageConfig -> Flag Bool
packageConfigRelocatable :: PackageConfig -> Flag Bool
packageConfigDebugInfo :: PackageConfig -> Flag DebugInfoLevel
packageConfigDumpBuildInfo :: PackageConfig -> Flag DumpBuildInfo
packageConfigRunTests :: PackageConfig -> Flag Bool
packageConfigHaddockHtmlLocation :: PackageConfig -> Flag String
packageConfigHaddockForeignLibs :: PackageConfig -> Flag Bool
packageConfigHaddockExecutables :: PackageConfig -> Flag Bool
packageConfigHaddockTestSuites :: PackageConfig -> Flag Bool
packageConfigHaddockBenchmarks :: PackageConfig -> Flag Bool
packageConfigHaddockCss :: PackageConfig -> Flag String
packageConfigHaddockHscolourCss :: PackageConfig -> Flag String
packageConfigHaddockContents :: PackageConfig -> Flag PathTemplate
packageConfigHaddockIndex :: PackageConfig -> Flag PathTemplate
packageConfigHaddockBaseUrl :: PackageConfig -> Flag String
packageConfigHaddockResourcesDir :: PackageConfig -> Flag String
packageConfigHaddockOutputDir :: PackageConfig -> Flag String
packageConfigHaddockForHackage :: PackageConfig -> Flag HaddockTarget
packageConfigTestHumanLog :: PackageConfig -> Flag PathTemplate
packageConfigTestMachineLog :: PackageConfig -> Flag PathTemplate
packageConfigTestShowDetails :: PackageConfig -> Flag TestShowDetails
packageConfigTestKeepTix :: PackageConfig -> Flag Bool
packageConfigTestWrapper :: PackageConfig -> Flag String
packageConfigTestFailWhenNoTestSuites :: PackageConfig -> Flag Bool
packageConfigTestTestOptions :: PackageConfig -> [PathTemplate]
packageConfigBenchmarkOptions :: PackageConfig -> [PathTemplate]
packageConfigProgramPaths :: MapLast String String
packageConfigProgramArgs :: MapMappend String [String]
packageConfigProgramPathExtra :: NubList String
packageConfigFlagAssignment :: FlagAssignment
packageConfigVanillaLib :: Flag Bool
packageConfigSharedLib :: Flag Bool
packageConfigStaticLib :: Flag Bool
packageConfigDynExe :: Flag Bool
packageConfigFullyStaticExe :: Flag Bool
packageConfigProf :: Flag Bool
packageConfigProfLib :: Flag Bool
packageConfigProfShared :: Flag Bool
packageConfigProfExe :: Flag Bool
packageConfigProfDetail :: Flag ProfDetailLevel
packageConfigProfLibDetail :: Flag ProfDetailLevel
packageConfigConfigureArgs :: [String]
packageConfigOptimization :: Flag OptimisationLevel
packageConfigProgPrefix :: Flag PathTemplate
packageConfigProgSuffix :: Flag PathTemplate
packageConfigExtraLibDirs :: [String]
packageConfigExtraLibDirsStatic :: [String]
packageConfigExtraFrameworkDirs :: [String]
packageConfigExtraIncludeDirs :: [String]
packageConfigGHCiLib :: Flag Bool
packageConfigSplitSections :: Flag Bool
packageConfigSplitObjs :: Flag Bool
packageConfigStripExes :: Flag Bool
packageConfigStripLibs :: Flag Bool
packageConfigTests :: Flag Bool
packageConfigBenchmarks :: Flag Bool
packageConfigCoverage :: Flag Bool
packageConfigRelocatable :: Flag Bool
packageConfigDebugInfo :: Flag DebugInfoLevel
packageConfigDumpBuildInfo :: Flag DumpBuildInfo
packageConfigRunTests :: Flag Bool
packageConfigDocumentation :: Flag Bool
packageConfigHaddockHoogle :: Flag Bool
packageConfigHaddockHtml :: Flag Bool
packageConfigHaddockHtmlLocation :: Flag String
packageConfigHaddockForeignLibs :: Flag Bool
packageConfigHaddockExecutables :: Flag Bool
packageConfigHaddockTestSuites :: Flag Bool
packageConfigHaddockBenchmarks :: Flag Bool
packageConfigHaddockInternal :: Flag Bool
packageConfigHaddockCss :: Flag String
packageConfigHaddockLinkedSource :: Flag Bool
packageConfigHaddockQuickJump :: Flag Bool
packageConfigHaddockHscolourCss :: Flag String
packageConfigHaddockContents :: Flag PathTemplate
packageConfigHaddockIndex :: Flag PathTemplate
packageConfigHaddockBaseUrl :: Flag String
packageConfigHaddockResourcesDir :: Flag String
packageConfigHaddockOutputDir :: Flag String
packageConfigHaddockUseUnicode :: Flag Bool
packageConfigHaddockForHackage :: Flag HaddockTarget
packageConfigTestHumanLog :: Flag PathTemplate
packageConfigTestMachineLog :: Flag PathTemplate
packageConfigTestShowDetails :: Flag TestShowDetails
packageConfigTestKeepTix :: Flag Bool
packageConfigTestWrapper :: Flag String
packageConfigTestFailWhenNoTestSuites :: Flag Bool
packageConfigTestTestOptions :: [PathTemplate]
packageConfigBenchmarkOptions :: [PathTemplate]
..} =
  LegacyPackageConfig
    { legacyConfigureFlags :: ConfigFlags
legacyConfigureFlags = ConfigFlags
configFlags
    , legacyInstallPkgFlags :: InstallFlags
legacyInstallPkgFlags = InstallFlags
installFlags
    , legacyHaddockFlags :: HaddockFlags
legacyHaddockFlags = HaddockFlags
haddockFlags
    , legacyTestFlags :: TestFlags
legacyTestFlags = TestFlags
testFlags
    , legacyBenchmarkFlags :: BenchmarkFlags
legacyBenchmarkFlags = BenchmarkFlags
benchmarkFlags
    }
  where
    commonFlags :: CommonSetupFlags
commonFlags =
      CommonSetupFlags
forall a. Monoid a => a
mempty
    configFlags :: ConfigFlags
configFlags =
      ConfigFlags
        { configCommonFlags :: CommonSetupFlags
configCommonFlags = CommonSetupFlags
commonFlags
        , configPrograms_ :: Option' (Last' ProgramDb)
configPrograms_ = ConfigFlags -> Option' (Last' ProgramDb)
configPrograms_ ConfigFlags
forall a. Monoid a => a
mempty
        , configProgramPaths :: [(String, String)]
configProgramPaths = Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
Map.toList (MapLast String String -> Map String String
forall k v. MapLast k v -> Map k v
getMapLast MapLast String String
packageConfigProgramPaths)
        , configProgramArgs :: [(String, [String])]
configProgramArgs = Map String [String] -> [(String, [String])]
forall k a. Map k a -> [(k, a)]
Map.toList (MapMappend String [String] -> Map String [String]
forall k v. MapMappend k v -> Map k v
getMapMappend MapMappend String [String]
packageConfigProgramArgs)
        , configProgramPathExtra :: NubList String
configProgramPathExtra = NubList String
packageConfigProgramPathExtra
        , configHcFlavor :: Flag CompilerFlavor
configHcFlavor = Flag CompilerFlavor
forall a. Monoid a => a
mempty
        , configHcPath :: Flag String
configHcPath = Flag String
forall a. Monoid a => a
mempty
        , configHcPkg :: Flag String
configHcPkg = Flag String
forall a. Monoid a => a
mempty
        , configInstantiateWith :: [(ModuleName, Module)]
configInstantiateWith = [(ModuleName, Module)]
forall a. Monoid a => a
mempty
        , configVanillaLib :: Flag Bool
configVanillaLib = Flag Bool
packageConfigVanillaLib
        , configProfLib :: Flag Bool
configProfLib = Flag Bool
packageConfigProfLib
        , configSharedLib :: Flag Bool
configSharedLib = Flag Bool
packageConfigSharedLib
        , configStaticLib :: Flag Bool
configStaticLib = Flag Bool
packageConfigStaticLib
        , configDynExe :: Flag Bool
configDynExe = Flag Bool
packageConfigDynExe
        , configFullyStaticExe :: Flag Bool
configFullyStaticExe = Flag Bool
packageConfigFullyStaticExe
        , configProfExe :: Flag Bool
configProfExe = Flag Bool
packageConfigProfExe
        , configProf :: Flag Bool
configProf = Flag Bool
packageConfigProf
        , configProfShared :: Flag Bool
configProfShared = Flag Bool
packageConfigProfShared
        , configProfDetail :: Flag ProfDetailLevel
configProfDetail = Flag ProfDetailLevel
packageConfigProfDetail
        , configProfLibDetail :: Flag ProfDetailLevel
configProfLibDetail = Flag ProfDetailLevel
packageConfigProfLibDetail
        , configConfigureArgs :: [String]
configConfigureArgs = [String]
packageConfigConfigureArgs
        , configOptimization :: Flag OptimisationLevel
configOptimization = Flag OptimisationLevel
packageConfigOptimization
        , configProgPrefix :: Flag PathTemplate
configProgPrefix = Flag PathTemplate
packageConfigProgPrefix
        , configProgSuffix :: Flag PathTemplate
configProgSuffix = Flag PathTemplate
packageConfigProgSuffix
        , configInstallDirs :: InstallDirs (Flag PathTemplate)
configInstallDirs = InstallDirs (Flag PathTemplate)
forall a. Monoid a => a
mempty
        , configScratchDir :: Flag String
configScratchDir = Flag String
forall a. Monoid a => a
mempty
        , configUserInstall :: Flag Bool
configUserInstall = Flag Bool
forall a. Monoid a => a
mempty
        , configPackageDBs :: [Maybe PackageDB]
configPackageDBs = [Maybe PackageDB]
forall a. Monoid a => a
mempty
        , configGHCiLib :: Flag Bool
configGHCiLib = Flag Bool
packageConfigGHCiLib
        , configSplitSections :: Flag Bool
configSplitSections = Flag Bool
packageConfigSplitSections
        , configSplitObjs :: Flag Bool
configSplitObjs = Flag Bool
packageConfigSplitObjs
        , configStripExes :: Flag Bool
configStripExes = Flag Bool
packageConfigStripExes
        , configStripLibs :: Flag Bool
configStripLibs = Flag Bool
packageConfigStripLibs
        , configExtraLibDirs :: [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirs = (String -> SymbolicPath Pkg ('Dir Lib))
-> [String] -> [SymbolicPath Pkg ('Dir Lib)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SymbolicPath Pkg ('Dir Lib)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath ([String] -> [SymbolicPath Pkg ('Dir Lib)])
-> [String] -> [SymbolicPath Pkg ('Dir Lib)]
forall a b. (a -> b) -> a -> b
$ [String]
packageConfigExtraLibDirs
        , configExtraLibDirsStatic :: [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirsStatic = (String -> SymbolicPath Pkg ('Dir Lib))
-> [String] -> [SymbolicPath Pkg ('Dir Lib)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SymbolicPath Pkg ('Dir Lib)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath ([String] -> [SymbolicPath Pkg ('Dir Lib)])
-> [String] -> [SymbolicPath Pkg ('Dir Lib)]
forall a b. (a -> b) -> a -> b
$ [String]
packageConfigExtraLibDirsStatic
        , configExtraFrameworkDirs :: [SymbolicPath Pkg ('Dir Framework)]
configExtraFrameworkDirs = (String -> SymbolicPath Pkg ('Dir Framework))
-> [String] -> [SymbolicPath Pkg ('Dir Framework)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SymbolicPath Pkg ('Dir Framework)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath ([String] -> [SymbolicPath Pkg ('Dir Framework)])
-> [String] -> [SymbolicPath Pkg ('Dir Framework)]
forall a b. (a -> b) -> a -> b
$ [String]
packageConfigExtraFrameworkDirs
        , configConstraints :: [PackageVersionConstraint]
configConstraints = [PackageVersionConstraint]
forall a. Monoid a => a
mempty
        , configDependencies :: [GivenComponent]
configDependencies = [GivenComponent]
forall a. Monoid a => a
mempty
        , configPromisedDependencies :: [PromisedComponent]
configPromisedDependencies = [PromisedComponent]
forall a. Monoid a => a
mempty
        , configExtraIncludeDirs :: [SymbolicPath Pkg ('Dir Include)]
configExtraIncludeDirs = (String -> SymbolicPath Pkg ('Dir Include))
-> [String] -> [SymbolicPath Pkg ('Dir Include)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SymbolicPath Pkg ('Dir Include)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath ([String] -> [SymbolicPath Pkg ('Dir Include)])
-> [String] -> [SymbolicPath Pkg ('Dir Include)]
forall a b. (a -> b) -> a -> b
$ [String]
packageConfigExtraIncludeDirs
        , configIPID :: Flag String
configIPID = Flag String
forall a. Monoid a => a
mempty
        , configCID :: Flag ComponentId
configCID = Flag ComponentId
forall a. Monoid a => a
mempty
        , configDeterministic :: Flag Bool
configDeterministic = Flag Bool
forall a. Monoid a => a
mempty
        , configConfigurationsFlags :: FlagAssignment
configConfigurationsFlags = FlagAssignment
packageConfigFlagAssignment
        , configTests :: Flag Bool
configTests = Flag Bool
packageConfigTests
        , configCoverage :: Flag Bool
configCoverage = Flag Bool
packageConfigCoverage -- TODO: don't merge
        , configLibCoverage :: Flag Bool
configLibCoverage = Flag Bool
packageConfigCoverage -- TODO: don't merge
        , configExactConfiguration :: Flag Bool
configExactConfiguration = Flag Bool
forall a. Monoid a => a
mempty
        , configBenchmarks :: Flag Bool
configBenchmarks = Flag Bool
packageConfigBenchmarks
        , configFlagError :: Flag String
configFlagError = Flag String
forall a. Monoid a => a
mempty -- TODO: ???
        , configRelocatable :: Flag Bool
configRelocatable = Flag Bool
packageConfigRelocatable
        , configDebugInfo :: Flag DebugInfoLevel
configDebugInfo = Flag DebugInfoLevel
packageConfigDebugInfo
        , configUseResponseFiles :: Flag Bool
configUseResponseFiles = Flag Bool
forall a. Monoid a => a
mempty
        , configDumpBuildInfo :: Flag DumpBuildInfo
configDumpBuildInfo = Flag DumpBuildInfo
packageConfigDumpBuildInfo
        , configAllowDependingOnPrivateLibs :: Flag Bool
configAllowDependingOnPrivateLibs = Flag Bool
forall a. Monoid a => a
mempty
        , configCoverageFor :: Flag [UnitId]
configCoverageFor = Flag [UnitId]
forall a. Monoid a => a
mempty
        , configIgnoreBuildTools :: Flag Bool
configIgnoreBuildTools = Flag Bool
forall a. Monoid a => a
mempty
        }

    installFlags :: InstallFlags
installFlags =
      InstallFlags
forall a. Monoid a => a
mempty
        { installDocumentation = packageConfigDocumentation
        , installRunTests = packageConfigRunTests
        }

    haddockFlags :: HaddockFlags
haddockFlags =
      HaddockFlags
        { haddockCommonFlags :: CommonSetupFlags
haddockCommonFlags = CommonSetupFlags
commonFlags
        , haddockProgramPaths :: [(String, String)]
haddockProgramPaths = [(String, String)]
forall a. Monoid a => a
mempty
        , haddockProgramArgs :: [(String, [String])]
haddockProgramArgs = [(String, [String])]
forall a. Monoid a => a
mempty
        , haddockHoogle :: Flag Bool
haddockHoogle = Flag Bool
packageConfigHaddockHoogle
        , haddockHtml :: Flag Bool
haddockHtml = Flag Bool
packageConfigHaddockHtml
        , haddockHtmlLocation :: Flag String
haddockHtmlLocation = Flag String
packageConfigHaddockHtmlLocation
        , haddockForHackage :: Flag HaddockTarget
haddockForHackage = Flag HaddockTarget
packageConfigHaddockForHackage
        , haddockForeignLibs :: Flag Bool
haddockForeignLibs = Flag Bool
packageConfigHaddockForeignLibs
        , haddockExecutables :: Flag Bool
haddockExecutables = Flag Bool
packageConfigHaddockExecutables
        , haddockTestSuites :: Flag Bool
haddockTestSuites = Flag Bool
packageConfigHaddockTestSuites
        , haddockBenchmarks :: Flag Bool
haddockBenchmarks = Flag Bool
packageConfigHaddockBenchmarks
        , haddockInternal :: Flag Bool
haddockInternal = Flag Bool
packageConfigHaddockInternal
        , haddockCss :: Flag String
haddockCss = Flag String
packageConfigHaddockCss
        , haddockLinkedSource :: Flag Bool
haddockLinkedSource = Flag Bool
packageConfigHaddockLinkedSource
        , haddockQuickJump :: Flag Bool
haddockQuickJump = Flag Bool
packageConfigHaddockQuickJump
        , haddockHscolourCss :: Flag String
haddockHscolourCss = Flag String
packageConfigHaddockHscolourCss
        , haddockContents :: Flag PathTemplate
haddockContents = Flag PathTemplate
packageConfigHaddockContents
        , haddockKeepTempFiles :: Flag Bool
haddockKeepTempFiles = Flag Bool
forall a. Monoid a => a
mempty
        , haddockIndex :: Flag PathTemplate
haddockIndex = Flag PathTemplate
packageConfigHaddockIndex
        , haddockBaseUrl :: Flag String
haddockBaseUrl = Flag String
packageConfigHaddockBaseUrl
        , haddockResourcesDir :: Flag String
haddockResourcesDir = Flag String
packageConfigHaddockResourcesDir
        , haddockOutputDir :: Flag String
haddockOutputDir = Flag String
packageConfigHaddockOutputDir
        , haddockUseUnicode :: Flag Bool
haddockUseUnicode = Flag Bool
packageConfigHaddockUseUnicode
        }

    testFlags :: TestFlags
testFlags =
      TestFlags
        { testCommonFlags :: CommonSetupFlags
testCommonFlags = CommonSetupFlags
commonFlags
        , testHumanLog :: Flag PathTemplate
testHumanLog = Flag PathTemplate
packageConfigTestHumanLog
        , testMachineLog :: Flag PathTemplate
testMachineLog = Flag PathTemplate
packageConfigTestMachineLog
        , testShowDetails :: Flag TestShowDetails
testShowDetails = Flag TestShowDetails
packageConfigTestShowDetails
        , testKeepTix :: Flag Bool
testKeepTix = Flag Bool
packageConfigTestKeepTix
        , testWrapper :: Flag String
testWrapper = Flag String
packageConfigTestWrapper
        , testFailWhenNoTestSuites :: Flag Bool
testFailWhenNoTestSuites = Flag Bool
packageConfigTestFailWhenNoTestSuites
        , testOptions :: [PathTemplate]
testOptions = [PathTemplate]
packageConfigTestTestOptions
        }

    benchmarkFlags :: BenchmarkFlags
benchmarkFlags =
      BenchmarkFlags
        { benchmarkCommonFlags :: CommonSetupFlags
benchmarkCommonFlags = CommonSetupFlags
commonFlags
        , benchmarkOptions :: [PathTemplate]
benchmarkOptions = [PathTemplate]
packageConfigBenchmarkOptions
        }

------------------------------------------------
-- Parsing and showing the project config file
--

parseLegacyProjectConfigFields :: ProjectConfigPath -> [ParseUtils.Field] -> ParseResult LegacyProjectConfig
parseLegacyProjectConfigFields :: ProjectConfigPath -> [Field] -> ParseResult LegacyProjectConfig
parseLegacyProjectConfigFields (ProjectConfigPath -> ConstraintSource
ConstraintSourceProjectConfig -> ConstraintSource
constraintSrc) =
  [FieldDescr LegacyProjectConfig]
-> [SectionDescr LegacyProjectConfig]
-> [FGSectionDescr ParsecFieldGrammar LegacyProjectConfig]
-> LegacyProjectConfig
-> [Field]
-> ParseResult LegacyProjectConfig
forall a.
[FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr ParsecFieldGrammar a]
-> a
-> [Field]
-> ParseResult a
parseFieldsAndSections
    (ConstraintSource -> [FieldDescr LegacyProjectConfig]
legacyProjectConfigFieldDescrs ConstraintSource
constraintSrc)
    [SectionDescr LegacyProjectConfig]
legacyPackageConfigSectionDescrs
    [FGSectionDescr ParsecFieldGrammar LegacyProjectConfig]
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (Identity RepoType), c (List NoCommaFSep FilePathNT String),
 c (NonEmpty' NoCommaFSep Token String)) =>
[FGSectionDescr g LegacyProjectConfig]
legacyPackageConfigFGSectionDescrs
    LegacyProjectConfig
forall a. Monoid a => a
mempty

parseLegacyProjectConfig :: FilePath -> BS.ByteString -> ParseResult LegacyProjectConfig
parseLegacyProjectConfig :: String -> ByteString -> ParseResult LegacyProjectConfig
parseLegacyProjectConfig String
rootConfig ByteString
bs =
  ProjectConfigPath -> [Field] -> ParseResult LegacyProjectConfig
parseLegacyProjectConfigFields (NonEmpty String -> ProjectConfigPath
ProjectConfigPath (NonEmpty String -> ProjectConfigPath)
-> NonEmpty String -> ProjectConfigPath
forall a b. (a -> b) -> a -> b
$ String
rootConfig String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| []) ([Field] -> ParseResult LegacyProjectConfig)
-> ParseResult [Field] -> ParseResult LegacyProjectConfig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ParseResult [Field]
ParseUtils.readFields ByteString
bs

showLegacyProjectConfig :: LegacyProjectConfig -> String
showLegacyProjectConfig :: LegacyProjectConfig -> String
showLegacyProjectConfig LegacyProjectConfig
config =
  Doc -> String
Disp.render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$
    [FieldDescr LegacyProjectConfig]
-> [SectionDescr LegacyProjectConfig]
-> [FGSectionDescr PrettyFieldGrammar LegacyProjectConfig]
-> LegacyProjectConfig
-> Doc
forall a.
[FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr PrettyFieldGrammar a]
-> a
-> Doc
showConfig
      (ConstraintSource -> [FieldDescr LegacyProjectConfig]
legacyProjectConfigFieldDescrs ConstraintSource
constraintSrc)
      [SectionDescr LegacyProjectConfig]
legacyPackageConfigSectionDescrs
      [FGSectionDescr PrettyFieldGrammar LegacyProjectConfig]
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (Identity RepoType), c (List NoCommaFSep FilePathNT String),
 c (NonEmpty' NoCommaFSep Token String)) =>
[FGSectionDescr g LegacyProjectConfig]
legacyPackageConfigFGSectionDescrs
      LegacyProjectConfig
config
      Doc -> Doc -> Doc
$+$ String -> Doc
Disp.text String
""
  where
    -- Note: ConstraintSource is unused when pretty-printing. We fake
    -- it here to avoid having to pass it on call-sites. It's not great
    -- but requires re-work of how we annotate provenance.
    constraintSrc :: ConstraintSource
constraintSrc = ProjectConfigPath -> ConstraintSource
ConstraintSourceProjectConfig ProjectConfigPath
nullProjectConfigPath

legacyProjectConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacyProjectConfig]
legacyProjectConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacyProjectConfig]
legacyProjectConfigFieldDescrs ConstraintSource
constraintSrc =
  [ String
-> (String -> Doc)
-> ReadP [String] String
-> (LegacyProjectConfig -> [String])
-> ([String] -> LegacyProjectConfig -> LegacyProjectConfig)
-> FieldDescr LegacyProjectConfig
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
      String
"packages"
      (String -> Doc
Disp.text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
renderPackageLocationToken)
      ReadP [String] String
forall r. ReadP r String
parsePackageLocationTokenQ
      LegacyProjectConfig -> [String]
legacyPackages
      (\[String]
v LegacyProjectConfig
flags -> LegacyProjectConfig
flags{legacyPackages = v})
  , String
-> (String -> Doc)
-> ReadP [String] String
-> (LegacyProjectConfig -> [String])
-> ([String] -> LegacyProjectConfig -> LegacyProjectConfig)
-> FieldDescr LegacyProjectConfig
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
      String
"optional-packages"
      (String -> Doc
Disp.text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
renderPackageLocationToken)
      ReadP [String] String
forall r. ReadP r String
parsePackageLocationTokenQ
      LegacyProjectConfig -> [String]
legacyPackagesOptional
      (\[String]
v LegacyProjectConfig
flags -> LegacyProjectConfig
flags{legacyPackagesOptional = v})
  , String
-> (PackageVersionConstraint -> Doc)
-> ParsecParser PackageVersionConstraint
-> (LegacyProjectConfig -> [PackageVersionConstraint])
-> ([PackageVersionConstraint]
    -> LegacyProjectConfig -> LegacyProjectConfig)
-> FieldDescr LegacyProjectConfig
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaNewLineListFieldParsec
      String
"extra-packages"
      PackageVersionConstraint -> Doc
forall a. Pretty a => a -> Doc
pretty
      ParsecParser PackageVersionConstraint
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m PackageVersionConstraint
parsec
      LegacyProjectConfig -> [PackageVersionConstraint]
legacyPackagesNamed
      (\[PackageVersionConstraint]
v LegacyProjectConfig
flags -> LegacyProjectConfig
flags{legacyPackagesNamed = v})
  ]
    [FieldDescr LegacyProjectConfig]
-> [FieldDescr LegacyProjectConfig]
-> [FieldDescr LegacyProjectConfig]
forall a. [a] -> [a] -> [a]
++ (FieldDescr LegacySharedConfig -> FieldDescr LegacyProjectConfig)
-> [FieldDescr LegacySharedConfig]
-> [FieldDescr LegacyProjectConfig]
forall a b. (a -> b) -> [a] -> [b]
map
      ( (LegacyProjectConfig -> LegacySharedConfig)
-> (LegacySharedConfig
    -> LegacyProjectConfig -> LegacyProjectConfig)
-> FieldDescr LegacySharedConfig
-> FieldDescr LegacyProjectConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
          LegacyProjectConfig -> LegacySharedConfig
legacySharedConfig
          (\LegacySharedConfig
flags LegacyProjectConfig
conf -> LegacyProjectConfig
conf{legacySharedConfig = flags})
      )
      (ConstraintSource -> [FieldDescr LegacySharedConfig]
legacySharedConfigFieldDescrs ConstraintSource
constraintSrc)
    [FieldDescr LegacyProjectConfig]
-> [FieldDescr LegacyProjectConfig]
-> [FieldDescr LegacyProjectConfig]
forall a. [a] -> [a] -> [a]
++ (FieldDescr LegacyPackageConfig -> FieldDescr LegacyProjectConfig)
-> [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyProjectConfig]
forall a b. (a -> b) -> [a] -> [b]
map
      ( (LegacyProjectConfig -> LegacyPackageConfig)
-> (LegacyPackageConfig
    -> LegacyProjectConfig -> LegacyProjectConfig)
-> FieldDescr LegacyPackageConfig
-> FieldDescr LegacyProjectConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
          LegacyProjectConfig -> LegacyPackageConfig
legacyLocalConfig
          (\LegacyPackageConfig
flags LegacyProjectConfig
conf -> LegacyProjectConfig
conf{legacyLocalConfig = flags})
      )
      [FieldDescr LegacyPackageConfig]
legacyPackageConfigFieldDescrs

-- | This is a bit tricky since it has to cover globs which have embedded @,@
-- chars. But we don't just want to parse strictly as a glob since we want to
-- allow http urls which don't parse as globs, and possibly some
-- system-dependent file paths. So we parse fairly liberally as a token, but
-- we allow @,@ inside matched @{}@ braces.
parsePackageLocationTokenQ :: ReadP r String
parsePackageLocationTokenQ :: forall r. ReadP r String
parsePackageLocationTokenQ =
  ReadP String String
forall r. ReadP r String
parseHaskellString
    ReadP String String -> ReadP r String -> ReadP r String
forall a r. ReadP a a -> ReadP r a -> ReadP r a
Parse.<++ ReadP r String
forall r. ReadP r String
parsePackageLocationToken
  where
    parsePackageLocationToken :: ReadP r String
    parsePackageLocationToken :: forall r. ReadP r String
parsePackageLocationToken = ((String, ()) -> String)
-> Parser r Char (String, ()) -> Parser r Char String
forall a b. (a -> b) -> Parser r Char a -> Parser r Char b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, ()) -> String
forall a b. (a, b) -> a
fst (ReadP (String -> P Char r) () -> Parser r Char (String, ())
forall r a. ReadP (String -> P Char r) a -> ReadP r (String, a)
Parse.gather ReadP (String -> P Char r) ()
forall {r}. ReadP r ()
outerTerm)
      where
        outerTerm :: ReadP r ()
outerTerm = ReadP r () -> ReadP r () -> ReadP r ()
forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternateEither1 ReadP r ()
forall {r}. ReadP r ()
outerToken (ReadP r () -> ReadP r ()
forall {r} {a}. ReadP r a -> ReadP r a
braces ReadP r ()
forall {r}. ReadP r ()
innerTerm)
        innerTerm :: ReadP r ()
innerTerm = ReadP r () -> ReadP r () -> ReadP r ()
forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternateEither ReadP r ()
forall {r}. ReadP r ()
innerToken (ReadP r () -> ReadP r ()
forall {r} {a}. ReadP r a -> ReadP r a
braces ReadP r ()
innerTerm)
        outerToken :: Parser r Char ()
outerToken = (Char -> Bool) -> ReadP r String
forall r. (Char -> Bool) -> ReadP r String
Parse.munch1 Char -> Bool
outerChar ReadP r String -> Parser r Char () -> Parser r Char ()
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser r Char ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        innerToken :: Parser r Char ()
innerToken = (Char -> Bool) -> ReadP r String
forall r. (Char -> Bool) -> ReadP r String
Parse.munch1 Char -> Bool
innerChar ReadP r String -> Parser r Char () -> Parser r Char ()
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser r Char ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        outerChar :: Char -> Bool
outerChar Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')
        innerChar :: Char -> Bool
innerChar Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}')
        braces :: ReadP r a -> ReadP r a
braces = ReadP r Char -> ReadP r Char -> ReadP r a -> ReadP r a
forall r open close a.
ReadP r open -> ReadP r close -> ReadP r a -> ReadP r a
Parse.between (Char -> ReadP r Char
forall r. Char -> ReadP r Char
Parse.char Char
'{') (Char -> ReadP r Char
forall r. Char -> ReadP r Char
Parse.char Char
'}')

    alternateEither
      , alternateEither1
      , alternatePQs
      , alternate1PQs
      , alternateQsP
      , alternate1QsP
        :: ReadP r () -> ReadP r () -> ReadP r ()

    alternateEither1 :: forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternateEither1 ReadP r ()
p ReadP r ()
q = ReadP r () -> ReadP r () -> ReadP r ()
forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternate1PQs ReadP r ()
p ReadP r ()
q ReadP r () -> ReadP r () -> ReadP r ()
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ ReadP r () -> ReadP r () -> ReadP r ()
forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternate1QsP ReadP r ()
q ReadP r ()
p
    alternateEither :: forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternateEither ReadP r ()
p ReadP r ()
q = ReadP r () -> ReadP r () -> ReadP r ()
forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternateEither1 ReadP r ()
p ReadP r ()
q ReadP r () -> ReadP r () -> ReadP r ()
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ () -> ReadP r ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    alternate1PQs :: forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternate1PQs ReadP r ()
p ReadP r ()
q = ReadP r ()
p ReadP r () -> ReadP r () -> ReadP r ()
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP r () -> ReadP r () -> ReadP r ()
forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternateQsP ReadP r ()
q ReadP r ()
p
    alternatePQs :: forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternatePQs ReadP r ()
p ReadP r ()
q = ReadP r () -> ReadP r () -> ReadP r ()
forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternate1PQs ReadP r ()
p ReadP r ()
q ReadP r () -> ReadP r () -> ReadP r ()
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ () -> ReadP r ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    alternate1QsP :: forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternate1QsP ReadP r ()
q ReadP r ()
p = ReadP r () -> ReadP r [()]
forall r a. ReadP r a -> ReadP r [a]
Parse.many1 ReadP r ()
q ReadP r [()] -> ReadP r () -> ReadP r ()
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP r () -> ReadP r () -> ReadP r ()
forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternatePQs ReadP r ()
p ReadP r ()
q
    alternateQsP :: forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternateQsP ReadP r ()
q ReadP r ()
p = ReadP r () -> ReadP r () -> ReadP r ()
forall r. ReadP r () -> ReadP r () -> ReadP r ()
alternate1QsP ReadP r ()
q ReadP r ()
p ReadP r () -> ReadP r () -> ReadP r ()
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ () -> ReadP r ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

renderPackageLocationToken :: String -> String
renderPackageLocationToken :: String -> String
renderPackageLocationToken String
s
  | Bool
needsQuoting = String -> String
forall a. Show a => a -> String
show String
s
  | Bool
otherwise = String
s
  where
    needsQuoting :: Bool
needsQuoting =
      Bool -> Bool
not (Int -> String -> Bool
ok Int
0 String
s)
        Bool -> Bool -> Bool
|| String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"." -- . on its own on a line has special meaning
        Bool -> Bool -> Bool
|| Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"--" -- on its own line is comment syntax
        -- TODO: [code cleanup] these "." and "--" escaping issues
        -- ought to be dealt with systematically in ParseUtils.
    ok :: Int -> String -> Bool
    ok :: Int -> String -> Bool
ok Int
n [] = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    ok Int
_ (Char
'"' : String
_) = Bool
False
    ok Int
n (Char
'{' : String
cs) = Int -> String -> Bool
ok (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
cs
    ok Int
n (Char
'}' : String
cs) = Int -> String -> Bool
ok (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
cs
    ok Int
n (Char
',' : String
cs) = (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Bool -> Bool -> Bool
&& Int -> String -> Bool
ok Int
n String
cs
    ok Int
_ (Char
c : String
_)
      | Char -> Bool
isSpace Char
c = Bool
False
    ok Int
n (Char
_ : String
cs) = Int -> String -> Bool
ok Int
n String
cs

legacySharedConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacySharedConfig]
legacySharedConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacySharedConfig]
legacySharedConfigFieldDescrs ConstraintSource
constraintSrc =
  [[FieldDescr LegacySharedConfig]]
-> [FieldDescr LegacySharedConfig]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ (LegacySharedConfig -> GlobalFlags)
-> (GlobalFlags -> LegacySharedConfig -> LegacySharedConfig)
-> [FieldDescr GlobalFlags]
-> [FieldDescr LegacySharedConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
        LegacySharedConfig -> GlobalFlags
legacyGlobalFlags
        (\GlobalFlags
flags LegacySharedConfig
conf -> LegacySharedConfig
conf{legacyGlobalFlags = flags})
        ([FieldDescr GlobalFlags] -> [FieldDescr LegacySharedConfig])
-> ([OptionField GlobalFlags] -> [FieldDescr GlobalFlags])
-> [OptionField GlobalFlags]
-> [FieldDescr LegacySharedConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldDescr GlobalFlags]
-> [FieldDescr GlobalFlags] -> [FieldDescr GlobalFlags]
forall a. [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
addFields
          [ String
-> (String -> Doc)
-> ReadP [String] String
-> (GlobalFlags -> [String])
-> ([String] -> GlobalFlags -> GlobalFlags)
-> FieldDescr GlobalFlags
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
              String
"extra-prog-path-shared-only"
              String -> Doc
showTokenQ
              ReadP [String] String
forall r. ReadP r String
parseTokenQ
              (NubList String -> [String]
forall a. NubList a -> [a]
fromNubList (NubList String -> [String])
-> (GlobalFlags -> NubList String) -> GlobalFlags -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalFlags -> NubList String
globalProgPathExtra)
              (\[String]
v GlobalFlags
conf -> GlobalFlags
conf{globalProgPathExtra = toNubList v})
          ]
        ([FieldDescr GlobalFlags] -> [FieldDescr GlobalFlags])
-> ([OptionField GlobalFlags] -> [FieldDescr GlobalFlags])
-> [OptionField GlobalFlags]
-> [FieldDescr GlobalFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [FieldDescr GlobalFlags] -> [FieldDescr GlobalFlags]
forall a. [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields
          [ String
"remote-repo-cache"
          , String
"logs-dir"
          , String
"store-dir"
          , String
"ignore-expiry"
          , String
"http-transport"
          , String
"active-repositories"
          ]
        ([FieldDescr GlobalFlags] -> [FieldDescr GlobalFlags])
-> ([OptionField GlobalFlags] -> [FieldDescr GlobalFlags])
-> [OptionField GlobalFlags]
-> [FieldDescr GlobalFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField GlobalFlags] -> [FieldDescr GlobalFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
        ([OptionField GlobalFlags] -> [FieldDescr LegacySharedConfig])
-> [OptionField GlobalFlags] -> [FieldDescr LegacySharedConfig]
forall a b. (a -> b) -> a -> b
$ CommandUI GlobalFlags
-> ShowOrParseArgs -> [OptionField GlobalFlags]
forall flags.
CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
commandOptions ([Command Any] -> CommandUI GlobalFlags
forall action. [Command action] -> CommandUI GlobalFlags
globalCommand []) ShowOrParseArgs
ParseArgs
    , (LegacySharedConfig -> ConfigFlags)
-> (ConfigFlags -> LegacySharedConfig -> LegacySharedConfig)
-> [FieldDescr ConfigFlags]
-> [FieldDescr LegacySharedConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
        LegacySharedConfig -> ConfigFlags
legacyConfigureShFlags
        (\ConfigFlags
flags LegacySharedConfig
conf -> LegacySharedConfig
conf{legacyConfigureShFlags = flags})
        ([FieldDescr ConfigFlags] -> [FieldDescr LegacySharedConfig])
-> ([OptionField ConfigFlags] -> [FieldDescr ConfigFlags])
-> [OptionField ConfigFlags]
-> [FieldDescr LegacySharedConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldDescr ConfigFlags]
-> [FieldDescr ConfigFlags] -> [FieldDescr ConfigFlags]
forall a. [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
addFields
          [ String
-> (Maybe PackageDB -> Doc)
-> ParsecParser (Maybe PackageDB)
-> (ConfigFlags -> [Maybe PackageDB])
-> ([Maybe PackageDB] -> ConfigFlags -> ConfigFlags)
-> FieldDescr ConfigFlags
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaNewLineListFieldParsec
              String
"package-dbs"
              (String -> Doc
Disp.text (String -> Doc)
-> (Maybe PackageDB -> String) -> Maybe PackageDB -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PackageDB -> String
showPackageDb)
              ((String -> Maybe PackageDB)
-> ParsecParser String -> ParsecParser (Maybe PackageDB)
forall a b. (a -> b) -> ParsecParser a -> ParsecParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe PackageDB
readPackageDb ParsecParser String
forall (m :: * -> *). CabalParsing m => m String
parsecToken)
              ConfigFlags -> [Maybe PackageDB]
configPackageDBs
              (\[Maybe PackageDB]
v ConfigFlags
conf -> ConfigFlags
conf{configPackageDBs = v})
          ]
        ([FieldDescr ConfigFlags] -> [FieldDescr ConfigFlags])
-> ([OptionField ConfigFlags] -> [FieldDescr ConfigFlags])
-> [OptionField ConfigFlags]
-> [FieldDescr ConfigFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [FieldDescr ConfigFlags] -> [FieldDescr ConfigFlags]
forall a. [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields ([String
"verbose", String
"builddir"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (OptionField (InstallDirs (Flag PathTemplate)) -> String)
-> [OptionField (InstallDirs (Flag PathTemplate))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map OptionField (InstallDirs (Flag PathTemplate)) -> String
forall a. OptionField a -> String
optionName [OptionField (InstallDirs (Flag PathTemplate))]
installDirsOptions)
        ([FieldDescr ConfigFlags] -> [FieldDescr ConfigFlags])
-> ([OptionField ConfigFlags] -> [FieldDescr ConfigFlags])
-> [OptionField ConfigFlags]
-> [FieldDescr ConfigFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField ConfigFlags] -> [FieldDescr ConfigFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
        ([OptionField ConfigFlags] -> [FieldDescr LegacySharedConfig])
-> [OptionField ConfigFlags] -> [FieldDescr LegacySharedConfig]
forall a b. (a -> b) -> a -> b
$ ShowOrParseArgs -> [OptionField ConfigFlags]
configureOptions ShowOrParseArgs
ParseArgs
    , (LegacySharedConfig -> ConfigExFlags)
-> (ConfigExFlags -> LegacySharedConfig -> LegacySharedConfig)
-> [FieldDescr ConfigExFlags]
-> [FieldDescr LegacySharedConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
        LegacySharedConfig -> ConfigExFlags
legacyConfigureExFlags
        (\ConfigExFlags
flags LegacySharedConfig
conf -> LegacySharedConfig
conf{legacyConfigureExFlags = flags})
        ([FieldDescr ConfigExFlags] -> [FieldDescr LegacySharedConfig])
-> ([OptionField ConfigExFlags] -> [FieldDescr ConfigExFlags])
-> [OptionField ConfigExFlags]
-> [FieldDescr LegacySharedConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldDescr ConfigExFlags]
-> [FieldDescr ConfigExFlags] -> [FieldDescr ConfigExFlags]
forall a. [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
addFields
          [ String
-> ((UserConstraint, ConstraintSource) -> Doc)
-> ParsecParser (UserConstraint, ConstraintSource)
-> (ConfigExFlags -> [(UserConstraint, ConstraintSource)])
-> ([(UserConstraint, ConstraintSource)]
    -> ConfigExFlags -> ConfigExFlags)
-> FieldDescr ConfigExFlags
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaNewLineListFieldParsec
              String
"constraints"
              (UserConstraint -> Doc
forall a. Pretty a => a -> Doc
pretty (UserConstraint -> Doc)
-> ((UserConstraint, ConstraintSource) -> UserConstraint)
-> (UserConstraint, ConstraintSource)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UserConstraint, ConstraintSource) -> UserConstraint
forall a b. (a, b) -> a
fst)
              ((UserConstraint -> (UserConstraint, ConstraintSource))
-> ParsecParser UserConstraint
-> ParsecParser (UserConstraint, ConstraintSource)
forall a b. (a -> b) -> ParsecParser a -> ParsecParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\UserConstraint
constraint -> (UserConstraint
constraint, ConstraintSource
constraintSrc)) ParsecParser UserConstraint
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m UserConstraint
parsec)
              ConfigExFlags -> [(UserConstraint, ConstraintSource)]
configExConstraints
              (\[(UserConstraint, ConstraintSource)]
v ConfigExFlags
conf -> ConfigExFlags
conf{configExConstraints = v})
          , String
-> (PackageVersionConstraint -> Doc)
-> ParsecParser PackageVersionConstraint
-> (ConfigExFlags -> [PackageVersionConstraint])
-> ([PackageVersionConstraint] -> ConfigExFlags -> ConfigExFlags)
-> FieldDescr ConfigExFlags
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaNewLineListFieldParsec
              String
"preferences"
              PackageVersionConstraint -> Doc
forall a. Pretty a => a -> Doc
pretty
              ParsecParser PackageVersionConstraint
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m PackageVersionConstraint
parsec
              ConfigExFlags -> [PackageVersionConstraint]
configPreferences
              (\[PackageVersionConstraint]
v ConfigExFlags
conf -> ConfigExFlags
conf{configPreferences = v})
          , String
-> (Maybe RelaxDeps -> Doc)
-> ParsecParser (Maybe RelaxDeps)
-> (ConfigExFlags -> Maybe RelaxDeps)
-> (Maybe RelaxDeps -> ConfigExFlags -> ConfigExFlags)
-> FieldDescr ConfigExFlags
forall a b.
Monoid a =>
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
monoidFieldParsec
              String
"allow-older"
              (Doc -> (RelaxDeps -> Doc) -> Maybe RelaxDeps -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Monoid a => a
mempty RelaxDeps -> Doc
forall a. Pretty a => a -> Doc
pretty)
              ((RelaxDeps -> Maybe RelaxDeps)
-> ParsecParser RelaxDeps -> ParsecParser (Maybe RelaxDeps)
forall a b. (a -> b) -> ParsecParser a -> ParsecParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RelaxDeps -> Maybe RelaxDeps
forall a. a -> Maybe a
Just ParsecParser RelaxDeps
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m RelaxDeps
parsec)
              ((AllowOlder -> RelaxDeps) -> Maybe AllowOlder -> Maybe RelaxDeps
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AllowOlder -> RelaxDeps
unAllowOlder (Maybe AllowOlder -> Maybe RelaxDeps)
-> (ConfigExFlags -> Maybe AllowOlder)
-> ConfigExFlags
-> Maybe RelaxDeps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigExFlags -> Maybe AllowOlder
configAllowOlder)
              (\Maybe RelaxDeps
v ConfigExFlags
conf -> ConfigExFlags
conf{configAllowOlder = fmap AllowOlder v})
          , String
-> (Maybe RelaxDeps -> Doc)
-> ParsecParser (Maybe RelaxDeps)
-> (ConfigExFlags -> Maybe RelaxDeps)
-> (Maybe RelaxDeps -> ConfigExFlags -> ConfigExFlags)
-> FieldDescr ConfigExFlags
forall a b.
Monoid a =>
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
monoidFieldParsec
              String
"allow-newer"
              (Doc -> (RelaxDeps -> Doc) -> Maybe RelaxDeps -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Monoid a => a
mempty RelaxDeps -> Doc
forall a. Pretty a => a -> Doc
pretty)
              ((RelaxDeps -> Maybe RelaxDeps)
-> ParsecParser RelaxDeps -> ParsecParser (Maybe RelaxDeps)
forall a b. (a -> b) -> ParsecParser a -> ParsecParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RelaxDeps -> Maybe RelaxDeps
forall a. a -> Maybe a
Just ParsecParser RelaxDeps
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m RelaxDeps
parsec)
              ((AllowNewer -> RelaxDeps) -> Maybe AllowNewer -> Maybe RelaxDeps
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AllowNewer -> RelaxDeps
unAllowNewer (Maybe AllowNewer -> Maybe RelaxDeps)
-> (ConfigExFlags -> Maybe AllowNewer)
-> ConfigExFlags
-> Maybe RelaxDeps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigExFlags -> Maybe AllowNewer
configAllowNewer)
              (\Maybe RelaxDeps
v ConfigExFlags
conf -> ConfigExFlags
conf{configAllowNewer = fmap AllowNewer v})
          ]
        ([FieldDescr ConfigExFlags] -> [FieldDescr ConfigExFlags])
-> ([OptionField ConfigExFlags] -> [FieldDescr ConfigExFlags])
-> [OptionField ConfigExFlags]
-> [FieldDescr ConfigExFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String]
-> [FieldDescr ConfigExFlags] -> [FieldDescr ConfigExFlags]
forall a. [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields
          [ String
"cabal-lib-version"
          , String
"solver"
          , String
"write-ghc-environment-files"
          -- not "constraint" or "preference", we use our own plural ones above
          ]
        ([FieldDescr ConfigExFlags] -> [FieldDescr ConfigExFlags])
-> ([OptionField ConfigExFlags] -> [FieldDescr ConfigExFlags])
-> [OptionField ConfigExFlags]
-> [FieldDescr ConfigExFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField ConfigExFlags] -> [FieldDescr ConfigExFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
        ([OptionField ConfigExFlags] -> [FieldDescr LegacySharedConfig])
-> [OptionField ConfigExFlags] -> [FieldDescr LegacySharedConfig]
forall a b. (a -> b) -> a -> b
$ ShowOrParseArgs -> ConstraintSource -> [OptionField ConfigExFlags]
configureExOptions ShowOrParseArgs
ParseArgs ConstraintSource
constraintSrc
    , (LegacySharedConfig -> InstallFlags)
-> (InstallFlags -> LegacySharedConfig -> LegacySharedConfig)
-> [FieldDescr InstallFlags]
-> [FieldDescr LegacySharedConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
        LegacySharedConfig -> InstallFlags
legacyInstallFlags
        (\InstallFlags
flags LegacySharedConfig
conf -> LegacySharedConfig
conf{legacyInstallFlags = flags})
        ([FieldDescr InstallFlags] -> [FieldDescr LegacySharedConfig])
-> ([OptionField InstallFlags] -> [FieldDescr InstallFlags])
-> [OptionField InstallFlags]
-> [FieldDescr LegacySharedConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldDescr InstallFlags]
-> [FieldDescr InstallFlags] -> [FieldDescr InstallFlags]
forall a. [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
addFields
          [ String
-> (PathTemplate -> Doc)
-> ReadP [PathTemplate] PathTemplate
-> (InstallFlags -> [PathTemplate])
-> ([PathTemplate] -> InstallFlags -> InstallFlags)
-> FieldDescr InstallFlags
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
              String
"build-summary"
              (String -> Doc
showTokenQ (String -> Doc) -> (PathTemplate -> String) -> PathTemplate -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathTemplate -> String
fromPathTemplate)
              ((String -> PathTemplate)
-> Parser [PathTemplate] Char String
-> ReadP [PathTemplate] PathTemplate
forall a b.
(a -> b)
-> Parser [PathTemplate] Char a -> Parser [PathTemplate] Char b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> PathTemplate
toPathTemplate Parser [PathTemplate] Char String
forall r. ReadP r String
parseTokenQ)
              (NubList PathTemplate -> [PathTemplate]
forall a. NubList a -> [a]
fromNubList (NubList PathTemplate -> [PathTemplate])
-> (InstallFlags -> NubList PathTemplate)
-> InstallFlags
-> [PathTemplate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstallFlags -> NubList PathTemplate
installSummaryFile)
              (\[PathTemplate]
v InstallFlags
conf -> InstallFlags
conf{installSummaryFile = toNubList v})
          ]
        ([FieldDescr InstallFlags] -> [FieldDescr InstallFlags])
-> ([OptionField InstallFlags] -> [FieldDescr InstallFlags])
-> [OptionField InstallFlags]
-> [FieldDescr InstallFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [FieldDescr InstallFlags] -> [FieldDescr InstallFlags]
forall a. [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields
          [ String
"doc-index-file"
          , String
"root-cmd"
          , String
"symlink-bindir"
          , String
"build-log"
          , String
"remote-build-reporting"
          , String
"report-planning-failure"
          , String
"jobs"
          , String
"semaphore"
          , String
"keep-going"
          , String
"offline"
          , String
"per-component"
          , -- solver flags:
            String
"max-backjumps"
          , String
"reorder-goals"
          , String
"count-conflicts"
          , String
"fine-grained-conflicts"
          , String
"minimize-conflict-set"
          , String
"independent-goals"
          , String
"prefer-oldest"
          , String
"strong-flags"
          , String
"allow-boot-library-installs"
          , String
"reject-unconstrained-dependencies"
          , String
"index-state"
          ]
        ([FieldDescr InstallFlags] -> [FieldDescr InstallFlags])
-> ([OptionField InstallFlags] -> [FieldDescr InstallFlags])
-> [OptionField InstallFlags]
-> [FieldDescr InstallFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField InstallFlags] -> [FieldDescr InstallFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
        ([OptionField InstallFlags] -> [FieldDescr LegacySharedConfig])
-> [OptionField InstallFlags] -> [FieldDescr LegacySharedConfig]
forall a b. (a -> b) -> a -> b
$ ShowOrParseArgs -> [OptionField InstallFlags]
installOptions ShowOrParseArgs
ParseArgs
    , (LegacySharedConfig -> ClientInstallFlags)
-> (ClientInstallFlags -> LegacySharedConfig -> LegacySharedConfig)
-> [FieldDescr ClientInstallFlags]
-> [FieldDescr LegacySharedConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
        LegacySharedConfig -> ClientInstallFlags
legacyClientInstallFlags
        (\ClientInstallFlags
flags LegacySharedConfig
conf -> LegacySharedConfig
conf{legacyClientInstallFlags = flags})
        ([FieldDescr ClientInstallFlags]
 -> [FieldDescr LegacySharedConfig])
-> ([OptionField ClientInstallFlags]
    -> [FieldDescr ClientInstallFlags])
-> [OptionField ClientInstallFlags]
-> [FieldDescr LegacySharedConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField ClientInstallFlags] -> [FieldDescr ClientInstallFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
        ([OptionField ClientInstallFlags]
 -> [FieldDescr LegacySharedConfig])
-> [OptionField ClientInstallFlags]
-> [FieldDescr LegacySharedConfig]
forall a b. (a -> b) -> a -> b
$ ShowOrParseArgs -> [OptionField ClientInstallFlags]
clientInstallOptions ShowOrParseArgs
ParseArgs
    , (LegacySharedConfig -> ProjectFlags)
-> (ProjectFlags -> LegacySharedConfig -> LegacySharedConfig)
-> [FieldDescr ProjectFlags]
-> [FieldDescr LegacySharedConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
        LegacySharedConfig -> ProjectFlags
legacyProjectFlags
        (\ProjectFlags
flags LegacySharedConfig
conf -> LegacySharedConfig
conf{legacyProjectFlags = flags})
        ([FieldDescr ProjectFlags] -> [FieldDescr LegacySharedConfig])
-> ([OptionField ProjectFlags] -> [FieldDescr ProjectFlags])
-> [OptionField ProjectFlags]
-> [FieldDescr LegacySharedConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField ProjectFlags] -> [FieldDescr ProjectFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
        ([OptionField ProjectFlags] -> [FieldDescr LegacySharedConfig])
-> [OptionField ProjectFlags] -> [FieldDescr LegacySharedConfig]
forall a b. (a -> b) -> a -> b
$ ShowOrParseArgs -> [OptionField ProjectFlags]
projectFlagsOptions ShowOrParseArgs
ParseArgs
    , [(LegacySharedConfig -> Flag Bool)
-> (Flag Bool -> LegacySharedConfig -> LegacySharedConfig)
-> FieldDescr (Flag Bool)
-> FieldDescr LegacySharedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField LegacySharedConfig -> Flag Bool
legacyMultiRepl (\Flag Bool
flags LegacySharedConfig
conf -> LegacySharedConfig
conf{legacyMultiRepl = flags}) (OptionField (Flag Bool) -> FieldDescr (Flag Bool)
forall a. OptionField a -> FieldDescr a
commandOptionToField OptionField (Flag Bool)
multiReplOption)]
    ]

legacyPackageConfigFieldDescrs :: [FieldDescr LegacyPackageConfig]
legacyPackageConfigFieldDescrs :: [FieldDescr LegacyPackageConfig]
legacyPackageConfigFieldDescrs =
  ( (LegacyPackageConfig -> ConfigFlags)
-> (ConfigFlags -> LegacyPackageConfig -> LegacyPackageConfig)
-> [FieldDescr ConfigFlags]
-> [FieldDescr LegacyPackageConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
      LegacyPackageConfig -> ConfigFlags
legacyConfigureFlags
      (\ConfigFlags
flags LegacyPackageConfig
conf -> LegacyPackageConfig
conf{legacyConfigureFlags = flags})
      ([FieldDescr ConfigFlags] -> [FieldDescr LegacyPackageConfig])
-> ([OptionField ConfigFlags] -> [FieldDescr ConfigFlags])
-> [OptionField ConfigFlags]
-> [FieldDescr LegacyPackageConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldDescr ConfigFlags]
-> [FieldDescr ConfigFlags] -> [FieldDescr ConfigFlags]
forall a. [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
addFields
        [ String
-> (String -> Doc)
-> ReadP [String] String
-> (ConfigFlags -> [String])
-> ([String] -> ConfigFlags -> ConfigFlags)
-> FieldDescr ConfigFlags
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
            String
"extra-include-dirs"
            String -> Doc
showTokenQ
            ReadP [String] String
forall r. ReadP r String
parseTokenQ
            ((SymbolicPath Pkg ('Dir Include) -> String)
-> [SymbolicPath Pkg ('Dir Include)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Include) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath ([SymbolicPath Pkg ('Dir Include)] -> [String])
-> (ConfigFlags -> [SymbolicPath Pkg ('Dir Include)])
-> ConfigFlags
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigFlags -> [SymbolicPath Pkg ('Dir Include)]
configExtraIncludeDirs)
            (\[String]
v ConfigFlags
conf -> ConfigFlags
conf{configExtraIncludeDirs = fmap makeSymbolicPath v})
        , String
-> (String -> Doc)
-> ReadP [String] String
-> (ConfigFlags -> [String])
-> ([String] -> ConfigFlags -> ConfigFlags)
-> FieldDescr ConfigFlags
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
            String
"extra-lib-dirs"
            String -> Doc
showTokenQ
            ReadP [String] String
forall r. ReadP r String
parseTokenQ
            ((SymbolicPath Pkg ('Dir Lib) -> String)
-> [SymbolicPath Pkg ('Dir Lib)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Lib) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath ([SymbolicPath Pkg ('Dir Lib)] -> [String])
-> (ConfigFlags -> [SymbolicPath Pkg ('Dir Lib)])
-> ConfigFlags
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigFlags -> [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirs)
            (\[String]
v ConfigFlags
conf -> ConfigFlags
conf{configExtraLibDirs = fmap makeSymbolicPath v})
        , String
-> (String -> Doc)
-> ReadP [String] String
-> (ConfigFlags -> [String])
-> ([String] -> ConfigFlags -> ConfigFlags)
-> FieldDescr ConfigFlags
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
            String
"extra-lib-dirs-static"
            String -> Doc
showTokenQ
            ReadP [String] String
forall r. ReadP r String
parseTokenQ
            ((SymbolicPath Pkg ('Dir Lib) -> String)
-> [SymbolicPath Pkg ('Dir Lib)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Lib) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath ([SymbolicPath Pkg ('Dir Lib)] -> [String])
-> (ConfigFlags -> [SymbolicPath Pkg ('Dir Lib)])
-> ConfigFlags
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigFlags -> [SymbolicPath Pkg ('Dir Lib)]
configExtraLibDirsStatic)
            (\[String]
v ConfigFlags
conf -> ConfigFlags
conf{configExtraLibDirsStatic = fmap makeSymbolicPath v})
        , String
-> (String -> Doc)
-> ReadP [String] String
-> (ConfigFlags -> [String])
-> ([String] -> ConfigFlags -> ConfigFlags)
-> FieldDescr ConfigFlags
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
            String
"extra-framework-dirs"
            String -> Doc
showTokenQ
            ReadP [String] String
forall r. ReadP r String
parseTokenQ
            ((SymbolicPath Pkg ('Dir Framework) -> String)
-> [SymbolicPath Pkg ('Dir Framework)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Framework) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath ([SymbolicPath Pkg ('Dir Framework)] -> [String])
-> (ConfigFlags -> [SymbolicPath Pkg ('Dir Framework)])
-> ConfigFlags
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigFlags -> [SymbolicPath Pkg ('Dir Framework)]
configExtraFrameworkDirs)
            (\[String]
v ConfigFlags
conf -> ConfigFlags
conf{configExtraFrameworkDirs = fmap makeSymbolicPath v})
        , String
-> (String -> Doc)
-> ReadP [String] String
-> (ConfigFlags -> [String])
-> ([String] -> ConfigFlags -> ConfigFlags)
-> FieldDescr ConfigFlags
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
            String
"extra-prog-path"
            String -> Doc
showTokenQ
            ReadP [String] String
forall r. ReadP r String
parseTokenQ
            (NubList String -> [String]
forall a. NubList a -> [a]
fromNubList (NubList String -> [String])
-> (ConfigFlags -> NubList String) -> ConfigFlags -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigFlags -> NubList String
configProgramPathExtra)
            (\[String]
v ConfigFlags
conf -> ConfigFlags
conf{configProgramPathExtra = toNubList v})
        , String
-> (String -> Doc)
-> ReadP [String] String
-> (ConfigFlags -> [String])
-> ([String] -> ConfigFlags -> ConfigFlags)
-> FieldDescr ConfigFlags
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
            String
"configure-options"
            String -> Doc
showTokenQ
            ReadP [String] String
forall r. ReadP r String
parseTokenQ
            ConfigFlags -> [String]
configConfigureArgs
            (\[String]
v ConfigFlags
conf -> ConfigFlags
conf{configConfigureArgs = v})
        , String
-> (FlagAssignment -> Doc)
-> ParsecParser FlagAssignment
-> (ConfigFlags -> FlagAssignment)
-> (FlagAssignment -> ConfigFlags -> ConfigFlags)
-> FieldDescr ConfigFlags
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec
            String
"flags"
            FlagAssignment -> Doc
dispFlagAssignment
            ParsecParser FlagAssignment
forall (m :: * -> *). CabalParsing m => m FlagAssignment
parsecFlagAssignment
            ConfigFlags -> FlagAssignment
configConfigurationsFlags
            (\FlagAssignment
v ConfigFlags
conf -> ConfigFlags
conf{configConfigurationsFlags = v})
        , FieldDescr ConfigFlags
overrideDumpBuildInfo
        ]
      ([FieldDescr ConfigFlags] -> [FieldDescr ConfigFlags])
-> ([OptionField ConfigFlags] -> [FieldDescr ConfigFlags])
-> [OptionField ConfigFlags]
-> [FieldDescr ConfigFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [FieldDescr ConfigFlags] -> [FieldDescr ConfigFlags]
forall a. [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields
        [ String
"with-compiler"
        , String
"with-hc-pkg"
        , String
"program-prefix"
        , String
"program-suffix"
        , String
"library-vanilla"
        , String
"library-profiling"
        , String
"library-vanilla"
        , String
"shared"
        , String
"static"
        , String
"executable-dynamic"
        , String
"executable-static"
        , String
"profiling"
        , String
"profiling-shared"
        , String
"executable-profiling"
        , String
"profiling-detail"
        , String
"library-profiling-detail"
        , String
"library-for-ghci"
        , String
"split-objs"
        , String
"split-sections"
        , String
"executable-stripping"
        , String
"library-stripping"
        , String
"tests"
        , String
"benchmarks"
        , String
"coverage"
        , String
"library-coverage"
        , String
"relocatable"
        -- not "extra-include-dirs", "extra-lib-dirs", "extra-framework-dirs"
        -- or "extra-prog-path". We use corrected ones above that parse
        -- as list fields.
        ]
      ([FieldDescr ConfigFlags] -> [FieldDescr ConfigFlags])
-> ([OptionField ConfigFlags] -> [FieldDescr ConfigFlags])
-> [OptionField ConfigFlags]
-> [FieldDescr ConfigFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField ConfigFlags] -> [FieldDescr ConfigFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
  )
    (ShowOrParseArgs -> [OptionField ConfigFlags]
configureOptions ShowOrParseArgs
ParseArgs)
    [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
forall a. [a] -> [a] -> [a]
++ (LegacyPackageConfig -> ConfigFlags)
-> (ConfigFlags -> LegacyPackageConfig -> LegacyPackageConfig)
-> [FieldDescr ConfigFlags]
-> [FieldDescr LegacyPackageConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
      LegacyPackageConfig -> ConfigFlags
legacyConfigureFlags
      (\ConfigFlags
flags LegacyPackageConfig
conf -> LegacyPackageConfig
conf{legacyConfigureFlags = flags})
      [ FieldDescr ConfigFlags
overrideFieldCompiler
      , FieldDescr ConfigFlags
overrideFieldOptimization
      , FieldDescr ConfigFlags
overrideFieldDebugInfo
      ]
    [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
forall a. [a] -> [a] -> [a]
++ ( (LegacyPackageConfig -> InstallFlags)
-> (InstallFlags -> LegacyPackageConfig -> LegacyPackageConfig)
-> [FieldDescr InstallFlags]
-> [FieldDescr LegacyPackageConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
          LegacyPackageConfig -> InstallFlags
legacyInstallPkgFlags
          (\InstallFlags
flags LegacyPackageConfig
conf -> LegacyPackageConfig
conf{legacyInstallPkgFlags = flags})
          ([FieldDescr InstallFlags] -> [FieldDescr LegacyPackageConfig])
-> ([OptionField InstallFlags] -> [FieldDescr InstallFlags])
-> [OptionField InstallFlags]
-> [FieldDescr LegacyPackageConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [FieldDescr InstallFlags] -> [FieldDescr InstallFlags]
forall a. [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields
            [ String
"documentation"
            , String
"run-tests"
            ]
          ([FieldDescr InstallFlags] -> [FieldDescr InstallFlags])
-> ([OptionField InstallFlags] -> [FieldDescr InstallFlags])
-> [OptionField InstallFlags]
-> [FieldDescr InstallFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField InstallFlags] -> [FieldDescr InstallFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
       )
      (ShowOrParseArgs -> [OptionField InstallFlags]
installOptions ShowOrParseArgs
ParseArgs)
    [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
forall a. [a] -> [a] -> [a]
++ ( (LegacyPackageConfig -> HaddockFlags)
-> (HaddockFlags -> LegacyPackageConfig -> LegacyPackageConfig)
-> [FieldDescr HaddockFlags]
-> [FieldDescr LegacyPackageConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
          LegacyPackageConfig -> HaddockFlags
legacyHaddockFlags
          (\HaddockFlags
flags LegacyPackageConfig
conf -> LegacyPackageConfig
conf{legacyHaddockFlags = flags})
          ([FieldDescr HaddockFlags] -> [FieldDescr LegacyPackageConfig])
-> ([OptionField HaddockFlags] -> [FieldDescr HaddockFlags])
-> [OptionField HaddockFlags]
-> [FieldDescr LegacyPackageConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String)
-> [FieldDescr HaddockFlags] -> [FieldDescr HaddockFlags]
forall a. (String -> String) -> [FieldDescr a] -> [FieldDescr a]
mapFieldNames
            (String
"haddock-" String -> String -> String
forall a. [a] -> [a] -> [a]
++)
          ([FieldDescr HaddockFlags] -> [FieldDescr HaddockFlags])
-> ([OptionField HaddockFlags] -> [FieldDescr HaddockFlags])
-> [OptionField HaddockFlags]
-> [FieldDescr HaddockFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldDescr HaddockFlags]
-> [FieldDescr HaddockFlags] -> [FieldDescr HaddockFlags]
forall a. [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
addFields
            [ String
-> (Flag HaddockTarget -> Doc)
-> ParsecParser (Flag HaddockTarget)
-> (HaddockFlags -> Flag HaddockTarget)
-> (Flag HaddockTarget -> HaddockFlags -> HaddockFlags)
-> FieldDescr HaddockFlags
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec
                String
"for-hackage"
                -- TODO: turn this into a library function
                (Doc -> Flag Doc -> Doc
forall a. a -> Flag a -> a
fromFlagOrDefault Doc
Disp.empty (Flag Doc -> Doc)
-> (Flag HaddockTarget -> Flag Doc) -> Flag HaddockTarget -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HaddockTarget -> Doc) -> Flag HaddockTarget -> Flag Doc
forall a b. (a -> b) -> Flag a -> Flag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HaddockTarget -> Doc
forall a. Pretty a => a -> Doc
pretty)
                (HaddockTarget -> Flag HaddockTarget
forall a. a -> Flag a
toFlag (HaddockTarget -> Flag HaddockTarget)
-> ParsecParser HaddockTarget -> ParsecParser (Flag HaddockTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecParser HaddockTarget
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m HaddockTarget
parsec ParsecParser (Flag HaddockTarget)
-> ParsecParser (Flag HaddockTarget)
-> ParsecParser (Flag HaddockTarget)
forall a. ParsecParser a -> ParsecParser a -> ParsecParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Flag HaddockTarget -> ParsecParser (Flag HaddockTarget)
forall a. a -> ParsecParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Flag HaddockTarget
forall a. Monoid a => a
mempty)
                HaddockFlags -> Flag HaddockTarget
haddockForHackage
                (\Flag HaddockTarget
v HaddockFlags
conf -> HaddockFlags
conf{haddockForHackage = v})
            ]
          ([FieldDescr HaddockFlags] -> [FieldDescr HaddockFlags])
-> ([OptionField HaddockFlags] -> [FieldDescr HaddockFlags])
-> [OptionField HaddockFlags]
-> [FieldDescr HaddockFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [FieldDescr HaddockFlags] -> [FieldDescr HaddockFlags]
forall a. [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields
            [ String
"hoogle"
            , String
"html"
            , String
"html-location"
            , String
"foreign-libraries"
            , String
"executables"
            , String
"tests"
            , String
"benchmarks"
            , String
"all"
            , String
"internal"
            , String
"css"
            , String
"hyperlink-source"
            , String
"quickjump"
            , String
"hscolour-css"
            , String
"contents-location"
            , String
"index-location"
            , String
"keep-temp-files"
            , String
"base-url"
            , String
"resources-dir"
            , String
"output-dir"
            , String
"use-unicode"
            ]
          ([FieldDescr HaddockFlags] -> [FieldDescr HaddockFlags])
-> ([OptionField HaddockFlags] -> [FieldDescr HaddockFlags])
-> [OptionField HaddockFlags]
-> [FieldDescr HaddockFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField HaddockFlags] -> [FieldDescr HaddockFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
       )
      (ShowOrParseArgs -> [OptionField HaddockFlags]
haddockOptions ShowOrParseArgs
ParseArgs)
    [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
forall a. [a] -> [a] -> [a]
++ ( (LegacyPackageConfig -> TestFlags)
-> (TestFlags -> LegacyPackageConfig -> LegacyPackageConfig)
-> [FieldDescr TestFlags]
-> [FieldDescr LegacyPackageConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
          LegacyPackageConfig -> TestFlags
legacyTestFlags
          (\TestFlags
flags LegacyPackageConfig
conf -> LegacyPackageConfig
conf{legacyTestFlags = flags})
          ([FieldDescr TestFlags] -> [FieldDescr LegacyPackageConfig])
-> ([OptionField TestFlags] -> [FieldDescr TestFlags])
-> [OptionField TestFlags]
-> [FieldDescr LegacyPackageConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String)
-> [FieldDescr TestFlags] -> [FieldDescr TestFlags]
forall a. (String -> String) -> [FieldDescr a] -> [FieldDescr a]
mapFieldNames
            String -> String
prefixTest
          ([FieldDescr TestFlags] -> [FieldDescr TestFlags])
-> ([OptionField TestFlags] -> [FieldDescr TestFlags])
-> [OptionField TestFlags]
-> [FieldDescr TestFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldDescr TestFlags]
-> [FieldDescr TestFlags] -> [FieldDescr TestFlags]
forall a. [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
addFields
            [ String
-> (PathTemplate -> Doc)
-> ReadP [PathTemplate] PathTemplate
-> (TestFlags -> [PathTemplate])
-> ([PathTemplate] -> TestFlags -> TestFlags)
-> FieldDescr TestFlags
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
                String
"test-options"
                (String -> Doc
showTokenQ (String -> Doc) -> (PathTemplate -> String) -> PathTemplate -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathTemplate -> String
fromPathTemplate)
                ((String -> PathTemplate)
-> Parser [PathTemplate] Char String
-> ReadP [PathTemplate] PathTemplate
forall a b.
(a -> b)
-> Parser [PathTemplate] Char a -> Parser [PathTemplate] Char b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> PathTemplate
toPathTemplate Parser [PathTemplate] Char String
forall r. ReadP r String
parseTokenQ)
                TestFlags -> [PathTemplate]
testOptions
                (\[PathTemplate]
v TestFlags
conf -> TestFlags
conf{testOptions = v})
            ]
          ([FieldDescr TestFlags] -> [FieldDescr TestFlags])
-> ([OptionField TestFlags] -> [FieldDescr TestFlags])
-> [OptionField TestFlags]
-> [FieldDescr TestFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [FieldDescr TestFlags] -> [FieldDescr TestFlags]
forall a. [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields
            [ String
"log"
            , String
"machine-log"
            , String
"show-details"
            , String
"keep-tix-files"
            , String
"fail-when-no-test-suites"
            , String
"test-wrapper"
            ]
          ([FieldDescr TestFlags] -> [FieldDescr TestFlags])
-> ([OptionField TestFlags] -> [FieldDescr TestFlags])
-> [OptionField TestFlags]
-> [FieldDescr TestFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField TestFlags] -> [FieldDescr TestFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
       )
      (ShowOrParseArgs -> [OptionField TestFlags]
testOptions' ShowOrParseArgs
ParseArgs)
    [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
forall a. [a] -> [a] -> [a]
++ ( (LegacyPackageConfig -> BenchmarkFlags)
-> (BenchmarkFlags -> LegacyPackageConfig -> LegacyPackageConfig)
-> [FieldDescr BenchmarkFlags]
-> [FieldDescr LegacyPackageConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
          LegacyPackageConfig -> BenchmarkFlags
legacyBenchmarkFlags
          (\BenchmarkFlags
flags LegacyPackageConfig
conf -> LegacyPackageConfig
conf{legacyBenchmarkFlags = flags})
          ([FieldDescr BenchmarkFlags] -> [FieldDescr LegacyPackageConfig])
-> ([OptionField BenchmarkFlags] -> [FieldDescr BenchmarkFlags])
-> [OptionField BenchmarkFlags]
-> [FieldDescr LegacyPackageConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldDescr BenchmarkFlags]
-> [FieldDescr BenchmarkFlags] -> [FieldDescr BenchmarkFlags]
forall a. [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
addFields
            [ String
-> (PathTemplate -> Doc)
-> ReadP [PathTemplate] PathTemplate
-> (BenchmarkFlags -> [PathTemplate])
-> ([PathTemplate] -> BenchmarkFlags -> BenchmarkFlags)
-> FieldDescr BenchmarkFlags
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField
                String
"benchmark-options"
                (String -> Doc
showTokenQ (String -> Doc) -> (PathTemplate -> String) -> PathTemplate -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathTemplate -> String
fromPathTemplate)
                ((String -> PathTemplate)
-> Parser [PathTemplate] Char String
-> ReadP [PathTemplate] PathTemplate
forall a b.
(a -> b)
-> Parser [PathTemplate] Char a -> Parser [PathTemplate] Char b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> PathTemplate
toPathTemplate Parser [PathTemplate] Char String
forall r. ReadP r String
parseTokenQ)
                BenchmarkFlags -> [PathTemplate]
benchmarkOptions
                (\[PathTemplate]
v BenchmarkFlags
conf -> BenchmarkFlags
conf{benchmarkOptions = v})
            ]
          ([FieldDescr BenchmarkFlags] -> [FieldDescr BenchmarkFlags])
-> ([OptionField BenchmarkFlags] -> [FieldDescr BenchmarkFlags])
-> [OptionField BenchmarkFlags]
-> [FieldDescr BenchmarkFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String]
-> [FieldDescr BenchmarkFlags] -> [FieldDescr BenchmarkFlags]
forall a. [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields
            []
          ([FieldDescr BenchmarkFlags] -> [FieldDescr BenchmarkFlags])
-> ([OptionField BenchmarkFlags] -> [FieldDescr BenchmarkFlags])
-> [OptionField BenchmarkFlags]
-> [FieldDescr BenchmarkFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptionField BenchmarkFlags] -> [FieldDescr BenchmarkFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields
       )
      (ShowOrParseArgs -> [OptionField BenchmarkFlags]
benchmarkOptions' ShowOrParseArgs
ParseArgs)
  where
    overrideFieldCompiler :: FieldDescr ConfigFlags
overrideFieldCompiler =
      String
-> (Flag CompilerFlavor -> Doc)
-> ParsecParser (Flag CompilerFlavor)
-> (ConfigFlags -> Flag CompilerFlavor)
-> (Flag CompilerFlavor -> ConfigFlags -> ConfigFlags)
-> FieldDescr ConfigFlags
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec
        String
"compiler"
        (Doc -> Flag Doc -> Doc
forall a. a -> Flag a -> a
fromFlagOrDefault Doc
Disp.empty (Flag Doc -> Doc)
-> (Flag CompilerFlavor -> Flag Doc) -> Flag CompilerFlavor -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerFlavor -> Doc) -> Flag CompilerFlavor -> Flag Doc
forall a b. (a -> b) -> Flag a -> Flag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompilerFlavor -> Doc
forall a. Pretty a => a -> Doc
pretty)
        (CompilerFlavor -> Flag CompilerFlavor
forall a. a -> Flag a
toFlag (CompilerFlavor -> Flag CompilerFlavor)
-> ParsecParser CompilerFlavor
-> ParsecParser (Flag CompilerFlavor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecParser CompilerFlavor
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m CompilerFlavor
parsec ParsecParser (Flag CompilerFlavor)
-> ParsecParser (Flag CompilerFlavor)
-> ParsecParser (Flag CompilerFlavor)
forall a. ParsecParser a -> ParsecParser a -> ParsecParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Flag CompilerFlavor -> ParsecParser (Flag CompilerFlavor)
forall a. a -> ParsecParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Flag CompilerFlavor
forall a. Monoid a => a
mempty)
        ConfigFlags -> Flag CompilerFlavor
configHcFlavor
        (\Flag CompilerFlavor
v ConfigFlags
flags -> ConfigFlags
flags{configHcFlavor = v})

    overrideDumpBuildInfo :: FieldDescr ConfigFlags
overrideDumpBuildInfo =
      (ConfigFlags -> Flag DumpBuildInfo)
-> (Flag DumpBuildInfo -> ConfigFlags -> ConfigFlags)
-> FieldDescr (Flag DumpBuildInfo)
-> FieldDescr ConfigFlags
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
        ConfigFlags -> Flag DumpBuildInfo
configDumpBuildInfo
        (\Flag DumpBuildInfo
v ConfigFlags
flags -> ConfigFlags
flags{configDumpBuildInfo = v})
        (FieldDescr (Flag DumpBuildInfo) -> FieldDescr ConfigFlags)
-> FieldDescr (Flag DumpBuildInfo) -> FieldDescr ConfigFlags
forall a b. (a -> b) -> a -> b
$ let name :: String
name = String
"build-info"
           in String
-> (Flag DumpBuildInfo -> Doc)
-> (Int
    -> String
    -> Flag DumpBuildInfo
    -> ParseResult (Flag DumpBuildInfo))
-> FieldDescr (Flag DumpBuildInfo)
forall a.
String
-> (a -> Doc)
-> (Int -> String -> a -> ParseResult a)
-> FieldDescr a
FieldDescr
                String
name
                ( \Flag DumpBuildInfo
f -> case Flag DumpBuildInfo
f of
                    Flag DumpBuildInfo
NoDumpBuildInfo -> String -> Doc
Disp.text String
"False"
                    Flag DumpBuildInfo
DumpBuildInfo -> String -> Doc
Disp.text String
"True"
                    Flag DumpBuildInfo
_ -> Doc
Disp.empty
                )
                ( \Int
line String
str Flag DumpBuildInfo
_ -> case () of
                    ()
_
                      | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"False" -> [PWarning]
-> Flag DumpBuildInfo -> ParseResult (Flag DumpBuildInfo)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DumpBuildInfo -> Flag DumpBuildInfo
forall a. a -> Flag a
Flag DumpBuildInfo
NoDumpBuildInfo)
                      | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"True" -> [PWarning]
-> Flag DumpBuildInfo -> ParseResult (Flag DumpBuildInfo)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DumpBuildInfo -> Flag DumpBuildInfo
forall a. a -> Flag a
Flag DumpBuildInfo
DumpBuildInfo)
                      | String
lstr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"false" -> [PWarning]
-> Flag DumpBuildInfo -> ParseResult (Flag DumpBuildInfo)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [String -> PWarning
caseWarning String
name] (DumpBuildInfo -> Flag DumpBuildInfo
forall a. a -> Flag a
Flag DumpBuildInfo
NoDumpBuildInfo)
                      | String
lstr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"true" -> [PWarning]
-> Flag DumpBuildInfo -> ParseResult (Flag DumpBuildInfo)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [String -> PWarning
caseWarning String
name] (DumpBuildInfo -> Flag DumpBuildInfo
forall a. a -> Flag a
Flag DumpBuildInfo
DumpBuildInfo)
                      | Bool
otherwise -> PError -> ParseResult (Flag DumpBuildInfo)
forall a. PError -> ParseResult a
ParseFailed (String -> Int -> PError
NoParse String
name Int
line)
                      where
                        lstr :: String
lstr = String -> String
lowercase String
str
                )

    -- TODO: [code cleanup] The following is a hack. The "optimization" and
    -- "debug-info" fields are OptArg, and viewAsFieldDescr fails on that.
    -- Instead of a hand-written parser and printer, we should handle this case
    -- properly in the library.

    overrideFieldOptimization :: FieldDescr ConfigFlags
overrideFieldOptimization =
      (ConfigFlags -> Flag OptimisationLevel)
-> (Flag OptimisationLevel -> ConfigFlags -> ConfigFlags)
-> FieldDescr (Flag OptimisationLevel)
-> FieldDescr ConfigFlags
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
        ConfigFlags -> Flag OptimisationLevel
configOptimization
        (\Flag OptimisationLevel
v ConfigFlags
flags -> ConfigFlags
flags{configOptimization = v})
        (FieldDescr (Flag OptimisationLevel) -> FieldDescr ConfigFlags)
-> FieldDescr (Flag OptimisationLevel) -> FieldDescr ConfigFlags
forall a b. (a -> b) -> a -> b
$ let name :: String
name = String
"optimization"
           in String
-> (Flag OptimisationLevel -> Doc)
-> (Int
    -> String
    -> Flag OptimisationLevel
    -> ParseResult (Flag OptimisationLevel))
-> FieldDescr (Flag OptimisationLevel)
forall a.
String
-> (a -> Doc)
-> (Int -> String -> a -> ParseResult a)
-> FieldDescr a
FieldDescr
                String
name
                ( \Flag OptimisationLevel
f -> case Flag OptimisationLevel
f of
                    Flag OptimisationLevel
NoOptimisation -> String -> Doc
Disp.text String
"False"
                    Flag OptimisationLevel
NormalOptimisation -> String -> Doc
Disp.text String
"True"
                    Flag OptimisationLevel
MaximumOptimisation -> String -> Doc
Disp.text String
"2"
                    Flag OptimisationLevel
_ -> Doc
Disp.empty
                )
                ( \Int
line String
str Flag OptimisationLevel
_ -> case () of
                    ()
_
                      | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"False" -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NoOptimisation)
                      | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"True" -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NormalOptimisation)
                      | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NoOptimisation)
                      | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1" -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NormalOptimisation)
                      | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"2" -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
MaximumOptimisation)
                      | String
lstr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"false" -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [String -> PWarning
caseWarning String
name] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NoOptimisation)
                      | String
lstr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"true" -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [String -> PWarning
caseWarning String
name] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NormalOptimisation)
                      | Bool
otherwise -> PError -> ParseResult (Flag OptimisationLevel)
forall a. PError -> ParseResult a
ParseFailed (String -> Int -> PError
NoParse String
name Int
line)
                      where
                        lstr :: String
lstr = String -> String
lowercase String
str
                )

    overrideFieldDebugInfo :: FieldDescr ConfigFlags
overrideFieldDebugInfo =
      (ConfigFlags -> Flag DebugInfoLevel)
-> (Flag DebugInfoLevel -> ConfigFlags -> ConfigFlags)
-> FieldDescr (Flag DebugInfoLevel)
-> FieldDescr ConfigFlags
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField ConfigFlags -> Flag DebugInfoLevel
configDebugInfo (\Flag DebugInfoLevel
v ConfigFlags
flags -> ConfigFlags
flags{configDebugInfo = v}) (FieldDescr (Flag DebugInfoLevel) -> FieldDescr ConfigFlags)
-> FieldDescr (Flag DebugInfoLevel) -> FieldDescr ConfigFlags
forall a b. (a -> b) -> a -> b
$
        let name :: String
name = String
"debug-info"
         in String
-> (Flag DebugInfoLevel -> Doc)
-> (Int
    -> String
    -> Flag DebugInfoLevel
    -> ParseResult (Flag DebugInfoLevel))
-> FieldDescr (Flag DebugInfoLevel)
forall a.
String
-> (a -> Doc)
-> (Int -> String -> a -> ParseResult a)
-> FieldDescr a
FieldDescr
              String
name
              ( \Flag DebugInfoLevel
f -> case Flag DebugInfoLevel
f of
                  Flag DebugInfoLevel
NoDebugInfo -> String -> Doc
Disp.text String
"False"
                  Flag DebugInfoLevel
MinimalDebugInfo -> String -> Doc
Disp.text String
"1"
                  Flag DebugInfoLevel
NormalDebugInfo -> String -> Doc
Disp.text String
"True"
                  Flag DebugInfoLevel
MaximalDebugInfo -> String -> Doc
Disp.text String
"3"
                  Flag DebugInfoLevel
_ -> Doc
Disp.empty
              )
              ( \Int
line String
str Flag DebugInfoLevel
_ -> case () of
                  ()
_
                    | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"False" -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NoDebugInfo)
                    | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"True" -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NormalDebugInfo)
                    | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NoDebugInfo)
                    | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1" -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
MinimalDebugInfo)
                    | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"2" -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NormalDebugInfo)
                    | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"3" -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
MaximalDebugInfo)
                    | String
lstr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"false" -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [String -> PWarning
caseWarning String
name] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NoDebugInfo)
                    | String
lstr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"true" -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [String -> PWarning
caseWarning String
name] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NormalDebugInfo)
                    | Bool
otherwise -> PError -> ParseResult (Flag DebugInfoLevel)
forall a. PError -> ParseResult a
ParseFailed (String -> Int -> PError
NoParse String
name Int
line)
                    where
                      lstr :: String
lstr = String -> String
lowercase String
str
              )

    caseWarning :: String -> PWarning
caseWarning String
name =
      String -> PWarning
PWarning (String -> PWarning) -> String -> PWarning
forall a b. (a -> b) -> a -> b
$
        String
"The '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' field is case sensitive, use 'True' or 'False'."

    prefixTest :: String -> String
prefixTest String
name
      | String
"test-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name = String
name
      | Bool
otherwise = String
"test-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name

legacyPackageConfigFGSectionDescrs
  :: ( FieldGrammar c g
     , Applicative (g SourceRepoList)
     , c (Identity RepoType)
     , c (List NoCommaFSep FilePathNT String)
     , c (NonEmpty' NoCommaFSep Token String)
     )
  => [FGSectionDescr g LegacyProjectConfig]
legacyPackageConfigFGSectionDescrs :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (Identity RepoType), c (List NoCommaFSep FilePathNT String),
 c (NonEmpty' NoCommaFSep Token String)) =>
[FGSectionDescr g LegacyProjectConfig]
legacyPackageConfigFGSectionDescrs =
  [ FGSectionDescr g LegacyProjectConfig
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (Identity RepoType), c (List NoCommaFSep FilePathNT String),
 c (NonEmpty' NoCommaFSep Token String)) =>
FGSectionDescr g LegacyProjectConfig
packageRepoSectionDescr
  ]

legacyPackageConfigSectionDescrs :: [SectionDescr LegacyProjectConfig]
legacyPackageConfigSectionDescrs :: [SectionDescr LegacyProjectConfig]
legacyPackageConfigSectionDescrs =
  [ SectionDescr LegacyProjectConfig
packageSpecificOptionsSectionDescr
  , (LegacyProjectConfig -> LegacyPackageConfig)
-> (LegacyPackageConfig
    -> LegacyProjectConfig -> LegacyProjectConfig)
-> SectionDescr LegacyPackageConfig
-> SectionDescr LegacyProjectConfig
forall b a.
(b -> a) -> (a -> b -> b) -> SectionDescr a -> SectionDescr b
liftSection
      LegacyProjectConfig -> LegacyPackageConfig
legacyLocalConfig
      (\LegacyPackageConfig
flags LegacyProjectConfig
conf -> LegacyProjectConfig
conf{legacyLocalConfig = flags})
      SectionDescr LegacyPackageConfig
programOptionsSectionDescr
  , (LegacyProjectConfig -> LegacyPackageConfig)
-> (LegacyPackageConfig
    -> LegacyProjectConfig -> LegacyProjectConfig)
-> SectionDescr LegacyPackageConfig
-> SectionDescr LegacyProjectConfig
forall b a.
(b -> a) -> (a -> b -> b) -> SectionDescr a -> SectionDescr b
liftSection
      LegacyProjectConfig -> LegacyPackageConfig
legacyLocalConfig
      (\LegacyPackageConfig
flags LegacyProjectConfig
conf -> LegacyProjectConfig
conf{legacyLocalConfig = flags})
      SectionDescr LegacyPackageConfig
programLocationsSectionDescr
  , (LegacyProjectConfig -> LegacySharedConfig)
-> (LegacySharedConfig
    -> LegacyProjectConfig -> LegacyProjectConfig)
-> SectionDescr LegacySharedConfig
-> SectionDescr LegacyProjectConfig
forall b a.
(b -> a) -> (a -> b -> b) -> SectionDescr a -> SectionDescr b
liftSection
      LegacyProjectConfig -> LegacySharedConfig
legacySharedConfig
      (\LegacySharedConfig
flags LegacyProjectConfig
conf -> LegacyProjectConfig
conf{legacySharedConfig = flags})
      (SectionDescr LegacySharedConfig
 -> SectionDescr LegacyProjectConfig)
-> SectionDescr LegacySharedConfig
-> SectionDescr LegacyProjectConfig
forall a b. (a -> b) -> a -> b
$ (LegacySharedConfig -> GlobalFlags)
-> (GlobalFlags -> LegacySharedConfig -> LegacySharedConfig)
-> SectionDescr GlobalFlags
-> SectionDescr LegacySharedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> SectionDescr a -> SectionDescr b
liftSection
        LegacySharedConfig -> GlobalFlags
legacyGlobalFlags
        (\GlobalFlags
flags LegacySharedConfig
conf -> LegacySharedConfig
conf{legacyGlobalFlags = flags})
        SectionDescr GlobalFlags
remoteRepoSectionDescr
  ]

packageRepoSectionDescr
  :: ( FieldGrammar c g
     , Applicative (g SourceRepoList)
     , c (Identity RepoType)
     , c (List NoCommaFSep FilePathNT String)
     , c (NonEmpty' NoCommaFSep Token String)
     )
  => FGSectionDescr g LegacyProjectConfig
packageRepoSectionDescr :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (Identity RepoType), c (List NoCommaFSep FilePathNT String),
 c (NonEmpty' NoCommaFSep Token String)) =>
FGSectionDescr g LegacyProjectConfig
packageRepoSectionDescr =
  FGSectionDescr
    { fgSectionName :: String
fgSectionName = String
"source-repository-package"
    , fgSectionGrammar :: g SourceRepoList SourceRepoList
fgSectionGrammar = g SourceRepoList SourceRepoList
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (Identity RepoType), c (List NoCommaFSep FilePathNT String),
 c (NonEmpty' NoCommaFSep Token String)) =>
g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar
    , fgSectionGet :: LegacyProjectConfig -> [(String, SourceRepoList)]
fgSectionGet = (SourceRepoList -> (String, SourceRepoList))
-> [SourceRepoList] -> [(String, SourceRepoList)]
forall a b. (a -> b) -> [a] -> [b]
map (\SourceRepoList
x -> (String
"", SourceRepoList
x)) ([SourceRepoList] -> [(String, SourceRepoList)])
-> (LegacyProjectConfig -> [SourceRepoList])
-> LegacyProjectConfig
-> [(String, SourceRepoList)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyProjectConfig -> [SourceRepoList]
legacyPackagesRepo
    , fgSectionSet :: Int
-> String
-> SourceRepoList
-> LegacyProjectConfig
-> ParseResult LegacyProjectConfig
fgSectionSet =
        \Int
lineno String
unused SourceRepoList
pkgrepo LegacyProjectConfig
projconf -> do
          Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
unused) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
            Int -> String -> ParseResult ()
forall a. Int -> String -> ParseResult a
syntaxError Int
lineno String
"the section 'source-repository-package' takes no arguments"
          LegacyProjectConfig -> ParseResult LegacyProjectConfig
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return
            LegacyProjectConfig
projconf
              { legacyPackagesRepo = legacyPackagesRepo projconf ++ [pkgrepo]
              }
    }

-- | The definitions of all the fields that can appear in the @package pkgfoo@
-- and @package *@ sections of the @cabal.project@-format files.
packageSpecificOptionsFieldDescrs :: [FieldDescr LegacyPackageConfig]
packageSpecificOptionsFieldDescrs :: [FieldDescr LegacyPackageConfig]
packageSpecificOptionsFieldDescrs =
  [FieldDescr LegacyPackageConfig]
legacyPackageConfigFieldDescrs
    [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
forall a. [a] -> [a] -> [a]
++ (LegacyPackageConfig -> [(String, [String])])
-> ([(String, [String])]
    -> LegacyPackageConfig -> LegacyPackageConfig)
-> [FieldDescr LegacyPackageConfig]
forall a.
(a -> [(String, [String])])
-> ([(String, [String])] -> a -> a) -> [FieldDescr a]
programOptionsFieldDescrs
      (ConfigFlags -> [(String, [String])]
configProgramArgs (ConfigFlags -> [(String, [String])])
-> (LegacyPackageConfig -> ConfigFlags)
-> LegacyPackageConfig
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyPackageConfig -> ConfigFlags
legacyConfigureFlags)
      ( \[(String, [String])]
args LegacyPackageConfig
pkgconf ->
          LegacyPackageConfig
pkgconf
            { legacyConfigureFlags =
                (legacyConfigureFlags pkgconf)
                  { configProgramArgs = args
                  }
            }
      )
    [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
-> [FieldDescr LegacyPackageConfig]
forall a. [a] -> [a] -> [a]
++ (LegacyPackageConfig -> ConfigFlags)
-> (ConfigFlags -> LegacyPackageConfig -> LegacyPackageConfig)
-> [FieldDescr ConfigFlags]
-> [FieldDescr LegacyPackageConfig]
forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields
      LegacyPackageConfig -> ConfigFlags
legacyConfigureFlags
      ( \ConfigFlags
flags LegacyPackageConfig
pkgconf ->
          LegacyPackageConfig
pkgconf
            { legacyConfigureFlags = flags
            }
      )
      [FieldDescr ConfigFlags]
programLocationsFieldDescrs

-- | The definition of the @package pkgfoo@ sections of the @cabal.project@-format
-- files. This section is per-package name. The special package @*@ applies to all
-- packages used anywhere by the project, locally or as dependencies.
packageSpecificOptionsSectionDescr :: SectionDescr LegacyProjectConfig
packageSpecificOptionsSectionDescr :: SectionDescr LegacyProjectConfig
packageSpecificOptionsSectionDescr =
  SectionDescr
    { sectionName :: String
sectionName = String
"package"
    , sectionFields :: [FieldDescr LegacyPackageConfig]
sectionFields = [FieldDescr LegacyPackageConfig]
packageSpecificOptionsFieldDescrs
    , sectionSubsections :: [SectionDescr LegacyPackageConfig]
sectionSubsections = []
    , sectionGet :: LegacyProjectConfig -> [(String, LegacyPackageConfig)]
sectionGet = \LegacyProjectConfig
projconf ->
        [ (PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
pkgname, LegacyPackageConfig
pkgconf)
        | (PackageName
pkgname, LegacyPackageConfig
pkgconf) <-
            Map PackageName LegacyPackageConfig
-> [(PackageName, LegacyPackageConfig)]
forall k a. Map k a -> [(k, a)]
Map.toList
              (Map PackageName LegacyPackageConfig
 -> [(PackageName, LegacyPackageConfig)])
-> (LegacyProjectConfig -> Map PackageName LegacyPackageConfig)
-> LegacyProjectConfig
-> [(PackageName, LegacyPackageConfig)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapMappend PackageName LegacyPackageConfig
-> Map PackageName LegacyPackageConfig
forall k v. MapMappend k v -> Map k v
getMapMappend
              (MapMappend PackageName LegacyPackageConfig
 -> Map PackageName LegacyPackageConfig)
-> (LegacyProjectConfig
    -> MapMappend PackageName LegacyPackageConfig)
-> LegacyProjectConfig
-> Map PackageName LegacyPackageConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyProjectConfig -> MapMappend PackageName LegacyPackageConfig
legacySpecificConfig
              (LegacyProjectConfig -> [(PackageName, LegacyPackageConfig)])
-> LegacyProjectConfig -> [(PackageName, LegacyPackageConfig)]
forall a b. (a -> b) -> a -> b
$ LegacyProjectConfig
projconf
        ]
          [(String, LegacyPackageConfig)]
-> [(String, LegacyPackageConfig)]
-> [(String, LegacyPackageConfig)]
forall a. [a] -> [a] -> [a]
++ [(String
"*", LegacyProjectConfig -> LegacyPackageConfig
legacyAllConfig LegacyProjectConfig
projconf)]
    , sectionSet :: Int
-> String
-> LegacyPackageConfig
-> LegacyProjectConfig
-> ParseResult LegacyProjectConfig
sectionSet =
        \Int
lineno String
pkgnamestr LegacyPackageConfig
pkgconf LegacyProjectConfig
projconf -> case String
pkgnamestr of
          String
"*" ->
            LegacyProjectConfig -> ParseResult LegacyProjectConfig
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return
              LegacyProjectConfig
projconf
                { legacyAllConfig = legacyAllConfig projconf <> pkgconf
                }
          String
_ -> do
            PackageName
pkgname <- case String -> Maybe PackageName
forall a. Parsec a => String -> Maybe a
simpleParsec String
pkgnamestr of
              Just PackageName
pkgname -> PackageName -> ParseResult PackageName
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return PackageName
pkgname
              Maybe PackageName
Nothing ->
                Int -> String -> ParseResult PackageName
forall a. Int -> String -> ParseResult a
syntaxError Int
lineno (String -> ParseResult PackageName)
-> String -> ParseResult PackageName
forall a b. (a -> b) -> a -> b
$
                  String
"a 'package' section requires a package name "
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"as an argument"
            LegacyProjectConfig -> ParseResult LegacyProjectConfig
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return
              LegacyProjectConfig
projconf
                { legacySpecificConfig =
                    MapMappend $
                      Map.insertWith
                        mappend
                        pkgname
                        pkgconf
                        (getMapMappend $ legacySpecificConfig projconf)
                }
    , sectionEmpty :: LegacyPackageConfig
sectionEmpty = LegacyPackageConfig
forall a. Monoid a => a
mempty
    }

programOptionsFieldDescrs
  :: (a -> [(String, [String])])
  -> ([(String, [String])] -> a -> a)
  -> [FieldDescr a]
programOptionsFieldDescrs :: forall a.
(a -> [(String, [String])])
-> ([(String, [String])] -> a -> a) -> [FieldDescr a]
programOptionsFieldDescrs a -> [(String, [String])]
get' [(String, [String])] -> a -> a
set =
  [OptionField a] -> [FieldDescr a]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields ([OptionField a] -> [FieldDescr a])
-> [OptionField a] -> [FieldDescr a]
forall a b. (a -> b) -> a -> b
$
    ProgramDb
-> ShowOrParseArgs
-> (a -> [(String, [String])])
-> ([(String, [String])] -> a -> a)
-> [OptionField a]
forall flags.
ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, [String])])
-> ([(String, [String])] -> flags -> flags)
-> [OptionField flags]
programDbOptions
      ProgramDb
defaultProgramDb
      ShowOrParseArgs
ParseArgs
      a -> [(String, [String])]
get'
      [(String, [String])] -> a -> a
set

programOptionsSectionDescr :: SectionDescr LegacyPackageConfig
programOptionsSectionDescr :: SectionDescr LegacyPackageConfig
programOptionsSectionDescr =
  SectionDescr
    { sectionName :: String
sectionName = String
"program-options"
    , sectionFields :: [FieldDescr ConfigFlags]
sectionFields =
        (ConfigFlags -> [(String, [String])])
-> ([(String, [String])] -> ConfigFlags -> ConfigFlags)
-> [FieldDescr ConfigFlags]
forall a.
(a -> [(String, [String])])
-> ([(String, [String])] -> a -> a) -> [FieldDescr a]
programOptionsFieldDescrs
          ConfigFlags -> [(String, [String])]
configProgramArgs
          (\[(String, [String])]
args ConfigFlags
conf -> ConfigFlags
conf{configProgramArgs = args})
    , sectionSubsections :: [SectionDescr ConfigFlags]
sectionSubsections = []
    , sectionGet :: LegacyPackageConfig -> [(String, ConfigFlags)]
sectionGet =
        (\ConfigFlags
x -> [(String
"", ConfigFlags
x)])
          (ConfigFlags -> [(String, ConfigFlags)])
-> (LegacyPackageConfig -> ConfigFlags)
-> LegacyPackageConfig
-> [(String, ConfigFlags)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyPackageConfig -> ConfigFlags
legacyConfigureFlags
    , sectionSet :: Int
-> String
-> ConfigFlags
-> LegacyPackageConfig
-> ParseResult LegacyPackageConfig
sectionSet =
        \Int
lineno String
unused ConfigFlags
confflags LegacyPackageConfig
pkgconf -> do
          Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
unused) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
            Int -> String -> ParseResult ()
forall a. Int -> String -> ParseResult a
syntaxError Int
lineno String
"the section 'program-options' takes no arguments"
          LegacyPackageConfig -> ParseResult LegacyPackageConfig
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return
            LegacyPackageConfig
pkgconf
              { legacyConfigureFlags = legacyConfigureFlags pkgconf <> confflags
              }
    , sectionEmpty :: ConfigFlags
sectionEmpty = ConfigFlags
forall a. Monoid a => a
mempty
    }

programLocationsFieldDescrs :: [FieldDescr ConfigFlags]
programLocationsFieldDescrs :: [FieldDescr ConfigFlags]
programLocationsFieldDescrs =
  [OptionField ConfigFlags] -> [FieldDescr ConfigFlags]
forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields ([OptionField ConfigFlags] -> [FieldDescr ConfigFlags])
-> [OptionField ConfigFlags] -> [FieldDescr ConfigFlags]
forall a b. (a -> b) -> a -> b
$
    (String -> String)
-> ProgramDb
-> ShowOrParseArgs
-> (ConfigFlags -> [(String, String)])
-> ([(String, String)] -> ConfigFlags -> ConfigFlags)
-> [OptionField ConfigFlags]
forall flags.
(String -> String)
-> ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, String)])
-> ([(String, String)] -> flags -> flags)
-> [OptionField flags]
programDbPaths'
      (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-location")
      ProgramDb
defaultProgramDb
      ShowOrParseArgs
ParseArgs
      ConfigFlags -> [(String, String)]
configProgramPaths
      (\[(String, String)]
paths ConfigFlags
conf -> ConfigFlags
conf{configProgramPaths = paths})

programLocationsSectionDescr :: SectionDescr LegacyPackageConfig
programLocationsSectionDescr :: SectionDescr LegacyPackageConfig
programLocationsSectionDescr =
  SectionDescr
    { sectionName :: String
sectionName = String
"program-locations"
    , sectionFields :: [FieldDescr ConfigFlags]
sectionFields = [FieldDescr ConfigFlags]
programLocationsFieldDescrs
    , sectionSubsections :: [SectionDescr ConfigFlags]
sectionSubsections = []
    , sectionGet :: LegacyPackageConfig -> [(String, ConfigFlags)]
sectionGet =
        (\ConfigFlags
x -> [(String
"", ConfigFlags
x)])
          (ConfigFlags -> [(String, ConfigFlags)])
-> (LegacyPackageConfig -> ConfigFlags)
-> LegacyPackageConfig
-> [(String, ConfigFlags)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyPackageConfig -> ConfigFlags
legacyConfigureFlags
    , sectionSet :: Int
-> String
-> ConfigFlags
-> LegacyPackageConfig
-> ParseResult LegacyPackageConfig
sectionSet =
        \Int
lineno String
unused ConfigFlags
confflags LegacyPackageConfig
pkgconf -> do
          Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
unused) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
            Int -> String -> ParseResult ()
forall a. Int -> String -> ParseResult a
syntaxError Int
lineno String
"the section 'program-locations' takes no arguments"
          LegacyPackageConfig -> ParseResult LegacyPackageConfig
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return
            LegacyPackageConfig
pkgconf
              { legacyConfigureFlags = legacyConfigureFlags pkgconf <> confflags
              }
    , sectionEmpty :: ConfigFlags
sectionEmpty = ConfigFlags
forall a. Monoid a => a
mempty
    }

-- | For each known program @PROG@ in 'progDb', produce a @PROG-options@
-- 'OptionField'.
programDbOptions
  :: ProgramDb
  -> ShowOrParseArgs
  -> (flags -> [(String, [String])])
  -> ([(String, [String])] -> (flags -> flags))
  -> [OptionField flags]
programDbOptions :: forall flags.
ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, [String])])
-> ([(String, [String])] -> flags -> flags)
-> [OptionField flags]
programDbOptions ProgramDb
progDb ShowOrParseArgs
showOrParseArgs flags -> [(String, [String])]
get' [(String, [String])] -> flags -> flags
set =
  case ShowOrParseArgs
showOrParseArgs of
    -- we don't want a verbose help text list so we just show a generic one:
    ShowOrParseArgs
ShowArgs -> [String -> OptionField flags
programOptions String
"PROG"]
    ShowOrParseArgs
ParseArgs ->
      ((Program, Maybe ConfiguredProgram) -> OptionField flags)
-> [(Program, Maybe ConfiguredProgram)] -> [OptionField flags]
forall a b. (a -> b) -> [a] -> [b]
map
        (String -> OptionField flags
programOptions (String -> OptionField flags)
-> ((Program, Maybe ConfiguredProgram) -> String)
-> (Program, Maybe ConfiguredProgram)
-> OptionField flags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> String
programName (Program -> String)
-> ((Program, Maybe ConfiguredProgram) -> Program)
-> (Program, Maybe ConfiguredProgram)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Program, Maybe ConfiguredProgram) -> Program
forall a b. (a, b) -> a
fst)
        (ProgramDb -> [(Program, Maybe ConfiguredProgram)]
knownPrograms ProgramDb
progDb)
  where
    programOptions :: String -> OptionField flags
programOptions String
prog =
      String
-> [String]
-> String
-> (flags -> [(String, [String])])
-> ([(String, [String])] -> flags -> flags)
-> MkOptDescr
     (flags -> [(String, [String])])
     ([(String, [String])] -> flags -> flags)
     flags
-> OptionField flags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
        String
""
        [String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-options"]
        (String
"give extra options to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prog)
        flags -> [(String, [String])]
get'
        [(String, [String])] -> flags -> flags
set
        ( String
-> (String -> [(String, [String])])
-> ([(String, [String])] -> [String])
-> MkOptDescr
     (flags -> [(String, [String])])
     ([(String, [String])] -> flags -> flags)
     flags
forall b a.
Monoid b =>
String
-> (String -> b)
-> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg'
            String
"OPTS"
            (\String
args -> [(String
prog, String -> [String]
splitArgs String
args)])
            ( \[(String, [String])]
progArgs ->
                [ [String] -> String
joinsArgs [String]
args
                | (String
prog', [String]
args) <- [(String, [String])]
progArgs
                , String
prog String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
prog'
                ]
            )
        )

    joinsArgs :: [String] -> String
joinsArgs = [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
escape
    escape :: String -> String
escape String
arg
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
arg = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
      | Bool
otherwise = String
arg

-- The implementation is slight hack: we parse all as remote repository
-- but if the url schema is file+noindex, we switch to local.
remoteRepoSectionDescr :: SectionDescr GlobalFlags
remoteRepoSectionDescr :: SectionDescr GlobalFlags
remoteRepoSectionDescr =
  SectionDescr
    { sectionName :: String
sectionName = String
"repository"
    , sectionEmpty :: RemoteRepo
sectionEmpty = RepoName -> RemoteRepo
emptyRemoteRepo (String -> RepoName
RepoName String
"")
    , sectionFields :: [FieldDescr RemoteRepo]
sectionFields = [FieldDescr RemoteRepo]
remoteRepoFields
    , sectionSubsections :: [SectionDescr RemoteRepo]
sectionSubsections = []
    , sectionGet :: GlobalFlags -> [(String, RemoteRepo)]
sectionGet = GlobalFlags -> [(String, RemoteRepo)]
getS
    , sectionSet :: Int
-> String -> RemoteRepo -> GlobalFlags -> ParseResult GlobalFlags
sectionSet = Int
-> String -> RemoteRepo -> GlobalFlags -> ParseResult GlobalFlags
setS
    }
  where
    getS :: GlobalFlags -> [(String, RemoteRepo)]
    getS :: GlobalFlags -> [(String, RemoteRepo)]
getS GlobalFlags
gf =
      (RemoteRepo -> (String, RemoteRepo))
-> [RemoteRepo] -> [(String, RemoteRepo)]
forall a b. (a -> b) -> [a] -> [b]
map (\RemoteRepo
x -> (RepoName -> String
unRepoName (RepoName -> String) -> RepoName -> String
forall a b. (a -> b) -> a -> b
$ RemoteRepo -> RepoName
remoteRepoName RemoteRepo
x, RemoteRepo
x)) (NubList RemoteRepo -> [RemoteRepo]
forall a. NubList a -> [a]
fromNubList (GlobalFlags -> NubList RemoteRepo
globalRemoteRepos GlobalFlags
gf))
        [(String, RemoteRepo)]
-> [(String, RemoteRepo)] -> [(String, RemoteRepo)]
forall a. [a] -> [a] -> [a]
++ (LocalRepo -> (String, RemoteRepo))
-> [LocalRepo] -> [(String, RemoteRepo)]
forall a b. (a -> b) -> [a] -> [b]
map (\LocalRepo
x -> (RepoName -> String
unRepoName (RepoName -> String) -> RepoName -> String
forall a b. (a -> b) -> a -> b
$ LocalRepo -> RepoName
localRepoName LocalRepo
x, LocalRepo -> RemoteRepo
localToRemote LocalRepo
x)) (NubList LocalRepo -> [LocalRepo]
forall a. NubList a -> [a]
fromNubList (GlobalFlags -> NubList LocalRepo
globalLocalNoIndexRepos GlobalFlags
gf))

    setS :: Int -> String -> RemoteRepo -> GlobalFlags -> ParseResult GlobalFlags
    setS :: Int
-> String -> RemoteRepo -> GlobalFlags -> ParseResult GlobalFlags
setS Int
lineno String
reponame RemoteRepo
repo0 GlobalFlags
conf = do
      Either LocalRepo RemoteRepo
repo1 <- Int
-> String
-> RemoteRepo
-> ParseResult (Either LocalRepo RemoteRepo)
postProcessRepo Int
lineno String
reponame RemoteRepo
repo0
      case Either LocalRepo RemoteRepo
repo1 of
        Left LocalRepo
repo ->
          GlobalFlags -> ParseResult GlobalFlags
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return
            GlobalFlags
conf
              { globalLocalNoIndexRepos = overNubList (++ [repo]) (globalLocalNoIndexRepos conf)
              }
        Right RemoteRepo
repo ->
          GlobalFlags -> ParseResult GlobalFlags
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return
            GlobalFlags
conf
              { globalRemoteRepos = overNubList (++ [repo]) (globalRemoteRepos conf)
              }

    localToRemote :: LocalRepo -> RemoteRepo
    localToRemote :: LocalRepo -> RemoteRepo
localToRemote (LocalRepo RepoName
name String
path Bool
sharedCache) =
      (RepoName -> RemoteRepo
emptyRemoteRepo RepoName
name)
        { remoteRepoURI =
            normaliseFileNoIndexURI buildOS $
              URI
                "file+noindex:"
                (Just nullURIAuth)
                path
                ""
                (if sharedCache then "#shared-cache" else "")
        }

-------------------------------
-- Local field utils
--

-- | Parser combinator for simple fields which uses the field type's
-- 'Monoid' instance for combining multiple occurrences of the field.
monoidFieldParsec
  :: Monoid a
  => String
  -> (a -> Doc)
  -> ParsecParser a
  -> (b -> a)
  -> (a -> b -> b)
  -> FieldDescr b
monoidFieldParsec :: forall a b.
Monoid a =>
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
monoidFieldParsec String
name a -> Doc
showF ParsecParser a
readF b -> a
get' a -> b -> b
set =
  (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField b -> a
get' a -> b -> b
set' (FieldDescr a -> FieldDescr b) -> FieldDescr a -> FieldDescr b
forall a b. (a -> b) -> a -> b
$ String -> (a -> Doc) -> ParsecParser a -> FieldDescr a
forall a. String -> (a -> Doc) -> ParsecParser a -> FieldDescr a
ParseUtils.fieldParsec String
name a -> Doc
showF ParsecParser a
readF
  where
    set' :: a -> b -> b
set' a
xs b
b = a -> b -> b
set (b -> a
get' b
b a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
xs) b
b

-- TODO: [code cleanup] local redefinition that should replace the version in
-- D.ParseUtils called showFilePath. This version escapes "." and "--" which
-- otherwise are special syntax.
showTokenQ :: String -> Doc
showTokenQ :: String -> Doc
showTokenQ String
"" = Doc
Disp.empty
showTokenQ x :: String
x@(Char
'-' : Char
'-' : String
_) = String -> Doc
Disp.text (String -> String
forall a. Show a => a -> String
show String
x)
showTokenQ x :: String
x@(Char
'.' : []) = String -> Doc
Disp.text (String -> String
forall a. Show a => a -> String
show String
x)
showTokenQ String
x = String -> Doc
showToken String
x

-- Handy util
addFields
  :: [FieldDescr a]
  -> ([FieldDescr a] -> [FieldDescr a])
addFields :: forall a. [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
addFields = [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
forall a. [a] -> [a] -> [a]
(++)