{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.PackageDescription.Parsec
(
parseGenericPackageDescription
, parseGenericPackageDescriptionMaybe
, ParseResult
, runParseResult
, scanSpecVersion
, parseHookedBuildInfo
) where
import Distribution.Compat.Prelude
import Prelude ()
import Control.Monad.State.Strict (StateT, execStateT)
import Control.Monad.Trans.Class (lift)
import Distribution.CabalSpecVersion
import Distribution.Compat.Lens
import Distribution.FieldGrammar
import Distribution.FieldGrammar.Parsec (NamelessField (..))
import Distribution.Fields.ConfVar (parseConditionConfVar)
import Distribution.Fields.Field (FieldName, getName)
import Distribution.Fields.LexerMonad (LexWarning, toPWarnings)
import Distribution.Fields.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 (..), 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
parseGenericPackageDescription :: BS.ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription :: ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription ByteString
bs = do
Maybe Version -> ParseResult ()
setCabalSpecVersion Maybe Version
ver
Maybe CabalSpecVersion
csv <- case Maybe Version
ver of
Just Version
v -> case [Int] -> Maybe CabalSpecVersion
cabalSpecFromVersionDigits (Version -> [Int]
versionNumbers Version
v) of
Just CabalSpecVersion
csv -> Maybe CabalSpecVersion -> ParseResult (Maybe CabalSpecVersion)
forall a. a -> ParseResult 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 (Maybe CabalSpecVersion)
forall a. Position -> String -> ParseResult a
parseFatalFailure Position
zeroPos (String -> ParseResult (Maybe CabalSpecVersion))
-> String -> ParseResult (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 (Maybe CabalSpecVersion)
forall a. a -> ParseResult 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 () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
patched (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
zeroPos PWarnType
PWTQuirkyCabalFile String
"Legacy cabal file"
Maybe CabalSpecVersion
-> [LexWarning]
-> Maybe Int
-> [Field Position]
-> ParseResult GenericPackageDescription
parseGenericPackageDescription' Maybe CabalSpecVersion
csv [LexWarning]
lexWarnings Maybe Int
invalidUtf8 [Field Position]
fs
Left ParseError
perr -> Position -> String -> ParseResult GenericPackageDescription
forall a. Position -> String -> ParseResult 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'
bs'' :: ByteString
bs'' = case Maybe Int
invalidUtf8 of
Maybe Int
Nothing -> ByteString
bs'
Just Int
_ -> String -> ByteString
toUTF8BS (ByteString -> String
fromUTF8BS ByteString
bs')
parseGenericPackageDescriptionMaybe :: BS.ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe :: ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe =
((Maybe Version, NonEmpty PError)
-> Maybe GenericPackageDescription)
-> (GenericPackageDescription -> Maybe GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription
-> Maybe GenericPackageDescription
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe GenericPackageDescription
-> (Maybe Version, NonEmpty PError)
-> 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 PError) GenericPackageDescription
-> Maybe GenericPackageDescription)
-> (ByteString
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription)
-> ByteString
-> Maybe GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription
forall a b. (a, b) -> b
snd (([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription)
-> (ByteString
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> ByteString
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseResult GenericPackageDescription
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult (ParseResult GenericPackageDescription
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> (ByteString -> ParseResult GenericPackageDescription)
-> ByteString
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription
fieldlinesToBS :: [FieldLine ann] -> BS.ByteString
fieldlinesToBS :: forall ann. [FieldLine ann] -> ByteString
fieldlinesToBS = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"\n" ([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)
type SectionParser = StateT SectionS ParseResult
data SectionS = SectionS
{ SectionS -> GenericPackageDescription
_stateGpd :: !GenericPackageDescription
, SectionS -> Map String CondTreeBuildInfo
_stateCommonStanzas :: !(Map String CondTreeBuildInfo)
}
stateGpd :: Lens' SectionS GenericPackageDescription
stateGpd :: Lens' SectionS GenericPackageDescription
stateGpd GenericPackageDescription -> f GenericPackageDescription
f (SectionS GenericPackageDescription
gpd Map String CondTreeBuildInfo
cs) = (\GenericPackageDescription
x -> GenericPackageDescription
-> Map String CondTreeBuildInfo -> SectionS
SectionS GenericPackageDescription
x Map String CondTreeBuildInfo
cs) (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 #-}
parseGenericPackageDescription'
:: Maybe CabalSpecVersion
-> [LexWarning]
-> Maybe Int
-> [Field Position]
-> ParseResult GenericPackageDescription
parseGenericPackageDescription' :: Maybe CabalSpecVersion
-> [LexWarning]
-> Maybe Int
-> [Field Position]
-> ParseResult GenericPackageDescription
parseGenericPackageDescription' Maybe CabalSpecVersion
scannedVer [LexWarning]
lexWarnings Maybe Int
utf8WarnPos [Field Position]
fs = do
[PWarning] -> ParseResult ()
parseWarnings ([LexWarning] -> [PWarning]
toPWarnings [LexWarning]
lexWarnings)
Maybe Int -> (Int -> ParseResult ()) -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Int
utf8WarnPos ((Int -> ParseResult ()) -> ParseResult ())
-> (Int -> ParseResult ()) -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ \Int
pos ->
Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
zeroPos PWarnType
PWTUTF (String -> ParseResult ()) -> String -> ParseResult ()
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'
CabalSpecVersion
specVer <- case Maybe CabalSpecVersion
scannedVer of
Just CabalSpecVersion
v -> CabalSpecVersion -> ParseResult CabalSpecVersion
forall a. a -> ParseResult 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 CabalSpecVersion
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return CabalSpecVersion
CabalSpecV1_0
Just (MkNamelessField Position
pos [FieldLine Position]
fls) -> do
CabalSpecVersion
v <-
ParseResult CabalSpecVersion -> ParseResult CabalSpecVersion
forall a. ParseResult a -> ParseResult a
withoutWarnings (ParseResult CabalSpecVersion -> ParseResult CabalSpecVersion)
-> ParseResult CabalSpecVersion -> ParseResult 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 SpecVersion -> ParseResult CabalSpecVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Position
-> ParsecParser SpecVersion
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult SpecVersion
forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult 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
Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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 CabalSpecVersion
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return CabalSpecVersion
v
let specVer' :: Version
specVer' = [Int] -> Version
mkVersion (CabalSpecVersion -> [Int]
cabalSpecToVersionDigits CabalSpecVersion
specVer)
Maybe Version -> ParseResult ()
setCabalSpecVersion (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
specVer')
PackageDescription
pd <- CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar PackageDescription PackageDescription
-> ParseResult PackageDescription
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
specVer Fields Position
fields ParsecFieldGrammar PackageDescription PackageDescription
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g PackageDescription),
Applicative (g PackageIdentifier), c (Identity BuildType),
c (Identity PackageName), c (Identity Version),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (RelativePathNT from to) (RelativePath from to)),
c (List FSep TestedWith (CompilerFlavor, VersionRange)),
c CompatLicenseFile, c CompatDataDir) =>
g PackageDescription PackageDescription
packageDescriptionFieldGrammar
Bool -> ParseResult () -> ParseResult ()
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 () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
zeroPos (String -> ParseResult ()) -> String -> ParseResult ()
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 ()
maybeWarnCabalVersion Syntax
syntax PackageDescription
pd
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 SectionS -> ParseResult GenericPackageDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT SectionS ParseResult () -> SectionS -> ParseResult SectionS
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (CabalSpecVersion
-> [Field Position] -> StateT SectionS ParseResult ()
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 ()
checkForUndefinedFlags GenericPackageDescription
gpd2
GenericPackageDescription -> ParseResult ()
checkForUndefinedCustomSetup GenericPackageDescription
gpd2
GenericPackageDescription
gpd2 GenericPackageDescription
-> ParseResult GenericPackageDescription
-> ParseResult GenericPackageDescription
forall a b. NFData a => a -> b -> b
`deepseq` GenericPackageDescription -> ParseResult GenericPackageDescription
forall a. a -> ParseResult 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 ()
maybeWarnCabalVersion :: Syntax -> PackageDescription -> ParseResult ()
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 ()
parseWarning Position
zeroPos PWarnType
PWTNewSyntax (String -> ParseResult ()) -> String -> ParseResult ()
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 ()
parseWarning Position
zeroPos PWarnType
PWTOldSyntax (String -> ParseResult ()) -> String -> ParseResult ()
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 ()
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 ()
goSections :: CabalSpecVersion
-> [Field Position] -> StateT SectionS ParseResult ()
goSections CabalSpecVersion
specVer = (Field Position -> StateT SectionS ParseResult ())
-> [Field Position] -> StateT SectionS ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Field Position -> StateT SectionS ParseResult ()
process
where
process :: Field Position -> StateT SectionS ParseResult ()
process (Field (Name Position
pos ByteString
name) [FieldLine Position]
_) =
ParseResult () -> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ())
-> ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTTrailingFields (String -> ParseResult ()) -> String -> ParseResult ()
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 ()
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
parseCondTree'
:: L.HasBuildInfo a
=> ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' :: forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' = CabalSpecVersion
-> ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
forall a.
HasBuildInfo a =>
CabalSpecVersion
-> ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTreeWithCommonStanzas CabalSpecVersion
specVer
parseSection :: Name Position -> [SectionArg Position] -> [Field Position] -> SectionParser ()
parseSection :: Name Position
-> [SectionArg Position]
-> [Field Position]
-> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ())
-> ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$ do
Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownSection (String -> ParseResult ()) -> String -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ String
"Ignoring section: common. You should set cabal-version: 2.2 or larger to use common stanzas."
| ByteString
name 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 (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 String -> StateT SectionS ParseResult 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 String -> StateT SectionS ParseResult String)
-> ParseResult String -> StateT SectionS ParseResult String
forall a b. (a -> b) -> a -> b
$ Position -> [SectionArg Position] -> ParseResult String
parseCommonName Position
pos [SectionArg Position]
args
CondTreeBuildInfo
biTree <- ParseResult CondTreeBuildInfo
-> StateT SectionS ParseResult 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 CondTreeBuildInfo
-> StateT SectionS ParseResult CondTreeBuildInfo)
-> ParseResult CondTreeBuildInfo
-> StateT SectionS ParseResult CondTreeBuildInfo
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' BuildInfo
-> (BuildInfo -> BuildInfo)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult CondTreeBuildInfo
forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' ParsecFieldGrammar' BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep Token String), c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (SymbolicPathNT from to) (SymbolicPath from to)),
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 ()
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 () -> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ())
-> ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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 [Dependency] Library)
prev <- Getting
(Maybe (CondTree ConfVar [Dependency] Library))
SectionS
(Maybe (CondTree ConfVar [Dependency] Library))
-> StateT
SectionS
ParseResult
(Maybe (CondTree ConfVar [Dependency] Library))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
(Maybe (CondTree ConfVar [Dependency] Library))
SectionS
(Maybe (CondTree ConfVar [Dependency] Library))
-> StateT
SectionS
ParseResult
(Maybe (CondTree ConfVar [Dependency] Library)))
-> Getting
(Maybe (CondTree ConfVar [Dependency] Library))
SectionS
(Maybe (CondTree ConfVar [Dependency] Library))
-> StateT
SectionS
ParseResult
(Maybe (CondTree ConfVar [Dependency] Library))
forall a b. (a -> b) -> a -> b
$ LensLike
(Const (Maybe (CondTree ConfVar [Dependency] Library)))
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
(Const (Maybe (CondTree ConfVar [Dependency] Library)))
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
-> ((Maybe (CondTree ConfVar [Dependency] Library)
-> Const
(Maybe (CondTree ConfVar [Dependency] Library))
(Maybe (CondTree ConfVar [Dependency] Library)))
-> GenericPackageDescription
-> Const
(Maybe (CondTree ConfVar [Dependency] Library))
GenericPackageDescription)
-> Getting
(Maybe (CondTree ConfVar [Dependency] Library))
SectionS
(Maybe (CondTree ConfVar [Dependency] Library))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CondTree ConfVar [Dependency] Library)
-> Const
(Maybe (CondTree ConfVar [Dependency] Library))
(Maybe (CondTree ConfVar [Dependency] Library)))
-> GenericPackageDescription
-> Const
(Maybe (CondTree ConfVar [Dependency] Library))
GenericPackageDescription
Lens'
GenericPackageDescription
(Maybe (CondTree ConfVar [Dependency] Library))
L.condLibrary
Bool
-> StateT SectionS ParseResult () -> StateT SectionS ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (CondTree ConfVar [Dependency] Library) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (CondTree ConfVar [Dependency] Library)
prev) (StateT SectionS ParseResult () -> StateT SectionS ParseResult ())
-> StateT SectionS ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
ParseResult () -> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ())
-> ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
String
"Multiple main libraries; have you forgotten to specify a name for an internal library?"
Map String CondTreeBuildInfo
commonStanzas <- Getting
(Map String CondTreeBuildInfo)
SectionS
(Map String CondTreeBuildInfo)
-> StateT SectionS ParseResult (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 [Dependency] Library
lib <- ParseResult (CondTree ConfVar [Dependency] Library)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] 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 (CondTree ConfVar [Dependency] Library)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] Library))
-> ParseResult (CondTree ConfVar [Dependency] Library)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] Library)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' Library
-> (BuildInfo -> Library)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] Library)
forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' (LibraryName -> ParsecFieldGrammar' Library
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Library),
Applicative (g BuildInfo), c (Identity LibraryVisibility),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List CommaVCat (Identity ModuleReexport) ModuleReexport),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep Token String), c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (SymbolicPathNT from to) (SymbolicPath from to)),
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
LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
-> ((Maybe (CondTree ConfVar [Dependency] Library)
-> Identity (Maybe (CondTree ConfVar [Dependency] Library)))
-> GenericPackageDescription -> Identity GenericPackageDescription)
-> (Maybe (CondTree ConfVar [Dependency] Library)
-> Identity (Maybe (CondTree ConfVar [Dependency] Library)))
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CondTree ConfVar [Dependency] Library)
-> Identity (Maybe (CondTree ConfVar [Dependency] Library)))
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
GenericPackageDescription
(Maybe (CondTree ConfVar [Dependency] Library))
L.condLibrary ((Maybe (CondTree ConfVar [Dependency] Library)
-> Identity (Maybe (CondTree ConfVar [Dependency] Library)))
-> SectionS -> Identity SectionS)
-> CondTree ConfVar [Dependency] Library
-> StateT SectionS ParseResult ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= CondTree ConfVar [Dependency] Library
lib
| 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 (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 UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
let name'' :: LibraryName
name'' = UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
name'
CondTree ConfVar [Dependency] Library
lib <- ParseResult (CondTree ConfVar [Dependency] Library)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] 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 (CondTree ConfVar [Dependency] Library)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] Library))
-> ParseResult (CondTree ConfVar [Dependency] Library)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] Library)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' Library
-> (BuildInfo -> Library)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] Library)
forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' (LibraryName -> ParsecFieldGrammar' Library
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Library),
Applicative (g BuildInfo), c (Identity LibraryVisibility),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List CommaVCat (Identity ModuleReexport) ModuleReexport),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep Token String), c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (SymbolicPathNT from to) (SymbolicPath from to)),
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
LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
-> (([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
GenericPackageDescription
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
L.condSubLibraries (([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> SectionS -> Identity SectionS)
-> ([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> StateT SectionS ParseResult ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar [Dependency] Library
lib)
| 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 (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 UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
CondTree ConfVar [Dependency] ForeignLib
flib <- ParseResult (CondTree ConfVar [Dependency] ForeignLib)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] 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 (CondTree ConfVar [Dependency] ForeignLib)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] ForeignLib))
-> ParseResult (CondTree ConfVar [Dependency] ForeignLib)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] ForeignLib)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' ForeignLib
-> (BuildInfo -> ForeignLib)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] ForeignLib)
forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' (UnqualComponentName -> ParsecFieldGrammar' ForeignLib
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g ForeignLib),
Applicative (g BuildInfo), c (Identity ForeignLibType),
c (Identity LibVersionInfo), c (Identity Version),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (Identity ForeignLibOption) ForeignLibOption),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep Token String),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (SymbolicPathNT from to) (SymbolicPath from to)),
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 () -> StateT SectionS ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((ForeignLib -> Bool)
-> CondTree ConfVar [Dependency] ForeignLib -> Bool
forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
onAllBranches ForeignLib -> Bool
hasType CondTree ConfVar [Dependency] ForeignLib
flib) (StateT SectionS ParseResult () -> StateT SectionS ParseResult ())
-> StateT SectionS ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
ParseResult () -> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ())
-> ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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)
]
LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
-> (([(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)])
-> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
GenericPackageDescription
[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
L.condForeignLibs (([(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)])
-> SectionS -> Identity SectionS)
-> ([(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)])
-> StateT SectionS ParseResult ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar [Dependency] 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 (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 UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
CondTree ConfVar [Dependency] Executable
exe <- ParseResult (CondTree ConfVar [Dependency] Executable)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] 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 (CondTree ConfVar [Dependency] Executable)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] Executable))
-> ParseResult (CondTree ConfVar [Dependency] Executable)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] Executable)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' Executable
-> (BuildInfo -> Executable)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] Executable)
forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' (UnqualComponentName -> ParsecFieldGrammar' Executable
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Executable),
Applicative (g BuildInfo), c (Identity ExecutableScope),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep Token String),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir). c (SymbolicPathNT from to),
forall from (to :: FileOrDir). c (RelativePathNT from to),
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
LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
-> (([(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)])
-> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
GenericPackageDescription
[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
L.condExecutables (([(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)])
-> SectionS -> Identity SectionS)
-> ([(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)])
-> StateT SectionS ParseResult ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar [Dependency] 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 (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 UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
CondTree ConfVar [Dependency] TestSuiteStanza
testStanza <- ParseResult (CondTree ConfVar [Dependency] TestSuiteStanza)
-> StateT
SectionS
ParseResult
(CondTree ConfVar [Dependency] 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 (CondTree ConfVar [Dependency] TestSuiteStanza)
-> StateT
SectionS
ParseResult
(CondTree ConfVar [Dependency] TestSuiteStanza))
-> ParseResult (CondTree ConfVar [Dependency] TestSuiteStanza)
-> StateT
SectionS
ParseResult
(CondTree ConfVar [Dependency] TestSuiteStanza)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' TestSuiteStanza
-> (BuildInfo -> TestSuiteStanza)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] TestSuiteStanza)
forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' ParsecFieldGrammar' TestSuiteStanza
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g TestSuiteStanza),
Applicative (g BuildInfo), c (Identity ModuleName),
c (Identity TestType),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List 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 FSep Token String), c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir). c (RelativePathNT from to),
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 [Dependency] TestSuite
testSuite <- ParseResult (CondTree ConfVar [Dependency] TestSuite)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] 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 (CondTree ConfVar [Dependency] TestSuite)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] TestSuite))
-> ParseResult (CondTree ConfVar [Dependency] TestSuite)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] TestSuite)
forall a b. (a -> b) -> a -> b
$ (TestSuiteStanza -> ParseResult TestSuite)
-> CondTree ConfVar [Dependency] TestSuiteStanza
-> ParseResult (CondTree ConfVar [Dependency] 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 [Dependency] a
-> f (CondTree ConfVar [Dependency] b)
traverse (CabalSpecVersion
-> Position -> TestSuiteStanza -> ParseResult TestSuite
validateTestSuite CabalSpecVersion
specVer Position
pos) CondTree ConfVar [Dependency] 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 () -> StateT SectionS ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((TestSuite -> Bool)
-> CondTree ConfVar [Dependency] TestSuite -> Bool
forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
onAllBranches TestSuite -> Bool
hasType CondTree ConfVar [Dependency] TestSuite
testSuite) (StateT SectionS ParseResult () -> StateT SectionS ParseResult ())
-> StateT SectionS ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
ParseResult () -> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ())
-> ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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)
]
]
LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
-> (([(UnqualComponentName,
CondTree ConfVar [Dependency] TestSuite)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)])
-> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([(UnqualComponentName,
CondTree ConfVar [Dependency] TestSuite)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
GenericPackageDescription
[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
L.condTestSuites (([(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)])
-> SectionS -> Identity SectionS)
-> ([(UnqualComponentName,
CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] TestSuite)])
-> StateT SectionS ParseResult ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar [Dependency] 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 (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 UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args
CondTree ConfVar [Dependency] BenchmarkStanza
benchStanza <- ParseResult (CondTree ConfVar [Dependency] BenchmarkStanza)
-> StateT
SectionS
ParseResult
(CondTree ConfVar [Dependency] 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 (CondTree ConfVar [Dependency] BenchmarkStanza)
-> StateT
SectionS
ParseResult
(CondTree ConfVar [Dependency] BenchmarkStanza))
-> ParseResult (CondTree ConfVar [Dependency] BenchmarkStanza)
-> StateT
SectionS
ParseResult
(CondTree ConfVar [Dependency] BenchmarkStanza)
forall a b. (a -> b) -> a -> b
$ ParsecFieldGrammar' BenchmarkStanza
-> (BuildInfo -> BenchmarkStanza)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] BenchmarkStanza)
forall a.
HasBuildInfo a =>
ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree' ParsecFieldGrammar' BenchmarkStanza
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BenchmarkStanza),
Applicative (g BuildInfo), c (Identity BenchmarkType),
c (Identity ModuleName),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep Token String), c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir). c (RelativePathNT from to),
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 [Dependency] Benchmark
bench <- ParseResult (CondTree ConfVar [Dependency] Benchmark)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] 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 (CondTree ConfVar [Dependency] Benchmark)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] Benchmark))
-> ParseResult (CondTree ConfVar [Dependency] Benchmark)
-> StateT
SectionS ParseResult (CondTree ConfVar [Dependency] Benchmark)
forall a b. (a -> b) -> a -> b
$ (BenchmarkStanza -> ParseResult Benchmark)
-> CondTree ConfVar [Dependency] BenchmarkStanza
-> ParseResult (CondTree ConfVar [Dependency] 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 [Dependency] a
-> f (CondTree ConfVar [Dependency] b)
traverse (CabalSpecVersion
-> Position -> BenchmarkStanza -> ParseResult Benchmark
validateBenchmark CabalSpecVersion
specVer Position
pos) CondTree ConfVar [Dependency] 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 () -> StateT SectionS ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Benchmark -> Bool)
-> CondTree ConfVar [Dependency] Benchmark -> Bool
forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
onAllBranches Benchmark -> Bool
hasType CondTree ConfVar [Dependency] Benchmark
bench) (StateT SectionS ParseResult () -> StateT SectionS ParseResult ())
-> StateT SectionS ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
ParseResult () -> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ())
-> ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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)
]
]
LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
Lens' SectionS GenericPackageDescription
stateGpd LensLike
Identity
SectionS
SectionS
GenericPackageDescription
GenericPackageDescription
-> (([(UnqualComponentName,
CondTree ConfVar [Dependency] Benchmark)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)])
-> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([(UnqualComponentName,
CondTree ConfVar [Dependency] Benchmark)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)])
-> SectionS
-> Identity SectionS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)])
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
GenericPackageDescription
[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
L.condBenchmarks (([(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> Identity
[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)])
-> SectionS -> Identity SectionS)
-> ([(UnqualComponentName,
CondTree ConfVar [Dependency] Benchmark)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Benchmark)])
-> StateT SectionS ParseResult ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
forall {a}. a -> [a] -> [a]
snoc (UnqualComponentName
name', CondTree ConfVar [Dependency] Benchmark
bench)
| ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"flag" = do
ByteString
name' <- Position -> [SectionArg Position] -> SectionParser ByteString
parseNameBS Position
pos [SectionArg Position]
args
FlagName
name'' <- ParseResult FlagName -> StateT SectionS ParseResult 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 FlagName -> StateT SectionS ParseResult FlagName)
-> ParseResult FlagName -> StateT SectionS ParseResult FlagName
forall a b. (a -> b) -> a -> b
$ [Position]
-> ParsecParser FlagName
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult FlagName
forall a.
[Position]
-> ParsecParser a
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult 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 FlagName -> FlagName -> ParseResult FlagName
forall a. ParseResult a -> a -> ParseResult a
`recoverWith` String -> FlagName
mkFlagName String
""
PackageFlag
flag <- ParseResult PackageFlag -> StateT SectionS ParseResult 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 PackageFlag
-> StateT SectionS ParseResult PackageFlag)
-> ParseResult PackageFlag
-> StateT SectionS ParseResult PackageFlag
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion
-> [Field Position]
-> ParsecFieldGrammar' PackageFlag
-> ParseResult PackageFlag
forall a.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult a
parseFields CabalSpecVersion
specVer [Field Position]
fields (FlagName -> ParsecFieldGrammar' PackageFlag
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g PackageFlag)) =>
FlagName -> g PackageFlag PackageFlag
flagFieldGrammar FlagName
name'')
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 ()
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 SetupBuildInfo
-> StateT SectionS ParseResult 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 SetupBuildInfo
-> StateT SectionS ParseResult SetupBuildInfo)
-> ParseResult SetupBuildInfo
-> StateT SectionS ParseResult SetupBuildInfo
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion
-> [Field Position]
-> ParsecFieldGrammar' SetupBuildInfo
-> ParseResult SetupBuildInfo
forall a.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult a
parseFields CabalSpecVersion
specVer [Field Position]
fields (Bool -> ParsecFieldGrammar' SetupBuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Functor (g SetupBuildInfo),
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 ()
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 RepoKind -> StateT SectionS ParseResult 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 RepoKind -> StateT SectionS ParseResult RepoKind)
-> ParseResult RepoKind -> StateT SectionS ParseResult RepoKind
forall a b. (a -> b) -> a -> b
$ case [SectionArg Position]
args of
[SecArgName Position
spos ByteString
secName] ->
[Position]
-> ParsecParser RepoKind
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult RepoKind
forall a.
[Position]
-> ParsecParser a
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult 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 RepoKind -> RepoKind -> ParseResult RepoKind
forall a. ParseResult a -> a -> ParseResult a
`recoverWith` RepoKind
RepoHead
[] -> do
Position -> String -> ParseResult ()
parseFailure Position
pos String
"'source-repository' requires exactly one argument"
RepoKind -> ParseResult RepoKind
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoKind
RepoHead
[SectionArg Position]
_ -> do
Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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 RepoKind
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoKind
RepoHead
SourceRepo
sr <- ParseResult SourceRepo -> StateT SectionS ParseResult 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 SourceRepo -> StateT SectionS ParseResult SourceRepo)
-> ParseResult SourceRepo -> StateT SectionS ParseResult SourceRepo
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion
-> [Field Position]
-> ParsecFieldGrammar' SourceRepo
-> ParseResult SourceRepo
forall a.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult a
parseFields CabalSpecVersion
specVer [Field Position]
fields (RepoKind -> ParsecFieldGrammar' SourceRepo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepo),
c (Identity RepoType), c Token, c FilePathNT) =>
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 ()
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 () -> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ())
-> ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownSection (String -> ParseResult ()) -> String -> ParseResult ()
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 String
parseName :: Position
-> [SectionArg Position] -> StateT SectionS ParseResult String
parseName Position
pos [SectionArg Position]
args = ByteString -> String
fromUTF8BS (ByteString -> String)
-> SectionParser ByteString -> StateT SectionS ParseResult String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> [SectionArg Position] -> SectionParser ByteString
parseNameBS Position
pos [SectionArg Position]
args
parseNameBS :: Position -> [SectionArg Position] -> SectionParser BS.ByteString
parseNameBS :: Position -> [SectionArg Position] -> SectionParser ByteString
parseNameBS Position
pos [SectionArg Position]
args = case [SectionArg Position]
args of
[SecArgName Position
_pos ByteString
secName] ->
ByteString -> SectionParser ByteString
forall a. a -> StateT SectionS ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
secName
[SecArgStr Position
_pos ByteString
secName] ->
ByteString -> SectionParser ByteString
forall a. a -> StateT SectionS ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
secName
[] -> do
ParseResult () -> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ())
-> ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos String
"name required"
ByteString -> SectionParser ByteString
forall a. a -> StateT SectionS ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
""
[SectionArg Position]
_ -> do
ParseResult () -> StateT SectionS ParseResult ()
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 () -> StateT SectionS ParseResult ())
-> ParseResult () -> StateT SectionS ParseResult ()
forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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 ByteString
forall a. a -> StateT SectionS ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
""
parseCommonName :: Position -> [SectionArg Position] -> ParseResult String
parseCommonName :: Position -> [SectionArg Position] -> ParseResult String
parseCommonName Position
pos [SectionArg Position]
args = case [SectionArg Position]
args of
[SecArgName Position
_pos ByteString
secName] ->
String -> ParseResult String
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParseResult String) -> String -> ParseResult String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
fromUTF8BS ByteString
secName
[SecArgStr Position
_pos ByteString
secName] ->
String -> ParseResult String
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParseResult String) -> String -> ParseResult String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
fromUTF8BS ByteString
secName
[] -> do
Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ String
"name required"
String -> ParseResult String
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
[SectionArg Position]
_ -> do
Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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 String
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
parseUnqualComponentName :: Position -> [SectionArg Position] -> SectionParser UnqualComponentName
parseUnqualComponentName :: Position
-> [SectionArg Position] -> SectionParser UnqualComponentName
parseUnqualComponentName Position
pos [SectionArg Position]
args = String -> UnqualComponentName
mkUnqualComponentName (String -> UnqualComponentName)
-> StateT SectionS ParseResult String
-> SectionParser UnqualComponentName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> [SectionArg Position] -> StateT SectionS ParseResult String
parseName Position
pos [SectionArg Position]
args
parseFields
:: CabalSpecVersion
-> [Field Position]
-> ParsecFieldGrammar' a
-> ParseResult a
parseFields :: forall a.
CabalSpecVersion
-> [Field Position] -> ParsecFieldGrammar' a -> ParseResult a
parseFields CabalSpecVersion
v [Field Position]
fields ParsecFieldGrammar' a
grammar = do
let (Fields Position
fs0, [[Section Position]]
ss) = [Field Position] -> (Fields Position, [[Section Position]])
forall ann. [Field ann] -> (Fields ann, [[Section ann]])
partitionFields [Field Position]
fields
([Section Position] -> ParseResult ())
-> [[Section Position]] -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Section Position -> ParseResult ())
-> [Section Position] -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Section Position -> ParseResult ()
warnInvalidSubsection) [[Section Position]]
ss
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar' a -> ParseResult a
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
v Fields Position
fs0 ParsecFieldGrammar' a
grammar
warnInvalidSubsection :: Section Position -> ParseResult ()
warnInvalidSubsection :: Section Position -> ParseResult ()
warnInvalidSubsection (MkSection (Name Position
pos ByteString
name) [SectionArg Position]
_ [Field Position]
_) =
ParseResult () -> ParseResult ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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 a
. L.HasBuildInfo a
=> CabalSpecVersion
-> HasElif
-> ParsecFieldGrammar' a
-> Map String CondTreeBuildInfo
-> (BuildInfo -> a)
-> (a -> [Dependency])
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree :: forall a.
HasBuildInfo a =>
CabalSpecVersion
-> HasElif
-> ParsecFieldGrammar' a
-> Map String CondTreeBuildInfo
-> (BuildInfo -> a)
-> (a -> [Dependency])
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree CabalSpecVersion
v HasElif
hasElif ParsecFieldGrammar' a
grammar Map String CondTreeBuildInfo
commonStanzas BuildInfo -> a
fromBuildInfo a -> [Dependency]
cond = [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go
where
go :: [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go [Field Position]
fields0 = do
([Field Position]
fields, CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a
endo) <-
if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0
then CabalSpecVersion
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
forall a.
HasBuildInfo a =>
CabalSpecVersion
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
processImports CabalSpecVersion
v BuildInfo -> a
fromBuildInfo Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields0
else (Field Position -> ParseResult (Maybe (Field Position)))
-> [Field Position] -> ParseResult [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 (Maybe (Field Position))
warnImport CabalSpecVersion
v) [Field Position]
fields0 ParseResult [Maybe (Field Position)]
-> ([Maybe (Field Position)]
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a))
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
forall a b. ParseResult a -> (a -> ParseResult b) -> ParseResult b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Maybe (Field Position)]
fields1 -> ([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
forall a. a -> ParseResult 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 [Dependency] a -> CondTree ConfVar [Dependency] 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 a
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
v Fields Position
fs ParsecFieldGrammar' a
grammar
[CondBranch ConfVar [Dependency] a]
branches <- [[CondBranch ConfVar [Dependency] a]]
-> [CondBranch ConfVar [Dependency] a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CondBranch ConfVar [Dependency] a]]
-> [CondBranch ConfVar [Dependency] a])
-> ParseResult [[CondBranch ConfVar [Dependency] a]]
-> ParseResult [CondBranch ConfVar [Dependency] a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a])
-> [[Section Position]]
-> ParseResult [[CondBranch ConfVar [Dependency] 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 [CondBranch ConfVar [Dependency] a]
parseIfs [[Section Position]]
ss
CondTree ConfVar [Dependency] a
-> ParseResult (CondTree ConfVar [Dependency] a)
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return (CondTree ConfVar [Dependency] a
-> ParseResult (CondTree ConfVar [Dependency] a))
-> CondTree ConfVar [Dependency] a
-> ParseResult (CondTree ConfVar [Dependency] a)
forall a b. (a -> b) -> a -> b
$ CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a
endo (CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a)
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a
forall a b. (a -> b) -> a -> b
$ a
-> [Dependency]
-> [CondBranch ConfVar [Dependency] a]
-> CondTree ConfVar [Dependency] a
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode a
x (a -> [Dependency]
cond a
x) [CondBranch ConfVar [Dependency] a]
branches
parseIfs :: [Section Position] -> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs :: [Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs [] = [CondBranch ConfVar [Dependency] a]
-> ParseResult [CondBranch ConfVar [Dependency] a]
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return []
parseIfs (MkSection (Name Position
_ ByteString
name) [SectionArg Position]
test [Field Position]
fields : [Section Position]
sections) | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"if" = do
Condition ConfVar
test' <- [SectionArg Position] -> ParseResult (Condition ConfVar)
parseConditionConfVar [SectionArg Position]
test
CondTree ConfVar [Dependency] a
fields' <- [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go [Field Position]
fields
(Maybe (CondTree ConfVar [Dependency] a)
elseFields, [CondBranch ConfVar [Dependency] a]
sections') <- [Section Position]
-> ParseResult
(Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
parseElseIfs [Section Position]
sections
[CondBranch ConfVar [Dependency] a]
-> ParseResult [CondBranch ConfVar [Dependency] a]
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return (Condition ConfVar
-> CondTree ConfVar [Dependency] a
-> Maybe (CondTree ConfVar [Dependency] a)
-> CondBranch ConfVar [Dependency] a
forall v c a.
Condition v
-> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a
CondBranch Condition ConfVar
test' CondTree ConfVar [Dependency] a
fields' Maybe (CondTree ConfVar [Dependency] a)
elseFields CondBranch ConfVar [Dependency] a
-> [CondBranch ConfVar [Dependency] a]
-> [CondBranch ConfVar [Dependency] a]
forall {a}. a -> [a] -> [a]
: [CondBranch ConfVar [Dependency] a]
sections')
parseIfs (MkSection (Name Position
pos ByteString
name) [SectionArg Position]
_ [Field Position]
_ : [Section Position]
sections) = do
Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTInvalidSubsection (String -> ParseResult ()) -> String -> ParseResult ()
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 [CondBranch ConfVar [Dependency] a]
parseIfs [Section Position]
sections
parseElseIfs
:: [Section Position]
-> ParseResult (Maybe (CondTree ConfVar [Dependency] a), [CondBranch ConfVar [Dependency] a])
parseElseIfs :: [Section Position]
-> ParseResult
(Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
parseElseIfs [] = (Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
-> ParseResult
(Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CondTree ConfVar [Dependency] 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 () -> ParseResult ()
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 () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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 [Dependency] a
elseFields <- [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go [Field Position]
fields
[CondBranch ConfVar [Dependency] a]
sections' <- [Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs [Section Position]
sections
(Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
-> ParseResult
(Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return (CondTree ConfVar [Dependency] a
-> Maybe (CondTree ConfVar [Dependency] a)
forall a. a -> Maybe a
Just CondTree ConfVar [Dependency] a
elseFields, [CondBranch ConfVar [Dependency] a]
sections')
parseElseIfs (MkSection (Name Position
_ ByteString
name) [SectionArg Position]
test [Field Position]
fields : [Section Position]
sections)
| HasElif
hasElif 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' <- [SectionArg Position] -> ParseResult (Condition ConfVar)
parseConditionConfVar [SectionArg Position]
test
CondTree ConfVar [Dependency] a
fields' <- [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go [Field Position]
fields
(Maybe (CondTree ConfVar [Dependency] a)
elseFields, [CondBranch ConfVar [Dependency] a]
sections') <- [Section Position]
-> ParseResult
(Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
parseElseIfs [Section Position]
sections
a
a <- CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar' a -> ParseResult a
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
v Fields Position
forall a. Monoid a => a
mempty ParsecFieldGrammar' a
grammar
(Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
-> ParseResult
(Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return (CondTree ConfVar [Dependency] a
-> Maybe (CondTree ConfVar [Dependency] a)
forall a. a -> Maybe a
Just (CondTree ConfVar [Dependency] a
-> Maybe (CondTree ConfVar [Dependency] a))
-> CondTree ConfVar [Dependency] a
-> Maybe (CondTree ConfVar [Dependency] a)
forall a b. (a -> b) -> a -> b
$ a
-> [Dependency]
-> [CondBranch ConfVar [Dependency] a]
-> CondTree ConfVar [Dependency] a
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode a
a (a -> [Dependency]
cond a
a) [Condition ConfVar
-> CondTree ConfVar [Dependency] a
-> Maybe (CondTree ConfVar [Dependency] a)
-> CondBranch ConfVar [Dependency] a
forall v c a.
Condition v
-> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a
CondBranch Condition ConfVar
test' CondTree ConfVar [Dependency] a
fields' Maybe (CondTree ConfVar [Dependency] a)
elseFields], [CondBranch ConfVar [Dependency] a]
sections')
parseElseIfs (MkSection (Name Position
pos ByteString
name) [SectionArg Position]
_ [Field Position]
_ : [Section Position]
sections) | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"elif" = do
Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTInvalidSubsection (String -> ParseResult ()) -> String -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ String
"invalid subsection \"elif\". You should set cabal-version: 2.2 or larger to use elif-conditionals."
(,) Maybe (CondTree ConfVar [Dependency] a)
forall a. Maybe a
Nothing ([CondBranch ConfVar [Dependency] a]
-> (Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a]))
-> ParseResult [CondBranch ConfVar [Dependency] a]
-> ParseResult
(Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs [Section Position]
sections
parseElseIfs [Section Position]
sections = (,) Maybe (CondTree ConfVar [Dependency] a)
forall a. Maybe a
Nothing ([CondBranch ConfVar [Dependency] a]
-> (Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a]))
-> ParseResult [CondBranch ConfVar [Dependency] a]
-> ParseResult
(Maybe (CondTree ConfVar [Dependency] a),
[CondBranch ConfVar [Dependency] a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Section Position]
-> ParseResult [CondBranch ConfVar [Dependency] a]
parseIfs [Section Position]
sections
type CondTreeBuildInfo = CondTree ConfVar [Dependency] BuildInfo
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 a
. L.HasBuildInfo a
=> CabalSpecVersion
-> ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTreeWithCommonStanzas :: forall a.
HasBuildInfo a =>
CabalSpecVersion
-> ParsecFieldGrammar' a
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTreeWithCommonStanzas CabalSpecVersion
v ParsecFieldGrammar' a
grammar BuildInfo -> a
fromBuildInfo Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields = do
([Field Position]
fields', CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a
endo) <- CabalSpecVersion
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
forall a.
HasBuildInfo a =>
CabalSpecVersion
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
processImports CabalSpecVersion
v BuildInfo -> a
fromBuildInfo Map String CondTreeBuildInfo
commonStanzas [Field Position]
fields
CondTree ConfVar [Dependency] a
x <- CabalSpecVersion
-> HasElif
-> ParsecFieldGrammar' a
-> Map String CondTreeBuildInfo
-> (BuildInfo -> a)
-> (a -> [Dependency])
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
forall a.
HasBuildInfo a =>
CabalSpecVersion
-> HasElif
-> ParsecFieldGrammar' a
-> Map String CondTreeBuildInfo
-> (BuildInfo -> a)
-> (a -> [Dependency])
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTree CabalSpecVersion
v HasElif
hasElif ParsecFieldGrammar' a
grammar Map String CondTreeBuildInfo
commonStanzas BuildInfo -> a
fromBuildInfo (Getting [Dependency] a [Dependency] -> a -> [Dependency]
forall a s. Getting a s a -> s -> a
view Getting [Dependency] a [Dependency]
forall a. HasBuildInfo a => Lens' a [Dependency]
Lens' a [Dependency]
L.targetBuildDepends) [Field Position]
fields'
CondTree ConfVar [Dependency] a
-> ParseResult (CondTree ConfVar [Dependency] a)
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return (CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a
endo CondTree ConfVar [Dependency] a
x)
where
hasElif :: HasElif
hasElif = CabalSpecVersion -> HasElif
specHasElif CabalSpecVersion
v
processImports
:: forall a
. L.HasBuildInfo a
=> CabalSpecVersion
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult ([Field Position], CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
processImports :: forall a.
HasBuildInfo a =>
CabalSpecVersion
-> (BuildInfo -> a)
-> Map String CondTreeBuildInfo
-> [Field Position]
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
processImports CabalSpecVersion
v BuildInfo -> a
fromBuildInfo Map String CondTreeBuildInfo
commonStanzas = [CondTreeBuildInfo]
-> [Field Position]
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
go []
where
hasCommonStanzas :: HasCommonStanzas
hasCommonStanzas = CabalSpecVersion -> HasCommonStanzas
specHasCommonStanzas CabalSpecVersion
v
getList' :: List CommaFSep Token String -> [String]
getList' :: List CommaFSep Token String -> [String]
getList' = List CommaFSep Token String -> [String]
forall o n. Newtype o n => n -> o
Newtype.unpack
go :: [CondTreeBuildInfo]
-> [Field Position]
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
go [CondTreeBuildInfo]
acc (Field (Name Position
pos ByteString
name) [FieldLine Position]
_ : [Field Position]
fields)
| ByteString
name 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 ()
parseWarning Position
pos PWarnType
PWTUnknownField String
"Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas"
[CondTreeBuildInfo]
-> [Field Position]
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
go [CondTreeBuildInfo]
acc [Field Position]
fields
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 (List CommaFSep Token String)
-> ParseResult [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> ParsecParser (List CommaFSep Token String)
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult (List CommaFSep Token String)
forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult 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 (Maybe CondTreeBuildInfo))
-> ParseResult [Maybe CondTreeBuildInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [String]
names ((String -> ParseResult (Maybe CondTreeBuildInfo))
-> ParseResult [Maybe CondTreeBuildInfo])
-> (String -> ParseResult (Maybe CondTreeBuildInfo))
-> ParseResult [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 ()
parseFailure Position
pos (String -> ParseResult ()) -> String -> ParseResult ()
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 (Maybe CondTreeBuildInfo)
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CondTreeBuildInfo
forall a. Maybe a
Nothing
Just CondTreeBuildInfo
commonTree ->
Maybe CondTreeBuildInfo -> ParseResult (Maybe CondTreeBuildInfo)
forall a. a -> ParseResult 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
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] 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
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 [Maybe (Field Position)]
-> ParseResult [Field Position]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field Position -> ParseResult (Maybe (Field Position)))
-> [Field Position] -> ParseResult [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 (Maybe (Field Position))
warnImport CabalSpecVersion
v) [Field Position]
fields
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a))
-> ([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
-> ParseResult
([Field Position],
CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a)
forall a b. (a -> b) -> a -> b
$ ([Field Position]
fields', \CondTree ConfVar [Dependency] a
x -> (CondTreeBuildInfo
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a)
-> CondTree ConfVar [Dependency] a
-> [CondTreeBuildInfo]
-> CondTree ConfVar [Dependency] 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 [Dependency] a
-> CondTree ConfVar [Dependency] a
forall a.
HasBuildInfo a =>
(BuildInfo -> a)
-> CondTreeBuildInfo
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a
mergeCommonStanza BuildInfo -> a
fromBuildInfo) CondTree ConfVar [Dependency] a
x [CondTreeBuildInfo]
acc)
warnImport :: CabalSpecVersion -> Field Position -> ParseResult (Maybe (Field Position))
warnImport :: CabalSpecVersion
-> Field Position -> ParseResult (Maybe (Field Position))
warnImport CabalSpecVersion
v (Field (Name Position
pos ByteString
name) [FieldLine Position]
_) | ByteString
name 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 ()
parseWarning Position
pos PWarnType
PWTUnknownField String
"Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas"
else Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownField String
"Unknown field: import. Common stanza imports should be at the top of the enclosing section"
Maybe (Field Position) -> ParseResult (Maybe (Field Position))
forall a. a -> ParseResult 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 (Maybe (Field Position))
forall a. a -> ParseResult 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 [Dependency] BuildInfo
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a
mergeCommonStanza :: forall a.
HasBuildInfo a =>
(BuildInfo -> a)
-> CondTreeBuildInfo
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a
mergeCommonStanza BuildInfo -> a
fromBuildInfo (CondNode BuildInfo
bi [Dependency]
_ [CondBranch ConfVar [Dependency] BuildInfo]
bis) (CondNode a
x [Dependency]
_ [CondBranch ConfVar [Dependency] a]
cs) =
a
-> [Dependency]
-> [CondBranch ConfVar [Dependency] a]
-> CondTree ConfVar [Dependency] a
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode a
x' (a
x' a -> Getting [Dependency] a [Dependency] -> [Dependency]
forall s a. s -> Getting a s a -> a
^. Getting [Dependency] a [Dependency]
forall a. HasBuildInfo a => Lens' a [Dependency]
Lens' a [Dependency]
L.targetBuildDepends) [CondBranch ConfVar [Dependency] a]
cs'
where
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
<>)
cs' :: [CondBranch ConfVar [Dependency] a]
cs' = (CondBranch ConfVar [Dependency] BuildInfo
-> CondBranch ConfVar [Dependency] a)
-> [CondBranch ConfVar [Dependency] BuildInfo]
-> [CondBranch ConfVar [Dependency] a]
forall a b. (a -> b) -> [a] -> [b]
map ((BuildInfo -> a)
-> CondBranch ConfVar [Dependency] BuildInfo
-> CondBranch ConfVar [Dependency] a
forall a b.
(a -> b)
-> CondBranch ConfVar [Dependency] a
-> CondBranch ConfVar [Dependency] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BuildInfo -> a
fromBuildInfo) [CondBranch ConfVar [Dependency] BuildInfo]
bis [CondBranch ConfVar [Dependency] a]
-> [CondBranch ConfVar [Dependency] a]
-> [CondBranch ConfVar [Dependency] a]
forall a. [a] -> [a] -> [a]
++ [CondBranch ConfVar [Dependency] a]
cs
onAllBranches :: forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
onAllBranches :: forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
onAllBranches a -> Bool
p = a -> CondTree v c a -> Bool
go a
forall a. Monoid a => a
mempty
where
go :: a -> CondTree v c a -> Bool
go :: a -> CondTree v c a -> Bool
go a
acc CondTree v c a
ct =
let acc' :: a
acc' = a
acc a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` CondTree v c a -> a
forall v c a. CondTree v c a -> a
condTreeData CondTree v c a
ct
in a -> Bool
p a
acc' Bool -> Bool -> Bool
|| (CondBranch v c a -> Bool) -> [CondBranch v c a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> CondBranch v c a -> Bool
goBranch a
acc') (CondTree v c a -> [CondBranch v c a]
forall v c a. CondTree v c a -> [CondBranch v c a]
condTreeComponents CondTree v c a
ct)
goBranch :: a -> CondBranch v c a -> Bool
goBranch :: a -> CondBranch v c a -> Bool
goBranch a
_ (CondBranch Condition v
_ CondTree v c a
_ Maybe (CondTree v c a)
Nothing) = Bool
False
goBranch a
acc (CondBranch Condition v
_ CondTree v c a
t (Just CondTree v c a
e)) = a -> CondTree v c a -> Bool
go a
acc CondTree v c a
t Bool -> Bool -> Bool
&& a -> CondTree v c a -> Bool
go a
acc CondTree v c a
e
checkForUndefinedFlags :: GenericPackageDescription -> ParseResult ()
checkForUndefinedFlags :: GenericPackageDescription -> ParseResult ()
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 [Dependency] a
-> Const (Set FlagName) (CondTree ConfVar [Dependency] a))
-> GenericPackageDescription
-> Const (Set FlagName) GenericPackageDescription
forall (f :: * -> *).
Applicative f =>
(forall a.
CondTree ConfVar [Dependency] a
-> f (CondTree ConfVar [Dependency] a))
-> GenericPackageDescription -> f GenericPackageDescription
L.allCondTrees CondTree ConfVar [Dependency] a
-> Const (Set FlagName) (CondTree ConfVar [Dependency] a)
forall a.
CondTree ConfVar [Dependency] a
-> Const (Set FlagName) (CondTree ConfVar [Dependency] a)
forall c a.
CondTree ConfVar c a -> Const (Set FlagName) (CondTree ConfVar c a)
f GenericPackageDescription
gpd
Bool -> ParseResult () -> ParseResult ()
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 () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
zeroPos (String -> ParseResult ()) -> String -> ParseResult ()
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 c a -> Const (Set.Set FlagName) (CondTree ConfVar c a)
f :: forall c a.
CondTree ConfVar c a -> Const (Set FlagName) (CondTree ConfVar c a)
f CondTree ConfVar c a
ct = Set FlagName -> Const (Set FlagName) (CondTree ConfVar c 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 c a -> [FlagName]
forall c a. CondTree ConfVar c a -> [FlagName]
freeVars CondTree ConfVar c a
ct))
checkForUndefinedCustomSetup :: GenericPackageDescription -> ParseResult ()
checkForUndefinedCustomSetup :: GenericPackageDescription -> ParseResult ()
checkForUndefinedCustomSetup GenericPackageDescription
gpd = do
let pd :: PackageDescription
pd = GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd
let csv :: CabalSpecVersion
csv = PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pd
Bool -> ParseResult () -> ParseResult ()
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 () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CabalSpecVersion
csv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_24) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
zeroPos (String -> ParseResult ()) -> String -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
String
"Since cabal-version: 1.24 specifying custom-setup section is mandatory"
Bool -> ParseResult () -> ParseResult ()
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 () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> String -> ParseResult ()
parseFailure Position
zeroPos (String -> ParseResult ()) -> String -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
String
"Packages with build-type: Hooks require a custom-setup stanza"
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 [Dependency] Library
_) <- GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
gpd
]
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
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
([(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
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)
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, Applicative (g Library),
Applicative (g BuildInfo), c (Identity LibraryVisibility),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List CommaVCat (Identity ModuleReexport) ModuleReexport),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep Token String), c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (SymbolicPathNT from to) (SymbolicPath from to)),
c (List VCat Token String), c (MQuoted Language)) =>
LibraryName -> g Library Library
libraryFieldGrammar LibraryName
LMainLibName)
parseHookedBuildInfo :: BS.ByteString -> ParseResult HookedBuildInfo
parseHookedBuildInfo :: ByteString -> ParseResult HookedBuildInfo
parseHookedBuildInfo ByteString
bs = case ByteString -> Either ParseError ([Field Position], [LexWarning])
readFields' ByteString
bs of
Right ([Field Position]
fs, [LexWarning]
lexWarnings) -> do
[LexWarning] -> [Field Position] -> ParseResult HookedBuildInfo
parseHookedBuildInfo' [LexWarning]
lexWarnings [Field Position]
fs
Left ParseError
perr -> Position -> String -> ParseResult HookedBuildInfo
forall a. Position -> String -> ParseResult a
parseFatalFailure Position
zeroPos (ParseError -> String
forall a. Show a => a -> String
show ParseError
perr)
parseHookedBuildInfo'
:: [LexWarning]
-> [Field Position]
-> ParseResult HookedBuildInfo
parseHookedBuildInfo' :: [LexWarning] -> [Field Position] -> ParseResult HookedBuildInfo
parseHookedBuildInfo' [LexWarning]
lexWarnings [Field Position]
fs = do
[PWarning] -> ParseResult ()
parseWarnings ([LexWarning] -> [PWarning]
toPWarnings [LexWarning]
lexWarnings)
(Fields Position
mLibFields, [(UnqualComponentName, Fields Position)]
exes) <- [Field Position]
-> ParseResult
(Fields Position, [(UnqualComponentName, Fields Position)])
stanzas [Field Position]
fs
Maybe BuildInfo
mLib <- Fields Position -> ParseResult (Maybe BuildInfo)
parseLib Fields Position
mLibFields
[(UnqualComponentName, BuildInfo)]
biExes <- ((UnqualComponentName, Fields Position)
-> ParseResult (UnqualComponentName, BuildInfo))
-> [(UnqualComponentName, Fields Position)]
-> ParseResult [(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 (UnqualComponentName, BuildInfo)
parseExe [(UnqualComponentName, Fields Position)]
exes
HookedBuildInfo -> ParseResult HookedBuildInfo
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BuildInfo
mLib, [(UnqualComponentName, BuildInfo)]
biExes)
where
parseLib :: Fields Position -> ParseResult (Maybe BuildInfo)
parseLib :: Fields Position -> ParseResult (Maybe BuildInfo)
parseLib Fields Position
fields
| Fields Position -> Bool
forall k a. Map k a -> Bool
Map.null Fields Position
fields = Maybe BuildInfo -> ParseResult (Maybe BuildInfo)
forall a. a -> ParseResult 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 BuildInfo -> ParseResult (Maybe BuildInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar' BuildInfo
-> ParseResult BuildInfo
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
cabalSpecLatest Fields Position
fields ParsecFieldGrammar' BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep Token String), c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (SymbolicPathNT from to) (SymbolicPath from to)),
c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
parseExe :: (UnqualComponentName, Fields Position) -> ParseResult (UnqualComponentName, BuildInfo)
parseExe :: (UnqualComponentName, Fields Position)
-> ParseResult (UnqualComponentName, BuildInfo)
parseExe (UnqualComponentName
n, Fields Position
fields) = do
BuildInfo
bi <- CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar' BuildInfo
-> ParseResult BuildInfo
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
cabalSpecLatest Fields Position
fields ParsecFieldGrammar' BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep Token String), c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
forall from (to :: FileOrDir).
c (List FSep (SymbolicPathNT from to) (SymbolicPath from to)),
forall from (to :: FileOrDir).
c (List FSep (RelativePathNT from to) (RelativePath from to)),
forall from (to :: FileOrDir).
c (List VCat (SymbolicPathNT from to) (SymbolicPath from to)),
c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
(UnqualComponentName, BuildInfo)
-> ParseResult (UnqualComponentName, BuildInfo)
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnqualComponentName
n, BuildInfo
bi)
stanzas :: [Field Position] -> ParseResult (Fields Position, [(UnqualComponentName, Fields Position)])
stanzas :: [Field Position]
-> ParseResult
(Fields Position, [(UnqualComponentName, Fields Position)])
stanzas [Field Position]
fields = do
let ([Field Position]
hdr0, Maybe ([FieldLine Position], [Field Position])
exes0) = (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 (Fields Position)
toFields [Field Position]
hdr0
[(UnqualComponentName, Fields Position)]
exes <- (Maybe ([FieldLine Position], [Field Position])
-> ParseResult
(Maybe
((UnqualComponentName, Fields Position),
Maybe ([FieldLine Position], [Field Position]))))
-> Maybe ([FieldLine Position], [Field Position])
-> ParseResult [(UnqualComponentName, Fields Position)]
forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> m [a]
unfoldrM ((([FieldLine Position], [Field Position])
-> ParseResult
((UnqualComponentName, Fields Position),
Maybe ([FieldLine Position], [Field Position])))
-> Maybe ([FieldLine Position], [Field Position])
-> ParseResult
(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
((UnqualComponentName, Fields Position),
Maybe ([FieldLine Position], [Field Position]))
toExe) Maybe ([FieldLine Position], [Field Position])
exes0
(Fields Position, [(UnqualComponentName, Fields Position)])
-> ParseResult
(Fields Position, [(UnqualComponentName, Fields Position)])
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fields Position
hdr, [(UnqualComponentName, Fields Position)]
exes)
toFields :: [Field Position] -> ParseResult (Fields Position)
toFields :: [Field Position] -> ParseResult (Fields Position)
toFields [Field Position]
fields = do
let (Fields Position
fields', [[Section Position]]
ss) = [Field Position] -> (Fields Position, [[Section Position]])
forall ann. [Field ann] -> (Fields ann, [[Section ann]])
partitionFields [Field Position]
fields
([Section Position] -> ParseResult ())
-> [[Section Position]] -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Section Position -> ParseResult ())
-> [Section Position] -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Section Position -> ParseResult ()
warnInvalidSubsection) [[Section Position]]
ss
Fields Position -> ParseResult (Fields Position)
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Fields Position
fields'
toExe
:: ([FieldLine Position], [Field Position])
-> ParseResult ((UnqualComponentName, Fields Position), Maybe ([FieldLine Position], [Field Position]))
toExe :: ([FieldLine Position], [Field Position])
-> ParseResult
((UnqualComponentName, Fields Position),
Maybe ([FieldLine Position], [Field Position]))
toExe ([FieldLine Position]
fss, [Field Position]
fields) = do
UnqualComponentName
name <- Position
-> ParsecParser UnqualComponentName
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult UnqualComponentName
forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult 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 (Fields Position)
toFields [Field Position]
hdr0
((UnqualComponentName, Fields Position),
Maybe ([FieldLine Position], [Field Position]))
-> ParseResult
((UnqualComponentName, Fields Position),
Maybe ([FieldLine Position], [Field Position]))
forall a. a -> ParseResult 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
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)
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)
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
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