{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.PackageDescription.FieldGrammar (
packageDescriptionFieldGrammar,
libraryFieldGrammar,
foreignLibFieldGrammar,
executableFieldGrammar,
TestSuiteStanza (..),
testSuiteFieldGrammar,
validateTestSuite,
unvalidateTestSuite,
testStanzaTestType,
testStanzaMainIs,
testStanzaTestModule,
testStanzaBuildInfo,
BenchmarkStanza (..),
benchmarkFieldGrammar,
validateBenchmark,
unvalidateBenchmark,
formatDependencyList,
formatExposedModules,
formatExtraSourceFiles,
formatHsSourceDirs,
formatMixinList,
formatOtherExtensions,
formatOtherModules,
benchmarkStanzaBenchmarkType,
benchmarkStanzaMainIs,
benchmarkStanzaBenchmarkModule,
benchmarkStanzaBuildInfo,
flagFieldGrammar,
sourceRepoFieldGrammar,
setupBInfoFieldGrammar,
buildInfoFieldGrammar,
) where
import Distribution.Compat.Lens
import Distribution.Compat.Prelude
import Language.Haskell.Extension
import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Compat.Newtype (Newtype, pack', unpack')
import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..))
import Distribution.FieldGrammar
import Distribution.Fields
import Distribution.ModuleName (ModuleName)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Parsec
import Distribution.Pretty (Pretty (..), prettyShow, showToken)
import Distribution.Utils.Path
import Distribution.Version (Version, VersionRange)
import qualified Data.ByteString.Char8 as BS8
import qualified Distribution.Compat.CharParsing as P
import qualified Distribution.SPDX as SPDX
import qualified Distribution.Types.Lens as L
packageDescriptionFieldGrammar
:: ( FieldGrammar c g, Applicative (g PackageDescription), Applicative (g PackageIdentifier)
, c (Identity BuildType)
, c (Identity PackageName)
, c (Identity Version)
, c (List FSep FilePathNT String)
, c (List FSep CompatFilePath String)
, c (List FSep (Identity (SymbolicPath PackageDir LicenseFile)) (SymbolicPath PackageDir LicenseFile))
, c (List FSep TestedWith (CompilerFlavor, VersionRange))
, c (List VCat FilePathNT String)
, c FilePathNT
, c CompatLicenseFile
, c CompatFilePath
, c SpecLicense
, c SpecVersion
)
=> g PackageDescription PackageDescription
packageDescriptionFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g PackageDescription),
Applicative (g PackageIdentifier), c (Identity BuildType),
c (Identity PackageName), c (Identity Version),
c (List FSep FilePathNT String),
c (List FSep CompatFilePath String),
c (List
FSep
(Identity (SymbolicPath PackageDir LicenseFile))
(SymbolicPath PackageDir LicenseFile)),
c (List FSep TestedWith (CompilerFlavor, VersionRange)),
c (List VCat FilePathNT String), c FilePathNT, c CompatLicenseFile,
c CompatFilePath, c SpecLicense, c SpecVersion) =>
g PackageDescription PackageDescription
packageDescriptionFieldGrammar = CabalSpecVersion
-> PackageIdentifier
-> Either License License
-> [SymbolicPath PackageDir LicenseFile]
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(String, String)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> PackageDescription
PackageDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla FieldName
"cabal-version" CabalSpecVersion -> SpecVersion
SpecVersion Lens' PackageDescription CabalSpecVersion
L.specVersion CabalSpecVersion
CabalSpecV1_0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar Lens' PackageDescription PackageIdentifier
L.package g PackageIdentifier PackageIdentifier
packageIdentifierGrammar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla FieldName
"license" Either License License -> SpecLicense
SpecLicense Lens' PackageDescription (Either License License)
L.licenseRaw (forall a b. a -> Either a b
Left License
SPDX.NONE)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g PackageDescription [SymbolicPath PackageDir LicenseFile]
licenseFilesGrammar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"copyright" Lens' PackageDescription ShortText
L.copyright
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"maintainer" Lens' PackageDescription ShortText
L.maintainer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"author" Lens' PackageDescription ShortText
L.author
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"stability" Lens' PackageDescription ShortText
L.stability
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"tested-with" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep (CompilerFlavor, VersionRange) -> TestedWith
TestedWith) Lens' PackageDescription [(CompilerFlavor, VersionRange)]
L.testedWith
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"homepage" Lens' PackageDescription ShortText
L.homepage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"package-url" Lens' PackageDescription ShortText
L.pkgUrl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"bug-reports" Lens' PackageDescription ShortText
L.bugReports
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"synopsis" Lens' PackageDescription ShortText
L.synopsis
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"description" Lens' PackageDescription ShortText
L.description
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"category" Lens' PackageDescription ShortText
L.category
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s [(String, String)] -> g s [(String, String)]
prefixedFields FieldName
"x-" Lens' PackageDescription [(String, String)]
L.customFieldsPD
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"build-type" Lens' PackageDescription (Maybe BuildType)
L.buildTypeRaw
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"data-files" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> FilePathNT
FilePathNT) Lens' PackageDescription [String]
L.dataFiles
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla FieldName
"data-dir" String -> CompatFilePath
CompatFilePath Lens' PackageDescription String
L.dataDir String
"."
forall a b. a -> (a -> b) -> b
^^^ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x then String
"." else String
x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extra-source-files" [String] -> List VCat FilePathNT String
formatExtraSourceFiles Lens' PackageDescription [String]
L.extraSrcFiles
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extra-tmp-files" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> FilePathNT
FilePathNT) Lens' PackageDescription [String]
L.extraTmpFiles
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extra-doc-files" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> FilePathNT
FilePathNT) Lens' PackageDescription [String]
L.extraDocFiles
where
packageIdentifierGrammar :: g PackageIdentifier PackageIdentifier
packageIdentifierGrammar = PackageName -> Version -> PackageIdentifier
PackageIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"name" Lens' PackageIdentifier PackageName
L.pkgName
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"version" Lens' PackageIdentifier Version
L.pkgVersion
licenseFilesGrammar :: g PackageDescription [SymbolicPath PackageDir LicenseFile]
licenseFilesGrammar = forall a. [a] -> [a] -> [a]
(++)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"license-file" [SymbolicPath PackageDir LicenseFile] -> CompatLicenseFile
CompatLicenseFile Lens' PackageDescription [SymbolicPath PackageDir LicenseFile]
L.licenseFiles
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"license-files" (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep) Lens' PackageDescription [SymbolicPath PackageDir LicenseFile]
L.licenseFiles
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
g s a -> g s a
hiddenField
libraryFieldGrammar
:: ( FieldGrammar c g, Applicative (g Library), Applicative (g BuildInfo)
, c (Identity LibraryVisibility)
, c (List CommaFSep (Identity ExeDependency) ExeDependency)
, c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
, c (List CommaVCat (Identity ModuleReexport) ModuleReexport)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep FilePathNT String)
, c (List FSep Token String)
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
, c (List VCat FilePathNT String)
, c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
, c (List VCat Token String)
, c (MQuoted Language)
)
=> LibraryName
-> g Library Library
libraryFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Library),
Applicative (g BuildInfo), c (Identity LibraryVisibility),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List CommaVCat (Identity ModuleReexport) ModuleReexport),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
LibraryName -> g Library Library
libraryFieldGrammar LibraryName
n = LibraryName
-> [ModuleName]
-> [ModuleReexport]
-> [ModuleName]
-> Bool
-> LibraryVisibility
-> BuildInfo
-> Library
Library LibraryName
n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"exposed-modules" [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatExposedModules Lens' Library [ModuleName]
L.exposedModules
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"reexported-modules" (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaVCat
CommaVCat) Lens' Library [ModuleReexport]
L.reexportedModules
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"signatures" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat forall a. a -> MQuoted a
MQuoted) Lens' Library [ModuleName]
L.signatures
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_0 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef FieldName
"exposed" Lens' Library Bool
L.libExposed Bool
True
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g Library LibraryVisibility
visibilityField
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar Lens' Library BuildInfo
L.libBuildInfo forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
where
visibilityField :: g Library LibraryVisibility
visibilityField = case LibraryName
n of
LibraryName
LMainLibName -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LibraryVisibility
LibraryVisibilityPublic
LSubLibName UnqualComponentName
_ ->
forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
(FieldGrammar c g, Functor (g s), c (Identity a), Eq a) =>
FieldName -> ALens' s a -> a -> g s a
optionalFieldDef FieldName
"visibility" Lens' Library LibraryVisibility
L.libVisibility LibraryVisibility
LibraryVisibilityPrivate
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 LibraryVisibility
LibraryVisibilityPrivate
{-# SPECIALIZE libraryFieldGrammar :: LibraryName -> ParsecFieldGrammar' Library #-}
{-# SPECIALIZE libraryFieldGrammar :: LibraryName -> PrettyFieldGrammar' Library #-}
foreignLibFieldGrammar
:: ( FieldGrammar c g, Applicative (g ForeignLib), Applicative (g BuildInfo)
, c (Identity ForeignLibType)
, c (Identity LibVersionInfo)
, c (Identity Version)
, c (List CommaFSep (Identity ExeDependency) ExeDependency)
, c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
, c (List FSep (Identity ForeignLibOption) ForeignLibOption)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep FilePathNT String)
, c (List FSep Token String)
, c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
, c (List VCat FilePathNT String), c (List VCat Token String)
, c (MQuoted Language)
)
=> UnqualComponentName -> g ForeignLib ForeignLib
foreignLibFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g ForeignLib),
Applicative (g BuildInfo), c (Identity ForeignLibType),
c (Identity LibVersionInfo), c (Identity Version),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (Identity ForeignLibOption) ForeignLibOption),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String), c (List VCat Token String),
c (MQuoted Language)) =>
UnqualComponentName -> g ForeignLib ForeignLib
foreignLibFieldGrammar UnqualComponentName
n = UnqualComponentName
-> ForeignLibType
-> [ForeignLibOption]
-> BuildInfo
-> Maybe LibVersionInfo
-> Maybe Version
-> [String]
-> ForeignLib
ForeignLib UnqualComponentName
n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
(FieldGrammar c g, Functor (g s), c (Identity a), Eq a) =>
FieldName -> ALens' s a -> a -> g s a
optionalFieldDef FieldName
"type" Lens' ForeignLib ForeignLibType
L.foreignLibType ForeignLibType
ForeignLibTypeUnknown
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"options" (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep) Lens' ForeignLib [ForeignLibOption]
L.foreignLibOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar Lens' ForeignLib BuildInfo
L.foreignLibBuildInfo forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"lib-version-info" Lens' ForeignLib (Maybe LibVersionInfo)
L.foreignLibVersionInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"lib-version-linux" Lens' ForeignLib (Maybe Version)
L.foreignLibVersionLinux
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"mod-def-file" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) Lens' ForeignLib [String]
L.foreignLibModDefFile
{-# SPECIALIZE foreignLibFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' ForeignLib #-}
{-# SPECIALIZE foreignLibFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' ForeignLib #-}
executableFieldGrammar
:: ( FieldGrammar c g, Applicative (g Executable), Applicative (g BuildInfo)
, c (Identity ExecutableScope)
, c (List CommaFSep (Identity ExeDependency) ExeDependency)
, c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep FilePathNT String)
, c (List FSep Token String)
, c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
, c (List VCat FilePathNT String)
, c (List VCat Token String)
, c (MQuoted Language)
)
=> UnqualComponentName -> g Executable Executable
executableFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Executable),
Applicative (g BuildInfo), c (Identity ExecutableScope),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String), c (List VCat Token String),
c (MQuoted Language)) =>
UnqualComponentName -> g Executable Executable
executableFieldGrammar UnqualComponentName
n = UnqualComponentName
-> String -> ExecutableScope -> BuildInfo -> Executable
Executable UnqualComponentName
n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla FieldName
"main-is" String -> FilePathNT
FilePathNT Lens' Executable String
L.modulePath String
""
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
(FieldGrammar c g, Functor (g s), c (Identity a), Eq a) =>
FieldName -> ALens' s a -> a -> g s a
optionalFieldDef FieldName
"scope" Lens' Executable ExecutableScope
L.exeScope ExecutableScope
ExecutablePublic
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_0 ExecutableScope
ExecutablePublic
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar forall a. HasBuildInfo a => Lens' a BuildInfo
L.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 FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
{-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' Executable #-}
{-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' Executable #-}
data TestSuiteStanza = TestSuiteStanza
{ TestSuiteStanza -> Maybe TestType
_testStanzaTestType :: Maybe TestType
, TestSuiteStanza -> Maybe String
_testStanzaMainIs :: Maybe FilePath
, TestSuiteStanza -> Maybe ModuleName
_testStanzaTestModule :: Maybe ModuleName
, TestSuiteStanza -> BuildInfo
_testStanzaBuildInfo :: BuildInfo
}
instance L.HasBuildInfo TestSuiteStanza where
buildInfo :: Lens' TestSuiteStanza BuildInfo
buildInfo = Lens' TestSuiteStanza BuildInfo
testStanzaBuildInfo
testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType)
testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType)
testStanzaTestType Maybe TestType -> f (Maybe TestType)
f TestSuiteStanza
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe TestType
x -> TestSuiteStanza
s { _testStanzaTestType :: Maybe TestType
_testStanzaTestType = Maybe TestType
x }) (Maybe TestType -> f (Maybe TestType)
f (TestSuiteStanza -> Maybe TestType
_testStanzaTestType TestSuiteStanza
s))
{-# INLINE testStanzaTestType #-}
testStanzaMainIs :: Lens' TestSuiteStanza (Maybe FilePath)
testStanzaMainIs :: Lens' TestSuiteStanza (Maybe String)
testStanzaMainIs Maybe String -> f (Maybe String)
f TestSuiteStanza
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe String
x -> TestSuiteStanza
s { _testStanzaMainIs :: Maybe String
_testStanzaMainIs = Maybe String
x }) (Maybe String -> f (Maybe String)
f (TestSuiteStanza -> Maybe String
_testStanzaMainIs TestSuiteStanza
s))
{-# INLINE testStanzaMainIs #-}
testStanzaTestModule :: Lens' TestSuiteStanza (Maybe ModuleName)
testStanzaTestModule :: Lens' TestSuiteStanza (Maybe ModuleName)
testStanzaTestModule Maybe ModuleName -> f (Maybe ModuleName)
f TestSuiteStanza
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe ModuleName
x -> TestSuiteStanza
s { _testStanzaTestModule :: Maybe ModuleName
_testStanzaTestModule = Maybe ModuleName
x }) (Maybe ModuleName -> f (Maybe ModuleName)
f (TestSuiteStanza -> Maybe ModuleName
_testStanzaTestModule TestSuiteStanza
s))
{-# INLINE testStanzaTestModule #-}
testStanzaBuildInfo :: Lens' TestSuiteStanza BuildInfo
testStanzaBuildInfo :: Lens' TestSuiteStanza BuildInfo
testStanzaBuildInfo BuildInfo -> f BuildInfo
f TestSuiteStanza
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\BuildInfo
x -> TestSuiteStanza
s { _testStanzaBuildInfo :: BuildInfo
_testStanzaBuildInfo = BuildInfo
x }) (BuildInfo -> f BuildInfo
f (TestSuiteStanza -> BuildInfo
_testStanzaBuildInfo TestSuiteStanza
s))
{-# INLINE testStanzaBuildInfo #-}
testSuiteFieldGrammar
:: ( FieldGrammar c g, Applicative (g TestSuiteStanza), Applicative (g BuildInfo)
, c (Identity ModuleName)
, c (Identity TestType)
, c (List CommaFSep (Identity ExeDependency) ExeDependency)
, c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep FilePathNT String)
, c (List FSep Token String)
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
, c (List VCat FilePathNT String)
, c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
, c (List VCat Token String)
, c (MQuoted Language)
)
=> g TestSuiteStanza TestSuiteStanza
testSuiteFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g TestSuiteStanza),
Applicative (g BuildInfo), c (Identity ModuleName),
c (Identity TestType),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
g TestSuiteStanza TestSuiteStanza
testSuiteFieldGrammar = Maybe TestType
-> Maybe String -> Maybe ModuleName -> BuildInfo -> TestSuiteStanza
TestSuiteStanza
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"type" Lens' TestSuiteStanza (Maybe TestType)
testStanzaTestType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla FieldName
"main-is" String -> FilePathNT
FilePathNT Lens' TestSuiteStanza (Maybe String)
testStanzaMainIs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"test-module" Lens' TestSuiteStanza (Maybe ModuleName)
testStanzaTestModule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar Lens' TestSuiteStanza BuildInfo
testStanzaBuildInfo forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
validateTestSuite :: Position -> TestSuiteStanza -> ParseResult TestSuite
validateTestSuite :: Position -> TestSuiteStanza -> ParseResult TestSuite
validateTestSuite Position
pos TestSuiteStanza
stanza = case TestSuiteStanza -> Maybe TestType
_testStanzaTestType TestSuiteStanza
stanza of
Maybe TestType
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
TestSuite
emptyTestSuite { testBuildInfo :: BuildInfo
testBuildInfo = TestSuiteStanza -> BuildInfo
_testStanzaBuildInfo TestSuiteStanza
stanza }
Just tt :: TestType
tt@(TestTypeUnknown String
_ Version
_) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestSuite
emptyTestSuite
{ testInterface :: TestSuiteInterface
testInterface = TestType -> TestSuiteInterface
TestSuiteUnsupported TestType
tt
, testBuildInfo :: BuildInfo
testBuildInfo = TestSuiteStanza -> BuildInfo
_testStanzaBuildInfo TestSuiteStanza
stanza
}
Just TestType
tt | TestType
tt forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [TestType]
knownTestTypes ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestSuite
emptyTestSuite
{ testInterface :: TestSuiteInterface
testInterface = TestType -> TestSuiteInterface
TestSuiteUnsupported TestType
tt
, testBuildInfo :: BuildInfo
testBuildInfo = TestSuiteStanza -> BuildInfo
_testStanzaBuildInfo TestSuiteStanza
stanza
}
Just tt :: TestType
tt@(TestTypeExe Version
ver) -> case TestSuiteStanza -> Maybe String
_testStanzaMainIs TestSuiteStanza
stanza of
Maybe String
Nothing -> do
Position -> String -> ParseResult ()
parseFailure Position
pos (forall {a}. Pretty a => String -> a -> String
missingField String
"main-is" TestType
tt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestSuite
emptyTestSuite
Just String
file -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust (TestSuiteStanza -> Maybe ModuleName
_testStanzaTestModule TestSuiteStanza
stanza)) forall a b. (a -> b) -> a -> b
$
Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTExtraBenchmarkModule (forall {a}. Pretty a => String -> a -> String
extraField String
"test-module" TestType
tt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestSuite
emptyTestSuite
{ testInterface :: TestSuiteInterface
testInterface = Version -> String -> TestSuiteInterface
TestSuiteExeV10 Version
ver String
file
, testBuildInfo :: BuildInfo
testBuildInfo = TestSuiteStanza -> BuildInfo
_testStanzaBuildInfo TestSuiteStanza
stanza
}
Just tt :: TestType
tt@(TestTypeLib Version
ver) -> case TestSuiteStanza -> Maybe ModuleName
_testStanzaTestModule TestSuiteStanza
stanza of
Maybe ModuleName
Nothing -> do
Position -> String -> ParseResult ()
parseFailure Position
pos (forall {a}. Pretty a => String -> a -> String
missingField String
"test-module" TestType
tt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestSuite
emptyTestSuite
Just ModuleName
module_ -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust (TestSuiteStanza -> Maybe String
_testStanzaMainIs TestSuiteStanza
stanza)) forall a b. (a -> b) -> a -> b
$
Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTExtraMainIs (forall {a}. Pretty a => String -> a -> String
extraField String
"main-is" TestType
tt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestSuite
emptyTestSuite
{ testInterface :: TestSuiteInterface
testInterface = Version -> ModuleName -> TestSuiteInterface
TestSuiteLibV09 Version
ver ModuleName
module_
, testBuildInfo :: BuildInfo
testBuildInfo = TestSuiteStanza -> BuildInfo
_testStanzaBuildInfo TestSuiteStanza
stanza
}
where
missingField :: String -> a -> String
missingField String
name a
tt = String
"The '" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"' field is required for the "
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow a
tt forall a. [a] -> [a] -> [a]
++ String
" test suite type."
extraField :: String -> a -> String
extraField String
name a
tt = String
"The '" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"' field is not used for the '"
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow a
tt forall a. [a] -> [a] -> [a]
++ String
"' test suite type."
unvalidateTestSuite :: TestSuite -> TestSuiteStanza
unvalidateTestSuite :: TestSuite -> TestSuiteStanza
unvalidateTestSuite TestSuite
t = TestSuiteStanza
{ _testStanzaTestType :: Maybe TestType
_testStanzaTestType = Maybe TestType
ty
, _testStanzaMainIs :: Maybe String
_testStanzaMainIs = Maybe String
ma
, _testStanzaTestModule :: Maybe ModuleName
_testStanzaTestModule = Maybe ModuleName
mo
, _testStanzaBuildInfo :: BuildInfo
_testStanzaBuildInfo = TestSuite -> BuildInfo
testBuildInfo TestSuite
t
}
where
(Maybe TestType
ty, Maybe String
ma, Maybe ModuleName
mo) = case TestSuite -> TestSuiteInterface
testInterface TestSuite
t of
TestSuiteExeV10 Version
ver String
file -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Version -> TestType
TestTypeExe Version
ver, forall a. a -> Maybe a
Just String
file, forall a. Maybe a
Nothing)
TestSuiteLibV09 Version
ver ModuleName
modu -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Version -> TestType
TestTypeLib Version
ver, forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just ModuleName
modu)
TestSuiteInterface
_ -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
data BenchmarkStanza = BenchmarkStanza
{ BenchmarkStanza -> Maybe BenchmarkType
_benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
, BenchmarkStanza -> Maybe String
_benchmarkStanzaMainIs :: Maybe FilePath
, BenchmarkStanza -> Maybe ModuleName
_benchmarkStanzaBenchmarkModule :: Maybe ModuleName
, BenchmarkStanza -> BuildInfo
_benchmarkStanzaBuildInfo :: BuildInfo
}
instance L.HasBuildInfo BenchmarkStanza where
buildInfo :: Lens' BenchmarkStanza BuildInfo
buildInfo = Lens' BenchmarkStanza BuildInfo
benchmarkStanzaBuildInfo
benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType)
benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType)
benchmarkStanzaBenchmarkType Maybe BenchmarkType -> f (Maybe BenchmarkType)
f BenchmarkStanza
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe BenchmarkType
x -> BenchmarkStanza
s { _benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
_benchmarkStanzaBenchmarkType = Maybe BenchmarkType
x }) (Maybe BenchmarkType -> f (Maybe BenchmarkType)
f (BenchmarkStanza -> Maybe BenchmarkType
_benchmarkStanzaBenchmarkType BenchmarkStanza
s))
{-# INLINE benchmarkStanzaBenchmarkType #-}
benchmarkStanzaMainIs :: Lens' BenchmarkStanza (Maybe FilePath)
benchmarkStanzaMainIs :: Lens' BenchmarkStanza (Maybe String)
benchmarkStanzaMainIs Maybe String -> f (Maybe String)
f BenchmarkStanza
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe String
x -> BenchmarkStanza
s { _benchmarkStanzaMainIs :: Maybe String
_benchmarkStanzaMainIs = Maybe String
x }) (Maybe String -> f (Maybe String)
f (BenchmarkStanza -> Maybe String
_benchmarkStanzaMainIs BenchmarkStanza
s))
{-# INLINE benchmarkStanzaMainIs #-}
benchmarkStanzaBenchmarkModule :: Lens' BenchmarkStanza (Maybe ModuleName)
benchmarkStanzaBenchmarkModule :: Lens' BenchmarkStanza (Maybe ModuleName)
benchmarkStanzaBenchmarkModule Maybe ModuleName -> f (Maybe ModuleName)
f BenchmarkStanza
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe ModuleName
x -> BenchmarkStanza
s { _benchmarkStanzaBenchmarkModule :: Maybe ModuleName
_benchmarkStanzaBenchmarkModule = Maybe ModuleName
x }) (Maybe ModuleName -> f (Maybe ModuleName)
f (BenchmarkStanza -> Maybe ModuleName
_benchmarkStanzaBenchmarkModule BenchmarkStanza
s))
{-# INLINE benchmarkStanzaBenchmarkModule #-}
benchmarkStanzaBuildInfo :: Lens' BenchmarkStanza BuildInfo
benchmarkStanzaBuildInfo :: Lens' BenchmarkStanza BuildInfo
benchmarkStanzaBuildInfo BuildInfo -> f BuildInfo
f BenchmarkStanza
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\BuildInfo
x -> BenchmarkStanza
s { _benchmarkStanzaBuildInfo :: BuildInfo
_benchmarkStanzaBuildInfo = BuildInfo
x }) (BuildInfo -> f BuildInfo
f (BenchmarkStanza -> BuildInfo
_benchmarkStanzaBuildInfo BenchmarkStanza
s))
{-# INLINE benchmarkStanzaBuildInfo #-}
benchmarkFieldGrammar
:: ( FieldGrammar c g, Applicative (g BenchmarkStanza), Applicative (g BuildInfo)
, c (Identity BenchmarkType)
, c (Identity ModuleName)
, c (List CommaFSep (Identity ExeDependency) ExeDependency)
, c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep FilePathNT String)
, c (List FSep Token String)
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
, c (List VCat FilePathNT String)
, c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
, c (List VCat Token String)
, c (MQuoted Language)
)
=> g BenchmarkStanza BenchmarkStanza
benchmarkFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BenchmarkStanza),
Applicative (g BuildInfo), c (Identity BenchmarkType),
c (Identity ModuleName),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
g BenchmarkStanza BenchmarkStanza
benchmarkFieldGrammar = Maybe BenchmarkType
-> Maybe String -> Maybe ModuleName -> BuildInfo -> BenchmarkStanza
BenchmarkStanza
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"type" Lens' BenchmarkStanza (Maybe BenchmarkType)
benchmarkStanzaBenchmarkType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla FieldName
"main-is" String -> FilePathNT
FilePathNT Lens' BenchmarkStanza (Maybe String)
benchmarkStanzaMainIs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"benchmark-module" Lens' BenchmarkStanza (Maybe ModuleName)
benchmarkStanzaBenchmarkModule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar Lens' BenchmarkStanza BuildInfo
benchmarkStanzaBuildInfo forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
validateBenchmark :: Position -> BenchmarkStanza -> ParseResult Benchmark
validateBenchmark :: Position -> BenchmarkStanza -> ParseResult Benchmark
validateBenchmark Position
pos BenchmarkStanza
stanza = case BenchmarkStanza -> Maybe BenchmarkType
_benchmarkStanzaBenchmarkType BenchmarkStanza
stanza of
Maybe BenchmarkType
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Benchmark
emptyBenchmark
{ benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BenchmarkStanza -> BuildInfo
_benchmarkStanzaBuildInfo BenchmarkStanza
stanza }
Just tt :: BenchmarkType
tt@(BenchmarkTypeUnknown String
_ Version
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Benchmark
emptyBenchmark
{ benchmarkInterface :: BenchmarkInterface
benchmarkInterface = BenchmarkType -> BenchmarkInterface
BenchmarkUnsupported BenchmarkType
tt
, benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BenchmarkStanza -> BuildInfo
_benchmarkStanzaBuildInfo BenchmarkStanza
stanza
}
Just BenchmarkType
tt | BenchmarkType
tt forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [BenchmarkType]
knownBenchmarkTypes -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Benchmark
emptyBenchmark
{ benchmarkInterface :: BenchmarkInterface
benchmarkInterface = BenchmarkType -> BenchmarkInterface
BenchmarkUnsupported BenchmarkType
tt
, benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BenchmarkStanza -> BuildInfo
_benchmarkStanzaBuildInfo BenchmarkStanza
stanza
}
Just tt :: BenchmarkType
tt@(BenchmarkTypeExe Version
ver) -> case BenchmarkStanza -> Maybe String
_benchmarkStanzaMainIs BenchmarkStanza
stanza of
Maybe String
Nothing -> do
Position -> String -> ParseResult ()
parseFailure Position
pos (forall {a}. Pretty a => String -> a -> String
missingField String
"main-is" BenchmarkType
tt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Benchmark
emptyBenchmark
Just String
file -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust (BenchmarkStanza -> Maybe ModuleName
_benchmarkStanzaBenchmarkModule BenchmarkStanza
stanza)) forall a b. (a -> b) -> a -> b
$
Position -> PWarnType -> String -> ParseResult ()
parseWarning Position
pos PWarnType
PWTExtraBenchmarkModule (forall {a}. Pretty a => String -> a -> String
extraField String
"benchmark-module" BenchmarkType
tt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Benchmark
emptyBenchmark
{ benchmarkInterface :: BenchmarkInterface
benchmarkInterface = Version -> String -> BenchmarkInterface
BenchmarkExeV10 Version
ver String
file
, benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BenchmarkStanza -> BuildInfo
_benchmarkStanzaBuildInfo BenchmarkStanza
stanza
}
where
missingField :: String -> a -> String
missingField String
name a
tt = String
"The '" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"' field is required for the "
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow a
tt forall a. [a] -> [a] -> [a]
++ String
" benchmark type."
extraField :: String -> a -> String
extraField String
name a
tt = String
"The '" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"' field is not used for the '"
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow a
tt forall a. [a] -> [a] -> [a]
++ String
"' benchmark type."
unvalidateBenchmark :: Benchmark -> BenchmarkStanza
unvalidateBenchmark :: Benchmark -> BenchmarkStanza
unvalidateBenchmark Benchmark
b = BenchmarkStanza
{ _benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
_benchmarkStanzaBenchmarkType = Maybe BenchmarkType
ty
, _benchmarkStanzaMainIs :: Maybe String
_benchmarkStanzaMainIs = Maybe String
ma
, _benchmarkStanzaBenchmarkModule :: Maybe ModuleName
_benchmarkStanzaBenchmarkModule = forall a. Maybe a
mo
, _benchmarkStanzaBuildInfo :: BuildInfo
_benchmarkStanzaBuildInfo = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
b
}
where
(Maybe BenchmarkType
ty, Maybe String
ma, Maybe a
mo) = case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
b of
BenchmarkExeV10 Version
ver String
"" -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Version -> BenchmarkType
BenchmarkTypeExe Version
ver, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
BenchmarkExeV10 Version
ver String
ma' -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Version -> BenchmarkType
BenchmarkTypeExe Version
ver, forall a. a -> Maybe a
Just String
ma', forall a. Maybe a
Nothing)
BenchmarkInterface
_ -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
buildInfoFieldGrammar
:: ( FieldGrammar c g, Applicative (g BuildInfo)
, c (List CommaFSep (Identity ExeDependency) ExeDependency)
, c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep FilePathNT String)
, c (List FSep Token String)
, c (List NoCommaFSep Token' String)
, c (List VCat (MQuoted ModuleName) ModuleName)
, c (List VCat FilePathNT String)
, c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
, c (List VCat Token String)
, c (MQuoted Language)
)
=> g BuildInfo BuildInfo
buildInfoFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar = Bool
-> [LegacyExeDependency]
-> [ExeDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [PkgconfigDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [SymbolicPath PackageDir SourceDir]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> PerCompilerFlavor [String]
-> PerCompilerFlavor [String]
-> PerCompilerFlavor [String]
-> PerCompilerFlavor [String]
-> [(String, String)]
-> [Dependency]
-> [Mixin]
-> BuildInfo
BuildInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef FieldName
"buildable" forall a. HasBuildInfo a => Lens' a Bool
L.buildable Bool
True
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"build-tools" (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaFSep
CommaFSep) forall a. HasBuildInfo a => Lens' a [LegacyExeDependency]
L.buildTools
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> String -> g s a -> g s a
deprecatedSince CabalSpecVersion
CabalSpecV2_0
String
"Please use 'build-tool-depends' field"
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> String -> g s a -> g s a
removedIn CabalSpecVersion
CabalSpecV3_0
String
"Please use 'build-tool-depends' field."
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"build-tool-depends" (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaFSep
CommaFSep) forall a. HasBuildInfo a => Lens' a [ExeDependency]
L.buildToolDepends
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"cpp-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') forall a. HasBuildInfo a => Lens' a [String]
L.cppOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"asm-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') forall a. HasBuildInfo a => Lens' a [String]
L.asmOptions
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"cmm-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') forall a. HasBuildInfo a => Lens' a [String]
L.cmmOptions
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"cc-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') forall a. HasBuildInfo a => Lens' a [String]
L.ccOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"cxx-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') forall a. HasBuildInfo a => Lens' a [String]
L.cxxOptions
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_2 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"ld-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') forall a. HasBuildInfo a => Lens' a [String]
L.ldOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"hsc2hs-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') forall a. HasBuildInfo a => Lens' a [String]
L.hsc2hsOptions
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_6 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"pkgconfig-depends" (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaFSep
CommaFSep) forall a. HasBuildInfo a => Lens' a [PkgconfigDependency]
L.pkgconfigDepends
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"frameworks" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token) forall a. HasBuildInfo a => Lens' a [String]
L.frameworks
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extra-framework-dirs" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.extraFrameworkDirs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"asm-sources" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.asmSources
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"cmm-sources" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.cmmSources
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"c-sources" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.cSources
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"cxx-sources" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.cxxSources
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_2 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"js-sources" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.jsSources
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir))) =>
g BuildInfo [SymbolicPath PackageDir SourceDir]
hsSourceDirsGrammar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"other-modules" [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules forall a. HasBuildInfo a => Lens' a [ModuleName]
L.otherModules
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"virtual-modules" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat forall a. a -> MQuoted a
MQuoted) forall a. HasBuildInfo a => Lens' a [ModuleName]
L.virtualModules
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_2 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"autogen-modules" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat forall a. a -> MQuoted a
MQuoted) forall a. HasBuildInfo a => Lens' a [ModuleName]
L.autogenModules
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_0 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla FieldName
"default-language" forall a. a -> MQuoted a
MQuoted forall a. HasBuildInfo a => Lens' a (Maybe Language)
L.defaultLanguage
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV1_10 forall a. Maybe a
Nothing
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"other-languages" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep forall a. a -> MQuoted a
MQuoted) forall a. HasBuildInfo a => Lens' a [Language]
L.otherLanguages
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV1_10 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"default-extensions" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep forall a. a -> MQuoted a
MQuoted) forall a. HasBuildInfo a => Lens' a [Extension]
L.defaultExtensions
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV1_10 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"other-extensions" [Extension] -> List FSep (MQuoted Extension) Extension
formatOtherExtensions forall a. HasBuildInfo a => Lens' a [Extension]
L.otherExtensions
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> g s a -> g s a
availableSinceWarn CabalSpecVersion
CabalSpecV1_10
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extensions" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep forall a. a -> MQuoted a
MQuoted) forall a. HasBuildInfo a => Lens' a [Extension]
L.oldExtensions
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> String -> g s a -> g s a
deprecatedSince CabalSpecVersion
CabalSpecV1_12
String
"Please use 'default-extensions' or 'other-extensions' fields."
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> String -> g s a -> g s a
removedIn CabalSpecVersion
CabalSpecV3_0
String
"Please use 'default-extensions' or 'other-extensions' fields."
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extra-libraries" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> Token
Token) forall a. HasBuildInfo a => Lens' a [String]
L.extraLibs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extra-ghci-libraries" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> Token
Token) forall a. HasBuildInfo a => Lens' a [String]
L.extraGHCiLibs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extra-bundled-libraries" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> Token
Token) forall a. HasBuildInfo a => Lens' a [String]
L.extraBundledLibs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extra-library-flavours" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> Token
Token) forall a. HasBuildInfo a => Lens' a [String]
L.extraLibFlavours
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extra-dynamic-library-flavours" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> Token
Token) forall a. HasBuildInfo a => Lens' a [String]
L.extraDynLibFlavours
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"extra-lib-dirs" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.extraLibDirs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"include-dirs" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.includeDirs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"includes" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.includes
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"autogen-includes" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"install-includes" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) forall a. HasBuildInfo a => Lens' a [String]
L.installIncludes
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List NoCommaFSep Token' String)) =>
g BuildInfo (PerCompilerFlavor [String])
optionsFieldGrammar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List NoCommaFSep Token' String)) =>
g BuildInfo (PerCompilerFlavor [String])
profOptionsFieldGrammar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List NoCommaFSep Token' String)) =>
g BuildInfo (PerCompilerFlavor [String])
sharedOptionsFieldGrammar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s [(String, String)] -> g s [(String, String)]
prefixedFields FieldName
"x-" forall a. HasBuildInfo a => Lens' a [(String, String)]
L.customFieldsBI
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"build-depends" [Dependency] -> List CommaVCat (Identity Dependency) Dependency
formatDependencyList forall a. HasBuildInfo a => Lens' a [Dependency]
L.targetBuildDepends
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"mixins" [Mixin] -> List CommaVCat (Identity Mixin) Mixin
formatMixinList forall a. HasBuildInfo a => Lens' a [Mixin]
L.mixins
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_0 []
{-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' BuildInfo #-}
{-# SPECIALIZE buildInfoFieldGrammar :: PrettyFieldGrammar' BuildInfo #-}
hsSourceDirsGrammar
:: ( FieldGrammar c g, Applicative (g BuildInfo)
, c (List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir))
)
=> g BuildInfo [SymbolicPath PackageDir SourceDir]
hsSourceDirsGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir))) =>
g BuildInfo [SymbolicPath PackageDir SourceDir]
hsSourceDirsGrammar = forall a. [a] -> [a] -> [a]
(++)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"hs-source-dirs" [SymbolicPath PackageDir SourceDir]
-> List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)
formatHsSourceDirs forall a.
HasBuildInfo a =>
Lens' a [SymbolicPath PackageDir SourceDir]
L.hsSourceDirs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"hs-source-dir" (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep) forall (f :: * -> *).
Functor f =>
LensLike' f BuildInfo [SymbolicPath PackageDir SourceDir]
wrongLens
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> String -> g s a -> g s a
deprecatedSince CabalSpecVersion
CabalSpecV1_2 String
"Please use 'hs-source-dirs'"
forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> String -> g s a -> g s a
removedIn CabalSpecVersion
CabalSpecV3_0 String
"Please use 'hs-source-dirs' field."
where
wrongLens :: Functor f => LensLike' f BuildInfo [SymbolicPath PackageDir SourceDir]
wrongLens :: forall (f :: * -> *).
Functor f =>
LensLike' f BuildInfo [SymbolicPath PackageDir SourceDir]
wrongLens [SymbolicPath PackageDir SourceDir]
-> f [SymbolicPath PackageDir SourceDir]
f BuildInfo
bi = (\[SymbolicPath PackageDir SourceDir]
fps -> forall s t a b. ASetter s t a b -> b -> s -> t
set forall a.
HasBuildInfo a =>
Lens' a [SymbolicPath PackageDir SourceDir]
L.hsSourceDirs [SymbolicPath PackageDir SourceDir]
fps BuildInfo
bi) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SymbolicPath PackageDir SourceDir]
-> f [SymbolicPath PackageDir SourceDir]
f []
optionsFieldGrammar
:: (FieldGrammar c g, Applicative (g BuildInfo), c (List NoCommaFSep Token' String))
=> g BuildInfo (PerCompilerFlavor [String])
optionsFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List NoCommaFSep Token' String)) =>
g BuildInfo (PerCompilerFlavor [String])
optionsFieldGrammar = forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"ghc-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [String]
extract CompilerFlavor
GHC)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"ghcjs-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [String]
extract CompilerFlavor
GHCJS)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> g s ()
knownField FieldName
"jhc-options"
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> g s ()
knownField FieldName
"hugs-options"
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> g s ()
knownField FieldName
"nhc98-options"
where
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract CompilerFlavor
flavor = forall a. HasBuildInfo a => Lens' a (PerCompilerFlavor [String])
L.options forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) v.
(Functor f, Monoid v) =>
CompilerFlavor -> LensLike' f (PerCompilerFlavor v) v
lookupLens CompilerFlavor
flavor
profOptionsFieldGrammar
:: (FieldGrammar c g, Applicative (g BuildInfo), c (List NoCommaFSep Token' String))
=> g BuildInfo (PerCompilerFlavor [String])
profOptionsFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List NoCommaFSep Token' String)) =>
g BuildInfo (PerCompilerFlavor [String])
profOptionsFieldGrammar = forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"ghc-prof-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [String]
extract CompilerFlavor
GHC)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"ghcjs-prof-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [String]
extract CompilerFlavor
GHCJS)
where
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract CompilerFlavor
flavor = forall a. HasBuildInfo a => Lens' a (PerCompilerFlavor [String])
L.profOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) v.
(Functor f, Monoid v) =>
CompilerFlavor -> LensLike' f (PerCompilerFlavor v) v
lookupLens CompilerFlavor
flavor
sharedOptionsFieldGrammar
:: (FieldGrammar c g, Applicative (g BuildInfo), c (List NoCommaFSep Token' String))
=> g BuildInfo (PerCompilerFlavor [String])
sharedOptionsFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List NoCommaFSep Token' String)) =>
g BuildInfo (PerCompilerFlavor [String])
sharedOptionsFieldGrammar = forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"ghc-shared-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [String]
extract CompilerFlavor
GHC)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"ghcjs-shared-options" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [String]
extract CompilerFlavor
GHCJS)
where
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract CompilerFlavor
flavor = forall a. HasBuildInfo a => Lens' a (PerCompilerFlavor [String])
L.sharedOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) v.
(Functor f, Monoid v) =>
CompilerFlavor -> LensLike' f (PerCompilerFlavor v) v
lookupLens CompilerFlavor
flavor
lookupLens :: (Functor f, Monoid v) => CompilerFlavor -> LensLike' f (PerCompilerFlavor v) v
lookupLens :: forall (f :: * -> *) v.
(Functor f, Monoid v) =>
CompilerFlavor -> LensLike' f (PerCompilerFlavor v) v
lookupLens CompilerFlavor
k v -> f v
f p :: PerCompilerFlavor v
p@(PerCompilerFlavor v
ghc v
ghcjs)
| CompilerFlavor
k forall a. Eq a => a -> a -> Bool
== CompilerFlavor
GHC = (\v
n -> forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor v
n v
ghcjs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> f v
f v
ghc
| CompilerFlavor
k forall a. Eq a => a -> a -> Bool
== CompilerFlavor
GHCJS = (\v
n -> forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor v
ghc v
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> f v
f v
ghcjs
| Bool
otherwise = PerCompilerFlavor v
p forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ v -> f v
f forall a. Monoid a => a
mempty
flagFieldGrammar
:: (FieldGrammar c g, Applicative (g PackageFlag))
=> FlagName -> g PackageFlag PackageFlag
flagFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g PackageFlag)) =>
FlagName -> g PackageFlag PackageFlag
flagFieldGrammar FlagName
name = FlagName -> String -> Bool -> Bool -> PackageFlag
MkPackageFlag FlagName
name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef FieldName
"description" Lens' PackageFlag String
L.flagDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef FieldName
"default" Lens' PackageFlag Bool
L.flagDefault Bool
True
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef FieldName
"manual" Lens' PackageFlag Bool
L.flagManual Bool
False
{-# SPECIALIZE flagFieldGrammar :: FlagName -> ParsecFieldGrammar' PackageFlag #-}
{-# SPECIALIZE flagFieldGrammar :: FlagName -> PrettyFieldGrammar' PackageFlag #-}
sourceRepoFieldGrammar
:: (FieldGrammar c g, Applicative (g SourceRepo), c (Identity RepoType), c Token, c FilePathNT)
=> RepoKind -> g SourceRepo SourceRepo
sourceRepoFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepo),
c (Identity RepoType), c Token, c FilePathNT) =>
RepoKind -> g SourceRepo SourceRepo
sourceRepoFieldGrammar RepoKind
kind = RepoKind
-> Maybe RepoType
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> SourceRepo
SourceRepo RepoKind
kind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"type" Lens' SourceRepo (Maybe RepoType)
L.repoType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s (Maybe String) -> g s (Maybe String)
freeTextField FieldName
"location" Lens' SourceRepo (Maybe String)
L.repoLocation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla FieldName
"module" String -> Token
Token Lens' SourceRepo (Maybe String)
L.repoModule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla FieldName
"branch" String -> Token
Token Lens' SourceRepo (Maybe String)
L.repoBranch
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla FieldName
"tag" String -> Token
Token Lens' SourceRepo (Maybe String)
L.repoTag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla FieldName
"subdir" String -> FilePathNT
FilePathNT Lens' SourceRepo (Maybe String)
L.repoSubdir
{-# SPECIALIZE sourceRepoFieldGrammar :: RepoKind -> ParsecFieldGrammar' SourceRepo #-}
{-# SPECIALIZE sourceRepoFieldGrammar :: RepoKind -> PrettyFieldGrammar' SourceRepo #-}
setupBInfoFieldGrammar
:: (FieldGrammar c g, Functor (g SetupBuildInfo), c (List CommaVCat (Identity Dependency) Dependency))
=> Bool -> g SetupBuildInfo SetupBuildInfo
setupBInfoFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Functor (g SetupBuildInfo),
c (List CommaVCat (Identity Dependency) Dependency)) =>
Bool -> g SetupBuildInfo SetupBuildInfo
setupBInfoFieldGrammar Bool
def = forall a b c. (a -> b -> c) -> b -> a -> c
flip [Dependency] -> Bool -> SetupBuildInfo
SetupBuildInfo Bool
def
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"setup-depends" (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaVCat
CommaVCat) Lens' SetupBuildInfo [Dependency]
L.setupDepends
{-# SPECIALIZE setupBInfoFieldGrammar :: Bool -> ParsecFieldGrammar' SetupBuildInfo #-}
{-# SPECIALIZE setupBInfoFieldGrammar :: Bool -> PrettyFieldGrammar' SetupBuildInfo #-}
formatDependencyList :: [Dependency] -> List CommaVCat (Identity Dependency) Dependency
formatDependencyList :: [Dependency] -> List CommaVCat (Identity Dependency) Dependency
formatDependencyList = forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaVCat
CommaVCat
formatMixinList :: [Mixin] -> List CommaVCat (Identity Mixin) Mixin
formatMixinList :: [Mixin] -> List CommaVCat (Identity Mixin) Mixin
formatMixinList = forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaVCat
CommaVCat
formatExtraSourceFiles :: [FilePath] -> List VCat FilePathNT FilePath
= forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat String -> FilePathNT
FilePathNT
formatExposedModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatExposedModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatExposedModules = forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat forall a. a -> MQuoted a
MQuoted
formatHsSourceDirs :: [SymbolicPath PackageDir SourceDir] -> List FSep (Identity (SymbolicPath PackageDir SourceDir)) (SymbolicPath PackageDir SourceDir)
formatHsSourceDirs :: [SymbolicPath PackageDir SourceDir]
-> List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)
formatHsSourceDirs = forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep
formatOtherExtensions :: [Extension] -> List FSep (MQuoted Extension) Extension
formatOtherExtensions :: [Extension] -> List FSep (MQuoted Extension) Extension
formatOtherExtensions = forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep forall a. a -> MQuoted a
MQuoted
formatOtherModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules = forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat forall a. a -> MQuoted a
MQuoted
newtype CompatFilePath = CompatFilePath { CompatFilePath -> String
getCompatFilePath :: FilePath }
instance Newtype String CompatFilePath
instance Parsec CompatFilePath where
parsec :: forall (m :: * -> *). CabalParsing m => m CompatFilePath
parsec = do
String
token <- forall (m :: * -> *). CabalParsing m => m String
parsecToken
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
token
then do
forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTEmptyFilePath String
"empty FilePath"
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CompatFilePath
CompatFilePath String
"")
else forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CompatFilePath
CompatFilePath String
token)
instance Pretty CompatFilePath where
pretty :: CompatFilePath -> Doc
pretty = String -> Doc
showToken forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompatFilePath -> String
getCompatFilePath
newtype CompatLicenseFile = CompatLicenseFile { CompatLicenseFile -> [SymbolicPath PackageDir LicenseFile]
getCompatLicenseFile :: [SymbolicPath PackageDir LicenseFile] }
instance Newtype [SymbolicPath PackageDir LicenseFile] CompatLicenseFile
instance Parsec CompatLicenseFile where
parsec :: forall (m :: * -> *). CabalParsing m => m CompatLicenseFile
parsec = m CompatLicenseFile
emptyToken forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [SymbolicPath PackageDir LicenseFile] -> CompatLicenseFile
CompatLicenseFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => (o -> n) -> n -> o
unpack' (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
where
emptyToken :: m CompatLicenseFile
emptyToken = forall (m :: * -> *) a. Parsing m => m a -> m a
P.try forall a b. (a -> b) -> a -> b
$ do
String
token <- forall (m :: * -> *). CabalParsing m => m String
parsecToken
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
token
then forall (m :: * -> *) a. Monad m => a -> m a
return ([SymbolicPath PackageDir LicenseFile] -> CompatLicenseFile
CompatLicenseFile [])
else forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected String
"non-empty-token"
instance Pretty CompatLicenseFile where
pretty :: CompatLicenseFile -> Doc
pretty = forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => (o -> n) -> o -> n
pack' (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompatLicenseFile -> [SymbolicPath PackageDir LicenseFile]
getCompatLicenseFile
_syntaxFieldNames :: IO ()
_syntaxFieldNames :: IO ()
_syntaxFieldNames = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ FieldName -> IO ()
BS8.putStrLn forall a b. (a -> b) -> a -> b
$ FieldName
" \\ " forall a. Semigroup a => a -> a -> a
<> FieldName
n
| FieldName
n <- forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ forall s a. ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g PackageDescription),
Applicative (g PackageIdentifier), c (Identity BuildType),
c (Identity PackageName), c (Identity Version),
c (List FSep FilePathNT String),
c (List FSep CompatFilePath String),
c (List
FSep
(Identity (SymbolicPath PackageDir LicenseFile))
(SymbolicPath PackageDir LicenseFile)),
c (List FSep TestedWith (CompilerFlavor, VersionRange)),
c (List VCat FilePathNT String), c FilePathNT, c CompatLicenseFile,
c CompatFilePath, c SpecLicense, c SpecVersion) =>
g PackageDescription PackageDescription
packageDescriptionFieldGrammar
, forall s a. ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Library),
Applicative (g BuildInfo), c (Identity LibraryVisibility),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List CommaVCat (Identity ModuleReexport) ModuleReexport),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
LibraryName -> g Library Library
libraryFieldGrammar LibraryName
LMainLibName
, forall s a. ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Executable),
Applicative (g BuildInfo), c (Identity ExecutableScope),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String), c (List VCat Token String),
c (MQuoted Language)) =>
UnqualComponentName -> g Executable Executable
executableFieldGrammar UnqualComponentName
"exe"
, forall s a. ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g ForeignLib),
Applicative (g BuildInfo), c (Identity ForeignLibType),
c (Identity LibVersionInfo), c (Identity Version),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (Identity ForeignLibOption) ForeignLibOption),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String), c (List VCat Token String),
c (MQuoted Language)) =>
UnqualComponentName -> g ForeignLib ForeignLib
foreignLibFieldGrammar UnqualComponentName
"flib"
, forall s a. ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g TestSuiteStanza),
Applicative (g BuildInfo), c (Identity ModuleName),
c (Identity TestType),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
g TestSuiteStanza TestSuiteStanza
testSuiteFieldGrammar
, forall s a. ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BenchmarkStanza),
Applicative (g BuildInfo), c (Identity BenchmarkType),
c (Identity ModuleName),
c (List CommaFSep (Identity ExeDependency) ExeDependency),
c (List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
c (List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
c (List CommaVCat (Identity Dependency) Dependency),
c (List CommaVCat (Identity Mixin) Mixin),
c (List FSep (MQuoted Extension) Extension),
c (List FSep (MQuoted Language) Language),
c (List FSep FilePathNT String), c (List FSep Token String),
c (List NoCommaFSep Token' String),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT String),
c (List
FSep
(Identity (SymbolicPath PackageDir SourceDir))
(SymbolicPath PackageDir SourceDir)),
c (List VCat Token String), c (MQuoted Language)) =>
g BenchmarkStanza BenchmarkStanza
benchmarkFieldGrammar
, forall s a. ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g PackageFlag)) =>
FlagName -> g PackageFlag PackageFlag
flagFieldGrammar (forall a. HasCallStack => String -> a
error String
"flagname")
, forall s a. ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepo),
c (Identity RepoType), c Token, c FilePathNT) =>
RepoKind -> g SourceRepo SourceRepo
sourceRepoFieldGrammar (forall a. HasCallStack => String -> a
error String
"repokind")
, forall s a. ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList forall a b. (a -> b) -> a -> b
$ forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Functor (g SetupBuildInfo),
c (List CommaVCat (Identity Dependency) Dependency)) =>
Bool -> g SetupBuildInfo SetupBuildInfo
setupBInfoFieldGrammar Bool
True
]
]
_syntaxExtensions :: IO ()
_syntaxExtensions :: IO ()
_syntaxExtensions = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
" \\ " forall a. Semigroup a => a -> a -> a
<> String
e
| String
e <- [String
"Safe",String
"Trustworthy",String
"Unsafe"]
forall a. [a] -> [a] -> [a]
++ [String]
es
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String
"No"forall a. [a] -> [a] -> [a]
++) [String]
es
]
where
es :: [String]
es = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort
[ forall a. Pretty a => a -> String
prettyShow KnownExtension
e
| KnownExtension
e <- [ forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound ]
, KnownExtension
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [KnownExtension
Safe,KnownExtension
Unsafe,KnownExtension
Trustworthy]
]