{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Rank2Types          #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.PackageDescription.Parsec
-- Copyright   :  Isaac Jones 2003-2005
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This defined parsers and partial pretty printers for the @.cabal@ format.

module Distribution.PackageDescription.Parsec (
    -- * Package descriptions
    readGenericPackageDescription,
    parseGenericPackageDescription,
    parseGenericPackageDescriptionMaybe,

    -- ** Parsing
    ParseResult,
    runParseResult,

    -- * New-style spec-version
    scanSpecVersion,

    -- ** Supplementary build information
    readHookedBuildInfo,
    parseHookedBuildInfo,
    ) where

import Distribution.Compat.Prelude
import Prelude ()

import Control.Monad.State.Strict                    (StateT, execStateT)
import Control.Monad.Trans.Class                     (lift)
import Distribution.CabalSpecVersion
import Distribution.Compat.Lens
import Distribution.FieldGrammar
import Distribution.FieldGrammar.Parsec              (NamelessField (..))
import Distribution.Fields.ConfVar                   (parseConditionConfVar)
import Distribution.Fields.Field                     (FieldName, getName)
import Distribution.Fields.LexerMonad                (LexWarning, toPWarnings)
import Distribution.Fields.Parser
import Distribution.Fields.ParseResult
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration (freeVars, transformAllBuildInfos)
import Distribution.PackageDescription.FieldGrammar
import Distribution.PackageDescription.Quirks        (patchQuirks)
import Distribution.Parsec                           (parsec, simpleParsecBS)
import Distribution.Parsec.FieldLineStream           (fieldLineStreamFromBS)
import Distribution.Parsec.Position                  (Position (..), zeroPos)
import Distribution.Parsec.Warning                   (PWarnType (..))
import Distribution.Pretty                           (prettyShow)
import Distribution.Simple.Utils                     (fromUTF8BS, toUTF8BS)
import Distribution.Utils.Generic                    (breakMaybe, unfoldrM, validateUTF8)
import Distribution.Verbosity                        (Verbosity)
import Distribution.Version                          (Version, mkVersion, versionNumbers)

import qualified Data.ByteString                                   as BS
import qualified Data.ByteString.Char8                             as BS8
import qualified Data.Map.Strict                                   as Map
import qualified Data.Set                                          as Set
import qualified Distribution.Compat.Newtype                       as Newtype
import qualified Distribution.Compat.NonEmptySet                   as NES
import qualified Distribution.Types.BuildInfo.Lens                 as L
import qualified Distribution.Types.Executable.Lens                as L
import qualified Distribution.Types.ForeignLib.Lens                as L
import qualified Distribution.Types.GenericPackageDescription.Lens as L
import qualified Distribution.Types.PackageDescription.Lens        as L
import qualified Distribution.Types.SetupBuildInfo.Lens            as L
import qualified Text.Parsec                                       as P

-- ---------------------------------------------------------------
-- Parsing
-- ---------------------------------------------------------------

-- | Parse the given package file.
readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription
readGenericPackageDescription :: Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription = forall a.
(ByteString -> ParseResult a) -> Verbosity -> String -> IO a
readAndParseFile ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription

------------------------------------------------------------------------------
-- | Parses the given file into a 'GenericPackageDescription'.
--
-- In Cabal 1.2 the syntax for package descriptions was changed to a format
-- with sections and possibly indented property descriptions.
--
parseGenericPackageDescription :: BS.ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription :: ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription ByteString
bs = do
    -- set scanned version
    Maybe Version -> ParseResult ()
setCabalSpecVersion Maybe Version
ver

    Maybe CabalSpecVersion
csv <- case Maybe Version
ver of
        -- if we get too new version, fail right away
        Just Version
v -> case [Int] -> Maybe CabalSpecVersion
cabalSpecFromVersionDigits (Version -> [Int]
versionNumbers Version
v) of
            Just CabalSpecVersion
csv -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just CabalSpecVersion
csv)
            Maybe CabalSpecVersion
Nothing  -> forall a. Position -> String -> ParseResult a
parseFatalFailure Position
zeroPos forall a b. (a -> b) -> a -> b
$
                String
"Unsupported cabal-version " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
v forall a. [a] -> [a] -> [a]
++ String
". See https://github.com/haskell/cabal/issues/4899."
        Maybe Version
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

    case ByteString -> Either ParseError ([Field Position], [LexWarning])
readFields' ByteString
bs'' of
        Right ([Field Position]
fs, [LexWarning]
lexWarnings) -> do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
patched forall a b. (a -> b) -> a -> b
$
                Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
zeroPos PWarnType
PWTQuirkyCabalFile String
"Legacy cabal file"
            -- UTF8 is validated in a prepass step, afterwards parsing is lenient.
            Maybe CabalSpecVersion
-> [LexWarning]
-> Maybe Int
-> [Field Position]
-> ParseResult GenericPackageDescription
parseGenericPackageDescription' Maybe CabalSpecVersion
csv [LexWarning]
lexWarnings Maybe Int
invalidUtf8 [Field Position]
fs
        -- TODO: better marshalling of errors
        Left ParseError
perr -> forall a. Position -> String -> ParseResult a
parseFatalFailure Position
pos (forall a. Show a => a -> String
show ParseError
perr) where
            ppos :: SourcePos
ppos = ParseError -> SourcePos
P.errorPos ParseError
perr
            pos :: Position
pos  = Int -> Int -> Position
Position (SourcePos -> Int
P.sourceLine SourcePos
ppos) (SourcePos -> Int
P.sourceColumn SourcePos
ppos)
  where
    (Bool
patched, ByteString
bs') = ByteString -> (Bool, ByteString)
patchQuirks ByteString
bs
    ver :: Maybe Version
ver = ByteString -> Maybe Version
scanSpecVersion ByteString
bs'

    invalidUtf8 :: Maybe Int
invalidUtf8 = ByteString -> Maybe Int
validateUTF8 ByteString
bs'

    -- if there are invalid utf8 characters, we make the bytestring valid.
    bs'' :: ByteString
bs'' = case Maybe Int
invalidUtf8 of
        Maybe Int
Nothing -> ByteString
bs'
        Just Int
_  -> String -> ByteString
toUTF8BS (ByteString -> String
fromUTF8BS ByteString
bs')


-- | 'Maybe' variant of 'parseGenericPackageDescription'
parseGenericPackageDescriptionMaybe :: BS.ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe :: ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription

fieldlinesToBS :: [FieldLine ann] -> BS.ByteString
fieldlinesToBS :: forall ann. [FieldLine ann] -> ByteString
fieldlinesToBS = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(FieldLine ann
_ ByteString
bs) -> ByteString
bs)

-- Monad in which sections are parsed
type SectionParser = StateT SectionS ParseResult

-- | State of section parser
data SectionS = SectionS
    { SectionS -> GenericPackageDescription
_stateGpd           :: !GenericPackageDescription
    , SectionS -> Map String CondTreeBuildInfo
_stateCommonStanzas :: !(Map String CondTreeBuildInfo)
    }

stateGpd :: Lens' SectionS GenericPackageDescription
stateGpd :: Lens' SectionS GenericPackageDescription
stateGpd GenericPackageDescription -> f GenericPackageDescription
f (SectionS GenericPackageDescription
gpd Map String CondTreeBuildInfo
cs) = (\GenericPackageDescription
x -> GenericPackageDescription
-> Map String CondTreeBuildInfo -> SectionS
SectionS GenericPackageDescription
x Map String CondTreeBuildInfo
cs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription -> f GenericPackageDescription
f GenericPackageDescription
gpd
{-# INLINE stateGpd #-}

stateCommonStanzas :: Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas :: Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas Map String CondTreeBuildInfo -> f (Map String CondTreeBuildInfo)
f (SectionS GenericPackageDescription
gpd Map String CondTreeBuildInfo
cs) = GenericPackageDescription
-> Map String CondTreeBuildInfo -> SectionS
SectionS GenericPackageDescription
gpd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String CondTreeBuildInfo -> f (Map String CondTreeBuildInfo)
f Map String CondTreeBuildInfo
cs
{-# INLINE stateCommonStanzas #-}

-- Note [Accumulating parser]
--
-- This parser has two "states":
-- * first we parse fields of PackageDescription
-- * then we parse sections (libraries, executables, etc)
parseGenericPackageDescription'
    :: Maybe CabalSpecVersion
    -> [LexWarning]
    -> Maybe Int
    -> [Field Position]
    -> ParseResult GenericPackageDescription
parseGenericPackageDescription' :: Maybe CabalSpecVersion
-> [LexWarning]
-> Maybe Int
-> [Field Position]
-> ParseResult GenericPackageDescription
parseGenericPackageDescription' Maybe CabalSpecVersion
scannedVer [LexWarning]
lexWarnings Maybe Int
utf8WarnPos [Field Position]
fs = do
    [PWarning] -> ParseResult ()
parseWarnings ([LexWarning] -> [PWarning]
toPWarnings [LexWarning]
lexWarnings)
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Int
utf8WarnPos forall a b. (a -> b) -> a -> b
$ \Int
pos ->
        Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
zeroPos PWarnType
PWTUTF forall a b. (a -> b) -> a -> b
$ String
"UTF8 encoding problem at byte offset " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
pos
    let (Syntax
syntax, [Field Position]
fs') = forall ann. [Field ann] -> (Syntax, [Field ann])
sectionizeFields [Field Position]
fs
    let (Fields Position
fields, [Field Position]
sectionFields) = forall ann. [Field ann] -> (Fields ann, [Field ann])
takeFields [Field Position]
fs'

    -- cabal-version
    CabalSpecVersion
specVer <- case Maybe CabalSpecVersion
scannedVer of
        Just CabalSpecVersion
v  -> forall (m :: * -> *) a. Monad m => a -> m a
return CabalSpecVersion
v
        Maybe CabalSpecVersion
Nothing -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
"cabal-version" Fields Position
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [a] -> Maybe a
safeLast of
            Maybe (NamelessField Position)
Nothing                        -> forall (m :: * -> *) a. Monad m => a -> m a
return CabalSpecVersion
CabalSpecV1_0
            Just (MkNamelessField Position
pos [FieldLine Position]
fls) -> do
                -- version will be parsed twice, therefore we parse without warnings.
                CabalSpecVersion
v <- forall a. ParseResult a -> ParseResult a
withoutWarnings forall a b. (a -> b) -> a -> b
$
                    forall o n. Newtype o n => (o -> n) -> n -> o
Newtype.unpack' CabalSpecVersion -> SpecVersion
SpecVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    -- Use version with || and && but before addition of ^>= and removal of -any
                    forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
runFieldParser Position
pos forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec CabalSpecVersion
CabalSpecV1_24 [FieldLine Position]
fls

                -- if it were at the beginning, scanner would found it
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2) forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$
                    String
"cabal-version should be at the beginning of the file starting with spec version 2.2. " forall a. [a] -> [a] -> [a]
++
                    String
"See https://github.com/haskell/cabal/issues/4899"

                forall (m :: * -> *) a. Monad m => a -> m a
return CabalSpecVersion
v

    -- reset cabal version, it might not be set
    let specVer' :: Version
specVer' = [Int] -> Version
mkVersion (CabalSpecVersion -> [Int]
cabalSpecToVersionDigits CabalSpecVersion
specVer)
    Maybe Version -> ParseResult ()
setCabalSpecVersion (forall a. a -> Maybe a
Just Version
specVer')

    -- Package description
    PackageDescription
pd <- forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
specVer Fields Position
fields forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g PackageDescription),
 Applicative (g PackageIdentifier), c (Identity BuildType),
 c (Identity PackageName), c (Identity Version),
 c (List FSep FilePathNT String),
 c (List FSep CompatFilePath String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir LicenseFile))
      (SymbolicPath PackageDir LicenseFile)),
 c (List FSep TestedWith (CompilerFlavor, VersionRange)),
 c (List VCat FilePathNT String), c FilePathNT, c CompatLicenseFile,
 c CompatFilePath, c SpecLicense, c SpecVersion) =>
g PackageDescription PackageDescription
packageDescriptionFieldGrammar

    -- Check that scanned and parsed versions match.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CabalSpecVersion
specVer forall a. Eq a => a -> a -> Bool
== PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pd) forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
zeroPos forall a b. (a -> b) -> a -> b
$
        String
"Scanned and parsed cabal-versions don't match " forall a. [a] -> [a] -> [a]
++
        forall a. Pretty a => a -> String
prettyShow (CabalSpecVersion -> SpecVersion
SpecVersion CabalSpecVersion
specVer) forall a. [a] -> [a] -> [a]
++ String
" /= " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (CabalSpecVersion -> SpecVersion
SpecVersion (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pd))

    Syntax -> PackageDescription -> ParseResult ()
maybeWarnCabalVersion Syntax
syntax PackageDescription
pd

    -- Sections
    let gpd :: GenericPackageDescription
gpd = GenericPackageDescription
emptyGenericPackageDescription
            forall a b. a -> (a -> b) -> b
& Lens' GenericPackageDescription PackageDescription
L.packageDescription forall s t a b. ASetter s t a b -> b -> s -> t
.~ PackageDescription
pd
    GenericPackageDescription
gpd1 <- forall a s. Getting a s a -> s -> a
view Lens' SectionS GenericPackageDescription
stateGpd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (CabalSpecVersion -> [Field Position] -> SectionParser ()
goSections CabalSpecVersion
specVer [Field Position]
sectionFields) (GenericPackageDescription
-> Map String CondTreeBuildInfo -> SectionS
SectionS GenericPackageDescription
gpd forall k a. Map k a
Map.empty)

    let gpd2 :: GenericPackageDescription
gpd2 = CabalSpecVersion
-> GenericPackageDescription -> GenericPackageDescription
postProcessInternalDeps CabalSpecVersion
specVer GenericPackageDescription
gpd1
    GenericPackageDescription -> ParseResult ()
checkForUndefinedFlags GenericPackageDescription
gpd2
    GenericPackageDescription -> ParseResult ()
checkForUndefinedCustomSetup GenericPackageDescription
gpd2
    -- See nothunks test, without this deepseq we get (at least):
    -- Thunk in ThunkInfo {thunkContext = ["PackageIdentifier","PackageDescription","GenericPackageDescription"]}
    --
    -- TODO: re-benchmark, whether `deepseq` is important (both cabal-benchmarks and solver-benchmarks)
    -- TODO: remove the need for deepseq if `deepseq` in fact matters
    -- NOTE: IIRC it does affect (maximal) memory usage, which causes less GC pressure
    GenericPackageDescription
gpd2 forall a b. NFData a => a -> b -> b
`deepseq` forall (m :: * -> *) a. Monad m => a -> m a
return GenericPackageDescription
gpd2
  where
    safeLast :: [a] -> Maybe a
    safeLast :: forall a. [a] -> Maybe a
safeLast = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

    newSyntaxVersion :: CabalSpecVersion
    newSyntaxVersion :: CabalSpecVersion
newSyntaxVersion = CabalSpecVersion
CabalSpecV1_2

    maybeWarnCabalVersion :: Syntax -> PackageDescription -> ParseResult ()
    maybeWarnCabalVersion :: Syntax -> PackageDescription -> ParseResult ()
maybeWarnCabalVersion Syntax
syntax PackageDescription
pkg
      | Syntax
syntax forall a. Eq a => a -> a -> Bool
== Syntax
NewSyntax Bool -> Bool -> Bool
&& PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
newSyntaxVersion
      = Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
zeroPos PWarnType
PWTNewSyntax forall a b. (a -> b) -> a -> b
$
             String
"A package using section syntax must specify at least\n"
          forall a. [a] -> [a] -> [a]
++ String
"'cabal-version: >= 1.2'."

    maybeWarnCabalVersion Syntax
syntax PackageDescription
pkg
      | Syntax
syntax forall a. Eq a => a -> a -> Bool
== Syntax
OldSyntax Bool -> Bool -> Bool
&& PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
newSyntaxVersion
      = Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
zeroPos PWarnType
PWTOldSyntax forall a b. (a -> b) -> a -> b
$
             String
"A package using 'cabal-version: "
          forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (CabalSpecVersion -> SpecVersion
SpecVersion (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg))
          forall a. [a] -> [a] -> [a]
++ String
"' must use section syntax. See the Cabal user guide for details."

    maybeWarnCabalVersion Syntax
_ PackageDescription
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

goSections :: CabalSpecVersion -> [Field Position] -> SectionParser ()
goSections :: CabalSpecVersion -> [Field Position] -> SectionParser ()
goSections CabalSpecVersion
specVer = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Field Position -> SectionParser ()
process
  where
    process :: Field Position -> SectionParser ()
process (Field (Name Position
pos ByteString
name) [FieldLine Position]
_) =
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTTrailingFields forall a b. (a -> b) -> a -> b
$
            String
"Ignoring trailing fields after sections: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
name
    process (Section Name Position
name [SectionArg Position]
args [Field Position]
secFields) =
        Name Position
-> [SectionArg Position] -> [Field Position] -> SectionParser ()
parseSection Name Position
name [SectionArg Position]
args [Field Position]
secFields

    snoc :: a -> [a] -> [a]
snoc a
x [a]
xs = [a]
xs forall a. [a] -> [a] -> [a]
++ [a
x]

    hasCommonStanzas :: HasCommonStanzas
hasCommonStanzas = CabalSpecVersion -> HasCommonStanzas
specHasCommonStanzas CabalSpecVersion
specVer

    -- we need signature, because this is polymorphic, but not-closed
    parseCondTree'
        :: L.HasBuildInfo a
        => ParsecFieldGrammar' a       -- ^ grammar
        -> (BuildInfo -> a)
        -> Map String CondTreeBuildInfo  -- ^ common stanzas
        -> [Field Position]
        -> ParseResult (CondTree ConfVar [Dependency] a)
    parseCondTree' :: forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' = forall a.
HasBuildInfo a =>
CabalSpecVersion
-> ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTreeWithCommonStanzas CabalSpecVersion
specVer

    parseSection :: Name Position -> [SectionArg Position] -> [Field Position] -> SectionParser ()
    parseSection :: Name Position
-> [SectionArg Position] -> [Field Position] -> SectionParser ()
parseSection (Name Position
pos ByteString
name) [SectionArg Position]
args [Field Position]
fields
        | HasCommonStanzas
hasCommonStanzas forall a. Eq a => a -> a -> Bool
== HasCommonStanzas
NoCommonStanzas, ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"common" = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
          Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownSection forall a b. (a -> b) -> a -> b
$ String
"Ignoring section: common. You should set cabal-version: 2.2 or larger to use common stanzas."

        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"common" = do
            Map String CondTreeBuildInfo
commonStanzas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
            String
name' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Position -> [SectionArg Position] -> ParseResult String
parseCommonName Position
pos [SectionArg Position]
args
            CondTreeBuildInfo
biTree <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar forall a. a -> a
id Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields

            case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name' Map String CondTreeBuildInfo
commonStanzas of
                Maybe CondTreeBuildInfo
Nothing -> Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name' CondTreeBuildInfo
biTree Map String CondTreeBuildInfo
commonStanzas
                Just CondTreeBuildInfo
_  -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$
                    String
"Duplicate common stanza: " forall a. [a] -> [a] -> [a]
++ String
name'

        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"library" Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SectionArg Position]
args = do
            Maybe (CondTree ConfVar [Dependency] Library)
prev <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' SectionS GenericPackageDescription
stateGpd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
L.condLibrary
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (CondTree ConfVar [Dependency] Library)
prev) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$
                String
"Multiple main libraries; have you forgotten to specify a name for an internal library?"

            Map String CondTreeBuildInfo
commonStanzas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
            let name'' :: LibraryName
name'' = LibraryName
LMainLibName
            CondTree ConfVar [Dependency] Library
lib <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Library),
 Applicative (g BuildInfo), c (Identity LibraryVisibility),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List CommaVCat (Identity ModuleReexport) ModuleReexport),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
LibraryName -> g Library Library
libraryFieldGrammar LibraryName
name'') (LibraryName -> BuildInfo -> Library
libraryFromBuildInfo LibraryName
name'') Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields
            --
            -- TODO check that not set
            Lens' SectionS GenericPackageDescription
stateGpd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
L.condLibrary forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= CondTree ConfVar [Dependency] Library
lib

        -- Sublibraries
        -- TODO: check cabal-version
        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"library" = do
            Map String CondTreeBuildInfo
commonStanzas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
            UnqualComponentName
name' <- Position
-> [SectionArg Position] -> SectionParser UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
            let name'' :: LibraryName
name'' = UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
name'
            CondTree ConfVar [Dependency] Library
lib   <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Library),
 Applicative (g BuildInfo), c (Identity LibraryVisibility),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List CommaVCat (Identity ModuleReexport) ModuleReexport),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
LibraryName -> g Library Library
libraryFieldGrammar LibraryName
name'') (LibraryName -> BuildInfo -> Library
libraryFromBuildInfo LibraryName
name'') Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields
            -- TODO check duplicate name here?
            Lens' SectionS GenericPackageDescription
stateGpd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
L.condSubLibraries forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar [Dependency] Library
lib)

        -- TODO: check cabal-version
        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"foreign-library" = do
            Map String CondTreeBuildInfo
commonStanzas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
            UnqualComponentName
name' <- Position
-> [SectionArg Position] -> SectionParser UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
            CondTree ConfVar [Dependency] ForeignLib
flib  <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g ForeignLib),
 Applicative (g BuildInfo), c (Identity ForeignLibType),
 c (Identity LibVersionInfo), c (Identity Version),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (Identity ForeignLibOption) ForeignLibOption),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String), c (List VCat Token String),
 c (MQuoted Language)) =>
UnqualComponentName -> g ForeignLib ForeignLib
foreignLibFieldGrammar UnqualComponentName
name') (forall a. FromBuildInfo a => UnqualComponentName -> BuildInfo -> a
fromBuildInfo' UnqualComponentName
name') Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields

            let hasType :: ForeignLib -> Bool
hasType ForeignLib
ts = ForeignLib -> ForeignLibType
foreignLibType ForeignLib
ts forall a. Eq a => a -> a -> Bool
/= ForeignLib -> ForeignLibType
foreignLibType forall a. Monoid a => a
mempty
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
onAllBranches ForeignLib -> Bool
hasType CondTree ConfVar [Dependency] ForeignLib
flib) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ String
"Foreign library " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name')
                , String
" is missing required field \"type\" or the field "
                , String
"is not present in all conditional branches. The "
                , String
"available test types are: "
                , forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [ForeignLibType]
knownForeignLibTypes)
                ]

            -- TODO check duplicate name here?
            Lens' SectionS GenericPackageDescription
stateGpd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
L.condForeignLibs forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar [Dependency] ForeignLib
flib)

        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"executable" = do
            Map String CondTreeBuildInfo
commonStanzas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
            UnqualComponentName
name' <- Position
-> [SectionArg Position] -> SectionParser UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
            CondTree ConfVar [Dependency] Executable
exe   <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Executable),
 Applicative (g BuildInfo), c (Identity ExecutableScope),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String), c (List VCat Token String),
 c (MQuoted Language)) =>
UnqualComponentName -> g Executable Executable
executableFieldGrammar UnqualComponentName
name') (forall a. FromBuildInfo a => UnqualComponentName -> BuildInfo -> a
fromBuildInfo' UnqualComponentName
name') Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields
            -- TODO check duplicate name here?
            Lens' SectionS GenericPackageDescription
stateGpd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
L.condExecutables forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar [Dependency] Executable
exe)

        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"test-suite" = do
            Map String CondTreeBuildInfo
commonStanzas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
            UnqualComponentName
name'      <- Position
-> [SectionArg Position] -> SectionParser UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
            CondTree ConfVar [Dependency] TestSuiteStanza
testStanza <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g TestSuiteStanza),
 Applicative (g BuildInfo), c (Identity ModuleName),
 c (Identity TestType),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
g TestSuiteStanza TestSuiteStanza
testSuiteFieldGrammar (forall a. FromBuildInfo a => UnqualComponentName -> BuildInfo -> a
fromBuildInfo' UnqualComponentName
name') Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields
            CondTree ConfVar [Dependency] TestSuite
testSuite  <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Position -> TestSuiteStanza -> ParseResult TestSuite
validateTestSuite Position
pos) CondTree ConfVar [Dependency] TestSuiteStanza
testStanza

            let hasType :: TestSuite -> Bool
hasType TestSuite
ts = TestSuite -> TestSuiteInterface
testInterface TestSuite
ts forall a. Eq a => a -> a -> Bool
/= TestSuite -> TestSuiteInterface
testInterface forall a. Monoid a => a
mempty
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
onAllBranches TestSuite -> Bool
hasType CondTree ConfVar [Dependency] TestSuite
testSuite) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ String
"Test suite " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name')
                , String
" is missing required field \"type\" or the field "
                , String
"is not present in all conditional branches. The "
                , String
"available test types are: "
                , forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [TestType]
knownTestTypes)
                ]

            -- TODO check duplicate name here?
            Lens' SectionS GenericPackageDescription
stateGpd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
L.condTestSuites forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar [Dependency] TestSuite
testSuite)

        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"benchmark" = do
            Map String CondTreeBuildInfo
commonStanzas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
            UnqualComponentName
name'       <- Position
-> [SectionArg Position] -> SectionParser UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
            CondTree ConfVar [Dependency] BenchmarkStanza
benchStanza <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BenchmarkStanza),
 Applicative (g BuildInfo), c (Identity BenchmarkType),
 c (Identity ModuleName),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
g BenchmarkStanza BenchmarkStanza
benchmarkFieldGrammar (forall a. FromBuildInfo a => UnqualComponentName -> BuildInfo -> a
fromBuildInfo' UnqualComponentName
name') Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields
            CondTree ConfVar [Dependency] Benchmark
bench       <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Position -> BenchmarkStanza -> ParseResult Benchmark
validateBenchmark Position
pos) CondTree ConfVar [Dependency] BenchmarkStanza
benchStanza

            let hasType :: Benchmark -> Bool
hasType Benchmark
ts = Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
ts forall a. Eq a => a -> a -> Bool
/= Benchmark -> BenchmarkInterface
benchmarkInterface forall a. Monoid a => a
mempty
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
onAllBranches Benchmark -> Bool
hasType CondTree ConfVar [Dependency] Benchmark
bench) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ String
"Benchmark " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name')
                , String
" is missing required field \"type\" or the field "
                , String
"is not present in all conditional branches. The "
                , String
"available benchmark types are: "
                , forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [BenchmarkType]
knownBenchmarkTypes)
                ]

            -- TODO check duplicate name here?
            Lens' SectionS GenericPackageDescription
stateGpd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
L.condBenchmarks forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar [Dependency] Benchmark
bench)

        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"flag" = do
            ByteString
name'  <- Position -> [SectionArg Position] -> SectionParser ByteString
parseNameBS Position
pos [SectionArg Position]
args
            FlagName
name'' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
[Position]
-> ParsecParser a
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult a
runFieldParser' [Position
pos] forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec CabalSpecVersion
specVer (ByteString -> FieldLineStream
fieldLineStreamFromBS ByteString
name') forall a. ParseResult a -> a -> ParseResult a
`recoverWith` String -> FlagName
mkFlagName String
""
            PackageFlag
flag   <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult a
parseFields CabalSpecVersion
specVer [Field Position]
fields (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g PackageFlag)) =>
FlagName -> g PackageFlag PackageFlag
flagFieldGrammar FlagName
name'')
            -- Check default flag
            Lens' SectionS GenericPackageDescription
stateGpd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GenericPackageDescription [PackageFlag]
L.genPackageFlags forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {a}. a -> [a] -> [a]
snoc PackageFlag
flag

        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"custom-setup" Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SectionArg Position]
args = do
            SetupBuildInfo
sbi <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult a
parseFields CabalSpecVersion
specVer [Field Position]
fields  (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Functor (g SetupBuildInfo),
 c (List CommaVCat (Identity Dependency) Dependency)) =>
Bool -> g SetupBuildInfo SetupBuildInfo
setupBInfoFieldGrammar Bool
False)
            Lens' SectionS GenericPackageDescription
stateGpd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GenericPackageDescription PackageDescription
L.packageDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageDescription (Maybe SetupBuildInfo)
L.setupBuildInfo forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= SetupBuildInfo
sbi

        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"source-repository" = do
            RepoKind
kind <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ case [SectionArg Position]
args of
                [SecArgName Position
spos ByteString
secName] ->
                    forall a.
[Position]
-> ParsecParser a
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult a
runFieldParser' [Position
spos] forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec CabalSpecVersion
specVer (ByteString -> FieldLineStream
fieldLineStreamFromBS ByteString
secName) forall a. ParseResult a -> a -> ParseResult a
`recoverWith` RepoKind
RepoHead
                [] -> do
                    Position -> String -> ParseResult ()
parseFailure Position
pos String
"'source-repository' requires exactly one argument"
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoKind
RepoHead
                [SectionArg Position]
_ -> do
                    Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$ String
"Invalid source-repository kind " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [SectionArg Position]
args
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoKind
RepoHead

            SourceRepo
sr <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult a
parseFields CabalSpecVersion
specVer [Field Position]
fields (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepo),
 c (Identity RepoType), c Token, c FilePathNT) =>
RepoKind -> g SourceRepo SourceRepo
sourceRepoFieldGrammar RepoKind
kind)
            Lens' SectionS GenericPackageDescription
stateGpd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GenericPackageDescription PackageDescription
L.packageDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageDescription [SourceRepo]
L.sourceRepos forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {a}. a -> [a] -> [a]
snoc SourceRepo
sr

        | Bool
otherwise = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
            Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownSection forall a b. (a -> b) -> a -> b
$ String
"Ignoring section: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
name

parseName :: Position -> [SectionArg Position] -> SectionParser String
parseName :: Position
-> [SectionArg Position] -> StateT SectionS ParseResult String
parseName Position
pos [SectionArg Position]
args = ByteString -> String
fromUTF8BS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> [SectionArg Position] -> SectionParser ByteString
parseNameBS Position
pos [SectionArg Position]
args

parseNameBS :: Position -> [SectionArg Position] -> SectionParser BS.ByteString
-- TODO: use strict parser
parseNameBS :: Position -> [SectionArg Position] -> SectionParser ByteString
parseNameBS Position
pos [SectionArg Position]
args = case [SectionArg Position]
args of
    [SecArgName Position
_pos ByteString
secName] ->
         forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
secName
    [SecArgStr Position
_pos ByteString
secName] ->
         forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
secName
    [] -> do
         forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos String
"name required"
         forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
""
    [SectionArg Position]
_ -> do
         -- TODO: pretty print args
         forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$ String
"Invalid name " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [SectionArg Position]
args
         forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
""

parseCommonName :: Position -> [SectionArg Position] -> ParseResult String
parseCommonName :: Position -> [SectionArg Position] -> ParseResult String
parseCommonName Position
pos [SectionArg Position]
args = case [SectionArg Position]
args of
    [SecArgName Position
_pos ByteString
secName] ->
         forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> String
fromUTF8BS ByteString
secName
    [SecArgStr Position
_pos ByteString
secName] ->
         forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> String
fromUTF8BS ByteString
secName
    [] -> do
         Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$ String
"name required"
         forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
    [SectionArg Position]
_ -> do
         -- TODO: pretty print args
         Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$ String
"Invalid name " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [SectionArg Position]
args
         forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""

-- TODO: avoid conversion to 'String'.
parseUnqualComponentName :: Position -> [SectionArg Position] -> SectionParser UnqualComponentName
parseUnqualComponentName :: Position
-> [SectionArg Position] -> SectionParser UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args = String -> UnqualComponentName
mkUnqualComponentName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> [SectionArg Position] -> StateT SectionS ParseResult String
parseName Position
pos [SectionArg Position]
args

-- | Parse a non-recursive list of fields.
parseFields
    :: CabalSpecVersion
    -> [Field Position] -- ^ fields to be parsed
    -> ParsecFieldGrammar' a
    -> ParseResult a
parseFields :: forall a.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult a
parseFields CabalSpecVersion
v [Field Position]
fields ParsecFieldGrammar' a
grammar = do
    let (Fields Position
fs0, [[Section Position]]
ss) = forall ann. [Field ann] -> (Fields ann, [[Section ann]])
partitionFields [Field Position]
fields
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Section Position -> ParseResult ()
warnInvalidSubsection) [[Section Position]]
ss
    forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
v Fields Position
fs0 ParsecFieldGrammar' a
grammar

warnInvalidSubsection :: Section Position -> ParseResult ()
warnInvalidSubsection :: Section Position -> ParseResult ()
warnInvalidSubsection (MkSection (Name Position
pos ByteString
name) [SectionArg Position]
_ [Field Position]
_) =
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$ String
"invalid subsection " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
name

parseCondTree
    :: forall a. L.HasBuildInfo a
    => CabalSpecVersion
    -> HasElif                        -- ^ accept @elif@
    -> ParsecFieldGrammar' a          -- ^ grammar
    -> Map String CondTreeBuildInfo   -- ^ common stanzas
    -> (BuildInfo -> a)               -- ^ constructor from buildInfo
    -> (a -> [Dependency])            -- ^ condition extractor
    -> [Field Position]
    -> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree :: forall a.
HasBuildInfo a =>
CabalSpecVersion
-> HasElif
-> ParsecFieldGrammar' a
-> Map String CondTreeBuildInfo
-> (BuildInfo -> a)
-> (a -> [Dependency])
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree CabalSpecVersion
v HasElif
hasElif ParsecFieldGrammar' a
grammar Map String CondTreeBuildInfo
commonStanzas BuildInfo -> a
fromBuildInfo a -> [Dependency]
cond = [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go
  where
    go :: [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go [Field Position]
fields0 = do
        ([Field Position]
fields, CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a
endo) <-
            if CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0
            then forall a.
HasBuildInfo a =>
CabalSpecVersion
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult
     ([Field Position],
      CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
processImports CabalSpecVersion
v BuildInfo -> a
fromBuildInfo Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields0
            else forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (CabalSpecVersion
-> Field Position -> ParseResult (Maybe (Field Position))
warnImport CabalSpecVersion
v) [Field Position]
fields0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Maybe (Field Position)]
fields1 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [Maybe a] -> [a]
catMaybes [Maybe (Field Position)]
fields1, forall a. a -> a
id)

        let (Fields Position
fs, [[Section Position]]
ss) = forall ann. [Field ann] -> (Fields ann, [[Section ann]])
partitionFields [Field Position]
fields
        a
x <- forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
v Fields Position
fs ParsecFieldGrammar' a
grammar
        [CondBranch ConfVar [Dependency] a]
branches <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs [[Section Position]]
ss
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a
endo forall a b. (a -> b) -> a -> b
$ forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode a
x (a -> [Dependency]
cond a
x) [CondBranch ConfVar [Dependency] a]
branches

    parseIfs :: [Section Position] -> ParseResult [CondBranch ConfVar [Dependency] a]
    parseIfs :: [Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
    parseIfs (MkSection (Name Position
_ ByteString
name) [SectionArg Position]
test [Field Position]
fields : [Section Position]
sections) | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"if" = do
        Condition ConfVar
test' <- [SectionArg Position] -> ParseResult (Condition ConfVar)
parseConditionConfVar [SectionArg Position]
test
        CondTree ConfVar [Dependency] a
fields' <- [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go [Field Position]
fields
        (Maybe (CondTree ConfVar [Dependency] a)
elseFields, [CondBranch ConfVar [Dependency] a]
sections') <- [Section Position]
-> ParseResult
     (Maybe (CondTree ConfVar [Dependency] a),
      [CondBranch ConfVar [Dependency] a])
parseElseIfs [Section Position]
sections
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall v c a.
Condition v
-> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a
CondBranch Condition ConfVar
test' CondTree ConfVar [Dependency] a
fields' Maybe (CondTree ConfVar [Dependency] a)
elseFields forall {a}. a -> [a] -> [a]
: [CondBranch ConfVar [Dependency] a]
sections')
    parseIfs (MkSection (Name Position
pos ByteString
name) [SectionArg Position]
_ [Field Position]
_ : [Section Position]
sections) = do
        Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTInvalidSubsection forall a b. (a -> b) -> a -> b
$ String
"invalid subsection " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
name
        [Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs [Section Position]
sections

    parseElseIfs
        :: [Section Position]
        -> ParseResult (Maybe (CondTree ConfVar [Dependency] a), [CondBranch ConfVar [Dependency] a])
    parseElseIfs :: [Section Position]
-> ParseResult
     (Maybe (CondTree ConfVar [Dependency] a),
      [CondBranch ConfVar [Dependency] a])
parseElseIfs [] = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, [])
    parseElseIfs (MkSection (Name Position
pos ByteString
name) [SectionArg Position]
args [Field Position]
fields : [Section Position]
sections) | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"else" = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SectionArg Position]
args) forall a b. (a -> b) -> a -> b
$
            Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$ String
"`else` section has section arguments " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [SectionArg Position]
args
        CondTree ConfVar [Dependency] a
elseFields <- [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go [Field Position]
fields
        [CondBranch ConfVar [Dependency] a]
sections' <- [Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs [Section Position]
sections
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just CondTree ConfVar [Dependency] a
elseFields, [CondBranch ConfVar [Dependency] a]
sections')

    parseElseIfs (MkSection (Name Position
_ ByteString
name) [SectionArg Position]
test [Field Position]
fields : [Section Position]
sections) | HasElif
hasElif forall a. Eq a => a -> a -> Bool
== HasElif
HasElif, ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"elif" = do
        Condition ConfVar
test' <- [SectionArg Position] -> ParseResult (Condition ConfVar)
parseConditionConfVar [SectionArg Position]
test
        CondTree ConfVar [Dependency] a
fields' <- [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go [Field Position]
fields
        (Maybe (CondTree ConfVar [Dependency] a)
elseFields, [CondBranch ConfVar [Dependency] a]
sections') <- [Section Position]
-> ParseResult
     (Maybe (CondTree ConfVar [Dependency] a),
      [CondBranch ConfVar [Dependency] a])
parseElseIfs [Section Position]
sections
        -- we parse an empty 'Fields', to get empty value for a node
        a
a <- forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
v forall a. Monoid a => a
mempty ParsecFieldGrammar' a
grammar
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode a
a (a -> [Dependency]
cond a
a) [forall v c a.
Condition v
-> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a
CondBranch Condition ConfVar
test' CondTree ConfVar [Dependency] a
fields' Maybe (CondTree ConfVar [Dependency] a)
elseFields], [CondBranch ConfVar [Dependency] a]
sections')

    parseElseIfs (MkSection (Name Position
pos ByteString
name) [SectionArg Position]
_ [Field Position]
_ : [Section Position]
sections) | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"elif" = do
        Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTInvalidSubsection forall a b. (a -> b) -> a -> b
$ String
"invalid subsection \"elif\". You should set cabal-version: 2.2 or larger to use elif-conditionals."
        (,) forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs [Section Position]
sections

    parseElseIfs [Section Position]
sections = (,) forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs [Section Position]
sections

{- Note [Accumulating parser]

Note: Outdated a bit

In there parser, @'FieldDescr' a@ is transformed into @Map FieldName (a ->
FieldParser a)@.  The weird value is used because we accumulate structure of
@a@ by folding over the fields.  There are various reasons for that:

* Almost all fields are optional

* This is simple approach so declarative bi-directional format (parsing and
printing) of structure could be specified (list of @'FieldDescr' a@)

* There are surface syntax fields corresponding to single field in the file:
  @license-file@ and @license-files@

* This is quite safe approach.

When/if we re-implement the parser to support formatting preservging roundtrip
with new AST, this all need to be rewritten.
-}

-------------------------------------------------------------------------------
-- Common stanzas
-------------------------------------------------------------------------------

-- $commonStanzas
--
-- [Note: Common stanzas]
--
-- In Cabal 2.2 we support simple common stanzas:
--
-- * Commons stanzas define 'BuildInfo'
--
-- * import "fields" can only occur at top of other stanzas (think: imports)
--
-- In particular __there aren't__
--
-- * implicit stanzas
--
-- * More specific common stanzas (executable, test-suite).
--
--
-- The approach uses the fact that 'BuildInfo' is a 'Monoid':
--
-- @
-- mergeCommonStanza' :: HasBuildInfo comp => BuildInfo -> comp -> comp
-- mergeCommonStanza' bi = over L.BuildInfo (bi <>)
-- @
--
-- Real 'mergeCommonStanza' is more complicated as we have to deal with
-- conditional trees.
--
-- The approach is simple, and have good properties:
--
-- * Common stanzas are parsed exactly once, even if not-used. Thus we report errors in them.
--
type CondTreeBuildInfo = CondTree ConfVar [Dependency] BuildInfo

-- | Create @a@ from 'BuildInfo'.
-- This class is used to implement common stanza parsing.
--
-- Law: @view buildInfo . fromBuildInfo = id@
--
-- This takes name, as 'FieldGrammar's take names too.
class L.HasBuildInfo a => FromBuildInfo a where
    fromBuildInfo' :: UnqualComponentName -> BuildInfo -> a

libraryFromBuildInfo :: LibraryName -> BuildInfo -> Library
libraryFromBuildInfo :: LibraryName -> BuildInfo -> Library
libraryFromBuildInfo LibraryName
n BuildInfo
bi = Library
emptyLibrary
    { libName :: LibraryName
libName       = LibraryName
n
    , libVisibility :: LibraryVisibility
libVisibility = case LibraryName
n of
        LibraryName
LMainLibName  -> LibraryVisibility
LibraryVisibilityPublic
        LSubLibName UnqualComponentName
_ -> LibraryVisibility
LibraryVisibilityPrivate
    , libBuildInfo :: BuildInfo
libBuildInfo  = BuildInfo
bi
    }

instance FromBuildInfo BuildInfo  where fromBuildInfo' :: UnqualComponentName -> BuildInfo -> BuildInfo
fromBuildInfo' UnqualComponentName
_ = forall a. a -> a
id
instance FromBuildInfo ForeignLib where fromBuildInfo' :: UnqualComponentName -> BuildInfo -> ForeignLib
fromBuildInfo' UnqualComponentName
n BuildInfo
bi = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ForeignLib UnqualComponentName
L.foreignLibName UnqualComponentName
n forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasBuildInfo a => Lens' a BuildInfo
L.buildInfo BuildInfo
bi ForeignLib
emptyForeignLib
instance FromBuildInfo Executable where fromBuildInfo' :: UnqualComponentName -> BuildInfo -> Executable
fromBuildInfo' UnqualComponentName
n BuildInfo
bi = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Executable UnqualComponentName
L.exeName        UnqualComponentName
n forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasBuildInfo a => Lens' a BuildInfo
L.buildInfo BuildInfo
bi Executable
emptyExecutable

instance FromBuildInfo TestSuiteStanza where
    fromBuildInfo' :: UnqualComponentName -> BuildInfo -> TestSuiteStanza
fromBuildInfo' UnqualComponentName
_ BuildInfo
bi = Maybe TestType
-> Maybe String -> Maybe ModuleName -> BuildInfo -> TestSuiteStanza
TestSuiteStanza forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing BuildInfo
bi

instance FromBuildInfo BenchmarkStanza where
    fromBuildInfo' :: UnqualComponentName -> BuildInfo -> BenchmarkStanza
fromBuildInfo' UnqualComponentName
_ BuildInfo
bi = Maybe BenchmarkType
-> Maybe String -> Maybe ModuleName -> BuildInfo -> BenchmarkStanza
BenchmarkStanza forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing BuildInfo
bi

parseCondTreeWithCommonStanzas
    :: forall a. L.HasBuildInfo a
    => CabalSpecVersion
    -> ParsecFieldGrammar' a       -- ^ grammar
    -> (BuildInfo -> a)              -- ^ construct fromBuildInfo
    -> Map String CondTreeBuildInfo  -- ^ common stanzas
    -> [Field Position]
    -> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTreeWithCommonStanzas :: forall a.
HasBuildInfo a =>
CabalSpecVersion
-> ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTreeWithCommonStanzas CabalSpecVersion
v ParsecFieldGrammar' a
grammar BuildInfo -> a
fromBuildInfo Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields = do
    ([Field Position]
fields', CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a
endo) <- forall a.
HasBuildInfo a =>
CabalSpecVersion
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult
     ([Field Position],
      CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
processImports CabalSpecVersion
v BuildInfo -> a
fromBuildInfo Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields
    CondTree ConfVar [Dependency] a
x <- forall a.
HasBuildInfo a =>
CabalSpecVersion
-> HasElif
-> ParsecFieldGrammar' a
-> Map String CondTreeBuildInfo
-> (BuildInfo -> a)
-> (a -> [Dependency])
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree CabalSpecVersion
v HasElif
hasElif ParsecFieldGrammar' a
grammar Map String CondTreeBuildInfo
commonStanzas BuildInfo -> a
fromBuildInfo (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [Dependency]
L.targetBuildDepends) [Field Position]
fields'
    forall (m :: * -> *) a. Monad m => a -> m a
return (CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a
endo CondTree ConfVar [Dependency] a
x)
  where
    hasElif :: HasElif
hasElif = CabalSpecVersion -> HasElif
specHasElif CabalSpecVersion
v

processImports
    :: forall a. L.HasBuildInfo a
    => CabalSpecVersion
    -> (BuildInfo -> a)              -- ^ construct fromBuildInfo
    -> Map String CondTreeBuildInfo  -- ^ common stanzas
    -> [Field Position]
    -> ParseResult ([Field Position], CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
processImports :: forall a.
HasBuildInfo a =>
CabalSpecVersion
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult
     ([Field Position],
      CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
processImports CabalSpecVersion
v BuildInfo -> a
fromBuildInfo Map String CondTreeBuildInfo
commonStanzas = [CondTreeBuildInfo]
-> [Field Position]
-> ParseResult
     ([Field Position],
      CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
go []
  where
    hasCommonStanzas :: HasCommonStanzas
hasCommonStanzas = CabalSpecVersion -> HasCommonStanzas
specHasCommonStanzas CabalSpecVersion
v

    getList' :: List CommaFSep Token String -> [String]
    getList' :: List CommaFSep Token String -> [String]
getList' = forall o n. Newtype o n => n -> o
Newtype.unpack

    go :: [CondTreeBuildInfo]
-> [Field Position]
-> ParseResult
     ([Field Position],
      CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
go [CondTreeBuildInfo]
acc (Field (Name Position
pos ByteString
name) [FieldLine Position]
_ : [Field Position]
fields) | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"import", HasCommonStanzas
hasCommonStanzas forall a. Eq a => a -> a -> Bool
== HasCommonStanzas
NoCommonStanzas = do
        Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownField String
"Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas"
        [CondTreeBuildInfo]
-> [Field Position]
-> ParseResult
     ([Field Position],
      CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
go [CondTreeBuildInfo]
acc [Field Position]
fields
    -- supported:
    go [CondTreeBuildInfo]
acc (Field (Name Position
pos ByteString
name) [FieldLine Position]
fls : [Field Position]
fields) | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"import" = do
        [String]
names <- List CommaFSep Token String -> [String]
getList' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
runFieldParser Position
pos forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec CabalSpecVersion
v [FieldLine Position]
fls
        [Maybe CondTreeBuildInfo]
names' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [String]
names forall a b. (a -> b) -> a -> b
$ \String
commonName ->
            case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
commonName Map String CondTreeBuildInfo
commonStanzas of
                Maybe CondTreeBuildInfo
Nothing -> do
                    Position -> String -> ParseResult ()
parseFailure Position
pos forall a b. (a -> b) -> a -> b
$ String
"Undefined common stanza imported: " forall a. [a] -> [a] -> [a]
++ String
commonName
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
                Just CondTreeBuildInfo
commonTree ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just CondTreeBuildInfo
commonTree)

        [CondTreeBuildInfo]
-> [Field Position]
-> ParseResult
     ([Field Position],
      CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
go ([CondTreeBuildInfo]
acc forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes [Maybe CondTreeBuildInfo]
names') [Field Position]
fields

    -- parse actual CondTree
    go [CondTreeBuildInfo]
acc [Field Position]
fields = do
        [Field Position]
fields' <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (CabalSpecVersion
-> Field Position -> ParseResult (Maybe (Field Position))
warnImport CabalSpecVersion
v) [Field Position]
fields
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ([Field Position]
fields', \CondTree ConfVar [Dependency] a
x -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a.
HasBuildInfo a =>
(BuildInfo -> a)
-> CondTreeBuildInfo
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a
mergeCommonStanza BuildInfo -> a
fromBuildInfo) CondTree ConfVar [Dependency] a
x [CondTreeBuildInfo]
acc)

-- | Warn on "import" fields, also map to Maybe, so errorneous fields can be filtered
warnImport :: CabalSpecVersion -> Field Position -> ParseResult (Maybe (Field Position))
warnImport :: CabalSpecVersion
-> Field Position -> ParseResult (Maybe (Field Position))
warnImport CabalSpecVersion
v (Field (Name Position
pos ByteString
name) [FieldLine Position]
_) | ByteString
name forall a. Eq a => a -> a -> Bool
==  ByteString
"import" = do
    if CabalSpecVersion -> HasCommonStanzas
specHasCommonStanzas CabalSpecVersion
v forall a. Eq a => a -> a -> Bool
== HasCommonStanzas
NoCommonStanzas
    then Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownField String
"Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas"
    else Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownField String
"Unknown field: import. Common stanza imports should be at the top of the enclosing section"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
warnImport CabalSpecVersion
_ Field Position
f = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Field Position
f)

mergeCommonStanza
    :: L.HasBuildInfo a
    => (BuildInfo -> a)
    -> CondTree ConfVar [Dependency] BuildInfo
    -> CondTree ConfVar [Dependency] a
    -> CondTree ConfVar [Dependency] a
mergeCommonStanza :: forall a.
HasBuildInfo a =>
(BuildInfo -> a)
-> CondTreeBuildInfo
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a
mergeCommonStanza BuildInfo -> a
fromBuildInfo (CondNode BuildInfo
bi [Dependency]
_ [CondBranch ConfVar [Dependency] BuildInfo]
bis) (CondNode a
x [Dependency]
_ [CondBranch ConfVar [Dependency] a]
cs) =
    forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode a
x' (a
x' forall s a. s -> Getting a s a -> a
^. forall a. HasBuildInfo a => Lens' a [Dependency]
L.targetBuildDepends) [CondBranch ConfVar [Dependency] a]
cs'
  where
    -- new value is old value with buildInfo field _prepended_.
    x' :: a
x' = a
x forall a b. a -> (a -> b) -> b
& forall a. HasBuildInfo a => Lens' a BuildInfo
L.buildInfo forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (BuildInfo
bi forall a. Semigroup a => a -> a -> a
<>)

    -- tree components are appended together.
    cs' :: [CondBranch ConfVar [Dependency] a]
cs' = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BuildInfo -> a
fromBuildInfo) [CondBranch ConfVar [Dependency] BuildInfo]
bis forall a. [a] -> [a] -> [a]
++ [CondBranch ConfVar [Dependency] a]
cs

-------------------------------------------------------------------------------
-- Branches
-------------------------------------------------------------------------------

-- Check that a property holds on all branches of a condition tree
onAllBranches :: forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
onAllBranches :: forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
onAllBranches a -> Bool
p = a -> CondTree v c a -> Bool
go forall a. Monoid a => a
mempty
  where
    -- If the current level of the tree satisfies the property, then we are
    -- done. If not, then one of the conditional branches below the current node
    -- must satisfy it. Each node may have multiple immediate children; we only
    -- one need one to satisfy the property because the configure step uses
    -- 'mappend' to join together the results of flag resolution.
    go :: a -> CondTree v c a -> Bool
    go :: a -> CondTree v c a -> Bool
go a
acc CondTree v c a
ct = let acc' :: a
acc' = a
acc forall a. Monoid a => a -> a -> a
`mappend` forall v c a. CondTree v c a -> a
condTreeData CondTree v c a
ct
                in a -> Bool
p a
acc' Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> CondBranch v c a -> Bool
goBranch a
acc') (forall v c a. CondTree v c a -> [CondBranch v c a]
condTreeComponents CondTree v c a
ct)

    -- Both the 'true' and the 'false' block must satisfy the property.
    goBranch :: a -> CondBranch v c a -> Bool
    goBranch :: a -> CondBranch v c a -> Bool
goBranch a
_   (CondBranch Condition v
_ CondTree v c a
_ Maybe (CondTree v c a)
Nothing) = Bool
False
    goBranch a
acc (CondBranch Condition v
_ CondTree v c a
t (Just CondTree v c a
e))  = a -> CondTree v c a -> Bool
go a
acc CondTree v c a
t Bool -> Bool -> Bool
&& a -> CondTree v c a -> Bool
go a
acc CondTree v c a
e

-------------------------------------------------------------------------------
-- Post parsing checks
-------------------------------------------------------------------------------

-- | Check that we 
--
-- * don't use undefined flags (very bad)
-- * define flags which are unused (just bad)
--
checkForUndefinedFlags :: GenericPackageDescription -> ParseResult ()
checkForUndefinedFlags :: GenericPackageDescription -> ParseResult ()
checkForUndefinedFlags GenericPackageDescription
gpd = do
    let definedFlags, usedFlags :: Set.Set FlagName
        definedFlags :: Set FlagName
definedFlags = forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (Lens' GenericPackageDescription [PackageFlag]
L.genPackageFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a r. (s -> a) -> Getting r s a
getting PackageFlag -> FlagName
flagName) GenericPackageDescription
gpd
        usedFlags :: Set FlagName
usedFlags    = forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Applicative f =>
(forall a.
 CondTree ConfVar [Dependency] a
 -> f (CondTree ConfVar [Dependency] a))
-> GenericPackageDescription -> f GenericPackageDescription
L.allCondTrees forall c a.
CondTree ConfVar c a -> Const (Set FlagName) (CondTree ConfVar c a)
f GenericPackageDescription
gpd

    -- Note: we can check for defined, but unused flags here too.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set FlagName
usedFlags forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set FlagName
definedFlags) forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
zeroPos forall a b. (a -> b) -> a -> b
$
        String
"These flags are used without having been defined: " forall a. [a] -> [a] -> [a]
++
        forall a. [a] -> [[a]] -> [a]
intercalate String
", " [ FlagName -> String
unFlagName FlagName
fn | FlagName
fn <- forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ Set FlagName
usedFlags forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set FlagName
definedFlags ]
  where
    f :: CondTree ConfVar c a -> Const (Set.Set FlagName) (CondTree ConfVar c a)
    f :: forall c a.
CondTree ConfVar c a -> Const (Set FlagName) (CondTree ConfVar c a)
f CondTree ConfVar c a
ct = forall {k} a (b :: k). a -> Const a b
Const (forall a. Ord a => [a] -> Set a
Set.fromList (forall c a. CondTree ConfVar c a -> [FlagName]
freeVars CondTree ConfVar c a
ct))

-- | Since @cabal-version: 1.24@ one can specify @custom-setup@.
-- Let us require it.
--
checkForUndefinedCustomSetup :: GenericPackageDescription -> ParseResult ()
checkForUndefinedCustomSetup :: GenericPackageDescription -> ParseResult ()
checkForUndefinedCustomSetup GenericPackageDescription
gpd = do
    let pd :: PackageDescription
pd  = GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd
    let csv :: CabalSpecVersion
csv = PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pd

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageDescription -> BuildType
buildType PackageDescription
pd forall a. Eq a => a -> a -> Bool
== BuildType
Custom Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pd)) forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CabalSpecVersion
csv forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_24) forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
zeroPos forall a b. (a -> b) -> a -> b
$
            String
"Since cabal-version: 1.24 specifying custom-setup section is mandatory"

-------------------------------------------------------------------------------
-- Post processing of internal dependencies
-------------------------------------------------------------------------------

-- Note [Dependencies on sublibraries]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- This is solution to https://github.com/haskell/cabal/issues/6083
--
-- Before 'cabal-version: 3.0' we didn't have a syntax specially
-- for referring to internal libraries. Internal library names
-- shadowed the outside ones.
--
-- Since 'cabal-version: 3.0' we have ability to write
--
--     build-depends: some-package:its-sub-lib >=1.2.3
--
-- This allows us to refer also to local packages by `this-package:sublib`.
-- So since 'cabal-version: 3.4' to refer to *any*
-- sublibrary we must use the two part syntax. Here's small table:
--
--                   | pre-3.4             |      3.4 and after            |
-- ------------------|---------------------|-------------------------------|
-- pkg-name          | may refer to sublib | always refers to external pkg |
-- pkg-name:sublib   | refers to sublib    | refers to sublib              |
-- pkg-name:pkg-name | may refer to sublib | always refers to external pkg |
--
-- In pre-3.4 case, if a package 'this-pkg' has a sublibrary 'pkg-name',
-- all dependency definitions will refer to that sublirary.
--
-- In 3.4 and after case, 'pkg-name' will always refer to external package,
-- and to use internal library you have to say 'this-pkg:pkg-name'.
--
-- In summary, In 3.4 and after, the internal names don't shadow,
-- as there is an explicit syntax to refer to them,
-- i.e. what you write is what you get;
-- For pre-3.4 we post-process the file.
--
-- Similarly, we process mixins.
-- See https://github.com/haskell/cabal/issues/6281
--

postProcessInternalDeps :: CabalSpecVersion -> GenericPackageDescription -> GenericPackageDescription
postProcessInternalDeps :: CabalSpecVersion
-> GenericPackageDescription -> GenericPackageDescription
postProcessInternalDeps CabalSpecVersion
specVer GenericPackageDescription
gpd
    | CabalSpecVersion
specVer forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_4 = GenericPackageDescription
gpd
    | Bool
otherwise                = (BuildInfo -> BuildInfo)
-> (SetupBuildInfo -> SetupBuildInfo)
-> GenericPackageDescription
-> GenericPackageDescription
transformAllBuildInfos BuildInfo -> BuildInfo
transformBI SetupBuildInfo -> SetupBuildInfo
transformSBI GenericPackageDescription
gpd
  where
    transformBI :: BuildInfo -> BuildInfo
    transformBI :: BuildInfo -> BuildInfo
transformBI
        = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a. HasBuildInfo a => Lens' a [Dependency]
L.targetBuildDepends (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Dependency -> [Dependency]
transformD)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a. HasBuildInfo a => Lens' a [Mixin]
L.mixins (forall a b. (a -> b) -> [a] -> [b]
map Mixin -> Mixin
transformM)

    transformSBI :: SetupBuildInfo -> SetupBuildInfo
    transformSBI :: SetupBuildInfo -> SetupBuildInfo
transformSBI = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SetupBuildInfo [Dependency]
L.setupDepends (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Dependency -> [Dependency]
transformD)

    transformD :: Dependency -> [Dependency]
    transformD :: Dependency -> [Dependency]
transformD (Dependency PackageName
pn VersionRange
vr NonEmptySet LibraryName
ln)
        | UnqualComponentName
uqn forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnqualComponentName
internalLibs
        , LibraryName
LMainLibName forall a. Ord a => a -> NonEmptySet a -> Bool
`NES.member` NonEmptySet LibraryName
ln
        = case forall a. Ord a => a -> NonEmptySet a -> Maybe (NonEmptySet a)
NES.delete LibraryName
LMainLibName NonEmptySet LibraryName
ln of
            Maybe (NonEmptySet LibraryName)
Nothing  -> [Dependency
dep]
            Just NonEmptySet LibraryName
ln' -> [Dependency
dep, PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
pn VersionRange
vr NonEmptySet LibraryName
ln']
      where
        uqn :: UnqualComponentName
uqn = PackageName -> UnqualComponentName
packageNameToUnqualComponentName PackageName
pn
        dep :: Dependency
dep = PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
thisPn VersionRange
vr (forall a. a -> NonEmptySet a
NES.singleton (UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
uqn))

    transformD Dependency
d = [Dependency
d]

    transformM :: Mixin -> Mixin
    transformM :: Mixin -> Mixin
transformM (Mixin PackageName
pn LibraryName
LMainLibName IncludeRenaming
incl)
        | UnqualComponentName
uqn forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnqualComponentName
internalLibs
        = PackageName -> LibraryName -> IncludeRenaming -> Mixin
mkMixin PackageName
thisPn (UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
uqn) IncludeRenaming
incl
      where
        uqn :: UnqualComponentName
uqn = PackageName -> UnqualComponentName
packageNameToUnqualComponentName PackageName
pn

    transformM Mixin
m = Mixin
m

    thisPn :: PackageName
    thisPn :: PackageName
thisPn = PackageIdentifier -> PackageName
pkgName (PackageDescription -> PackageIdentifier
package (GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd))

    internalLibs :: Set UnqualComponentName
    internalLibs :: Set UnqualComponentName
internalLibs = forall a. Ord a => [a] -> Set a
Set.fromList
        [ UnqualComponentName
n
        | (UnqualComponentName
n, CondTree ConfVar [Dependency] Library
_) <- GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
gpd
        ]

-------------------------------------------------------------------------------
-- Old syntax
-------------------------------------------------------------------------------

-- TODO: move to own module

-- | "Sectionize" an old-style Cabal file.  A sectionized file has:
--
--  * all global fields at the beginning, followed by
--
--  * all flag declarations, followed by
--
--  * an optional library section, and an arbitrary number of executable
--    sections (in any order).
--
-- The current implementation just gathers all library-specific fields
-- in a library section and wraps all executable stanzas in an executable
-- section.
sectionizeFields :: [Field ann] -> (Syntax, [Field ann])
sectionizeFields :: forall ann. [Field ann] -> (Syntax, [Field ann])
sectionizeFields [Field ann]
fs = case forall ann. [Field ann] -> Maybe [(Name ann, [FieldLine ann])]
classifyFields [Field ann]
fs of
    Just [(Name ann, [FieldLine ann])]
fields -> (Syntax
OldSyntax, forall ann. [(Name ann, [FieldLine ann])] -> [Field ann]
convert [(Name ann, [FieldLine ann])]
fields)
    Maybe [(Name ann, [FieldLine ann])]
Nothing     -> (Syntax
NewSyntax, [Field ann]
fs)
  where
    -- return 'Just' if all fields are simple fields
    classifyFields :: [Field ann] -> Maybe [(Name ann, [FieldLine ann])]
    classifyFields :: forall ann. [Field ann] -> Maybe [(Name ann, [FieldLine ann])]
classifyFields = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {ann}. Field ann -> Maybe (Name ann, [FieldLine ann])
f
      where
        f :: Field ann -> Maybe (Name ann, [FieldLine ann])
f (Field Name ann
name [FieldLine ann]
fieldlines) = forall a. a -> Maybe a
Just (Name ann
name, [FieldLine ann]
fieldlines)
        f Field ann
_                      = forall a. Maybe a
Nothing

    trim :: ByteString -> ByteString
trim = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isSpace' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isSpace' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse
    isSpace' :: Word8 -> Bool
isSpace' = (forall a. Eq a => a -> a -> Bool
== Word8
32)

    convert :: [(Name ann, [FieldLine ann])] -> [Field ann]
    convert :: forall ann. [(Name ann, [FieldLine ann])] -> [Field ann]
convert [(Name ann, [FieldLine ann])]
fields =
      let
        toField :: (Name ann, [FieldLine ann]) -> Field ann
toField (Name ann
name, [FieldLine ann]
ls) = forall ann. Name ann -> [FieldLine ann] -> Field ann
Field Name ann
name [FieldLine ann]
ls
        -- "build-depends" is a local field now.  To be backwards
        -- compatible, we still allow it as a global field in old-style
        -- package description files and translate it to a local field by
        -- adding it to every non-empty section
        ([(Name ann, [FieldLine ann])]
hdr0, [(Name ann, [FieldLine ann])]
exes0) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((forall a. Eq a => a -> a -> Bool
==ByteString
"executable") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Name ann -> ByteString
getName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Name ann, [FieldLine ann])]
fields
        ([(Name ann, [FieldLine ann])]
hdr, [(Name ann, [FieldLine ann])]
libfs0) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
libFieldNames) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Name ann -> ByteString
getName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Name ann, [FieldLine ann])]
hdr0

        ([(Name ann, [FieldLine ann])]
deps, [(Name ann, [FieldLine ann])]
libfs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
== ByteString
"build-depends") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Name ann -> ByteString
getName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
                                   [(Name ann, [FieldLine ann])]
libfs0

        exes :: [Field ann]
exes = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr [(Name ann, [FieldLine ann])]
-> Maybe (Field ann, [(Name ann, [FieldLine ann])])
toExe [(Name ann, [FieldLine ann])]
exes0
        toExe :: [(Name ann, [FieldLine ann])]
-> Maybe (Field ann, [(Name ann, [FieldLine ann])])
toExe [] = forall a. Maybe a
Nothing
        toExe ((Name ann
pos ByteString
n, [FieldLine ann]
ls) : [(Name ann, [FieldLine ann])]
r)
          | ByteString
n forall a. Eq a => a -> a -> Bool
== ByteString
"executable" =
              let ([(Name ann, [FieldLine ann])]
efs, [(Name ann, [FieldLine ann])]
r') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((forall a. Eq a => a -> a -> Bool
== ByteString
"executable") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Name ann -> ByteString
getName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Name ann, [FieldLine ann])]
r
              in forall a. a -> Maybe a
Just (forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section (forall ann. ann -> ByteString -> Name ann
Name ann
pos ByteString
"executable") [forall ann. ann -> ByteString -> SectionArg ann
SecArgName ann
pos forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
trim forall a b. (a -> b) -> a -> b
$ forall ann. [FieldLine ann] -> ByteString
fieldlinesToBS [FieldLine ann]
ls] (forall a b. (a -> b) -> [a] -> [b]
map forall {ann}. (Name ann, [FieldLine ann]) -> Field ann
toField forall a b. (a -> b) -> a -> b
$ [(Name ann, [FieldLine ann])]
deps forall a. [a] -> [a] -> [a]
++ [(Name ann, [FieldLine ann])]
efs), [(Name ann, [FieldLine ann])]
r')
        toExe [(Name ann, [FieldLine ann])]
_ = forall a. HasCallStack => String -> a
error String
"unexpected input to 'toExe'"

        lib :: [Field ann]
lib = case [(Name ann, [FieldLine ann])]
libfs of
            []                         -> []
            ((Name ann
pos ByteString
_,  [FieldLine ann]
_) : [(Name ann, [FieldLine ann])]
_) ->
                [forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section (forall ann. ann -> ByteString -> Name ann
Name ann
pos ByteString
"library") [] (forall a b. (a -> b) -> [a] -> [b]
map forall {ann}. (Name ann, [FieldLine ann]) -> Field ann
toField forall a b. (a -> b) -> a -> b
$ [(Name ann, [FieldLine ann])]
deps forall a. [a] -> [a] -> [a]
++ [(Name ann, [FieldLine ann])]
libfs)]

      in forall a b. (a -> b) -> [a] -> [b]
map forall {ann}. (Name ann, [FieldLine ann]) -> Field ann
toField [(Name ann, [FieldLine ann])]
hdr forall a. [a] -> [a] -> [a]
++ [Field ann]
lib forall a. [a] -> [a] -> [a]
++ [Field ann]
exes

-- | See 'sectionizeFields'.
data Syntax = OldSyntax | NewSyntax
    deriving (Syntax -> Syntax -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Syntax -> Syntax -> Bool
$c/= :: Syntax -> Syntax -> Bool
== :: Syntax -> Syntax -> Bool
$c== :: Syntax -> Syntax -> Bool
Eq, Int -> Syntax -> ShowS
[Syntax] -> ShowS
Syntax -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Syntax] -> ShowS
$cshowList :: [Syntax] -> ShowS
show :: Syntax -> String
$cshow :: Syntax -> String
showsPrec :: Int -> Syntax -> ShowS
$cshowsPrec :: Int -> Syntax -> ShowS
Show)

-- TODO:
libFieldNames :: [FieldName]
libFieldNames :: [ByteString]
libFieldNames = forall s a. ParsecFieldGrammar s a -> [ByteString]
fieldGrammarKnownFieldList (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Library),
 Applicative (g BuildInfo), c (Identity LibraryVisibility),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List CommaVCat (Identity ModuleReexport) ModuleReexport),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
LibraryName -> g Library Library
libraryFieldGrammar LibraryName
LMainLibName)

-------------------------------------------------------------------------------
-- Suplementary build information
-------------------------------------------------------------------------------

readHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo
readHookedBuildInfo :: Verbosity -> String -> IO HookedBuildInfo
readHookedBuildInfo = forall a.
(ByteString -> ParseResult a) -> Verbosity -> String -> IO a
readAndParseFile ByteString -> ParseResult HookedBuildInfo
parseHookedBuildInfo

parseHookedBuildInfo :: BS.ByteString -> ParseResult HookedBuildInfo
parseHookedBuildInfo :: ByteString -> ParseResult HookedBuildInfo
parseHookedBuildInfo ByteString
bs = case ByteString -> Either ParseError ([Field Position], [LexWarning])
readFields' ByteString
bs of
    Right ([Field Position]
fs, [LexWarning]
lexWarnings) -> do
        [LexWarning] -> [Field Position] -> ParseResult HookedBuildInfo
parseHookedBuildInfo' [LexWarning]
lexWarnings [Field Position]
fs
    -- TODO: better marshalling of errors
    Left ParseError
perr -> forall a. Position -> String -> ParseResult a
parseFatalFailure Position
zeroPos (forall a. Show a => a -> String
show ParseError
perr)

parseHookedBuildInfo'
    :: [LexWarning]
    -> [Field Position]
    -> ParseResult HookedBuildInfo
parseHookedBuildInfo' :: [LexWarning] -> [Field Position] -> ParseResult HookedBuildInfo
parseHookedBuildInfo' [LexWarning]
lexWarnings [Field Position]
fs = do
    [PWarning] -> ParseResult ()
parseWarnings ([LexWarning] -> [PWarning]
toPWarnings [LexWarning]
lexWarnings)
    (Fields Position
mLibFields, [(UnqualComponentName, Fields Position)]
exes) <- [Field Position]
-> ParseResult
     (Fields Position, [(UnqualComponentName, Fields Position)])
stanzas [Field Position]
fs
    Maybe BuildInfo
mLib <- Fields Position -> ParseResult (Maybe BuildInfo)
parseLib Fields Position
mLibFields
    [(UnqualComponentName, BuildInfo)]
biExes <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (UnqualComponentName, Fields Position)
-> ParseResult (UnqualComponentName, BuildInfo)
parseExe [(UnqualComponentName, Fields Position)]
exes
    forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BuildInfo
mLib, [(UnqualComponentName, BuildInfo)]
biExes)
  where
    parseLib :: Fields Position -> ParseResult (Maybe BuildInfo)
    parseLib :: Fields Position -> ParseResult (Maybe BuildInfo)
parseLib Fields Position
fields
        | forall k a. Map k a -> Bool
Map.null Fields Position
fields = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        | Bool
otherwise       = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
cabalSpecLatest Fields Position
fields forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar

    parseExe :: (UnqualComponentName, Fields Position) -> ParseResult (UnqualComponentName, BuildInfo)
    parseExe :: (UnqualComponentName, Fields Position)
-> ParseResult (UnqualComponentName, BuildInfo)
parseExe (UnqualComponentName
n, Fields Position
fields) = do
        BuildInfo
bi <- forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
cabalSpecLatest Fields Position
fields forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnqualComponentName
n, BuildInfo
bi)

    stanzas :: [Field Position] -> ParseResult (Fields Position, [(UnqualComponentName, Fields Position)])
    stanzas :: [Field Position]
-> ParseResult
     (Fields Position, [(UnqualComponentName, Fields Position)])
stanzas [Field Position]
fields = do
        let ([Field Position]
hdr0, Maybe ([FieldLine Position], [Field Position])
exes0) = forall a b. (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakMaybe forall {ann}. Field ann -> Maybe [FieldLine ann]
isExecutableField [Field Position]
fields
        Fields Position
hdr <- [Field Position] -> ParseResult (Fields Position)
toFields [Field Position]
hdr0
        [(UnqualComponentName, Fields Position)]
exes <- forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> m [a]
unfoldrM (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([FieldLine Position], [Field Position])
-> ParseResult
     ((UnqualComponentName, Fields Position),
      Maybe ([FieldLine Position], [Field Position]))
toExe) Maybe ([FieldLine Position], [Field Position])
exes0
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fields Position
hdr, [(UnqualComponentName, Fields Position)]
exes)

    toFields :: [Field Position] -> ParseResult (Fields Position)
    toFields :: [Field Position] -> ParseResult (Fields Position)
toFields [Field Position]
fields = do
        let (Fields Position
fields', [[Section Position]]
ss) = forall ann. [Field ann] -> (Fields ann, [[Section ann]])
partitionFields [Field Position]
fields
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Section Position -> ParseResult ()
warnInvalidSubsection) [[Section Position]]
ss
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Fields Position
fields'

    toExe
        :: ([FieldLine Position], [Field Position])
        -> ParseResult ((UnqualComponentName, Fields Position), Maybe ([FieldLine Position], [Field Position]))
    toExe :: ([FieldLine Position], [Field Position])
-> ParseResult
     ((UnqualComponentName, Fields Position),
      Maybe ([FieldLine Position], [Field Position]))
toExe ([FieldLine Position]
fss, [Field Position]
fields) = do
        UnqualComponentName
name <- forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
runFieldParser Position
zeroPos forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec CabalSpecVersion
cabalSpecLatest [FieldLine Position]
fss
        let ([Field Position]
hdr0, Maybe ([FieldLine Position], [Field Position])
rest) = forall a b. (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakMaybe forall {ann}. Field ann -> Maybe [FieldLine ann]
isExecutableField [Field Position]
fields
        Fields Position
hdr <- [Field Position] -> ParseResult (Fields Position)
toFields [Field Position]
hdr0
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ((UnqualComponentName
name, Fields Position
hdr), Maybe ([FieldLine Position], [Field Position])
rest)

    isExecutableField :: Field ann -> Maybe [FieldLine ann]
isExecutableField (Field (Name ann
_ ByteString
name) [FieldLine ann]
fss)
        | ByteString
name forall a. Eq a => a -> a -> Bool
== ByteString
"executable" = forall a. a -> Maybe a
Just [FieldLine ann]
fss
        | Bool
otherwise            = forall a. Maybe a
Nothing
    isExecutableField Field ann
_ = forall a. Maybe a
Nothing

-------------------------------------------------------------------------------
-- Scan of spec version
-------------------------------------------------------------------------------

-- | Quickly scan new-style spec-version
--
-- A new-style spec-version declaration begins the .cabal file and
-- follow the following case-insensitive grammar (expressed in
-- RFC5234 ABNF):
--
-- @
-- newstyle-spec-version-decl = "cabal-version" *WS ":" *WS newstyle-pec-version *WS
--
-- spec-version               = NUM "." NUM [ "." NUM ]
--
-- NUM    = DIGIT0 / DIGITP 1*DIGIT0
-- DIGIT0 = %x30-39
-- DIGITP = %x31-39
-- WS = %20
-- @
--
scanSpecVersion :: BS.ByteString -> Maybe Version
scanSpecVersion :: ByteString -> Maybe Version
scanSpecVersion ByteString
bs = do
    ByteString
fstline':[ByteString]
_ <- forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> [ByteString]
BS8.lines ByteString
bs)

    -- parse <newstyle-spec-version-decl>
    -- normalise: remove all whitespace, convert to lower-case
    let fstline :: ByteString
fstline = (Word8 -> Word8) -> ByteString -> ByteString
BS.map Word8 -> Word8
toLowerW8 forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BS.filter (forall a. Eq a => a -> a -> Bool
/= Word8
0x20) ByteString
fstline'
    [ByteString
"cabal-version",ByteString
vers] <- forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> ByteString -> [ByteString]
BS8.split Char
':' ByteString
fstline)

    -- parse <spec-version>
    --
    -- This is currently more tolerant regarding leading 0 digits.
    --
    Version
ver <- forall a. Parsec a => ByteString -> Maybe a
simpleParsecBS ByteString
vers
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ case Version -> [Int]
versionNumbers Version
ver of
              [Int
_,Int
_]   -> Bool
True
              [Int
_,Int
_,Int
_] -> Bool
True
              [Int]
_       -> Bool
False

    forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
ver
  where
    -- | Translate ['A'..'Z'] to ['a'..'z']
    toLowerW8 :: Word8 -> Word8
    toLowerW8 :: Word8 -> Word8
toLowerW8 Word8
w | Word8
0x40 forall a. Ord a => a -> a -> Bool
< Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
< Word8
0x5b = Word8
wforall a. Num a => a -> a -> a
+Word8
0x20
                | Bool
otherwise            = Word8
w