{-# 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
    parseGenericPackageDescription
  , parseGenericPackageDescriptionMaybe

    -- ** Parsing
  , ParseResult
  , runParseResult
  , PSource (..)
  , withSource

    -- * New-style spec-version
  , scanSpecVersion

    -- ** Supplementary build information
  , 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, sectionArgAnn)
import Distribution.Fields.LexerMonad (LexWarning, toPWarnings)
import Distribution.Fields.ParseResult
import Distribution.Fields.Parser
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 (..), incPos, zeroPos)
import Distribution.Parsec.Warning (PWarnType (..))
import Distribution.Pretty (prettyShow)
import Distribution.Utils.Generic (breakMaybe, fromUTF8BS, toUTF8BS, unfoldrM, validateUTF8)
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

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

-- | 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 src GenericPackageDescription
parseGenericPackageDescription :: forall src. ByteString -> ParseResult src GenericPackageDescription
parseGenericPackageDescription ByteString
bs = do
  -- set scanned version
  Maybe Version -> ParseResult src ()
forall src. Maybe Version -> ParseResult src ()
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 -> Maybe CabalSpecVersion -> ParseResult src (Maybe CabalSpecVersion)
forall a. a -> ParseResult src a
forall (m :: * -> *) a. Monad m => a -> m a
return (CabalSpecVersion -> Maybe CabalSpecVersion
forall a. a -> Maybe a
Just CabalSpecVersion
csv)
      Maybe CabalSpecVersion
Nothing ->
        Position -> String -> ParseResult src (Maybe CabalSpecVersion)
forall src a. Position -> String -> ParseResult src a
parseFatalFailure Position
zeroPos (String -> ParseResult src (Maybe CabalSpecVersion))
-> String -> ParseResult src (Maybe CabalSpecVersion)
forall a b. (a -> b) -> a -> b
$
          String
"Unsupported cabal format version in cabal-version field: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
v
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".\n"
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cabalFormatVersionsDesc
    Maybe Version
_ -> Maybe CabalSpecVersion -> ParseResult src (Maybe CabalSpecVersion)
forall a. a -> ParseResult src a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CabalSpecVersion
forall a. Maybe a
Nothing

  case ByteString -> Either ParseError ([Field Position], [LexWarning])
readFields' ByteString
bs'' of
    Right ([Field Position]
fs, [LexWarning]
lexWarnings) -> do
      Bool -> ParseResult src () -> ParseResult src ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
patched (ParseResult src () -> ParseResult src ())
-> ParseResult src () -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$
        Position -> PWarnType -> String -> ParseResult src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
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 src GenericPackageDescription
forall src.
Maybe CabalSpecVersion
-> [LexWarning]
-> Maybe Int
-> [Field Position]
-> ParseResult src GenericPackageDescription
parseGenericPackageDescription' Maybe CabalSpecVersion
csv [LexWarning]
lexWarnings Maybe Int
invalidUtf8 [Field Position]
fs
    -- TODO: better marshalling of errors
    Left ParseError
perr -> Position -> String -> ParseResult src GenericPackageDescription
forall src a. Position -> String -> ParseResult src a
parseFatalFailure Position
pos (ParseError -> String
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 =
  ((Maybe Version, NonEmpty (PErrorWithSource Any))
 -> Maybe GenericPackageDescription)
-> (GenericPackageDescription -> Maybe GenericPackageDescription)
-> Either
     (Maybe Version, NonEmpty (PErrorWithSource Any))
     GenericPackageDescription
-> Maybe GenericPackageDescription
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe GenericPackageDescription
-> (Maybe Version, NonEmpty (PErrorWithSource Any))
-> Maybe GenericPackageDescription
forall a b. a -> b -> a
const Maybe GenericPackageDescription
forall a. Maybe a
Nothing) GenericPackageDescription -> Maybe GenericPackageDescription
forall a. a -> Maybe a
Just (Either
   (Maybe Version, NonEmpty (PErrorWithSource Any))
   GenericPackageDescription
 -> Maybe GenericPackageDescription)
-> (ByteString
    -> Either
         (Maybe Version, NonEmpty (PErrorWithSource Any))
         GenericPackageDescription)
-> ByteString
-> Maybe GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([PWarningWithSource Any],
 Either
   (Maybe Version, NonEmpty (PErrorWithSource Any))
   GenericPackageDescription)
-> Either
     (Maybe Version, NonEmpty (PErrorWithSource Any))
     GenericPackageDescription
forall a b. (a, b) -> b
snd (([PWarningWithSource Any],
  Either
    (Maybe Version, NonEmpty (PErrorWithSource Any))
    GenericPackageDescription)
 -> Either
      (Maybe Version, NonEmpty (PErrorWithSource Any))
      GenericPackageDescription)
-> (ByteString
    -> ([PWarningWithSource Any],
        Either
          (Maybe Version, NonEmpty (PErrorWithSource Any))
          GenericPackageDescription))
-> ByteString
-> Either
     (Maybe Version, NonEmpty (PErrorWithSource Any))
     GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseResult Any GenericPackageDescription
-> ([PWarningWithSource Any],
    Either
      (Maybe Version, NonEmpty (PErrorWithSource Any))
      GenericPackageDescription)
forall src a.
ParseResult src a
-> ([PWarningWithSource src],
    Either (Maybe Version, NonEmpty (PErrorWithSource src)) a)
runParseResult (ParseResult Any GenericPackageDescription
 -> ([PWarningWithSource Any],
     Either
       (Maybe Version, NonEmpty (PErrorWithSource Any))
       GenericPackageDescription))
-> (ByteString -> ParseResult Any GenericPackageDescription)
-> ByteString
-> ([PWarningWithSource Any],
    Either
      (Maybe Version, NonEmpty (PErrorWithSource Any))
      GenericPackageDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ParseResult Any GenericPackageDescription
forall src. ByteString -> ParseResult src GenericPackageDescription
parseGenericPackageDescription

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

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

-- | 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
-> Map String CondTreeBuildInfo -> SectionS
`SectionS` Map String CondTreeBuildInfo
cs) (GenericPackageDescription -> SectionS)
-> f GenericPackageDescription -> f SectionS
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 (Map String CondTreeBuildInfo -> SectionS)
-> f (Map String CondTreeBuildInfo) -> f SectionS
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 src GenericPackageDescription
parseGenericPackageDescription' :: forall src.
Maybe CabalSpecVersion
-> [LexWarning]
-> Maybe Int
-> [Field Position]
-> ParseResult src GenericPackageDescription
parseGenericPackageDescription' Maybe CabalSpecVersion
scannedVer [LexWarning]
lexWarnings Maybe Int
utf8WarnPos [Field Position]
fs = do
  [PWarning] -> ParseResult src ()
forall src. [PWarning] -> ParseResult src ()
parseWarnings ([LexWarning] -> [PWarning]
toPWarnings [LexWarning]
lexWarnings)
  Maybe Int -> (Int -> ParseResult src ()) -> ParseResult src ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Int
utf8WarnPos ((Int -> ParseResult src ()) -> ParseResult src ())
-> (Int -> ParseResult src ()) -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$ \Int
pos ->
    Position -> PWarnType -> String -> ParseResult src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
parseWarning Position
zeroPos PWarnType
PWTUTF (String -> ParseResult src ()) -> String -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$ String
"UTF8 encoding problem at byte offset " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
pos
  let (Syntax
syntax, [Field Position]
fs') = [Field Position] -> (Syntax, [Field Position])
forall ann. [Field ann] -> (Syntax, [Field ann])
sectionizeFields [Field Position]
fs
  let (Fields Position
fields, [Field Position]
sectionFields) = [Field Position] -> (Fields Position, [Field Position])
forall ann. [Field ann] -> (Fields ann, [Field ann])
takeFields [Field Position]
fs'

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

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

        CabalSpecVersion -> ParseResult src CabalSpecVersion
forall a. a -> ParseResult src a
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 src ()
forall src. Maybe Version -> ParseResult src ()
setCabalSpecVersion (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
specVer')

  -- Package description
  PackageDescription
pd <- CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar PackageDescription PackageDescription
-> ParseResult src PackageDescription
forall s a src.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult src a
parseFieldGrammar CabalSpecVersion
specVer Fields Position
fields ParsecFieldGrammar PackageDescription PackageDescription
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, c (Identity BuildType),
 c (Identity PackageName), c (Identity Version),
 c (List
      FSep
      (RelativePathNT Pkg 'File)
      (SymbolicPathX 'OnlyRelative Pkg 'File)),
 c (List
      VCat (RelativePathNT DataDir 'File) (RelativePath DataDir 'File)),
 c (List
      VCat
      (RelativePathNT Pkg 'File)
      (SymbolicPathX 'OnlyRelative Pkg 'File)),
 c (List FSep TestedWith (CompilerFlavor, VersionRange)),
 c CompatLicenseFile, c CompatDataDir) =>
g PackageDescription PackageDescription
packageDescriptionFieldGrammar

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

  Syntax -> PackageDescription -> ParseResult src ()
forall src. Syntax -> PackageDescription -> ParseResult src ()
maybeWarnCabalVersion Syntax
syntax PackageDescription
pd

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

  let gpd2 :: GenericPackageDescription
gpd2 = CabalSpecVersion
-> GenericPackageDescription -> GenericPackageDescription
postProcessInternalDeps CabalSpecVersion
specVer GenericPackageDescription
gpd1
  GenericPackageDescription -> ParseResult src ()
forall src. GenericPackageDescription -> ParseResult src ()
checkForUndefinedFlags GenericPackageDescription
gpd2
  GenericPackageDescription -> ParseResult src ()
forall src. GenericPackageDescription -> ParseResult src ()
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 GenericPackageDescription
-> ParseResult src GenericPackageDescription
-> ParseResult src GenericPackageDescription
forall a b. NFData a => a -> b -> b
`deepseq` GenericPackageDescription
-> ParseResult src GenericPackageDescription
forall a. a -> ParseResult src a
forall (m :: * -> *) a. Monad m => a -> m a
return GenericPackageDescription
gpd2
  where
    safeLast :: [a] -> Maybe a
    safeLast :: forall a. [a] -> Maybe a
safeLast = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> ([a] -> [a]) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

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

    maybeWarnCabalVersion :: Syntax -> PackageDescription -> ParseResult src ()
    maybeWarnCabalVersion :: forall src. Syntax -> PackageDescription -> ParseResult src ()
maybeWarnCabalVersion Syntax
syntax PackageDescription
pkg
      | Syntax
syntax Syntax -> Syntax -> Bool
forall a. Eq a => a -> a -> Bool
== Syntax
NewSyntax Bool -> Bool -> Bool
&& PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
newSyntaxVersion =
          Position -> PWarnType -> String -> ParseResult src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
parseWarning Position
zeroPos PWarnType
PWTNewSyntax (String -> ParseResult src ()) -> String -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$
            String
"A package using section syntax must specify at least\n"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'cabal-version: >= 1.2'."
    maybeWarnCabalVersion Syntax
syntax PackageDescription
pkg
      | Syntax
syntax Syntax -> Syntax -> Bool
forall a. Eq a => a -> a -> Bool
== Syntax
OldSyntax Bool -> Bool -> Bool
&& PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
newSyntaxVersion =
          Position -> PWarnType -> String -> ParseResult src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
parseWarning Position
zeroPos PWarnType
PWTOldSyntax (String -> ParseResult src ()) -> String -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$
            String
"A package using 'cabal-version: "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ SpecVersion -> String
forall a. Pretty a => a -> String
prettyShow (CabalSpecVersion -> SpecVersion
SpecVersion (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg))
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' must use section syntax. See the Cabal user guide for details."
    maybeWarnCabalVersion Syntax
_ PackageDescription
_ = () -> ParseResult src ()
forall a. a -> ParseResult src a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- See #4899
cabalFormatVersionsDesc :: String
cabalFormatVersionsDesc :: String
cabalFormatVersionsDesc = String
"Current cabal-version values are listed at https://cabal.readthedocs.io/en/stable/file-format-changelog.html."

goSections :: CabalSpecVersion -> [Field Position] -> SectionParser src ()
goSections :: forall src.
CabalSpecVersion -> [Field Position] -> SectionParser src ()
goSections CabalSpecVersion
specVer = (Field Position -> StateT SectionS (ParseResult src) ())
-> [Field Position] -> StateT SectionS (ParseResult src) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Field Position -> StateT SectionS (ParseResult src) ()
forall {src}.
Field Position -> StateT SectionS (ParseResult src) ()
process
  where
    process :: Field Position -> StateT SectionS (ParseResult src) ()
process (Field (Name Position
pos ByteString
name) [FieldLine Position]
_) =
      ParseResult src () -> StateT SectionS (ParseResult src) ()
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src () -> StateT SectionS (ParseResult src) ())
-> ParseResult src () -> StateT SectionS (ParseResult src) ()
forall a b. (a -> b) -> a -> b
$
        Position -> PWarnType -> String -> ParseResult src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
parseWarning Position
pos PWarnType
PWTTrailingFields (String -> ParseResult src ()) -> String -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$
          String
"Ignoring trailing fields after sections: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
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]
-> StateT SectionS (ParseResult src) ()
forall src.
Name Position
-> [SectionArg Position]
-> [Field Position]
-> SectionParser src ()
parseSection Name Position
name [SectionArg Position]
args [Field Position]
secFields

    snoc :: a -> [a] -> [a]
snoc a
x [a]
xs = [a]
xs [a] -> [a] -> [a]
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 src (CondTree ConfVar a)
    parseCondTree' :: forall a src.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar a)
parseCondTree' = CabalSpecVersion
-> ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar a)
forall src a.
HasBuildInfo a =>
CabalSpecVersion
-> ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar a)
parseCondTreeWithCommonStanzas CabalSpecVersion
specVer

    parseSection :: Name Position -> [SectionArg Position] -> [Field Position] -> SectionParser src ()
    parseSection :: forall src.
Name Position
-> [SectionArg Position]
-> [Field Position]
-> SectionParser src ()
parseSection (Name Position
pos ByteString
name) [SectionArg Position]
args [Field Position]
fields
      | HasCommonStanzas
hasCommonStanzas HasCommonStanzas -> HasCommonStanzas -> Bool
forall a. Eq a => a -> a -> Bool
== HasCommonStanzas
NoCommonStanzas
      , ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"common" = ParseResult src () -> StateT SectionS (ParseResult src) ()
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src () -> StateT SectionS (ParseResult src) ())
-> ParseResult src () -> StateT SectionS (ParseResult src) ()
forall a b. (a -> b) -> a -> b
$ do
          Position -> PWarnType -> String -> ParseResult src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
parseWarning Position
pos PWarnType
PWTUnknownSection String
"Ignoring section: common. You should set cabal-version: 2.2 or larger to use common stanzas."
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"common" = do
          Map String CondTreeBuildInfo
commonStanzas <- Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
-> StateT SectionS (ParseResult src) (Map String CondTreeBuildInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
          String
name' <- ParseResult src String -> StateT SectionS (ParseResult src) String
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src String
 -> StateT SectionS (ParseResult src) String)
-> ParseResult src String
-> StateT SectionS (ParseResult src) String
forall a b. (a -> b) -> a -> b
$ Position -> [SectionArg Position] -> ParseResult src String
forall src.
Position -> [SectionArg Position] -> ParseResult src String
parseCommonName Position
pos [SectionArg Position]
args
          CondTreeBuildInfo
biTree <- ParseResult src CondTreeBuildInfo
-> StateT SectionS (ParseResult src) CondTreeBuildInfo
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src CondTreeBuildInfo
 -> StateT SectionS (ParseResult src) CondTreeBuildInfo)
-> ParseResult src CondTreeBuildInfo
-> StateT SectionS (ParseResult src) CondTreeBuildInfo
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' BuildInfo
-> (BuildInfo -> BuildInfo)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src CondTreeBuildInfo
forall a src.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar a)
parseCondTree' ParsecFieldGrammar' BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g,
 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 NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Framework))
      (SymbolicPath Pkg ('Dir Framework))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Lib))
      (SymbolicPath Pkg ('Dir Lib))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Source))
      (SymbolicPath Pkg ('Dir Source))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Include))
      (SymbolicPath Pkg ('Dir Include))),
 c (List
      FSep (SymbolicPathNT Include 'File) (SymbolicPath Include 'File)),
 c (List
      FSep
      (RelativePathNT Framework 'File)
      (RelativePath Framework 'File)),
 c (List
      FSep (RelativePathNT Include 'File) (RelativePath Include 'File)),
 c (List VCat (SymbolicPathNT Pkg 'File) (SymbolicPath Pkg 'File)),
 c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar BuildInfo -> BuildInfo
forall a. a -> a
id Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields

          case String -> Map String CondTreeBuildInfo -> Maybe CondTreeBuildInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name' Map String CondTreeBuildInfo
commonStanzas of
            Maybe CondTreeBuildInfo
Nothing -> LensLike
  Identity
  SectionS
  SectionS
  (Map String CondTreeBuildInfo)
  (Map String CondTreeBuildInfo)
Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas LensLike
  Identity
  SectionS
  SectionS
  (Map String CondTreeBuildInfo)
  (Map String CondTreeBuildInfo)
-> Map String CondTreeBuildInfo
-> StateT SectionS (ParseResult src) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= String
-> CondTreeBuildInfo
-> Map String CondTreeBuildInfo
-> Map String CondTreeBuildInfo
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
_ ->
              ParseResult src () -> StateT SectionS (ParseResult src) ()
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src () -> StateT SectionS (ParseResult src) ())
-> ParseResult src () -> StateT SectionS (ParseResult src) ()
forall a b. (a -> b) -> a -> b
$
                Position -> String -> ParseResult src ()
forall src. Position -> String -> ParseResult src ()
parseFailure Position
pos (String -> ParseResult src ()) -> String -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$
                  String
"Duplicate common stanza: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name'
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"library" Bool -> Bool -> Bool
&& [SectionArg Position] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SectionArg Position]
args = do
          Maybe (CondTree ConfVar Library)
prev <- Getting
  (Maybe (CondTree ConfVar Library))
  SectionS
  (Maybe (CondTree ConfVar Library))
-> StateT
     SectionS (ParseResult src) (Maybe (CondTree ConfVar Library))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (Maybe (CondTree ConfVar Library))
   SectionS
   (Maybe (CondTree ConfVar Library))
 -> StateT
      SectionS (ParseResult src) (Maybe (CondTree ConfVar Library)))
-> Getting
     (Maybe (CondTree ConfVar Library))
     SectionS
     (Maybe (CondTree ConfVar Library))
-> StateT
     SectionS (ParseResult src) (Maybe (CondTree ConfVar Library))
forall a b. (a -> b) -> a -> b
$ LensLike
  (Const (Maybe (CondTree ConfVar Library)))
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
  (Const (Maybe (CondTree ConfVar Library)))
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
-> ((Maybe (CondTree ConfVar Library)
     -> Const
          (Maybe (CondTree ConfVar Library))
          (Maybe (CondTree ConfVar Library)))
    -> GenericPackageDescription
    -> Const
         (Maybe (CondTree ConfVar Library)) GenericPackageDescription)
-> Getting
     (Maybe (CondTree ConfVar Library))
     SectionS
     (Maybe (CondTree ConfVar Library))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CondTree ConfVar Library)
 -> Const
      (Maybe (CondTree ConfVar Library))
      (Maybe (CondTree ConfVar Library)))
-> GenericPackageDescription
-> Const
     (Maybe (CondTree ConfVar Library)) GenericPackageDescription
Lens' GenericPackageDescription (Maybe (CondTree ConfVar Library))
L.condLibrary
          Bool
-> StateT SectionS (ParseResult src) ()
-> StateT SectionS (ParseResult src) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (CondTree ConfVar Library) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (CondTree ConfVar Library)
prev) (StateT SectionS (ParseResult src) ()
 -> StateT SectionS (ParseResult src) ())
-> StateT SectionS (ParseResult src) ()
-> StateT SectionS (ParseResult src) ()
forall a b. (a -> b) -> a -> b
$
            ParseResult src () -> StateT SectionS (ParseResult src) ()
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src () -> StateT SectionS (ParseResult src) ())
-> ParseResult src () -> StateT SectionS (ParseResult src) ()
forall a b. (a -> b) -> a -> b
$
              Position -> String -> ParseResult src ()
forall src. Position -> String -> ParseResult src ()
parseFailure Position
pos String
"Multiple main libraries; have you forgotten to specify a name for an internal library?"

          Map String CondTreeBuildInfo
commonStanzas <- Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
-> StateT SectionS (ParseResult src) (Map String CondTreeBuildInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
          let name'' :: LibraryName
name'' = LibraryName
LMainLibName
          CondTree ConfVar Library
lib <- ParseResult src (CondTree ConfVar Library)
-> StateT SectionS (ParseResult src) (CondTree ConfVar Library)
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src (CondTree ConfVar Library)
 -> StateT SectionS (ParseResult src) (CondTree ConfVar Library))
-> ParseResult src (CondTree ConfVar Library)
-> StateT SectionS (ParseResult src) (CondTree ConfVar Library)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' Library
-> (BuildInfo -> Library)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar Library)
forall a src.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar a)
parseCondTree' (LibraryName -> ParsecFieldGrammar' Library
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, 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 NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Framework))
      (SymbolicPath Pkg ('Dir Framework))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Lib))
      (SymbolicPath Pkg ('Dir Lib))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Source))
      (SymbolicPath Pkg ('Dir Source))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Include))
      (SymbolicPath Pkg ('Dir Include))),
 c (List
      FSep (SymbolicPathNT Include 'File) (SymbolicPath Include 'File)),
 c (List
      FSep
      (RelativePathNT Framework 'File)
      (RelativePath Framework 'File)),
 c (List
      FSep (RelativePathNT Include 'File) (RelativePath Include 'File)),
 c (List VCat (SymbolicPathNT Pkg 'File) (SymbolicPath Pkg 'File)),
 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
          LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
-> ((Maybe (CondTree ConfVar Library)
     -> Identity (Maybe (CondTree ConfVar Library)))
    -> GenericPackageDescription -> Identity GenericPackageDescription)
-> (Maybe (CondTree ConfVar Library)
    -> Identity (Maybe (CondTree ConfVar Library)))
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CondTree ConfVar Library)
 -> Identity (Maybe (CondTree ConfVar Library)))
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens' GenericPackageDescription (Maybe (CondTree ConfVar Library))
L.condLibrary ((Maybe (CondTree ConfVar Library)
  -> Identity (Maybe (CondTree ConfVar Library)))
 -> SectionS -> Identity SectionS)
-> CondTree ConfVar Library -> StateT SectionS (ParseResult src) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= CondTree ConfVar Library
lib

      -- Sublibraries
      -- TODO: check cabal-version
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"library" = do
          Map String CondTreeBuildInfo
commonStanzas <- Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
-> StateT SectionS (ParseResult src) (Map String CondTreeBuildInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
          UnqualComponentName
name' <- Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
forall src.
Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
          let name'' :: LibraryName
name'' = UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
name'
          CondTree ConfVar Library
lib <- ParseResult src (CondTree ConfVar Library)
-> StateT SectionS (ParseResult src) (CondTree ConfVar Library)
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src (CondTree ConfVar Library)
 -> StateT SectionS (ParseResult src) (CondTree ConfVar Library))
-> ParseResult src (CondTree ConfVar Library)
-> StateT SectionS (ParseResult src) (CondTree ConfVar Library)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' Library
-> (BuildInfo -> Library)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar Library)
forall a src.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar a)
parseCondTree' (LibraryName -> ParsecFieldGrammar' Library
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, 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 NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Framework))
      (SymbolicPath Pkg ('Dir Framework))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Lib))
      (SymbolicPath Pkg ('Dir Lib))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Source))
      (SymbolicPath Pkg ('Dir Source))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Include))
      (SymbolicPath Pkg ('Dir Include))),
 c (List
      FSep (SymbolicPathNT Include 'File) (SymbolicPath Include 'File)),
 c (List
      FSep
      (RelativePathNT Framework 'File)
      (RelativePath Framework 'File)),
 c (List
      FSep (RelativePathNT Include 'File) (RelativePath Include 'File)),
 c (List VCat (SymbolicPathNT Pkg 'File) (SymbolicPath Pkg 'File)),
 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?
          LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
-> (([(UnqualComponentName, CondTree ConfVar Library)]
     -> Identity [(UnqualComponentName, CondTree ConfVar Library)])
    -> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([(UnqualComponentName, CondTree ConfVar Library)]
    -> Identity [(UnqualComponentName, CondTree ConfVar Library)])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UnqualComponentName, CondTree ConfVar Library)]
 -> Identity [(UnqualComponentName, CondTree ConfVar Library)])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar Library)]
L.condSubLibraries (([(UnqualComponentName, CondTree ConfVar Library)]
  -> Identity [(UnqualComponentName, CondTree ConfVar Library)])
 -> SectionS -> Identity SectionS)
-> ([(UnqualComponentName, CondTree ConfVar Library)]
    -> [(UnqualComponentName, CondTree ConfVar Library)])
-> StateT SectionS (ParseResult src) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UnqualComponentName, CondTree ConfVar Library)
-> [(UnqualComponentName, CondTree ConfVar Library)]
-> [(UnqualComponentName, CondTree ConfVar Library)]
forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar Library
lib)

      -- TODO: check cabal-version
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"foreign-library" = do
          Map String CondTreeBuildInfo
commonStanzas <- Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
-> StateT SectionS (ParseResult src) (Map String CondTreeBuildInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
          UnqualComponentName
name' <- Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
forall src.
Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
          CondTree ConfVar ForeignLib
flib <- ParseResult src (CondTree ConfVar ForeignLib)
-> StateT SectionS (ParseResult src) (CondTree ConfVar ForeignLib)
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src (CondTree ConfVar ForeignLib)
 -> StateT SectionS (ParseResult src) (CondTree ConfVar ForeignLib))
-> ParseResult src (CondTree ConfVar ForeignLib)
-> StateT SectionS (ParseResult src) (CondTree ConfVar ForeignLib)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' ForeignLib
-> (BuildInfo -> ForeignLib)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar ForeignLib)
forall a src.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar a)
parseCondTree' (UnqualComponentName -> ParsecFieldGrammar' ForeignLib
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, 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
      (SymbolicPathNT Pkg ('Dir Framework))
      (SymbolicPath Pkg ('Dir Framework))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Lib))
      (SymbolicPath Pkg ('Dir Lib))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Source))
      (SymbolicPath Pkg ('Dir Source))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Include))
      (SymbolicPath Pkg ('Dir Include))),
 c (List
      FSep (SymbolicPathNT Include 'File) (SymbolicPath Include 'File)),
 c (List
      FSep
      (RelativePathNT Framework 'File)
      (RelativePath Framework 'File)),
 c (List
      FSep (RelativePathNT Include 'File) (RelativePath Include 'File)),
 c (List
      FSep (RelativePathNT Source 'File) (RelativePath Source 'File)),
 c (List VCat (SymbolicPathNT Pkg 'File) (SymbolicPath Pkg 'File)),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat Token String), c (MQuoted Language)) =>
UnqualComponentName -> g ForeignLib ForeignLib
foreignLibFieldGrammar UnqualComponentName
name') (UnqualComponentName -> BuildInfo -> ForeignLib
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 ForeignLibType -> ForeignLibType -> Bool
forall a. Eq a => a -> a -> Bool
/= ForeignLib -> ForeignLibType
foreignLibType ForeignLib
forall a. Monoid a => a
mempty
          Bool
-> StateT SectionS (ParseResult src) ()
-> StateT SectionS (ParseResult src) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((ForeignLib -> Bool) -> CondTree ConfVar ForeignLib -> Bool
forall v a. Monoid a => (a -> Bool) -> CondTree v a -> Bool
onAllBranches ForeignLib -> Bool
hasType CondTree ConfVar ForeignLib
flib) (StateT SectionS (ParseResult src) ()
 -> StateT SectionS (ParseResult src) ())
-> StateT SectionS (ParseResult src) ()
-> StateT SectionS (ParseResult src) ()
forall a b. (a -> b) -> a -> b
$
            ParseResult src () -> StateT SectionS (ParseResult src) ()
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src () -> StateT SectionS (ParseResult src) ())
-> ParseResult src () -> StateT SectionS (ParseResult src) ()
forall a b. (a -> b) -> a -> b
$
              Position -> String -> ParseResult src ()
forall src. Position -> String -> ParseResult src ()
parseFailure Position
pos (String -> ParseResult src ()) -> String -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                  [ String
"Foreign library " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (UnqualComponentName -> String
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: "
                  , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((ForeignLibType -> String) -> [ForeignLibType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ForeignLibType -> String
forall a. Pretty a => a -> String
prettyShow [ForeignLibType]
knownForeignLibTypes)
                  ]

          -- TODO check duplicate name here?
          LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
-> (([(UnqualComponentName, CondTree ConfVar ForeignLib)]
     -> Identity [(UnqualComponentName, CondTree ConfVar ForeignLib)])
    -> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([(UnqualComponentName, CondTree ConfVar ForeignLib)]
    -> Identity [(UnqualComponentName, CondTree ConfVar ForeignLib)])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UnqualComponentName, CondTree ConfVar ForeignLib)]
 -> Identity [(UnqualComponentName, CondTree ConfVar ForeignLib)])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar ForeignLib)]
L.condForeignLibs (([(UnqualComponentName, CondTree ConfVar ForeignLib)]
  -> Identity [(UnqualComponentName, CondTree ConfVar ForeignLib)])
 -> SectionS -> Identity SectionS)
-> ([(UnqualComponentName, CondTree ConfVar ForeignLib)]
    -> [(UnqualComponentName, CondTree ConfVar ForeignLib)])
-> StateT SectionS (ParseResult src) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UnqualComponentName, CondTree ConfVar ForeignLib)
-> [(UnqualComponentName, CondTree ConfVar ForeignLib)]
-> [(UnqualComponentName, CondTree ConfVar ForeignLib)]
forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar ForeignLib
flib)
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"executable" = do
          Map String CondTreeBuildInfo
commonStanzas <- Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
-> StateT SectionS (ParseResult src) (Map String CondTreeBuildInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
          UnqualComponentName
name' <- Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
forall src.
Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
          CondTree ConfVar Executable
exe <- ParseResult src (CondTree ConfVar Executable)
-> StateT SectionS (ParseResult src) (CondTree ConfVar Executable)
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src (CondTree ConfVar Executable)
 -> StateT SectionS (ParseResult src) (CondTree ConfVar Executable))
-> ParseResult src (CondTree ConfVar Executable)
-> StateT SectionS (ParseResult src) (CondTree ConfVar Executable)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' Executable
-> (BuildInfo -> Executable)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar Executable)
forall a src.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar a)
parseCondTree' (UnqualComponentName -> ParsecFieldGrammar' Executable
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, 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
      (SymbolicPathNT Pkg ('Dir Framework))
      (SymbolicPath Pkg ('Dir Framework))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Lib))
      (SymbolicPath Pkg ('Dir Lib))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Source))
      (SymbolicPath Pkg ('Dir Source))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Include))
      (SymbolicPath Pkg ('Dir Include))),
 c (List
      FSep (SymbolicPathNT Include 'File) (SymbolicPath Include 'File)),
 c (List
      FSep
      (RelativePathNT Framework 'File)
      (RelativePath Framework 'File)),
 c (List
      FSep (RelativePathNT Include 'File) (RelativePath Include 'File)),
 c (List VCat (SymbolicPathNT Pkg 'File) (SymbolicPath Pkg 'File)),
 c (RelativePathNT Source 'File),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat Token String), c (MQuoted Language)) =>
UnqualComponentName -> g Executable Executable
executableFieldGrammar UnqualComponentName
name') (UnqualComponentName -> BuildInfo -> Executable
forall a. FromBuildInfo a => UnqualComponentName -> BuildInfo -> a
fromBuildInfo' UnqualComponentName
name') Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields
          -- TODO check duplicate name here?
          LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
-> (([(UnqualComponentName, CondTree ConfVar Executable)]
     -> Identity [(UnqualComponentName, CondTree ConfVar Executable)])
    -> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([(UnqualComponentName, CondTree ConfVar Executable)]
    -> Identity [(UnqualComponentName, CondTree ConfVar Executable)])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UnqualComponentName, CondTree ConfVar Executable)]
 -> Identity [(UnqualComponentName, CondTree ConfVar Executable)])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar Executable)]
L.condExecutables (([(UnqualComponentName, CondTree ConfVar Executable)]
  -> Identity [(UnqualComponentName, CondTree ConfVar Executable)])
 -> SectionS -> Identity SectionS)
-> ([(UnqualComponentName, CondTree ConfVar Executable)]
    -> [(UnqualComponentName, CondTree ConfVar Executable)])
-> StateT SectionS (ParseResult src) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UnqualComponentName, CondTree ConfVar Executable)
-> [(UnqualComponentName, CondTree ConfVar Executable)]
-> [(UnqualComponentName, CondTree ConfVar Executable)]
forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar Executable
exe)
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"test-suite" = do
          Map String CondTreeBuildInfo
commonStanzas <- Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
-> StateT SectionS (ParseResult src) (Map String CondTreeBuildInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
          UnqualComponentName
name' <- Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
forall src.
Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
          CondTree ConfVar TestSuiteStanza
testStanza <- ParseResult src (CondTree ConfVar TestSuiteStanza)
-> StateT
     SectionS (ParseResult src) (CondTree ConfVar TestSuiteStanza)
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src (CondTree ConfVar TestSuiteStanza)
 -> StateT
      SectionS (ParseResult src) (CondTree ConfVar TestSuiteStanza))
-> ParseResult src (CondTree ConfVar TestSuiteStanza)
-> StateT
     SectionS (ParseResult src) (CondTree ConfVar TestSuiteStanza)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' TestSuiteStanza
-> (BuildInfo -> TestSuiteStanza)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar TestSuiteStanza)
forall a src.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar a)
parseCondTree' ParsecFieldGrammar' TestSuiteStanza
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, 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 CommaFSep Token String),
 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 NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Framework))
      (SymbolicPath Pkg ('Dir Framework))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Lib))
      (SymbolicPath Pkg ('Dir Lib))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Source))
      (SymbolicPath Pkg ('Dir Source))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Include))
      (SymbolicPath Pkg ('Dir Include))),
 c (List
      FSep (SymbolicPathNT Include 'File) (SymbolicPath Include 'File)),
 c (List
      FSep
      (RelativePathNT Framework 'File)
      (RelativePath Framework 'File)),
 c (List
      FSep (RelativePathNT Include 'File) (RelativePath Include 'File)),
 c (List VCat (SymbolicPathNT Pkg 'File) (SymbolicPath Pkg 'File)),
 c (RelativePathNT Source 'File), c (List VCat Token String),
 c (MQuoted Language)) =>
g TestSuiteStanza TestSuiteStanza
testSuiteFieldGrammar (UnqualComponentName -> BuildInfo -> TestSuiteStanza
forall a. FromBuildInfo a => UnqualComponentName -> BuildInfo -> a
fromBuildInfo' UnqualComponentName
name') Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields
          CondTree ConfVar TestSuite
testSuite <- ParseResult src (CondTree ConfVar TestSuite)
-> StateT SectionS (ParseResult src) (CondTree ConfVar TestSuite)
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src (CondTree ConfVar TestSuite)
 -> StateT SectionS (ParseResult src) (CondTree ConfVar TestSuite))
-> ParseResult src (CondTree ConfVar TestSuite)
-> StateT SectionS (ParseResult src) (CondTree ConfVar TestSuite)
forall a b. (a -> b) -> a -> b
$ (TestSuiteStanza -> ParseResult src TestSuite)
-> CondTree ConfVar TestSuiteStanza
-> ParseResult src (CondTree ConfVar TestSuite)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CondTree ConfVar a -> f (CondTree ConfVar b)
traverse (CabalSpecVersion
-> Position -> TestSuiteStanza -> ParseResult src TestSuite
forall src.
CabalSpecVersion
-> Position -> TestSuiteStanza -> ParseResult src TestSuite
validateTestSuite CabalSpecVersion
specVer Position
pos) CondTree ConfVar TestSuiteStanza
testStanza

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

          -- TODO check duplicate name here?
          LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
-> (([(UnqualComponentName, CondTree ConfVar TestSuite)]
     -> Identity [(UnqualComponentName, CondTree ConfVar TestSuite)])
    -> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([(UnqualComponentName, CondTree ConfVar TestSuite)]
    -> Identity [(UnqualComponentName, CondTree ConfVar TestSuite)])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UnqualComponentName, CondTree ConfVar TestSuite)]
 -> Identity [(UnqualComponentName, CondTree ConfVar TestSuite)])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar TestSuite)]
L.condTestSuites (([(UnqualComponentName, CondTree ConfVar TestSuite)]
  -> Identity [(UnqualComponentName, CondTree ConfVar TestSuite)])
 -> SectionS -> Identity SectionS)
-> ([(UnqualComponentName, CondTree ConfVar TestSuite)]
    -> [(UnqualComponentName, CondTree ConfVar TestSuite)])
-> StateT SectionS (ParseResult src) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UnqualComponentName, CondTree ConfVar TestSuite)
-> [(UnqualComponentName, CondTree ConfVar TestSuite)]
-> [(UnqualComponentName, CondTree ConfVar TestSuite)]
forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar TestSuite
testSuite)
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"benchmark" = do
          Map String CondTreeBuildInfo
commonStanzas <- Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
-> StateT SectionS (ParseResult src) (Map String CondTreeBuildInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map String CondTreeBuildInfo)
  SectionS
  (Map String CondTreeBuildInfo)
Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas
          UnqualComponentName
name' <- Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
forall src.
Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
          CondTree ConfVar BenchmarkStanza
benchStanza <- ParseResult src (CondTree ConfVar BenchmarkStanza)
-> StateT
     SectionS (ParseResult src) (CondTree ConfVar BenchmarkStanza)
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src (CondTree ConfVar BenchmarkStanza)
 -> StateT
      SectionS (ParseResult src) (CondTree ConfVar BenchmarkStanza))
-> ParseResult src (CondTree ConfVar BenchmarkStanza)
-> StateT
     SectionS (ParseResult src) (CondTree ConfVar BenchmarkStanza)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' BenchmarkStanza
-> (BuildInfo -> BenchmarkStanza)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar BenchmarkStanza)
forall a src.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult src (CondTree ConfVar a)
parseCondTree' ParsecFieldGrammar' BenchmarkStanza
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, 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 NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Framework))
      (SymbolicPath Pkg ('Dir Framework))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Lib))
      (SymbolicPath Pkg ('Dir Lib))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Source))
      (SymbolicPath Pkg ('Dir Source))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Include))
      (SymbolicPath Pkg ('Dir Include))),
 c (List
      FSep (SymbolicPathNT Include 'File) (SymbolicPath Include 'File)),
 c (List
      FSep
      (RelativePathNT Framework 'File)
      (RelativePath Framework 'File)),
 c (List
      FSep (RelativePathNT Include 'File) (RelativePath Include 'File)),
 c (List VCat (SymbolicPathNT Pkg 'File) (SymbolicPath Pkg 'File)),
 c (RelativePathNT Source 'File), c (List VCat Token String),
 c (MQuoted Language)) =>
g BenchmarkStanza BenchmarkStanza
benchmarkFieldGrammar (UnqualComponentName -> BuildInfo -> BenchmarkStanza
forall a. FromBuildInfo a => UnqualComponentName -> BuildInfo -> a
fromBuildInfo' UnqualComponentName
name') Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields
          CondTree ConfVar Benchmark
bench <- ParseResult src (CondTree ConfVar Benchmark)
-> StateT SectionS (ParseResult src) (CondTree ConfVar Benchmark)
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src (CondTree ConfVar Benchmark)
 -> StateT SectionS (ParseResult src) (CondTree ConfVar Benchmark))
-> ParseResult src (CondTree ConfVar Benchmark)
-> StateT SectionS (ParseResult src) (CondTree ConfVar Benchmark)
forall a b. (a -> b) -> a -> b
$ (BenchmarkStanza -> ParseResult src Benchmark)
-> CondTree ConfVar BenchmarkStanza
-> ParseResult src (CondTree ConfVar Benchmark)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CondTree ConfVar a -> f (CondTree ConfVar b)
traverse (CabalSpecVersion
-> Position -> BenchmarkStanza -> ParseResult src Benchmark
forall src.
CabalSpecVersion
-> Position -> BenchmarkStanza -> ParseResult src Benchmark
validateBenchmark CabalSpecVersion
specVer Position
pos) CondTree ConfVar BenchmarkStanza
benchStanza

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

          -- TODO check duplicate name here?
          LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
-> (([(UnqualComponentName, CondTree ConfVar Benchmark)]
     -> Identity [(UnqualComponentName, CondTree ConfVar Benchmark)])
    -> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([(UnqualComponentName, CondTree ConfVar Benchmark)]
    -> Identity [(UnqualComponentName, CondTree ConfVar Benchmark)])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UnqualComponentName, CondTree ConfVar Benchmark)]
 -> Identity [(UnqualComponentName, CondTree ConfVar Benchmark)])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar Benchmark)]
L.condBenchmarks (([(UnqualComponentName, CondTree ConfVar Benchmark)]
  -> Identity [(UnqualComponentName, CondTree ConfVar Benchmark)])
 -> SectionS -> Identity SectionS)
-> ([(UnqualComponentName, CondTree ConfVar Benchmark)]
    -> [(UnqualComponentName, CondTree ConfVar Benchmark)])
-> StateT SectionS (ParseResult src) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UnqualComponentName, CondTree ConfVar Benchmark)
-> [(UnqualComponentName, CondTree ConfVar Benchmark)]
-> [(UnqualComponentName, CondTree ConfVar Benchmark)]
forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar Benchmark
bench)
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"flag" = do
          ByteString
name' <- Position -> [SectionArg Position] -> SectionParser src ByteString
forall src.
Position -> [SectionArg Position] -> SectionParser src ByteString
parseNameBS Position
pos [SectionArg Position]
args
          FlagName
name'' <- ParseResult src FlagName
-> StateT SectionS (ParseResult src) FlagName
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src FlagName
 -> StateT SectionS (ParseResult src) FlagName)
-> ParseResult src FlagName
-> StateT SectionS (ParseResult src) FlagName
forall a b. (a -> b) -> a -> b
$ [Position]
-> ParsecParser FlagName
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult src FlagName
forall a src.
[Position]
-> ParsecParser a
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult src a
runFieldParser' [Position
pos] ParsecParser FlagName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m FlagName
parsec CabalSpecVersion
specVer (ByteString -> FieldLineStream
fieldLineStreamFromBS ByteString
name') ParseResult src FlagName -> FlagName -> ParseResult src FlagName
forall src a. ParseResult src a -> a -> ParseResult src a
`recoverWith` String -> FlagName
mkFlagName String
""
          PackageFlag
flag <- ParseResult src PackageFlag
-> StateT SectionS (ParseResult src) PackageFlag
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src PackageFlag
 -> StateT SectionS (ParseResult src) PackageFlag)
-> ParseResult src PackageFlag
-> StateT SectionS (ParseResult src) PackageFlag
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion
-> [Field Position]
-> ParsecFieldGrammar' PackageFlag
-> ParseResult src PackageFlag
forall a src.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult src a
parseFields CabalSpecVersion
specVer [Field Position]
fields (FlagName -> ParsecFieldGrammar' PackageFlag
forall (c :: * -> Constraint) (g :: * -> * -> *).
FieldGrammar c g =>
FlagName -> g PackageFlag PackageFlag
flagFieldGrammar FlagName
name'')
          -- Check default flag
          LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
-> (([PackageFlag] -> Identity [PackageFlag])
    -> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([PackageFlag] -> Identity [PackageFlag])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([PackageFlag] -> Identity [PackageFlag])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens' GenericPackageDescription [PackageFlag]
L.genPackageFlags (([PackageFlag] -> Identity [PackageFlag])
 -> SectionS -> Identity SectionS)
-> ([PackageFlag] -> [PackageFlag])
-> StateT SectionS (ParseResult src) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= PackageFlag -> [PackageFlag] -> [PackageFlag]
forall {a}. a -> [a] -> [a]
snoc PackageFlag
flag
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"custom-setup" Bool -> Bool -> Bool
&& [SectionArg Position] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SectionArg Position]
args = do
          SetupBuildInfo
sbi <- ParseResult src SetupBuildInfo
-> StateT SectionS (ParseResult src) SetupBuildInfo
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src SetupBuildInfo
 -> StateT SectionS (ParseResult src) SetupBuildInfo)
-> ParseResult src SetupBuildInfo
-> StateT SectionS (ParseResult src) SetupBuildInfo
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion
-> [Field Position]
-> ParsecFieldGrammar' SetupBuildInfo
-> ParseResult src SetupBuildInfo
forall a src.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult src a
parseFields CabalSpecVersion
specVer [Field Position]
fields (Bool -> ParsecFieldGrammar' SetupBuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g,
 c (List CommaVCat (Identity Dependency) Dependency)) =>
Bool -> g SetupBuildInfo SetupBuildInfo
setupBInfoFieldGrammar Bool
False)
          LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
-> ((Maybe SetupBuildInfo -> Identity (Maybe SetupBuildInfo))
    -> GenericPackageDescription -> Identity GenericPackageDescription)
-> (Maybe SetupBuildInfo -> Identity (Maybe SetupBuildInfo))
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  PackageDescription
  PackageDescription
Lens' GenericPackageDescription PackageDescription
L.packageDescription LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  PackageDescription
  PackageDescription
-> ((Maybe SetupBuildInfo -> Identity (Maybe SetupBuildInfo))
    -> PackageDescription -> Identity PackageDescription)
-> (Maybe SetupBuildInfo -> Identity (Maybe SetupBuildInfo))
-> GenericPackageDescription
-> Identity GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SetupBuildInfo -> Identity (Maybe SetupBuildInfo))
-> PackageDescription -> Identity PackageDescription
Lens' PackageDescription (Maybe SetupBuildInfo)
L.setupBuildInfo ((Maybe SetupBuildInfo -> Identity (Maybe SetupBuildInfo))
 -> SectionS -> Identity SectionS)
-> SetupBuildInfo -> StateT SectionS (ParseResult src) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= SetupBuildInfo
sbi
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"source-repository" = do
          RepoKind
kind <- ParseResult src RepoKind
-> StateT SectionS (ParseResult src) RepoKind
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src RepoKind
 -> StateT SectionS (ParseResult src) RepoKind)
-> ParseResult src RepoKind
-> StateT SectionS (ParseResult src) RepoKind
forall a b. (a -> b) -> a -> b
$ case [SectionArg Position]
args of
            [SecArgName Position
spos ByteString
secName] ->
              [Position]
-> ParsecParser RepoKind
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult src RepoKind
forall a src.
[Position]
-> ParsecParser a
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult src a
runFieldParser' [Position
spos] ParsecParser RepoKind
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m RepoKind
parsec CabalSpecVersion
specVer (ByteString -> FieldLineStream
fieldLineStreamFromBS ByteString
secName) ParseResult src RepoKind -> RepoKind -> ParseResult src RepoKind
forall src a. ParseResult src a -> a -> ParseResult src a
`recoverWith` RepoKind
RepoHead
            [] -> do
              Position -> String -> ParseResult src ()
forall src. Position -> String -> ParseResult src ()
parseFailure Position
pos String
"'source-repository' requires exactly one argument"
              RepoKind -> ParseResult src RepoKind
forall a. a -> ParseResult src a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoKind
RepoHead
            [SectionArg Position]
_ -> do
              Position -> String -> ParseResult src ()
forall src. Position -> String -> ParseResult src ()
parseFailure Position
pos (String -> ParseResult src ()) -> String -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid source-repository kind " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SectionArg Position] -> String
forall a. Show a => a -> String
show [SectionArg Position]
args
              RepoKind -> ParseResult src RepoKind
forall a. a -> ParseResult src a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoKind
RepoHead

          SourceRepo
sr <- ParseResult src SourceRepo
-> StateT SectionS (ParseResult src) SourceRepo
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src SourceRepo
 -> StateT SectionS (ParseResult src) SourceRepo)
-> ParseResult src SourceRepo
-> StateT SectionS (ParseResult src) SourceRepo
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion
-> [Field Position]
-> ParsecFieldGrammar' SourceRepo
-> ParseResult src SourceRepo
forall a src.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult src a
parseFields CabalSpecVersion
specVer [Field Position]
fields (RepoKind -> ParsecFieldGrammar' SourceRepo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, c (Identity RepoType)) =>
RepoKind -> g SourceRepo SourceRepo
sourceRepoFieldGrammar RepoKind
kind)
          LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
  Identity
  SectionS
  SectionS
  GenericPackageDescription
  GenericPackageDescription
-> (([SourceRepo] -> Identity [SourceRepo])
    -> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([SourceRepo] -> Identity [SourceRepo])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  PackageDescription
  PackageDescription
Lens' GenericPackageDescription PackageDescription
L.packageDescription LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  PackageDescription
  PackageDescription
-> (([SourceRepo] -> Identity [SourceRepo])
    -> PackageDescription -> Identity PackageDescription)
-> ([SourceRepo] -> Identity [SourceRepo])
-> GenericPackageDescription
-> Identity GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SourceRepo] -> Identity [SourceRepo])
-> PackageDescription -> Identity PackageDescription
Lens' PackageDescription [SourceRepo]
L.sourceRepos (([SourceRepo] -> Identity [SourceRepo])
 -> SectionS -> Identity SectionS)
-> ([SourceRepo] -> [SourceRepo])
-> StateT SectionS (ParseResult src) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= SourceRepo -> [SourceRepo] -> [SourceRepo]
forall {a}. a -> [a] -> [a]
snoc SourceRepo
sr
      | Bool
otherwise =
          ParseResult src () -> StateT SectionS (ParseResult src) ()
forall (m :: * -> *) a. Monad m => m a -> StateT SectionS m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParseResult src () -> StateT SectionS (ParseResult src) ())
-> ParseResult src () -> StateT SectionS (ParseResult src) ()
forall a b. (a -> b) -> a -> b
$
            Position -> PWarnType -> String -> ParseResult src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
parseWarning Position
pos PWarnType
PWTUnknownSection (String -> ParseResult src ()) -> String -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$
              String
"Ignoring section: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
name

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

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

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

-- TODO: avoid conversion to 'String'.
parseUnqualComponentName :: Position -> [SectionArg Position] -> SectionParser src UnqualComponentName
parseUnqualComponentName :: forall src.
Position
-> [SectionArg Position] -> SectionParser src UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args = String -> UnqualComponentName
mkUnqualComponentName (String -> UnqualComponentName)
-> StateT SectionS (ParseResult src) String
-> StateT SectionS (ParseResult src) UnqualComponentName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> [SectionArg Position]
-> StateT SectionS (ParseResult src) String
forall src.
Position -> [SectionArg Position] -> SectionParser src 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 src a
parseFields :: forall a src.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult src a
parseFields CabalSpecVersion
v [Field Position]
fields ParsecFieldGrammar' a
grammar = do
  let (Fields Position
fs0, [[Section Position]]
ss) = [Field Position] -> (Fields Position, [[Section Position]])
forall ann. [Field ann] -> (Fields ann, [[Section ann]])
partitionFields [Field Position]
fields
  ([Section Position] -> ParseResult src ())
-> [[Section Position]] -> ParseResult src ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Section Position -> ParseResult src ())
-> [Section Position] -> ParseResult src ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Section Position -> ParseResult src ()
forall src. Section Position -> ParseResult src ()
warnInvalidSubsection) [[Section Position]]
ss
  CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar' a -> ParseResult src a
forall s a src.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult src a
parseFieldGrammar CabalSpecVersion
v Fields Position
fs0 ParsecFieldGrammar' a
grammar

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

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

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

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

    parseElseIfs
      :: [Section Position]
      -> ParseResult src (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
    parseElseIfs :: [Section Position]
-> ParseResult
     src (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
parseElseIfs [] = (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
-> ParseResult
     src (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
forall a. a -> ParseResult src a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CondTree ConfVar a)
forall a. Maybe a
Nothing, [])
    parseElseIfs (MkSection (Name Position
pos ByteString
name) [SectionArg Position]
args [Field Position]
fields : [Section Position]
sections) | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"else" = do
      Bool -> ParseResult src () -> ParseResult src ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SectionArg Position] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SectionArg Position]
args) (ParseResult src () -> ParseResult src ())
-> ParseResult src () -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$
        Position -> String -> ParseResult src ()
forall src. Position -> String -> ParseResult src ()
parseFailure Position
pos (String -> ParseResult src ()) -> String -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$
          String
"`else` section has section arguments " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SectionArg Position] -> String
forall a. Show a => a -> String
show [SectionArg Position]
args
      CondTree ConfVar a
elseFields <- [Field Position] -> ParseResult src (CondTree ConfVar a)
go [Field Position]
fields
      [CondBranch ConfVar a]
sections' <- [Section Position] -> ParseResult src [CondBranch ConfVar a]
parseIfs [Section Position]
sections
      (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
-> ParseResult
     src (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
forall a. a -> ParseResult src a
forall (m :: * -> *) a. Monad m => a -> m a
return (CondTree ConfVar a -> Maybe (CondTree ConfVar a)
forall a. a -> Maybe a
Just CondTree ConfVar a
elseFields, [CondBranch ConfVar a]
sections')
    parseElseIfs (MkSection (Name Position
pos ByteString
name) [SectionArg Position]
test [Field Position]
fields : [Section Position]
sections)
      | HasElif
hasElif HasElif -> HasElif -> Bool
forall a. Eq a => a -> a -> Bool
== HasElif
HasElif
      , ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"elif" = do
          Condition ConfVar
test' <- Position
-> [SectionArg Position] -> ParseResult src (Condition ConfVar)
forall src.
Position
-> [SectionArg Position] -> ParseResult src (Condition ConfVar)
parseConditionConfVar (Position -> [SectionArg Position] -> Position
startOfSection (Int -> Position -> Position
incPos Int
4 Position
pos) [SectionArg Position]
test) [SectionArg Position]
test
          CondTree ConfVar a
fields' <- [Field Position] -> ParseResult src (CondTree ConfVar a)
go [Field Position]
fields
          (Maybe (CondTree ConfVar a)
elseFields, [CondBranch ConfVar a]
sections') <- [Section Position]
-> ParseResult
     src (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
parseElseIfs [Section Position]
sections
          -- we parse an empty 'Fields', to get empty value for a node
          a
a <- CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar' a -> ParseResult src a
forall s a src.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult src a
parseFieldGrammar CabalSpecVersion
v Fields Position
forall a. Monoid a => a
mempty ParsecFieldGrammar' a
grammar
          (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
-> ParseResult
     src (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
forall a. a -> ParseResult src a
forall (m :: * -> *) a. Monad m => a -> m a
return (CondTree ConfVar a -> Maybe (CondTree ConfVar a)
forall a. a -> Maybe a
Just (CondTree ConfVar a -> Maybe (CondTree ConfVar a))
-> CondTree ConfVar a -> Maybe (CondTree ConfVar a)
forall a b. (a -> b) -> a -> b
$ a -> [CondBranch ConfVar a] -> CondTree ConfVar a
forall v a. a -> [CondBranch v a] -> CondTree v a
CondNode a
a [Condition ConfVar
-> CondTree ConfVar a
-> Maybe (CondTree ConfVar a)
-> CondBranch ConfVar a
forall v a.
Condition v
-> CondTree v a -> Maybe (CondTree v a) -> CondBranch v a
CondBranch Condition ConfVar
test' CondTree ConfVar a
fields' Maybe (CondTree ConfVar a)
elseFields], [CondBranch ConfVar a]
sections')
    parseElseIfs (MkSection (Name Position
pos ByteString
name) [SectionArg Position]
_ [Field Position]
_ : [Section Position]
sections) | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"elif" = do
      Position -> PWarnType -> String -> ParseResult src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
parseWarning Position
pos PWarnType
PWTInvalidSubsection String
"invalid subsection \"elif\". You should set cabal-version: 2.2 or larger to use elif-conditionals."
      (,) Maybe (CondTree ConfVar a)
forall a. Maybe a
Nothing ([CondBranch ConfVar a]
 -> (Maybe (CondTree ConfVar a), [CondBranch ConfVar a]))
-> ParseResult src [CondBranch ConfVar a]
-> ParseResult
     src (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Section Position] -> ParseResult src [CondBranch ConfVar a]
parseIfs [Section Position]
sections
    parseElseIfs [Section Position]
sections = (,) Maybe (CondTree ConfVar a)
forall a. Maybe a
Nothing ([CondBranch ConfVar a]
 -> (Maybe (CondTree ConfVar a), [CondBranch ConfVar a]))
-> ParseResult src [CondBranch ConfVar a]
-> ParseResult
     src (Maybe (CondTree ConfVar a), [CondBranch ConfVar a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Section Position] -> ParseResult src [CondBranch ConfVar a]
parseIfs [Section Position]
sections

startOfSection :: Position -> [SectionArg Position] -> Position
-- The case where we have no args is the start of the section
startOfSection :: Position -> [SectionArg Position] -> Position
startOfSection Position
defaultPos [] = Position
defaultPos
-- Otherwise the start of the section is the position of the first argument.
startOfSection Position
_ (SectionArg Position
cond : [SectionArg Position]
_) = SectionArg Position -> Position
forall ann. SectionArg ann -> ann
sectionArgAnn SectionArg Position
cond

{- 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 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 = n
    , libVisibility = case n of
        LibraryName
LMainLibName -> LibraryVisibility
LibraryVisibilityPublic
        LSubLibName UnqualComponentName
_ -> LibraryVisibility
LibraryVisibilityPrivate
    , libBuildInfo = bi
    }

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

instance FromBuildInfo TestSuiteStanza where
  fromBuildInfo' :: UnqualComponentName -> BuildInfo -> TestSuiteStanza
fromBuildInfo' UnqualComponentName
_ BuildInfo
bi = Maybe TestType
-> Maybe (RelativePath Source 'File)
-> Maybe ModuleName
-> BuildInfo
-> [String]
-> TestSuiteStanza
TestSuiteStanza Maybe TestType
forall a. Maybe a
Nothing Maybe (RelativePath Source 'File)
forall a. Maybe a
Nothing Maybe ModuleName
forall a. Maybe a
Nothing BuildInfo
bi []

instance FromBuildInfo BenchmarkStanza where
  fromBuildInfo' :: UnqualComponentName -> BuildInfo -> BenchmarkStanza
fromBuildInfo' UnqualComponentName
_ BuildInfo
bi = Maybe BenchmarkType
-> Maybe (RelativePath Source 'File)
-> Maybe ModuleName
-> BuildInfo
-> BenchmarkStanza
BenchmarkStanza Maybe BenchmarkType
forall a. Maybe a
Nothing Maybe (RelativePath Source 'File)
forall a. Maybe a
Nothing Maybe ModuleName
forall a. Maybe a
Nothing BuildInfo
bi

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

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

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

    go :: [CondTreeBuildInfo]
-> [Field Position]
-> ParseResult
     src ([Field Position], CondTree ConfVar a -> CondTree ConfVar a)
go [CondTreeBuildInfo]
acc (Field (Name Position
pos ByteString
name) [FieldLine Position]
_ : [Field Position]
fields)
      | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"import"
      , HasCommonStanzas
hasCommonStanzas HasCommonStanzas -> HasCommonStanzas -> Bool
forall a. Eq a => a -> a -> Bool
== HasCommonStanzas
NoCommonStanzas = do
          Position -> PWarnType -> String -> ParseResult src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
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
     src ([Field Position], CondTree ConfVar a -> CondTree ConfVar 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 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"import" = do
      [String]
names <- List CommaFSep Token String -> [String]
getList' (List CommaFSep Token String -> [String])
-> ParseResult src (List CommaFSep Token String)
-> ParseResult src [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> ParsecParser (List CommaFSep Token String)
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult src (List CommaFSep Token String)
forall a src.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult src a
runFieldParser Position
pos ParsecParser (List CommaFSep Token String)
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *).
CabalParsing m =>
m (List CommaFSep Token String)
parsec CabalSpecVersion
v [FieldLine Position]
fls
      [Maybe CondTreeBuildInfo]
names' <- [String]
-> (String -> ParseResult src (Maybe CondTreeBuildInfo))
-> ParseResult src [Maybe CondTreeBuildInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [String]
names ((String -> ParseResult src (Maybe CondTreeBuildInfo))
 -> ParseResult src [Maybe CondTreeBuildInfo])
-> (String -> ParseResult src (Maybe CondTreeBuildInfo))
-> ParseResult src [Maybe CondTreeBuildInfo]
forall a b. (a -> b) -> a -> b
$ \String
commonName ->
        case String -> Map String CondTreeBuildInfo -> Maybe CondTreeBuildInfo
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 src ()
forall src. Position -> String -> ParseResult src ()
parseFailure Position
pos (String -> ParseResult src ()) -> String -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$ String
"Undefined common stanza imported: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
commonName
            Maybe CondTreeBuildInfo
-> ParseResult src (Maybe CondTreeBuildInfo)
forall a. a -> ParseResult src a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CondTreeBuildInfo
forall a. Maybe a
Nothing
          Just CondTreeBuildInfo
commonTree ->
            Maybe CondTreeBuildInfo
-> ParseResult src (Maybe CondTreeBuildInfo)
forall a. a -> ParseResult src a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CondTreeBuildInfo -> Maybe CondTreeBuildInfo
forall a. a -> Maybe a
Just CondTreeBuildInfo
commonTree)

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

-- | Warn on "import" fields, also map to Maybe, so erroneous fields can be filtered
warnImport :: CabalSpecVersion -> Field Position -> ParseResult src (Maybe (Field Position))
warnImport :: forall src.
CabalSpecVersion
-> Field Position -> ParseResult src (Maybe (Field Position))
warnImport CabalSpecVersion
v (Field (Name Position
pos ByteString
name) [FieldLine Position]
_) | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"import" = do
  if CabalSpecVersion -> HasCommonStanzas
specHasCommonStanzas CabalSpecVersion
v HasCommonStanzas -> HasCommonStanzas -> Bool
forall a. Eq a => a -> a -> Bool
== HasCommonStanzas
NoCommonStanzas
    then Position -> PWarnType -> String -> ParseResult src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
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 src ()
forall src. Position -> PWarnType -> String -> ParseResult src ()
parseWarning Position
pos PWarnType
PWTUnknownField String
"Unknown field: import. Common stanza imports should be at the top of the enclosing section"
  Maybe (Field Position) -> ParseResult src (Maybe (Field Position))
forall a. a -> ParseResult src a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Field Position)
forall a. Maybe a
Nothing
warnImport CabalSpecVersion
_ Field Position
f = Maybe (Field Position) -> ParseResult src (Maybe (Field Position))
forall a. a -> ParseResult src a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field Position -> Maybe (Field Position)
forall a. a -> Maybe a
Just Field Position
f)

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

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

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

-- Check that a property holds on all branches of a condition tree
onAllBranches :: forall v a. Monoid a => (a -> Bool) -> CondTree v a -> Bool
onAllBranches :: forall v a. Monoid a => (a -> Bool) -> CondTree v a -> Bool
onAllBranches a -> Bool
p = a -> CondTree v a -> Bool
go a
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 a -> Bool
    go :: a -> CondTree v a -> Bool
go a
acc CondTree v a
ct =
      let acc' :: a
acc' = a
acc a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` CondTree v a -> a
forall v a. CondTree v a -> a
condTreeData CondTree v a
ct
       in a -> Bool
p a
acc' Bool -> Bool -> Bool
|| (CondBranch v a -> Bool) -> [CondBranch v a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> CondBranch v a -> Bool
goBranch a
acc') (CondTree v a -> [CondBranch v a]
forall v a. CondTree v a -> [CondBranch v a]
condTreeComponents CondTree v a
ct)

    -- Both the 'true' and the 'false' block must satisfy the property.
    goBranch :: a -> CondBranch v a -> Bool
    goBranch :: a -> CondBranch v a -> Bool
goBranch a
_ (CondBranch Condition v
_ CondTree v a
_ Maybe (CondTree v a)
Nothing) = Bool
False
    goBranch a
acc (CondBranch Condition v
_ CondTree v a
t (Just CondTree v a
e)) = a -> CondTree v a -> Bool
go a
acc CondTree v a
t Bool -> Bool -> Bool
&& a -> CondTree v a -> Bool
go a
acc CondTree v 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 src ()
checkForUndefinedFlags :: forall src. GenericPackageDescription -> ParseResult src ()
checkForUndefinedFlags GenericPackageDescription
gpd = do
  let definedFlags, usedFlags :: Set.Set FlagName
      definedFlags :: Set FlagName
definedFlags = Getting (Set FlagName) GenericPackageDescription FlagName
-> GenericPackageDescription -> Set FlagName
forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [PackageFlag]
  [PackageFlag]
Lens' GenericPackageDescription [PackageFlag]
L.genPackageFlags LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [PackageFlag]
  [PackageFlag]
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> [PackageFlag] -> Const (Set FlagName) [PackageFlag])
-> Getting (Set FlagName) GenericPackageDescription FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageFlag -> Const (Set FlagName) PackageFlag)
-> [PackageFlag] -> Const (Set FlagName) [PackageFlag]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((PackageFlag -> Const (Set FlagName) PackageFlag)
 -> [PackageFlag] -> Const (Set FlagName) [PackageFlag])
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> PackageFlag -> Const (Set FlagName) PackageFlag)
-> (FlagName -> Const (Set FlagName) FlagName)
-> [PackageFlag]
-> Const (Set FlagName) [PackageFlag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageFlag -> FlagName)
-> (FlagName -> Const (Set FlagName) FlagName)
-> PackageFlag
-> Const (Set FlagName) PackageFlag
forall s a r. (s -> a) -> Getting r s a
getting PackageFlag -> FlagName
flagName) GenericPackageDescription
gpd
      usedFlags :: Set FlagName
usedFlags = Const (Set FlagName) GenericPackageDescription -> Set FlagName
forall {k} a (b :: k). Const a b -> a
getConst (Const (Set FlagName) GenericPackageDescription -> Set FlagName)
-> Const (Set FlagName) GenericPackageDescription -> Set FlagName
forall a b. (a -> b) -> a -> b
$ (forall a.
 CondTree ConfVar a -> Const (Set FlagName) (CondTree ConfVar a))
-> GenericPackageDescription
-> Const (Set FlagName) GenericPackageDescription
forall (f :: * -> *).
Applicative f =>
(forall a. CondTree ConfVar a -> f (CondTree ConfVar a))
-> GenericPackageDescription -> f GenericPackageDescription
L.allCondTrees CondTree ConfVar a -> Const (Set FlagName) (CondTree ConfVar a)
forall a.
CondTree ConfVar a -> Const (Set FlagName) (CondTree ConfVar a)
f GenericPackageDescription
gpd

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

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

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

  Bool -> ParseResult src () -> ParseResult src ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageDescription -> BuildType
buildType PackageDescription
pd BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Hooks Bool -> Bool -> Bool
&& Maybe SetupBuildInfo -> Bool
forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pd)) (ParseResult src () -> ParseResult src ())
-> ParseResult src () -> ParseResult src ()
forall a b. (a -> b) -> a -> b
$
    Position -> String -> ParseResult src ()
forall src. Position -> String -> ParseResult src ()
parseFailure Position
zeroPos String
"Packages with build-type: Hooks require a custom-setup stanza"

-------------------------------------------------------------------------------
-- 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 CabalSpecVersion -> CabalSpecVersion -> Bool
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 =
      ASetter BuildInfo BuildInfo [Dependency] [Dependency]
-> ([Dependency] -> [Dependency]) -> BuildInfo -> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter BuildInfo BuildInfo [Dependency] [Dependency]
forall a. HasBuildInfo a => Lens' a [Dependency]
Lens' BuildInfo [Dependency]
L.targetBuildDepends ((Dependency -> [Dependency]) -> [Dependency] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Dependency -> [Dependency]
transformD)
        (BuildInfo -> BuildInfo)
-> (BuildInfo -> BuildInfo) -> BuildInfo -> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter BuildInfo BuildInfo [Mixin] [Mixin]
-> ([Mixin] -> [Mixin]) -> BuildInfo -> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter BuildInfo BuildInfo [Mixin] [Mixin]
forall a. HasBuildInfo a => Lens' a [Mixin]
Lens' BuildInfo [Mixin]
L.mixins ((Mixin -> Mixin) -> [Mixin] -> [Mixin]
forall a b. (a -> b) -> [a] -> [b]
map Mixin -> Mixin
transformM)

    transformSBI :: SetupBuildInfo -> SetupBuildInfo
    transformSBI :: SetupBuildInfo -> SetupBuildInfo
transformSBI = ASetter SetupBuildInfo SetupBuildInfo [Dependency] [Dependency]
-> ([Dependency] -> [Dependency])
-> SetupBuildInfo
-> SetupBuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter SetupBuildInfo SetupBuildInfo [Dependency] [Dependency]
Lens' SetupBuildInfo [Dependency]
L.setupDepends ((Dependency -> [Dependency]) -> [Dependency] -> [Dependency]
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 UnqualComponentName -> Set UnqualComponentName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnqualComponentName
internalLibs
      , LibraryName
LMainLibName LibraryName -> NonEmptySet LibraryName -> Bool
forall a. Ord a => a -> NonEmptySet a -> Bool
`NES.member` NonEmptySet LibraryName
ln =
          case LibraryName
-> NonEmptySet LibraryName -> Maybe (NonEmptySet LibraryName)
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 (LibraryName -> NonEmptySet LibraryName
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 UnqualComponentName -> Set UnqualComponentName -> Bool
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 =
      [UnqualComponentName] -> Set UnqualComponentName
forall a. Ord a => [a] -> Set a
Set.fromList
        [ UnqualComponentName
n
        | (UnqualComponentName
n, CondTree ConfVar Library
_) <- GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar 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 [Field ann] -> Maybe [(Name ann, [FieldLine ann])]
forall ann. [Field ann] -> Maybe [(Name ann, [FieldLine ann])]
classifyFields [Field ann]
fs of
  Just [(Name ann, [FieldLine ann])]
fields -> (Syntax
OldSyntax, [(Name ann, [FieldLine ann])] -> [Field ann]
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 = (Field ann -> Maybe (Name ann, [FieldLine ann]))
-> [Field ann] -> Maybe [(Name ann, [FieldLine ann])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Field ann -> Maybe (Name ann, [FieldLine ann])
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) = (Name ann, [FieldLine ann]) -> Maybe (Name ann, [FieldLine ann])
forall a. a -> Maybe a
Just (Name ann
name, [FieldLine ann]
fieldlines)
        f Field ann
_ = Maybe (Name ann, [FieldLine ann])
forall a. Maybe a
Nothing

    trim :: ByteString -> ByteString
trim = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isSpace' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isSpace' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse
    isSpace' :: Word8 -> Bool
isSpace' = (Word8 -> Word8 -> Bool
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) = Name ann -> [FieldLine ann] -> Field ann
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) = ((Name ann, [FieldLine ann]) -> Bool)
-> [(Name ann, [FieldLine ann])]
-> ([(Name ann, [FieldLine ann])], [(Name ann, [FieldLine ann])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"executable") (ByteString -> Bool)
-> ((Name ann, [FieldLine ann]) -> ByteString)
-> (Name ann, [FieldLine ann])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name ann -> ByteString
forall ann. Name ann -> ByteString
getName (Name ann -> ByteString)
-> ((Name ann, [FieldLine ann]) -> Name ann)
-> (Name ann, [FieldLine ann])
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name ann, [FieldLine ann]) -> Name ann
forall a b. (a, b) -> a
fst) [(Name ann, [FieldLine ann])]
fields
        ([(Name ann, [FieldLine ann])]
hdr, [(Name ann, [FieldLine ann])]
libfs0) = ((Name ann, [FieldLine ann]) -> Bool)
-> [(Name ann, [FieldLine ann])]
-> ([(Name ann, [FieldLine ann])], [(Name ann, [FieldLine ann])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Bool -> Bool
not (Bool -> Bool)
-> ((Name ann, [FieldLine ann]) -> Bool)
-> (Name ann, [FieldLine ann])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
libFieldNames) (ByteString -> Bool)
-> ((Name ann, [FieldLine ann]) -> ByteString)
-> (Name ann, [FieldLine ann])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name ann -> ByteString
forall ann. Name ann -> ByteString
getName (Name ann -> ByteString)
-> ((Name ann, [FieldLine ann]) -> Name ann)
-> (Name ann, [FieldLine ann])
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name ann, [FieldLine ann]) -> Name ann
forall a b. (a, b) -> a
fst) [(Name ann, [FieldLine ann])]
hdr0

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

        exes :: [Field ann]
exes = ([(Name ann, [FieldLine ann])]
 -> Maybe (Field ann, [(Name ann, [FieldLine ann])]))
-> [(Name ann, [FieldLine ann])] -> [Field ann]
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 [] = Maybe (Field ann, [(Name ann, [FieldLine ann])])
forall a. Maybe a
Nothing
        toExe ((Name ann
pos ByteString
n, [FieldLine ann]
ls) : [(Name ann, [FieldLine ann])]
r)
          | ByteString
n ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"executable" =
              let ([(Name ann, [FieldLine ann])]
efs, [(Name ann, [FieldLine ann])]
r') = ((Name ann, [FieldLine ann]) -> Bool)
-> [(Name ann, [FieldLine ann])]
-> ([(Name ann, [FieldLine ann])], [(Name ann, [FieldLine ann])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"executable") (ByteString -> Bool)
-> ((Name ann, [FieldLine ann]) -> ByteString)
-> (Name ann, [FieldLine ann])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name ann -> ByteString
forall ann. Name ann -> ByteString
getName (Name ann -> ByteString)
-> ((Name ann, [FieldLine ann]) -> Name ann)
-> (Name ann, [FieldLine ann])
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name ann, [FieldLine ann]) -> Name ann
forall a b. (a, b) -> a
fst) [(Name ann, [FieldLine ann])]
r
               in (Field ann, [(Name ann, [FieldLine ann])])
-> Maybe (Field ann, [(Name ann, [FieldLine ann])])
forall a. a -> Maybe a
Just (Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section (ann -> ByteString -> Name ann
forall ann. ann -> ByteString -> Name ann
Name ann
pos ByteString
"executable") [ann -> ByteString -> SectionArg ann
forall ann. ann -> ByteString -> SectionArg ann
SecArgName ann
pos (ByteString -> SectionArg ann) -> ByteString -> SectionArg ann
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
trim (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [FieldLine ann] -> ByteString
forall ann. [FieldLine ann] -> ByteString
fieldlinesToBS [FieldLine ann]
ls] (((Name ann, [FieldLine ann]) -> Field ann)
-> [(Name ann, [FieldLine ann])] -> [Field ann]
forall a b. (a -> b) -> [a] -> [b]
map (Name ann, [FieldLine ann]) -> Field ann
forall {ann}. (Name ann, [FieldLine ann]) -> Field ann
toField ([(Name ann, [FieldLine ann])] -> [Field ann])
-> [(Name ann, [FieldLine ann])] -> [Field ann]
forall a b. (a -> b) -> a -> b
$ [(Name ann, [FieldLine ann])]
deps [(Name ann, [FieldLine ann])]
-> [(Name ann, [FieldLine ann])] -> [(Name ann, [FieldLine ann])]
forall a. [a] -> [a] -> [a]
++ [(Name ann, [FieldLine ann])]
efs), [(Name ann, [FieldLine ann])]
r')
        toExe [(Name ann, [FieldLine ann])]
_ = String -> Maybe (Field ann, [(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])]
_) ->
            [Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section (ann -> ByteString -> Name ann
forall ann. ann -> ByteString -> Name ann
Name ann
pos ByteString
"library") [] (((Name ann, [FieldLine ann]) -> Field ann)
-> [(Name ann, [FieldLine ann])] -> [Field ann]
forall a b. (a -> b) -> [a] -> [b]
map (Name ann, [FieldLine ann]) -> Field ann
forall {ann}. (Name ann, [FieldLine ann]) -> Field ann
toField ([(Name ann, [FieldLine ann])] -> [Field ann])
-> [(Name ann, [FieldLine ann])] -> [Field ann]
forall a b. (a -> b) -> a -> b
$ [(Name ann, [FieldLine ann])]
deps [(Name ann, [FieldLine ann])]
-> [(Name ann, [FieldLine ann])] -> [(Name ann, [FieldLine ann])]
forall a. [a] -> [a] -> [a]
++ [(Name ann, [FieldLine ann])]
libfs)]
       in
        ((Name ann, [FieldLine ann]) -> Field ann)
-> [(Name ann, [FieldLine ann])] -> [Field ann]
forall a b. (a -> b) -> [a] -> [b]
map (Name ann, [FieldLine ann]) -> Field ann
forall {ann}. (Name ann, [FieldLine ann]) -> Field ann
toField [(Name ann, [FieldLine ann])]
hdr [Field ann] -> [Field ann] -> [Field ann]
forall a. [a] -> [a] -> [a]
++ [Field ann]
lib [Field ann] -> [Field ann] -> [Field ann]
forall a. [a] -> [a] -> [a]
++ [Field ann]
exes

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

-- TODO:
libFieldNames :: [FieldName]
libFieldNames :: [ByteString]
libFieldNames = ParsecFieldGrammar' Library -> [ByteString]
forall s a. ParsecFieldGrammar s a -> [ByteString]
fieldGrammarKnownFieldList (LibraryName -> ParsecFieldGrammar' Library
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, 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 NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Framework))
      (SymbolicPath Pkg ('Dir Framework))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Lib))
      (SymbolicPath Pkg ('Dir Lib))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Source))
      (SymbolicPath Pkg ('Dir Source))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Include))
      (SymbolicPath Pkg ('Dir Include))),
 c (List
      FSep (SymbolicPathNT Include 'File) (SymbolicPath Include 'File)),
 c (List
      FSep
      (RelativePathNT Framework 'File)
      (RelativePath Framework 'File)),
 c (List
      FSep (RelativePathNT Include 'File) (RelativePath Include 'File)),
 c (List VCat (SymbolicPathNT Pkg 'File) (SymbolicPath Pkg 'File)),
 c (List VCat Token String), c (MQuoted Language)) =>
LibraryName -> g Library Library
libraryFieldGrammar LibraryName
LMainLibName)

-------------------------------------------------------------------------------
-- Supplementary build information
-------------------------------------------------------------------------------

parseHookedBuildInfo :: BS.ByteString -> ParseResult src HookedBuildInfo
parseHookedBuildInfo :: forall src. ByteString -> ParseResult src 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 src HookedBuildInfo
forall src.
[LexWarning] -> [Field Position] -> ParseResult src HookedBuildInfo
parseHookedBuildInfo' [LexWarning]
lexWarnings [Field Position]
fs
  -- TODO: better marshalling of errors
  Left ParseError
perr -> Position -> String -> ParseResult src HookedBuildInfo
forall src a. Position -> String -> ParseResult src a
parseFatalFailure Position
zeroPos (ParseError -> String
forall a. Show a => a -> String
show ParseError
perr)

parseHookedBuildInfo'
  :: [LexWarning]
  -> [Field Position]
  -> ParseResult src HookedBuildInfo
parseHookedBuildInfo' :: forall src.
[LexWarning] -> [Field Position] -> ParseResult src HookedBuildInfo
parseHookedBuildInfo' [LexWarning]
lexWarnings [Field Position]
fs = do
  [PWarning] -> ParseResult src ()
forall src. [PWarning] -> ParseResult src ()
parseWarnings ([LexWarning] -> [PWarning]
toPWarnings [LexWarning]
lexWarnings)
  (Fields Position
mLibFields, [(UnqualComponentName, Fields Position)]
exes) <- [Field Position]
-> ParseResult
     src (Fields Position, [(UnqualComponentName, Fields Position)])
forall src.
[Field Position]
-> ParseResult
     src (Fields Position, [(UnqualComponentName, Fields Position)])
stanzas [Field Position]
fs
  Maybe BuildInfo
mLib <- Fields Position -> ParseResult src (Maybe BuildInfo)
forall src. Fields Position -> ParseResult src (Maybe BuildInfo)
parseLib Fields Position
mLibFields
  [(UnqualComponentName, BuildInfo)]
biExes <- ((UnqualComponentName, Fields Position)
 -> ParseResult src (UnqualComponentName, BuildInfo))
-> [(UnqualComponentName, Fields Position)]
-> ParseResult src [(UnqualComponentName, BuildInfo)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (UnqualComponentName, Fields Position)
-> ParseResult src (UnqualComponentName, BuildInfo)
forall src.
(UnqualComponentName, Fields Position)
-> ParseResult src (UnqualComponentName, BuildInfo)
parseExe [(UnqualComponentName, Fields Position)]
exes
  HookedBuildInfo -> ParseResult src HookedBuildInfo
forall a. a -> ParseResult src a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BuildInfo
mLib, [(UnqualComponentName, BuildInfo)]
biExes)
  where
    parseLib :: Fields Position -> ParseResult src (Maybe BuildInfo)
    parseLib :: forall src. Fields Position -> ParseResult src (Maybe BuildInfo)
parseLib Fields Position
fields
      | Fields Position -> Bool
forall k a. Map k a -> Bool
Map.null Fields Position
fields = Maybe BuildInfo -> ParseResult src (Maybe BuildInfo)
forall a. a -> ParseResult src a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BuildInfo
forall a. Maybe a
Nothing
      | Bool
otherwise = BuildInfo -> Maybe BuildInfo
forall a. a -> Maybe a
Just (BuildInfo -> Maybe BuildInfo)
-> ParseResult src BuildInfo -> ParseResult src (Maybe BuildInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar' BuildInfo
-> ParseResult src BuildInfo
forall s a src.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult src a
parseFieldGrammar CabalSpecVersion
cabalSpecLatest Fields Position
fields ParsecFieldGrammar' BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g,
 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 NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Framework))
      (SymbolicPath Pkg ('Dir Framework))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Lib))
      (SymbolicPath Pkg ('Dir Lib))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Source))
      (SymbolicPath Pkg ('Dir Source))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Include))
      (SymbolicPath Pkg ('Dir Include))),
 c (List
      FSep (SymbolicPathNT Include 'File) (SymbolicPath Include 'File)),
 c (List
      FSep
      (RelativePathNT Framework 'File)
      (RelativePath Framework 'File)),
 c (List
      FSep (RelativePathNT Include 'File) (RelativePath Include 'File)),
 c (List VCat (SymbolicPathNT Pkg 'File) (SymbolicPath Pkg 'File)),
 c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar

    parseExe :: (UnqualComponentName, Fields Position) -> ParseResult src (UnqualComponentName, BuildInfo)
    parseExe :: forall src.
(UnqualComponentName, Fields Position)
-> ParseResult src (UnqualComponentName, BuildInfo)
parseExe (UnqualComponentName
n, Fields Position
fields) = do
      BuildInfo
bi <- CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar' BuildInfo
-> ParseResult src BuildInfo
forall s a src.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult src a
parseFieldGrammar CabalSpecVersion
cabalSpecLatest Fields Position
fields ParsecFieldGrammar' BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g,
 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 NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Framework))
      (SymbolicPath Pkg ('Dir Framework))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Lib))
      (SymbolicPath Pkg ('Dir Lib))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Source))
      (SymbolicPath Pkg ('Dir Source))),
 c (List
      FSep
      (SymbolicPathNT Pkg ('Dir Include))
      (SymbolicPath Pkg ('Dir Include))),
 c (List
      FSep (SymbolicPathNT Include 'File) (SymbolicPath Include 'File)),
 c (List
      FSep
      (RelativePathNT Framework 'File)
      (RelativePath Framework 'File)),
 c (List
      FSep (RelativePathNT Include 'File) (RelativePath Include 'File)),
 c (List VCat (SymbolicPathNT Pkg 'File) (SymbolicPath Pkg 'File)),
 c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
      (UnqualComponentName, BuildInfo)
-> ParseResult src (UnqualComponentName, BuildInfo)
forall a. a -> ParseResult src a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnqualComponentName
n, BuildInfo
bi)

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

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

    toExe
      :: ([FieldLine Position], [Field Position])
      -> ParseResult src ((UnqualComponentName, Fields Position), Maybe ([FieldLine Position], [Field Position]))
    toExe :: forall src.
([FieldLine Position], [Field Position])
-> ParseResult
     src
     ((UnqualComponentName, Fields Position),
      Maybe ([FieldLine Position], [Field Position]))
toExe ([FieldLine Position]
fss, [Field Position]
fields) = do
      UnqualComponentName
name <- Position
-> ParsecParser UnqualComponentName
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult src UnqualComponentName
forall a src.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult src a
runFieldParser Position
zeroPos ParsecParser UnqualComponentName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m UnqualComponentName
parsec CabalSpecVersion
cabalSpecLatest [FieldLine Position]
fss
      let ([Field Position]
hdr0, Maybe ([FieldLine Position], [Field Position])
rest) = (Field Position -> Maybe [FieldLine Position])
-> [Field Position]
-> ([Field Position],
    Maybe ([FieldLine Position], [Field Position]))
forall a b. (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakMaybe Field Position -> Maybe [FieldLine Position]
forall {ann}. Field ann -> Maybe [FieldLine ann]
isExecutableField [Field Position]
fields
      Fields Position
hdr <- [Field Position] -> ParseResult src (Fields Position)
forall src. [Field Position] -> ParseResult src (Fields Position)
toFields [Field Position]
hdr0
      ((UnqualComponentName, Fields Position),
 Maybe ([FieldLine Position], [Field Position]))
-> ParseResult
     src
     ((UnqualComponentName, Fields Position),
      Maybe ([FieldLine Position], [Field Position]))
forall a. a -> ParseResult src a
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 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"executable" = [FieldLine ann] -> Maybe [FieldLine ann]
forall a. a -> Maybe a
Just [FieldLine ann]
fss
      | Bool
otherwise = Maybe [FieldLine ann]
forall a. Maybe a
Nothing
    isExecutableField Field ann
_ = Maybe [FieldLine 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-spec-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]
_ <- [ByteString] -> Maybe [ByteString]
forall a. a -> Maybe a
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BS.filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x20) ByteString
fstline'
  [ByteString
"cabal-version", ByteString
vers] <- [ByteString] -> Maybe [ByteString]
forall a. a -> Maybe a
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 <- ByteString -> Maybe Version
forall a. Parsec a => ByteString -> Maybe a
simpleParsecBS ByteString
vers
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
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

  Version -> Maybe Version
forall a. a -> Maybe a
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x5b = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
0x20
      | Bool
otherwise = Word8
w