{-# LANGUAGE ConstraintKinds #-}
{-# 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.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 (prettyShow)
import Distribution.Types.ModuleReexport
import Distribution.Types.Mixin (Mixin)
import Distribution.Version (Version, VersionRange)
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 TestedWith (CompilerFlavor, VersionRange))
, c (List VCat FilePathNT String)
, c FilePathNT
, c SpecLicense
, c SpecVersion
)
=> g PackageDescription PackageDescription
packageDescriptionFieldGrammar :: g PackageDescription PackageDescription
packageDescriptionFieldGrammar = CabalSpecVersion
-> PackageIdentifier
-> Either License License
-> [FilePath]
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription
PackageDescription
(CabalSpecVersion
-> PackageIdentifier
-> Either License License
-> [FilePath]
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription CabalSpecVersion
-> g PackageDescription
(PackageIdentifier
-> Either License License
-> [FilePath]
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> (CabalSpecVersion -> SpecVersion)
-> ALens' PackageDescription CabalSpecVersion
-> CabalSpecVersion
-> g PackageDescription CabalSpecVersion
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 ALens' PackageDescription CabalSpecVersion
Lens' PackageDescription CabalSpecVersion
L.specVersion CabalSpecVersion
CabalSpecV1_0
g PackageDescription
(PackageIdentifier
-> Either License License
-> [FilePath]
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription PackageIdentifier
-> g PackageDescription
(Either License License
-> [FilePath]
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ALens' PackageDescription PackageIdentifier
-> g PackageIdentifier PackageIdentifier
-> g PackageDescription PackageIdentifier
forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar ALens' PackageDescription PackageIdentifier
Lens' PackageDescription PackageIdentifier
L.package g PackageIdentifier PackageIdentifier
packageIdentifierGrammar
g PackageDescription
(Either License License
-> [FilePath]
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription (Either License License)
-> g PackageDescription
([FilePath]
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (Either License License -> SpecLicense)
-> ALens' PackageDescription (Either License License)
-> Either License License
-> g PackageDescription (Either License License)
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 ALens' PackageDescription (Either License License)
Lens' PackageDescription (Either License License)
L.licenseRaw (License -> Either License License
forall a b. a -> Either a b
Left License
SPDX.NONE)
g PackageDescription
([FilePath]
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription [FilePath]
-> g PackageDescription
(ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g PackageDescription [FilePath]
licenseFilesGrammar
g PackageDescription
(ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription ShortText
-> g PackageDescription
(ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription ShortText
-> g PackageDescription ShortText
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"copyright" ALens' PackageDescription ShortText
Lens' PackageDescription ShortText
L.copyright
g PackageDescription
(ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription ShortText
-> g PackageDescription
(ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription ShortText
-> g PackageDescription ShortText
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"maintainer" ALens' PackageDescription ShortText
Lens' PackageDescription ShortText
L.maintainer
g PackageDescription
(ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription ShortText
-> g PackageDescription
(ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription ShortText
-> g PackageDescription ShortText
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"author" ALens' PackageDescription ShortText
Lens' PackageDescription ShortText
L.author
g PackageDescription
(ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription ShortText
-> g PackageDescription
([(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription ShortText
-> g PackageDescription ShortText
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"stability" ALens' PackageDescription ShortText
Lens' PackageDescription ShortText
L.stability
g PackageDescription
([(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription [(CompilerFlavor, VersionRange)]
-> g PackageDescription
(ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([(CompilerFlavor, VersionRange)]
-> List FSep TestedWith (CompilerFlavor, VersionRange))
-> ALens' PackageDescription [(CompilerFlavor, VersionRange)]
-> g PackageDescription [(CompilerFlavor, VersionRange)]
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" (FSep
-> ((CompilerFlavor, VersionRange) -> TestedWith)
-> [(CompilerFlavor, VersionRange)]
-> List FSep TestedWith (CompilerFlavor, VersionRange)
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep (CompilerFlavor, VersionRange) -> TestedWith
TestedWith) ALens' PackageDescription [(CompilerFlavor, VersionRange)]
Lens' PackageDescription [(CompilerFlavor, VersionRange)]
L.testedWith
g PackageDescription
(ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription ShortText
-> g PackageDescription
(ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription ShortText
-> g PackageDescription ShortText
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"homepage" ALens' PackageDescription ShortText
Lens' PackageDescription ShortText
L.homepage
g PackageDescription
(ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription ShortText
-> g PackageDescription
(ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription ShortText
-> g PackageDescription ShortText
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"package-url" ALens' PackageDescription ShortText
Lens' PackageDescription ShortText
L.pkgUrl
g PackageDescription
(ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription ShortText
-> g PackageDescription
([SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription ShortText
-> g PackageDescription ShortText
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"bug-reports" ALens' PackageDescription ShortText
Lens' PackageDescription ShortText
L.bugReports
g PackageDescription
([SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription [SourceRepo]
-> g PackageDescription
(ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [SourceRepo] -> g PackageDescription [SourceRepo]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
g PackageDescription
(ShortText
-> ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription ShortText
-> g PackageDescription
(ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription ShortText
-> g PackageDescription ShortText
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"synopsis" ALens' PackageDescription ShortText
Lens' PackageDescription ShortText
L.synopsis
g PackageDescription
(ShortText
-> ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription ShortText
-> g PackageDescription
(ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription ShortText
-> g PackageDescription ShortText
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"description" ALens' PackageDescription ShortText
Lens' PackageDescription ShortText
L.description
g PackageDescription
(ShortText
-> [(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription ShortText
-> g PackageDescription
([(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription ShortText
-> g PackageDescription ShortText
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST FieldName
"category" ALens' PackageDescription ShortText
Lens' PackageDescription ShortText
L.category
g PackageDescription
([(FilePath, FilePath)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription [(FilePath, FilePath)]
-> g PackageDescription
(Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription [(FilePath, FilePath)]
-> g PackageDescription [(FilePath, FilePath)]
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName
-> ALens' s [(FilePath, FilePath)] -> g s [(FilePath, FilePath)]
prefixedFields FieldName
"x-" ALens' PackageDescription [(FilePath, FilePath)]
Lens' PackageDescription [(FilePath, FilePath)]
L.customFieldsPD
g PackageDescription
(Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription (Maybe BuildType)
-> g PackageDescription
(Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageDescription (Maybe BuildType)
-> g PackageDescription (Maybe BuildType)
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" ALens' PackageDescription (Maybe BuildType)
Lens' PackageDescription (Maybe BuildType)
L.buildTypeRaw
g PackageDescription
(Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription (Maybe SetupBuildInfo)
-> g PackageDescription
(Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe SetupBuildInfo -> g PackageDescription (Maybe SetupBuildInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SetupBuildInfo
forall a. Maybe a
Nothing
g PackageDescription
(Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription (Maybe Library)
-> g PackageDescription
([Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Library -> g PackageDescription (Maybe Library)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Library
forall a. Maybe a
Nothing
g PackageDescription
([Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription [Library]
-> g PackageDescription
([Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Library] -> g PackageDescription [Library]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
g PackageDescription
([Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription [Executable]
-> g PackageDescription
([ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Executable] -> g PackageDescription [Executable]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
g PackageDescription
([ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription [ForeignLib]
-> g PackageDescription
([TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ForeignLib] -> g PackageDescription [ForeignLib]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
g PackageDescription
([TestSuite]
-> [Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription [TestSuite]
-> g PackageDescription
([Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TestSuite] -> g PackageDescription [TestSuite]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
g PackageDescription
([Benchmark]
-> [FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription [Benchmark]
-> g PackageDescription
([FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Benchmark] -> g PackageDescription [Benchmark]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
g PackageDescription
([FilePath]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PackageDescription)
-> g PackageDescription [FilePath]
-> g PackageDescription
(FilePath
-> [FilePath] -> [FilePath] -> [FilePath] -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat FilePathNT FilePath)
-> ALens' PackageDescription [FilePath]
-> g PackageDescription [FilePath]
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" (VCat
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List VCat FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> FilePathNT
FilePathNT) ALens' PackageDescription [FilePath]
Lens' PackageDescription [FilePath]
L.dataFiles
g PackageDescription
(FilePath
-> [FilePath] -> [FilePath] -> [FilePath] -> PackageDescription)
-> g PackageDescription FilePath
-> g PackageDescription
([FilePath] -> [FilePath] -> [FilePath] -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (FilePath -> FilePathNT)
-> ALens' PackageDescription FilePath
-> FilePath
-> g PackageDescription FilePath
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" FilePath -> FilePathNT
FilePathNT ALens' PackageDescription FilePath
Lens' PackageDescription FilePath
L.dataDir FilePath
"."
g PackageDescription
([FilePath] -> [FilePath] -> [FilePath] -> PackageDescription)
-> g PackageDescription [FilePath]
-> g PackageDescription
([FilePath] -> [FilePath] -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat FilePathNT FilePath)
-> ALens' PackageDescription [FilePath]
-> g PackageDescription [FilePath]
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" [FilePath] -> List VCat FilePathNT FilePath
formatExtraSourceFiles ALens' PackageDescription [FilePath]
Lens' PackageDescription [FilePath]
L.extraSrcFiles
g PackageDescription
([FilePath] -> [FilePath] -> PackageDescription)
-> g PackageDescription [FilePath]
-> g PackageDescription ([FilePath] -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat FilePathNT FilePath)
-> ALens' PackageDescription [FilePath]
-> g PackageDescription [FilePath]
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" (VCat
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List VCat FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> FilePathNT
FilePathNT) ALens' PackageDescription [FilePath]
Lens' PackageDescription [FilePath]
L.extraTmpFiles
g PackageDescription ([FilePath] -> PackageDescription)
-> g PackageDescription [FilePath]
-> g PackageDescription PackageDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat FilePathNT FilePath)
-> ALens' PackageDescription [FilePath]
-> g PackageDescription [FilePath]
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" (VCat
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List VCat FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> FilePathNT
FilePathNT) ALens' PackageDescription [FilePath]
Lens' PackageDescription [FilePath]
L.extraDocFiles
where
packageIdentifierGrammar :: g PackageIdentifier PackageIdentifier
packageIdentifierGrammar = PackageName -> Version -> PackageIdentifier
PackageIdentifier
(PackageName -> Version -> PackageIdentifier)
-> g PackageIdentifier PackageName
-> g PackageIdentifier (Version -> PackageIdentifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ALens' PackageIdentifier PackageName
-> g PackageIdentifier PackageName
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"name" ALens' PackageIdentifier PackageName
Lens' PackageIdentifier PackageName
L.pkgName
g PackageIdentifier (Version -> PackageIdentifier)
-> g PackageIdentifier Version
-> g PackageIdentifier PackageIdentifier
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' PackageIdentifier Version -> g PackageIdentifier Version
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"version" ALens' PackageIdentifier Version
Lens' PackageIdentifier Version
L.pkgVersion
licenseFilesGrammar :: g PackageDescription [FilePath]
licenseFilesGrammar = [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
(++)
([FilePath] -> [FilePath] -> [FilePath])
-> g PackageDescription [FilePath]
-> g PackageDescription ([FilePath] -> [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' PackageDescription [FilePath]
-> g PackageDescription [FilePath]
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" (FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT) ALens' PackageDescription [FilePath]
Lens' PackageDescription [FilePath]
L.licenseFiles
g PackageDescription ([FilePath] -> [FilePath])
-> g PackageDescription [FilePath]
-> g PackageDescription [FilePath]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' PackageDescription [FilePath]
-> g PackageDescription [FilePath]
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" (FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT) ALens' PackageDescription [FilePath]
Lens' PackageDescription [FilePath]
L.licenseFiles
g PackageDescription [FilePath]
-> (g PackageDescription [FilePath]
-> g PackageDescription [FilePath])
-> g PackageDescription [FilePath]
forall a b. a -> (a -> b) -> b
^^^ g PackageDescription [FilePath] -> g PackageDescription [FilePath]
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 VCat Token String)
, c (MQuoted Language)
)
=> LibraryName
-> g Library Library
libraryFieldGrammar :: LibraryName -> g Library Library
libraryFieldGrammar LibraryName
n = LibraryName
-> [ModuleName]
-> [ModuleReexport]
-> [ModuleName]
-> Bool
-> LibraryVisibility
-> BuildInfo
-> Library
Library LibraryName
n
([ModuleName]
-> [ModuleReexport]
-> [ModuleName]
-> Bool
-> LibraryVisibility
-> BuildInfo
-> Library)
-> g Library [ModuleName]
-> g Library
([ModuleReexport]
-> [ModuleName]
-> Bool
-> LibraryVisibility
-> BuildInfo
-> Library)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ([ModuleName] -> List VCat (MQuoted ModuleName) ModuleName)
-> ALens' Library [ModuleName]
-> g Library [ModuleName]
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 ALens' Library [ModuleName]
Lens' Library [ModuleName]
L.exposedModules
g Library
([ModuleReexport]
-> [ModuleName]
-> Bool
-> LibraryVisibility
-> BuildInfo
-> Library)
-> g Library [ModuleReexport]
-> g Library
([ModuleName] -> Bool -> LibraryVisibility -> BuildInfo -> Library)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([ModuleReexport]
-> List CommaVCat (Identity ModuleReexport) ModuleReexport)
-> ALens' Library [ModuleReexport]
-> g Library [ModuleReexport]
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" (CommaVCat
-> [ModuleReexport]
-> List CommaVCat (Identity ModuleReexport) ModuleReexport
forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaVCat
CommaVCat) ALens' Library [ModuleReexport]
Lens' Library [ModuleReexport]
L.reexportedModules
g Library
([ModuleName] -> Bool -> LibraryVisibility -> BuildInfo -> Library)
-> g Library [ModuleName]
-> g Library (Bool -> LibraryVisibility -> BuildInfo -> Library)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([ModuleName] -> List VCat (MQuoted ModuleName) ModuleName)
-> ALens' Library [ModuleName]
-> g Library [ModuleName]
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" (VCat
-> (ModuleName -> MQuoted ModuleName)
-> [ModuleName]
-> List VCat (MQuoted ModuleName) ModuleName
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat ModuleName -> MQuoted ModuleName
forall a. a -> MQuoted a
MQuoted) ALens' Library [ModuleName]
Lens' Library [ModuleName]
L.signatures
g Library [ModuleName]
-> (g Library [ModuleName] -> g Library [ModuleName])
-> g Library [ModuleName]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [ModuleName] -> g Library [ModuleName] -> g Library [ModuleName]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_0 []
g Library (Bool -> LibraryVisibility -> BuildInfo -> Library)
-> g Library Bool
-> g Library (LibraryVisibility -> BuildInfo -> Library)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> ALens' Library Bool -> Bool -> g Library Bool
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef FieldName
"exposed" ALens' Library Bool
Lens' Library Bool
L.libExposed Bool
True
g Library (LibraryVisibility -> BuildInfo -> Library)
-> g Library LibraryVisibility -> g Library (BuildInfo -> Library)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g Library LibraryVisibility
visibilityField
g Library (BuildInfo -> Library)
-> g Library BuildInfo -> g Library Library
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ALens' Library BuildInfo
-> g BuildInfo BuildInfo -> g Library BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar ALens' Library BuildInfo
Lens' Library BuildInfo
L.libBuildInfo g BuildInfo 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 FilePath), c (List FSep Token FilePath),
c (List NoCommaFSep Token' FilePath),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT FilePath), c (List VCat Token FilePath),
c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
where
visibilityField :: g Library LibraryVisibility
visibilityField = case LibraryName
n of
LibraryName
LMainLibName -> LibraryVisibility -> g Library LibraryVisibility
forall (f :: * -> *) a. Applicative f => a -> f a
pure LibraryVisibility
LibraryVisibilityPublic
LSubLibName UnqualComponentName
_ ->
FieldName
-> ALens' Library LibraryVisibility
-> LibraryVisibility
-> g Library LibraryVisibility
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" ALens' Library LibraryVisibility
Lens' Library LibraryVisibility
L.libVisibility LibraryVisibility
LibraryVisibilityPrivate
g Library LibraryVisibility
-> (g Library LibraryVisibility -> g Library LibraryVisibility)
-> g Library LibraryVisibility
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> LibraryVisibility
-> g Library LibraryVisibility
-> g Library LibraryVisibility
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 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 -> g ForeignLib ForeignLib
foreignLibFieldGrammar UnqualComponentName
n = UnqualComponentName
-> ForeignLibType
-> [ForeignLibOption]
-> BuildInfo
-> Maybe LibVersionInfo
-> Maybe Version
-> [FilePath]
-> ForeignLib
ForeignLib UnqualComponentName
n
(ForeignLibType
-> [ForeignLibOption]
-> BuildInfo
-> Maybe LibVersionInfo
-> Maybe Version
-> [FilePath]
-> ForeignLib)
-> g ForeignLib ForeignLibType
-> g ForeignLib
([ForeignLibOption]
-> BuildInfo
-> Maybe LibVersionInfo
-> Maybe Version
-> [FilePath]
-> ForeignLib)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ALens' ForeignLib ForeignLibType
-> ForeignLibType
-> g ForeignLib ForeignLibType
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" ALens' ForeignLib ForeignLibType
Lens' ForeignLib ForeignLibType
L.foreignLibType ForeignLibType
ForeignLibTypeUnknown
g ForeignLib
([ForeignLibOption]
-> BuildInfo
-> Maybe LibVersionInfo
-> Maybe Version
-> [FilePath]
-> ForeignLib)
-> g ForeignLib [ForeignLibOption]
-> g ForeignLib
(BuildInfo
-> Maybe LibVersionInfo
-> Maybe Version
-> [FilePath]
-> ForeignLib)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([ForeignLibOption]
-> List FSep (Identity ForeignLibOption) ForeignLibOption)
-> ALens' ForeignLib [ForeignLibOption]
-> g ForeignLib [ForeignLibOption]
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" (FSep
-> [ForeignLibOption]
-> List FSep (Identity ForeignLibOption) ForeignLibOption
forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep) ALens' ForeignLib [ForeignLibOption]
Lens' ForeignLib [ForeignLibOption]
L.foreignLibOptions
g ForeignLib
(BuildInfo
-> Maybe LibVersionInfo
-> Maybe Version
-> [FilePath]
-> ForeignLib)
-> g ForeignLib BuildInfo
-> g ForeignLib
(Maybe LibVersionInfo -> Maybe Version -> [FilePath] -> ForeignLib)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ALens' ForeignLib BuildInfo
-> g BuildInfo BuildInfo -> g ForeignLib BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar ALens' ForeignLib BuildInfo
Lens' ForeignLib BuildInfo
L.foreignLibBuildInfo g BuildInfo 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 FilePath), c (List FSep Token FilePath),
c (List NoCommaFSep Token' FilePath),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT FilePath), c (List VCat Token FilePath),
c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar
g ForeignLib
(Maybe LibVersionInfo -> Maybe Version -> [FilePath] -> ForeignLib)
-> g ForeignLib (Maybe LibVersionInfo)
-> g ForeignLib (Maybe Version -> [FilePath] -> ForeignLib)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' ForeignLib (Maybe LibVersionInfo)
-> g ForeignLib (Maybe LibVersionInfo)
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" ALens' ForeignLib (Maybe LibVersionInfo)
Lens' ForeignLib (Maybe LibVersionInfo)
L.foreignLibVersionInfo
g ForeignLib (Maybe Version -> [FilePath] -> ForeignLib)
-> g ForeignLib (Maybe Version)
-> g ForeignLib ([FilePath] -> ForeignLib)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' ForeignLib (Maybe Version)
-> g ForeignLib (Maybe Version)
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" ALens' ForeignLib (Maybe Version)
Lens' ForeignLib (Maybe Version)
L.foreignLibVersionLinux
g ForeignLib ([FilePath] -> ForeignLib)
-> g ForeignLib [FilePath] -> g ForeignLib ForeignLib
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' ForeignLib [FilePath]
-> g ForeignLib [FilePath]
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" (FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT) ALens' ForeignLib [FilePath]
Lens' ForeignLib [FilePath]
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 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 -> g Executable Executable
executableFieldGrammar UnqualComponentName
n = UnqualComponentName
-> FilePath -> ExecutableScope -> BuildInfo -> Executable
Executable UnqualComponentName
n
(FilePath -> ExecutableScope -> BuildInfo -> Executable)
-> g Executable FilePath
-> g Executable (ExecutableScope -> BuildInfo -> Executable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> (FilePath -> FilePathNT)
-> ALens' Executable FilePath
-> FilePath
-> g Executable FilePath
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" FilePath -> FilePathNT
FilePathNT ALens' Executable FilePath
Lens' Executable FilePath
L.modulePath FilePath
""
g Executable (ExecutableScope -> BuildInfo -> Executable)
-> g Executable ExecutableScope
-> g Executable (BuildInfo -> Executable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' Executable ExecutableScope
-> ExecutableScope
-> g Executable ExecutableScope
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" ALens' Executable ExecutableScope
Lens' Executable ExecutableScope
L.exeScope ExecutableScope
ExecutablePublic
g Executable ExecutableScope
-> (g Executable ExecutableScope -> g Executable ExecutableScope)
-> g Executable ExecutableScope
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> ExecutableScope
-> g Executable ExecutableScope
-> g Executable ExecutableScope
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_0 ExecutableScope
ExecutablePublic
g Executable (BuildInfo -> Executable)
-> g Executable BuildInfo -> g Executable Executable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ALens' Executable BuildInfo
-> g BuildInfo BuildInfo -> g Executable BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar ALens' Executable BuildInfo
forall a. HasBuildInfo a => Lens' a BuildInfo
L.buildInfo g BuildInfo 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 FilePath), c (List FSep Token FilePath),
c (List NoCommaFSep Token' FilePath),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT FilePath), c (List VCat Token FilePath),
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 FilePath
_testStanzaMainIs :: Maybe FilePath
, TestSuiteStanza -> Maybe ModuleName
_testStanzaTestModule :: Maybe ModuleName
, TestSuiteStanza -> BuildInfo
_testStanzaBuildInfo :: BuildInfo
}
instance L.HasBuildInfo TestSuiteStanza where
buildInfo :: LensLike f TestSuiteStanza TestSuiteStanza BuildInfo BuildInfo
buildInfo = LensLike f TestSuiteStanza TestSuiteStanza BuildInfo BuildInfo
Lens' TestSuiteStanza BuildInfo
testStanzaBuildInfo
testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType)
testStanzaTestType :: LensLike
f TestSuiteStanza TestSuiteStanza (Maybe TestType) (Maybe TestType)
testStanzaTestType Maybe TestType -> f (Maybe TestType)
f TestSuiteStanza
s = (Maybe TestType -> TestSuiteStanza)
-> f (Maybe TestType) -> f TestSuiteStanza
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 :: LensLike
f TestSuiteStanza TestSuiteStanza (Maybe FilePath) (Maybe FilePath)
testStanzaMainIs Maybe FilePath -> f (Maybe FilePath)
f TestSuiteStanza
s = (Maybe FilePath -> TestSuiteStanza)
-> f (Maybe FilePath) -> f TestSuiteStanza
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe FilePath
x -> TestSuiteStanza
s { _testStanzaMainIs :: Maybe FilePath
_testStanzaMainIs = Maybe FilePath
x }) (Maybe FilePath -> f (Maybe FilePath)
f (TestSuiteStanza -> Maybe FilePath
_testStanzaMainIs TestSuiteStanza
s))
{-# INLINE testStanzaMainIs #-}
testStanzaTestModule :: Lens' TestSuiteStanza (Maybe ModuleName)
testStanzaTestModule :: LensLike
f
TestSuiteStanza
TestSuiteStanza
(Maybe ModuleName)
(Maybe ModuleName)
testStanzaTestModule Maybe ModuleName -> f (Maybe ModuleName)
f TestSuiteStanza
s = (Maybe ModuleName -> TestSuiteStanza)
-> f (Maybe ModuleName) -> f TestSuiteStanza
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 :: LensLike f TestSuiteStanza TestSuiteStanza BuildInfo BuildInfo
testStanzaBuildInfo BuildInfo -> f BuildInfo
f TestSuiteStanza
s = (BuildInfo -> TestSuiteStanza) -> f BuildInfo -> f TestSuiteStanza
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 VCat Token String)
, c (MQuoted Language)
)
=> g TestSuiteStanza TestSuiteStanza
testSuiteFieldGrammar :: g TestSuiteStanza TestSuiteStanza
testSuiteFieldGrammar = Maybe TestType
-> Maybe FilePath
-> Maybe ModuleName
-> BuildInfo
-> TestSuiteStanza
TestSuiteStanza
(Maybe TestType
-> Maybe FilePath
-> Maybe ModuleName
-> BuildInfo
-> TestSuiteStanza)
-> g TestSuiteStanza (Maybe TestType)
-> g TestSuiteStanza
(Maybe FilePath
-> Maybe ModuleName -> BuildInfo -> TestSuiteStanza)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ALens' TestSuiteStanza (Maybe TestType)
-> g TestSuiteStanza (Maybe TestType)
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"type" ALens' TestSuiteStanza (Maybe TestType)
Lens' TestSuiteStanza (Maybe TestType)
testStanzaTestType
g TestSuiteStanza
(Maybe FilePath
-> Maybe ModuleName -> BuildInfo -> TestSuiteStanza)
-> g TestSuiteStanza (Maybe FilePath)
-> g TestSuiteStanza
(Maybe ModuleName -> BuildInfo -> TestSuiteStanza)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (FilePath -> FilePathNT)
-> ALens' TestSuiteStanza (Maybe FilePath)
-> g TestSuiteStanza (Maybe FilePath)
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" FilePath -> FilePathNT
FilePathNT ALens' TestSuiteStanza (Maybe FilePath)
Lens' TestSuiteStanza (Maybe FilePath)
testStanzaMainIs
g TestSuiteStanza
(Maybe ModuleName -> BuildInfo -> TestSuiteStanza)
-> g TestSuiteStanza (Maybe ModuleName)
-> g TestSuiteStanza (BuildInfo -> TestSuiteStanza)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' TestSuiteStanza (Maybe ModuleName)
-> g TestSuiteStanza (Maybe ModuleName)
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" ALens' TestSuiteStanza (Maybe ModuleName)
Lens' TestSuiteStanza (Maybe ModuleName)
testStanzaTestModule
g TestSuiteStanza (BuildInfo -> TestSuiteStanza)
-> g TestSuiteStanza BuildInfo -> g TestSuiteStanza TestSuiteStanza
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ALens' TestSuiteStanza BuildInfo
-> g BuildInfo BuildInfo -> g TestSuiteStanza BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar ALens' TestSuiteStanza BuildInfo
Lens' TestSuiteStanza BuildInfo
testStanzaBuildInfo g BuildInfo 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 FilePath), c (List FSep Token FilePath),
c (List NoCommaFSep Token' FilePath),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT FilePath), c (List VCat Token FilePath),
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 -> TestSuite -> ParseResult TestSuite
forall (m :: * -> *) a. Monad m => a -> m a
return (TestSuite -> ParseResult TestSuite)
-> TestSuite -> ParseResult TestSuite
forall a b. (a -> b) -> a -> b
$
TestSuite
emptyTestSuite { testBuildInfo :: BuildInfo
testBuildInfo = TestSuiteStanza -> BuildInfo
_testStanzaBuildInfo TestSuiteStanza
stanza }
Just tt :: TestType
tt@(TestTypeUnknown FilePath
_ Version
_) ->
TestSuite -> ParseResult TestSuite
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 TestType -> [TestType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [TestType]
knownTestTypes ->
TestSuite -> ParseResult TestSuite
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 FilePath
_testStanzaMainIs TestSuiteStanza
stanza of
Maybe FilePath
Nothing -> do
Position -> FilePath -> ParseResult ()
parseFailure Position
pos (FilePath -> TestType -> FilePath
forall a. Pretty a => FilePath -> a -> FilePath
missingField FilePath
"main-is" TestType
tt)
TestSuite -> ParseResult TestSuite
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestSuite
emptyTestSuite
Just FilePath
file -> do
Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ModuleName -> Bool
forall a. Maybe a -> Bool
isJust (TestSuiteStanza -> Maybe ModuleName
_testStanzaTestModule TestSuiteStanza
stanza)) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> PWarnType -> FilePath -> ParseResult ()
parseWarning Position
pos PWarnType
PWTExtraBenchmarkModule (FilePath -> TestType -> FilePath
forall a. Pretty a => FilePath -> a -> FilePath
extraField FilePath
"test-module" TestType
tt)
TestSuite -> ParseResult TestSuite
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestSuite
emptyTestSuite
{ testInterface :: TestSuiteInterface
testInterface = Version -> FilePath -> TestSuiteInterface
TestSuiteExeV10 Version
ver FilePath
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 -> FilePath -> ParseResult ()
parseFailure Position
pos (FilePath -> TestType -> FilePath
forall a. Pretty a => FilePath -> a -> FilePath
missingField FilePath
"test-module" TestType
tt)
TestSuite -> ParseResult TestSuite
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestSuite
emptyTestSuite
Just ModuleName
module_ -> do
Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (TestSuiteStanza -> Maybe FilePath
_testStanzaMainIs TestSuiteStanza
stanza)) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> PWarnType -> FilePath -> ParseResult ()
parseWarning Position
pos PWarnType
PWTExtraMainIs (FilePath -> TestType -> FilePath
forall a. Pretty a => FilePath -> a -> FilePath
extraField FilePath
"main-is" TestType
tt)
TestSuite -> ParseResult TestSuite
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 :: FilePath -> a -> FilePath
missingField FilePath
name a
tt = FilePath
"The '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' field is required for the "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
tt FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" test suite type."
extraField :: FilePath -> a -> FilePath
extraField FilePath
name a
tt = FilePath
"The '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' field is not used for the '"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
tt FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' test suite type."
unvalidateTestSuite :: TestSuite -> TestSuiteStanza
unvalidateTestSuite :: TestSuite -> TestSuiteStanza
unvalidateTestSuite TestSuite
t = TestSuiteStanza :: Maybe TestType
-> Maybe FilePath
-> Maybe ModuleName
-> BuildInfo
-> TestSuiteStanza
TestSuiteStanza
{ _testStanzaTestType :: Maybe TestType
_testStanzaTestType = Maybe TestType
ty
, _testStanzaMainIs :: Maybe FilePath
_testStanzaMainIs = Maybe FilePath
ma
, _testStanzaTestModule :: Maybe ModuleName
_testStanzaTestModule = Maybe ModuleName
mo
, _testStanzaBuildInfo :: BuildInfo
_testStanzaBuildInfo = TestSuite -> BuildInfo
testBuildInfo TestSuite
t
}
where
(Maybe TestType
ty, Maybe FilePath
ma, Maybe ModuleName
mo) = case TestSuite -> TestSuiteInterface
testInterface TestSuite
t of
TestSuiteExeV10 Version
ver FilePath
file -> (TestType -> Maybe TestType
forall a. a -> Maybe a
Just (TestType -> Maybe TestType) -> TestType -> Maybe TestType
forall a b. (a -> b) -> a -> b
$ Version -> TestType
TestTypeExe Version
ver, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
file, Maybe ModuleName
forall a. Maybe a
Nothing)
TestSuiteLibV09 Version
ver ModuleName
modu -> (TestType -> Maybe TestType
forall a. a -> Maybe a
Just (TestType -> Maybe TestType) -> TestType -> Maybe TestType
forall a b. (a -> b) -> a -> b
$ Version -> TestType
TestTypeLib Version
ver, Maybe FilePath
forall a. Maybe a
Nothing, ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
modu)
TestSuiteInterface
_ -> (Maybe TestType
forall a. Maybe a
Nothing, Maybe FilePath
forall a. Maybe a
Nothing, Maybe ModuleName
forall a. Maybe a
Nothing)
data BenchmarkStanza = BenchmarkStanza
{ BenchmarkStanza -> Maybe BenchmarkType
_benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
, BenchmarkStanza -> Maybe FilePath
_benchmarkStanzaMainIs :: Maybe FilePath
, BenchmarkStanza -> Maybe ModuleName
_benchmarkStanzaBenchmarkModule :: Maybe ModuleName
, BenchmarkStanza -> BuildInfo
_benchmarkStanzaBuildInfo :: BuildInfo
}
instance L.HasBuildInfo BenchmarkStanza where
buildInfo :: LensLike f BenchmarkStanza BenchmarkStanza BuildInfo BuildInfo
buildInfo = LensLike f BenchmarkStanza BenchmarkStanza BuildInfo BuildInfo
Lens' BenchmarkStanza BuildInfo
benchmarkStanzaBuildInfo
benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType)
benchmarkStanzaBenchmarkType :: LensLike
f
BenchmarkStanza
BenchmarkStanza
(Maybe BenchmarkType)
(Maybe BenchmarkType)
benchmarkStanzaBenchmarkType Maybe BenchmarkType -> f (Maybe BenchmarkType)
f BenchmarkStanza
s = (Maybe BenchmarkType -> BenchmarkStanza)
-> f (Maybe BenchmarkType) -> f BenchmarkStanza
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 :: LensLike
f BenchmarkStanza BenchmarkStanza (Maybe FilePath) (Maybe FilePath)
benchmarkStanzaMainIs Maybe FilePath -> f (Maybe FilePath)
f BenchmarkStanza
s = (Maybe FilePath -> BenchmarkStanza)
-> f (Maybe FilePath) -> f BenchmarkStanza
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe FilePath
x -> BenchmarkStanza
s { _benchmarkStanzaMainIs :: Maybe FilePath
_benchmarkStanzaMainIs = Maybe FilePath
x }) (Maybe FilePath -> f (Maybe FilePath)
f (BenchmarkStanza -> Maybe FilePath
_benchmarkStanzaMainIs BenchmarkStanza
s))
{-# INLINE benchmarkStanzaMainIs #-}
benchmarkStanzaBenchmarkModule :: Lens' BenchmarkStanza (Maybe ModuleName)
benchmarkStanzaBenchmarkModule :: LensLike
f
BenchmarkStanza
BenchmarkStanza
(Maybe ModuleName)
(Maybe ModuleName)
benchmarkStanzaBenchmarkModule Maybe ModuleName -> f (Maybe ModuleName)
f BenchmarkStanza
s = (Maybe ModuleName -> BenchmarkStanza)
-> f (Maybe ModuleName) -> f BenchmarkStanza
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 :: LensLike f BenchmarkStanza BenchmarkStanza BuildInfo BuildInfo
benchmarkStanzaBuildInfo BuildInfo -> f BuildInfo
f BenchmarkStanza
s = (BuildInfo -> BenchmarkStanza) -> f BuildInfo -> f BenchmarkStanza
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 VCat Token String)
, c (MQuoted Language)
)
=> g BenchmarkStanza BenchmarkStanza
benchmarkFieldGrammar :: g BenchmarkStanza BenchmarkStanza
benchmarkFieldGrammar = Maybe BenchmarkType
-> Maybe FilePath
-> Maybe ModuleName
-> BuildInfo
-> BenchmarkStanza
BenchmarkStanza
(Maybe BenchmarkType
-> Maybe FilePath
-> Maybe ModuleName
-> BuildInfo
-> BenchmarkStanza)
-> g BenchmarkStanza (Maybe BenchmarkType)
-> g BenchmarkStanza
(Maybe FilePath
-> Maybe ModuleName -> BuildInfo -> BenchmarkStanza)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ALens' BenchmarkStanza (Maybe BenchmarkType)
-> g BenchmarkStanza (Maybe BenchmarkType)
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"type" ALens' BenchmarkStanza (Maybe BenchmarkType)
Lens' BenchmarkStanza (Maybe BenchmarkType)
benchmarkStanzaBenchmarkType
g BenchmarkStanza
(Maybe FilePath
-> Maybe ModuleName -> BuildInfo -> BenchmarkStanza)
-> g BenchmarkStanza (Maybe FilePath)
-> g BenchmarkStanza
(Maybe ModuleName -> BuildInfo -> BenchmarkStanza)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (FilePath -> FilePathNT)
-> ALens' BenchmarkStanza (Maybe FilePath)
-> g BenchmarkStanza (Maybe FilePath)
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" FilePath -> FilePathNT
FilePathNT ALens' BenchmarkStanza (Maybe FilePath)
Lens' BenchmarkStanza (Maybe FilePath)
benchmarkStanzaMainIs
g BenchmarkStanza
(Maybe ModuleName -> BuildInfo -> BenchmarkStanza)
-> g BenchmarkStanza (Maybe ModuleName)
-> g BenchmarkStanza (BuildInfo -> BenchmarkStanza)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' BenchmarkStanza (Maybe ModuleName)
-> g BenchmarkStanza (Maybe ModuleName)
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" ALens' BenchmarkStanza (Maybe ModuleName)
Lens' BenchmarkStanza (Maybe ModuleName)
benchmarkStanzaBenchmarkModule
g BenchmarkStanza (BuildInfo -> BenchmarkStanza)
-> g BenchmarkStanza BuildInfo -> g BenchmarkStanza BenchmarkStanza
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ALens' BenchmarkStanza BuildInfo
-> g BuildInfo BuildInfo -> g BenchmarkStanza BuildInfo
forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar ALens' BenchmarkStanza BuildInfo
Lens' BenchmarkStanza BuildInfo
benchmarkStanzaBuildInfo g BuildInfo 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 FilePath), c (List FSep Token FilePath),
c (List NoCommaFSep Token' FilePath),
c (List VCat (MQuoted ModuleName) ModuleName),
c (List VCat FilePathNT FilePath), c (List VCat Token FilePath),
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 -> Benchmark -> ParseResult Benchmark
forall (f :: * -> *) a. Applicative f => a -> f a
pure Benchmark
emptyBenchmark
{ benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BenchmarkStanza -> BuildInfo
_benchmarkStanzaBuildInfo BenchmarkStanza
stanza }
Just tt :: BenchmarkType
tt@(BenchmarkTypeUnknown FilePath
_ Version
_) -> Benchmark -> ParseResult Benchmark
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 BenchmarkType -> [BenchmarkType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [BenchmarkType]
knownBenchmarkTypes -> Benchmark -> ParseResult Benchmark
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 FilePath
_benchmarkStanzaMainIs BenchmarkStanza
stanza of
Maybe FilePath
Nothing -> do
Position -> FilePath -> ParseResult ()
parseFailure Position
pos (FilePath -> BenchmarkType -> FilePath
forall a. Pretty a => FilePath -> a -> FilePath
missingField FilePath
"main-is" BenchmarkType
tt)
Benchmark -> ParseResult Benchmark
forall (f :: * -> *) a. Applicative f => a -> f a
pure Benchmark
emptyBenchmark
Just FilePath
file -> do
Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ModuleName -> Bool
forall a. Maybe a -> Bool
isJust (BenchmarkStanza -> Maybe ModuleName
_benchmarkStanzaBenchmarkModule BenchmarkStanza
stanza)) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
Position -> PWarnType -> FilePath -> ParseResult ()
parseWarning Position
pos PWarnType
PWTExtraBenchmarkModule (FilePath -> BenchmarkType -> FilePath
forall a. Pretty a => FilePath -> a -> FilePath
extraField FilePath
"benchmark-module" BenchmarkType
tt)
Benchmark -> ParseResult Benchmark
forall (f :: * -> *) a. Applicative f => a -> f a
pure Benchmark
emptyBenchmark
{ benchmarkInterface :: BenchmarkInterface
benchmarkInterface = Version -> FilePath -> BenchmarkInterface
BenchmarkExeV10 Version
ver FilePath
file
, benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BenchmarkStanza -> BuildInfo
_benchmarkStanzaBuildInfo BenchmarkStanza
stanza
}
where
missingField :: FilePath -> a -> FilePath
missingField FilePath
name a
tt = FilePath
"The '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' field is required for the "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
tt FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" benchmark type."
extraField :: FilePath -> a -> FilePath
extraField FilePath
name a
tt = FilePath
"The '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' field is not used for the '"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
tt FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' benchmark type."
unvalidateBenchmark :: Benchmark -> BenchmarkStanza
unvalidateBenchmark :: Benchmark -> BenchmarkStanza
unvalidateBenchmark Benchmark
b = BenchmarkStanza :: Maybe BenchmarkType
-> Maybe FilePath
-> Maybe ModuleName
-> BuildInfo
-> BenchmarkStanza
BenchmarkStanza
{ _benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
_benchmarkStanzaBenchmarkType = Maybe BenchmarkType
ty
, _benchmarkStanzaMainIs :: Maybe FilePath
_benchmarkStanzaMainIs = Maybe FilePath
ma
, _benchmarkStanzaBenchmarkModule :: Maybe ModuleName
_benchmarkStanzaBenchmarkModule = Maybe ModuleName
forall a. Maybe a
mo
, _benchmarkStanzaBuildInfo :: BuildInfo
_benchmarkStanzaBuildInfo = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
b
}
where
(Maybe BenchmarkType
ty, Maybe FilePath
ma, Maybe a
mo) = case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
b of
BenchmarkExeV10 Version
ver FilePath
"" -> (BenchmarkType -> Maybe BenchmarkType
forall a. a -> Maybe a
Just (BenchmarkType -> Maybe BenchmarkType)
-> BenchmarkType -> Maybe BenchmarkType
forall a b. (a -> b) -> a -> b
$ Version -> BenchmarkType
BenchmarkTypeExe Version
ver, Maybe FilePath
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
BenchmarkExeV10 Version
ver FilePath
ma' -> (BenchmarkType -> Maybe BenchmarkType
forall a. a -> Maybe a
Just (BenchmarkType -> Maybe BenchmarkType)
-> BenchmarkType -> Maybe BenchmarkType
forall a b. (a -> b) -> a -> b
$ Version -> BenchmarkType
BenchmarkTypeExe Version
ver, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
ma', Maybe a
forall a. Maybe a
Nothing)
BenchmarkInterface
_ -> (Maybe BenchmarkType
forall a. Maybe a
Nothing, Maybe FilePath
forall a. Maybe a
Nothing, Maybe a
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 VCat Token String)
, c (MQuoted Language)
)
=> g BuildInfo BuildInfo
buildInfoFieldGrammar :: g BuildInfo BuildInfo
buildInfoFieldGrammar = Bool
-> [LegacyExeDependency]
-> [ExeDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo
BuildInfo
(Bool
-> [LegacyExeDependency]
-> [ExeDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo Bool
-> g BuildInfo
([LegacyExeDependency]
-> [ExeDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName -> ALens' BuildInfo Bool -> Bool -> g BuildInfo Bool
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef FieldName
"buildable" ALens' BuildInfo Bool
forall a. HasBuildInfo a => Lens' a Bool
L.buildable Bool
True
g BuildInfo
([LegacyExeDependency]
-> [ExeDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [LegacyExeDependency]
-> g BuildInfo
([ExeDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([LegacyExeDependency]
-> List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
-> ALens' BuildInfo [LegacyExeDependency]
-> g BuildInfo [LegacyExeDependency]
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" (CommaFSep
-> [LegacyExeDependency]
-> List
CommaFSep (Identity LegacyExeDependency) LegacyExeDependency
forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaFSep
CommaFSep) ALens' BuildInfo [LegacyExeDependency]
forall a. HasBuildInfo a => Lens' a [LegacyExeDependency]
L.buildTools
g BuildInfo [LegacyExeDependency]
-> (g BuildInfo [LegacyExeDependency]
-> g BuildInfo [LegacyExeDependency])
-> g BuildInfo [LegacyExeDependency]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> FilePath
-> g BuildInfo [LegacyExeDependency]
-> g BuildInfo [LegacyExeDependency]
forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> FilePath -> g s a -> g s a
deprecatedSince CabalSpecVersion
CabalSpecV2_0
FilePath
"Please use 'build-tool-depends' field"
g BuildInfo [LegacyExeDependency]
-> (g BuildInfo [LegacyExeDependency]
-> g BuildInfo [LegacyExeDependency])
-> g BuildInfo [LegacyExeDependency]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> FilePath
-> g BuildInfo [LegacyExeDependency]
-> g BuildInfo [LegacyExeDependency]
forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> FilePath -> g s a -> g s a
removedIn CabalSpecVersion
CabalSpecV3_0
FilePath
"Please use 'build-tool-depends' field."
g BuildInfo
([ExeDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [ExeDependency]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([ExeDependency]
-> List CommaFSep (Identity ExeDependency) ExeDependency)
-> ALens' BuildInfo [ExeDependency]
-> g BuildInfo [ExeDependency]
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" (CommaFSep
-> [ExeDependency]
-> List CommaFSep (Identity ExeDependency) ExeDependency
forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaFSep
CommaFSep) ALens' BuildInfo [ExeDependency]
forall a. HasBuildInfo a => Lens' a [ExeDependency]
L.buildToolDepends
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.cppOptions
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.asmOptions
g BuildInfo [FilePath]
-> (g BuildInfo [FilePath] -> g BuildInfo [FilePath])
-> g BuildInfo [FilePath]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [FilePath] -> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.cmmOptions
g BuildInfo [FilePath]
-> (g BuildInfo [FilePath] -> g BuildInfo [FilePath])
-> g BuildInfo [FilePath]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [FilePath] -> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.ccOptions
g BuildInfo
([FilePath]
-> [FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.cxxOptions
g BuildInfo [FilePath]
-> (g BuildInfo [FilePath] -> g BuildInfo [FilePath])
-> g BuildInfo [FilePath]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [FilePath] -> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_2 []
g BuildInfo
([FilePath]
-> [PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.ldOptions
g BuildInfo
([PkgconfigDependency]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [PkgconfigDependency]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([PkgconfigDependency]
-> List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
-> ALens' BuildInfo [PkgconfigDependency]
-> g BuildInfo [PkgconfigDependency]
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" (CommaFSep
-> [PkgconfigDependency]
-> List
CommaFSep (Identity PkgconfigDependency) PkgconfigDependency
forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaFSep
CommaFSep) ALens' BuildInfo [PkgconfigDependency]
forall a. HasBuildInfo a => Lens' a [PkgconfigDependency]
L.pkgconfigDepends
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List FSep Token FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (FSep
-> (FilePath -> Token) -> [FilePath] -> List FSep Token FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> Token
Token) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.frameworks
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.extraFrameworkDirs
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (VCat
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List VCat FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.asmSources
g BuildInfo [FilePath]
-> (g BuildInfo [FilePath] -> g BuildInfo [FilePath])
-> g BuildInfo [FilePath]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [FilePath] -> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (VCat
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List VCat FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.cmmSources
g BuildInfo [FilePath]
-> (g BuildInfo [FilePath] -> g BuildInfo [FilePath])
-> g BuildInfo [FilePath]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [FilePath] -> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (VCat
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List VCat FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.cSources
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (VCat
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List VCat FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.cxxSources
g BuildInfo [FilePath]
-> (g BuildInfo [FilePath] -> g BuildInfo [FilePath])
-> g BuildInfo [FilePath]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [FilePath] -> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_2 []
g BuildInfo
([FilePath]
-> [FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (VCat
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List VCat FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.jsSources
g BuildInfo
([FilePath]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List FSep FilePathNT FilePath)) =>
g BuildInfo [FilePath]
hsSourceDirsGrammar
g BuildInfo
([ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [ModuleName]
-> g BuildInfo
([ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([ModuleName] -> List VCat (MQuoted ModuleName) ModuleName)
-> ALens' BuildInfo [ModuleName]
-> g BuildInfo [ModuleName]
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 ALens' BuildInfo [ModuleName]
forall a. HasBuildInfo a => Lens' a [ModuleName]
L.otherModules
g BuildInfo
([ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [ModuleName]
-> g BuildInfo
([ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([ModuleName] -> List VCat (MQuoted ModuleName) ModuleName)
-> ALens' BuildInfo [ModuleName]
-> g BuildInfo [ModuleName]
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" (VCat
-> (ModuleName -> MQuoted ModuleName)
-> [ModuleName]
-> List VCat (MQuoted ModuleName) ModuleName
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat ModuleName -> MQuoted ModuleName
forall a. a -> MQuoted a
MQuoted) ALens' BuildInfo [ModuleName]
forall a. HasBuildInfo a => Lens' a [ModuleName]
L.virtualModules
g BuildInfo [ModuleName]
-> (g BuildInfo [ModuleName] -> g BuildInfo [ModuleName])
-> g BuildInfo [ModuleName]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [ModuleName]
-> g BuildInfo [ModuleName]
-> g BuildInfo [ModuleName]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_2 []
g BuildInfo
([ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [ModuleName]
-> g BuildInfo
(Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([ModuleName] -> List VCat (MQuoted ModuleName) ModuleName)
-> ALens' BuildInfo [ModuleName]
-> g BuildInfo [ModuleName]
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" (VCat
-> (ModuleName -> MQuoted ModuleName)
-> [ModuleName]
-> List VCat (MQuoted ModuleName) ModuleName
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat ModuleName -> MQuoted ModuleName
forall a. a -> MQuoted a
MQuoted) ALens' BuildInfo [ModuleName]
forall a. HasBuildInfo a => Lens' a [ModuleName]
L.autogenModules
g BuildInfo [ModuleName]
-> (g BuildInfo [ModuleName] -> g BuildInfo [ModuleName])
-> g BuildInfo [ModuleName]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [ModuleName]
-> g BuildInfo [ModuleName]
-> g BuildInfo [ModuleName]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV2_0 []
g BuildInfo
(Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo (Maybe Language)
-> g BuildInfo
([Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (Language -> MQuoted Language)
-> ALens' BuildInfo (Maybe Language)
-> g BuildInfo (Maybe Language)
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" Language -> MQuoted Language
forall a. a -> MQuoted a
MQuoted ALens' BuildInfo (Maybe Language)
forall a. HasBuildInfo a => Lens' a (Maybe Language)
L.defaultLanguage
g BuildInfo (Maybe Language)
-> (g BuildInfo (Maybe Language) -> g BuildInfo (Maybe Language))
-> g BuildInfo (Maybe Language)
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> Maybe Language
-> g BuildInfo (Maybe Language)
-> g BuildInfo (Maybe Language)
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV1_10 Maybe Language
forall a. Maybe a
Nothing
g BuildInfo
([Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [Language]
-> g BuildInfo
([Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([Language] -> List FSep (MQuoted Language) Language)
-> ALens' BuildInfo [Language]
-> g BuildInfo [Language]
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" (FSep
-> (Language -> MQuoted Language)
-> [Language]
-> List FSep (MQuoted Language) Language
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep Language -> MQuoted Language
forall a. a -> MQuoted a
MQuoted) ALens' BuildInfo [Language]
forall a. HasBuildInfo a => Lens' a [Language]
L.otherLanguages
g BuildInfo [Language]
-> (g BuildInfo [Language] -> g BuildInfo [Language])
-> g BuildInfo [Language]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [Language] -> g BuildInfo [Language] -> g BuildInfo [Language]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV1_10 []
g BuildInfo
([Extension]
-> [Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [Extension]
-> g BuildInfo
([Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([Extension] -> List FSep (MQuoted Extension) Extension)
-> ALens' BuildInfo [Extension]
-> g BuildInfo [Extension]
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" (FSep
-> (Extension -> MQuoted Extension)
-> [Extension]
-> List FSep (MQuoted Extension) Extension
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep Extension -> MQuoted Extension
forall a. a -> MQuoted a
MQuoted) ALens' BuildInfo [Extension]
forall a. HasBuildInfo a => Lens' a [Extension]
L.defaultExtensions
g BuildInfo [Extension]
-> (g BuildInfo [Extension] -> g BuildInfo [Extension])
-> g BuildInfo [Extension]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [Extension]
-> g BuildInfo [Extension]
-> g BuildInfo [Extension]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV1_10 []
g BuildInfo
([Extension]
-> [Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [Extension]
-> g BuildInfo
([Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([Extension] -> List FSep (MQuoted Extension) Extension)
-> ALens' BuildInfo [Extension]
-> g BuildInfo [Extension]
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 ALens' BuildInfo [Extension]
forall a. HasBuildInfo a => Lens' a [Extension]
L.otherExtensions
g BuildInfo [Extension]
-> (g BuildInfo [Extension] -> g BuildInfo [Extension])
-> g BuildInfo [Extension]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> g BuildInfo [Extension] -> g BuildInfo [Extension]
forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> g s a -> g s a
availableSinceWarn CabalSpecVersion
CabalSpecV1_10
g BuildInfo
([Extension]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [Extension]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([Extension] -> List FSep (MQuoted Extension) Extension)
-> ALens' BuildInfo [Extension]
-> g BuildInfo [Extension]
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" (FSep
-> (Extension -> MQuoted Extension)
-> [Extension]
-> List FSep (MQuoted Extension) Extension
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep Extension -> MQuoted Extension
forall a. a -> MQuoted a
MQuoted) ALens' BuildInfo [Extension]
forall a. HasBuildInfo a => Lens' a [Extension]
L.oldExtensions
g BuildInfo [Extension]
-> (g BuildInfo [Extension] -> g BuildInfo [Extension])
-> g BuildInfo [Extension]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> FilePath -> g BuildInfo [Extension] -> g BuildInfo [Extension]
forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> FilePath -> g s a -> g s a
deprecatedSince CabalSpecVersion
CabalSpecV1_12
FilePath
"Please use 'default-extensions' or 'other-extensions' fields."
g BuildInfo [Extension]
-> (g BuildInfo [Extension] -> g BuildInfo [Extension])
-> g BuildInfo [Extension]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> FilePath -> g BuildInfo [Extension] -> g BuildInfo [Extension]
forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> FilePath -> g s a -> g s a
removedIn CabalSpecVersion
CabalSpecV3_0
FilePath
"Please use 'default-extensions' or 'other-extensions' fields."
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat Token FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (VCat
-> (FilePath -> Token) -> [FilePath] -> List VCat Token FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> Token
Token) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.extraLibs
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat Token FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (VCat
-> (FilePath -> Token) -> [FilePath] -> List VCat Token FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> Token
Token) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.extraGHCiLibs
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat Token FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (VCat
-> (FilePath -> Token) -> [FilePath] -> List VCat Token FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> Token
Token) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.extraBundledLibs
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat Token FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (VCat
-> (FilePath -> Token) -> [FilePath] -> List VCat Token FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> Token
Token) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.extraLibFlavours
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List VCat Token FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (VCat
-> (FilePath -> Token) -> [FilePath] -> List VCat Token FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> Token
Token) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.extraDynLibFlavours
g BuildInfo [FilePath]
-> (g BuildInfo [FilePath] -> g BuildInfo [FilePath])
-> g BuildInfo [FilePath]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [FilePath] -> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.extraLibDirs
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.includeDirs
g BuildInfo
([FilePath]
-> [FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.includes
g BuildInfo
([FilePath]
-> [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
([FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.autogenIncludes
g BuildInfo [FilePath]
-> (g BuildInfo [FilePath] -> g BuildInfo [FilePath])
-> g BuildInfo [FilePath]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [FilePath] -> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
FieldGrammar c g =>
CabalSpecVersion -> a -> g s a -> g s a
availableSince CabalSpecVersion
CabalSpecV3_0 []
g BuildInfo
([FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo [FilePath]
-> g BuildInfo
(PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.installIncludes
g BuildInfo
(PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo (PerCompilerFlavor [FilePath])
-> g BuildInfo
(PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g BuildInfo (PerCompilerFlavor [FilePath])
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List NoCommaFSep Token' FilePath)) =>
g BuildInfo (PerCompilerFlavor [FilePath])
optionsFieldGrammar
g BuildInfo
(PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo (PerCompilerFlavor [FilePath])
-> g BuildInfo
(PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g BuildInfo (PerCompilerFlavor [FilePath])
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List NoCommaFSep Token' FilePath)) =>
g BuildInfo (PerCompilerFlavor [FilePath])
profOptionsFieldGrammar
g BuildInfo
(PerCompilerFlavor [FilePath]
-> PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)]
-> [Dependency]
-> [Mixin]
-> BuildInfo)
-> g BuildInfo (PerCompilerFlavor [FilePath])
-> g BuildInfo
(PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)] -> [Dependency] -> [Mixin] -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g BuildInfo (PerCompilerFlavor [FilePath])
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
c (List NoCommaFSep Token' FilePath)) =>
g BuildInfo (PerCompilerFlavor [FilePath])
sharedOptionsFieldGrammar
g BuildInfo
(PerCompilerFlavor [FilePath]
-> [(FilePath, FilePath)] -> [Dependency] -> [Mixin] -> BuildInfo)
-> g BuildInfo (PerCompilerFlavor [FilePath])
-> g BuildInfo
([(FilePath, FilePath)] -> [Dependency] -> [Mixin] -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PerCompilerFlavor [FilePath]
-> g BuildInfo (PerCompilerFlavor [FilePath])
forall (f :: * -> *) a. Applicative f => a -> f a
pure PerCompilerFlavor [FilePath]
forall a. Monoid a => a
mempty
g BuildInfo
([(FilePath, FilePath)] -> [Dependency] -> [Mixin] -> BuildInfo)
-> g BuildInfo [(FilePath, FilePath)]
-> g BuildInfo ([Dependency] -> [Mixin] -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' BuildInfo [(FilePath, FilePath)]
-> g BuildInfo [(FilePath, FilePath)]
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName
-> ALens' s [(FilePath, FilePath)] -> g s [(FilePath, FilePath)]
prefixedFields FieldName
"x-" ALens' BuildInfo [(FilePath, FilePath)]
forall a. HasBuildInfo a => Lens' a [(FilePath, FilePath)]
L.customFieldsBI
g BuildInfo ([Dependency] -> [Mixin] -> BuildInfo)
-> g BuildInfo [Dependency] -> g BuildInfo ([Mixin] -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([Dependency]
-> List CommaVCat (Identity Dependency) Dependency)
-> ALens' BuildInfo [Dependency]
-> g BuildInfo [Dependency]
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 ALens' BuildInfo [Dependency]
forall a. HasBuildInfo a => Lens' a [Dependency]
L.targetBuildDepends
g BuildInfo ([Mixin] -> BuildInfo)
-> g BuildInfo [Mixin] -> g BuildInfo BuildInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([Mixin] -> List CommaVCat (Identity Mixin) Mixin)
-> ALens' BuildInfo [Mixin]
-> g BuildInfo [Mixin]
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 ALens' BuildInfo [Mixin]
forall a. HasBuildInfo a => Lens' a [Mixin]
L.mixins
g BuildInfo [Mixin]
-> (g BuildInfo [Mixin] -> g BuildInfo [Mixin])
-> g BuildInfo [Mixin]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> [Mixin] -> g BuildInfo [Mixin] -> g BuildInfo [Mixin]
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 FilePathNT FilePath))
=> g BuildInfo [FilePath]
hsSourceDirsGrammar :: g BuildInfo [FilePath]
hsSourceDirsGrammar = [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
(++)
([FilePath] -> [FilePath] -> [FilePath])
-> g BuildInfo [FilePath] -> g BuildInfo ([FilePath] -> [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" [FilePath] -> List FSep FilePathNT FilePath
formatHsSourceDirs ALens' BuildInfo [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.hsSourceDirs
g BuildInfo ([FilePath] -> [FilePath])
-> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List FSep FilePathNT FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT) ALens' BuildInfo [FilePath]
forall (f :: * -> *). Functor f => LensLike' f BuildInfo [FilePath]
wrongLens
g BuildInfo [FilePath]
-> (g BuildInfo [FilePath] -> g BuildInfo [FilePath])
-> g BuildInfo [FilePath]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> FilePath -> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> FilePath -> g s a -> g s a
deprecatedSince CabalSpecVersion
CabalSpecV1_2 FilePath
"Please use 'hs-source-dirs'"
g BuildInfo [FilePath]
-> (g BuildInfo [FilePath] -> g BuildInfo [FilePath])
-> g BuildInfo [FilePath]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> FilePath -> g BuildInfo [FilePath] -> g BuildInfo [FilePath]
forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> FilePath -> g s a -> g s a
removedIn CabalSpecVersion
CabalSpecV3_0 FilePath
"Please use 'hs-source-dirs' field."
where
wrongLens :: Functor f => LensLike' f BuildInfo [FilePath]
wrongLens :: LensLike' f BuildInfo [FilePath]
wrongLens [FilePath] -> f [FilePath]
f BuildInfo
bi = (\[FilePath]
fps -> ASetter BuildInfo BuildInfo [FilePath] [FilePath]
-> [FilePath] -> BuildInfo -> BuildInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter BuildInfo BuildInfo [FilePath] [FilePath]
forall a. HasBuildInfo a => Lens' a [FilePath]
L.hsSourceDirs [FilePath]
fps BuildInfo
bi) ([FilePath] -> BuildInfo) -> f [FilePath] -> f BuildInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> f [FilePath]
f []
optionsFieldGrammar
:: (FieldGrammar c g, Applicative (g BuildInfo), c (List NoCommaFSep Token' String))
=> g BuildInfo (PerCompilerFlavor [String])
optionsFieldGrammar :: g BuildInfo (PerCompilerFlavor [FilePath])
optionsFieldGrammar = [FilePath] -> [FilePath] -> PerCompilerFlavor [FilePath]
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor
([FilePath] -> [FilePath] -> PerCompilerFlavor [FilePath])
-> g BuildInfo [FilePath]
-> g BuildInfo ([FilePath] -> PerCompilerFlavor [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [FilePath]
extract CompilerFlavor
GHC)
g BuildInfo ([FilePath] -> PerCompilerFlavor [FilePath])
-> g BuildInfo [FilePath]
-> g BuildInfo (PerCompilerFlavor [FilePath])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [FilePath]
extract CompilerFlavor
GHCJS)
g BuildInfo (PerCompilerFlavor [FilePath])
-> g BuildInfo () -> g BuildInfo (PerCompilerFlavor [FilePath])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* FieldName -> g BuildInfo ()
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> g s ()
knownField FieldName
"jhc-options"
g BuildInfo (PerCompilerFlavor [FilePath])
-> g BuildInfo () -> g BuildInfo (PerCompilerFlavor [FilePath])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* FieldName -> g BuildInfo ()
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> g s ()
knownField FieldName
"hugs-options"
g BuildInfo (PerCompilerFlavor [FilePath])
-> g BuildInfo () -> g BuildInfo (PerCompilerFlavor [FilePath])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* FieldName -> g BuildInfo ()
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 [FilePath]
extract CompilerFlavor
flavor = LensLike
(Pretext [FilePath] [FilePath])
BuildInfo
BuildInfo
(PerCompilerFlavor [FilePath])
(PerCompilerFlavor [FilePath])
forall a. HasBuildInfo a => Lens' a (PerCompilerFlavor [FilePath])
L.options LensLike
(Pretext [FilePath] [FilePath])
BuildInfo
BuildInfo
(PerCompilerFlavor [FilePath])
(PerCompilerFlavor [FilePath])
-> (([FilePath] -> Pretext [FilePath] [FilePath] [FilePath])
-> PerCompilerFlavor [FilePath]
-> Pretext [FilePath] [FilePath] (PerCompilerFlavor [FilePath]))
-> ALens' BuildInfo [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerFlavor
-> ([FilePath] -> Pretext [FilePath] [FilePath] [FilePath])
-> PerCompilerFlavor [FilePath]
-> Pretext [FilePath] [FilePath] (PerCompilerFlavor [FilePath])
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 :: g BuildInfo (PerCompilerFlavor [FilePath])
profOptionsFieldGrammar = [FilePath] -> [FilePath] -> PerCompilerFlavor [FilePath]
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor
([FilePath] -> [FilePath] -> PerCompilerFlavor [FilePath])
-> g BuildInfo [FilePath]
-> g BuildInfo ([FilePath] -> PerCompilerFlavor [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [FilePath]
extract CompilerFlavor
GHC)
g BuildInfo ([FilePath] -> PerCompilerFlavor [FilePath])
-> g BuildInfo [FilePath]
-> g BuildInfo (PerCompilerFlavor [FilePath])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [FilePath]
extract CompilerFlavor
GHCJS)
where
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract :: CompilerFlavor -> ALens' BuildInfo [FilePath]
extract CompilerFlavor
flavor = LensLike
(Pretext [FilePath] [FilePath])
BuildInfo
BuildInfo
(PerCompilerFlavor [FilePath])
(PerCompilerFlavor [FilePath])
forall a. HasBuildInfo a => Lens' a (PerCompilerFlavor [FilePath])
L.profOptions LensLike
(Pretext [FilePath] [FilePath])
BuildInfo
BuildInfo
(PerCompilerFlavor [FilePath])
(PerCompilerFlavor [FilePath])
-> (([FilePath] -> Pretext [FilePath] [FilePath] [FilePath])
-> PerCompilerFlavor [FilePath]
-> Pretext [FilePath] [FilePath] (PerCompilerFlavor [FilePath]))
-> ALens' BuildInfo [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerFlavor
-> ([FilePath] -> Pretext [FilePath] [FilePath] [FilePath])
-> PerCompilerFlavor [FilePath]
-> Pretext [FilePath] [FilePath] (PerCompilerFlavor [FilePath])
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 :: g BuildInfo (PerCompilerFlavor [FilePath])
sharedOptionsFieldGrammar = [FilePath] -> [FilePath] -> PerCompilerFlavor [FilePath]
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor
([FilePath] -> [FilePath] -> PerCompilerFlavor [FilePath])
-> g BuildInfo [FilePath]
-> g BuildInfo ([FilePath] -> PerCompilerFlavor [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [FilePath]
extract CompilerFlavor
GHC)
g BuildInfo ([FilePath] -> PerCompilerFlavor [FilePath])
-> g BuildInfo [FilePath]
-> g BuildInfo (PerCompilerFlavor [FilePath])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([FilePath] -> List NoCommaFSep Token' FilePath)
-> ALens' BuildInfo [FilePath]
-> g BuildInfo [FilePath]
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" (NoCommaFSep
-> (FilePath -> Token')
-> [FilePath]
-> List NoCommaFSep Token' FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> Token'
Token') (CompilerFlavor -> ALens' BuildInfo [FilePath]
extract CompilerFlavor
GHCJS)
where
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract :: CompilerFlavor -> ALens' BuildInfo [FilePath]
extract CompilerFlavor
flavor = LensLike
(Pretext [FilePath] [FilePath])
BuildInfo
BuildInfo
(PerCompilerFlavor [FilePath])
(PerCompilerFlavor [FilePath])
forall a. HasBuildInfo a => Lens' a (PerCompilerFlavor [FilePath])
L.sharedOptions LensLike
(Pretext [FilePath] [FilePath])
BuildInfo
BuildInfo
(PerCompilerFlavor [FilePath])
(PerCompilerFlavor [FilePath])
-> (([FilePath] -> Pretext [FilePath] [FilePath] [FilePath])
-> PerCompilerFlavor [FilePath]
-> Pretext [FilePath] [FilePath] (PerCompilerFlavor [FilePath]))
-> ALens' BuildInfo [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerFlavor
-> ([FilePath] -> Pretext [FilePath] [FilePath] [FilePath])
-> PerCompilerFlavor [FilePath]
-> Pretext [FilePath] [FilePath] (PerCompilerFlavor [FilePath])
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 :: CompilerFlavor -> LensLike' f (PerCompilerFlavor v) v
lookupLens CompilerFlavor
k v -> f v
f p :: PerCompilerFlavor v
p@(PerCompilerFlavor v
ghc v
ghcjs)
| CompilerFlavor
k CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerFlavor
GHC = (\v
n -> v -> v -> PerCompilerFlavor v
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor v
n v
ghcjs) (v -> PerCompilerFlavor v) -> f v -> f (PerCompilerFlavor v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> f v
f v
ghc
| CompilerFlavor
k CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerFlavor
GHCJS = (\v
n -> v -> v -> PerCompilerFlavor v
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor v
ghc v
n) (v -> PerCompilerFlavor v) -> f v -> f (PerCompilerFlavor v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> f v
f v
ghcjs
| Bool
otherwise = PerCompilerFlavor v
p PerCompilerFlavor v -> f v -> f (PerCompilerFlavor v)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ v -> f v
f v
forall a. Monoid a => a
mempty
flagFieldGrammar
:: (FieldGrammar c g, Applicative (g PackageFlag))
=> FlagName -> g PackageFlag PackageFlag
flagFieldGrammar :: FlagName -> g PackageFlag PackageFlag
flagFieldGrammar FlagName
name = FlagName -> FilePath -> Bool -> Bool -> PackageFlag
MkPackageFlag FlagName
name
(FilePath -> Bool -> Bool -> PackageFlag)
-> g PackageFlag FilePath
-> g PackageFlag (Bool -> Bool -> PackageFlag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName -> ALens' PackageFlag FilePath -> g PackageFlag FilePath
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s FilePath -> g s FilePath
freeTextFieldDef FieldName
"description" ALens' PackageFlag FilePath
Lens' PackageFlag FilePath
L.flagDescription
g PackageFlag (Bool -> Bool -> PackageFlag)
-> g PackageFlag Bool -> g PackageFlag (Bool -> PackageFlag)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> ALens' PackageFlag Bool -> Bool -> g PackageFlag Bool
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef FieldName
"default" ALens' PackageFlag Bool
Lens' PackageFlag Bool
L.flagDefault Bool
True
g PackageFlag (Bool -> PackageFlag)
-> g PackageFlag Bool -> g PackageFlag PackageFlag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> ALens' PackageFlag Bool -> Bool -> g PackageFlag Bool
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef FieldName
"manual" ALens' PackageFlag Bool
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 :: RepoKind -> g SourceRepo SourceRepo
sourceRepoFieldGrammar RepoKind
kind = RepoKind
-> Maybe RepoType
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> SourceRepo
SourceRepo RepoKind
kind
(Maybe RepoType
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> SourceRepo)
-> g SourceRepo (Maybe RepoType)
-> g SourceRepo
(Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> SourceRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ALens' SourceRepo (Maybe RepoType)
-> g SourceRepo (Maybe RepoType)
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
"type" ALens' SourceRepo (Maybe RepoType)
Lens' SourceRepo (Maybe RepoType)
L.repoType
g SourceRepo
(Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> SourceRepo)
-> g SourceRepo (Maybe FilePath)
-> g SourceRepo
(Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' SourceRepo (Maybe FilePath)
-> g SourceRepo (Maybe FilePath)
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s (Maybe FilePath) -> g s (Maybe FilePath)
freeTextField FieldName
"location" ALens' SourceRepo (Maybe FilePath)
Lens' SourceRepo (Maybe FilePath)
L.repoLocation
g SourceRepo
(Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> SourceRepo)
-> g SourceRepo (Maybe FilePath)
-> g SourceRepo
(Maybe FilePath -> Maybe FilePath -> Maybe FilePath -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (FilePath -> Token)
-> ALens' SourceRepo (Maybe FilePath)
-> g SourceRepo (Maybe FilePath)
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" FilePath -> Token
Token ALens' SourceRepo (Maybe FilePath)
Lens' SourceRepo (Maybe FilePath)
L.repoModule
g SourceRepo
(Maybe FilePath -> Maybe FilePath -> Maybe FilePath -> SourceRepo)
-> g SourceRepo (Maybe FilePath)
-> g SourceRepo (Maybe FilePath -> Maybe FilePath -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (FilePath -> Token)
-> ALens' SourceRepo (Maybe FilePath)
-> g SourceRepo (Maybe FilePath)
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" FilePath -> Token
Token ALens' SourceRepo (Maybe FilePath)
Lens' SourceRepo (Maybe FilePath)
L.repoBranch
g SourceRepo (Maybe FilePath -> Maybe FilePath -> SourceRepo)
-> g SourceRepo (Maybe FilePath)
-> g SourceRepo (Maybe FilePath -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (FilePath -> Token)
-> ALens' SourceRepo (Maybe FilePath)
-> g SourceRepo (Maybe FilePath)
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" FilePath -> Token
Token ALens' SourceRepo (Maybe FilePath)
Lens' SourceRepo (Maybe FilePath)
L.repoTag
g SourceRepo (Maybe FilePath -> SourceRepo)
-> g SourceRepo (Maybe FilePath) -> g SourceRepo SourceRepo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (FilePath -> FilePathNT)
-> ALens' SourceRepo (Maybe FilePath)
-> g SourceRepo (Maybe FilePath)
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" FilePath -> FilePathNT
FilePathNT ALens' SourceRepo (Maybe FilePath)
Lens' SourceRepo (Maybe FilePath)
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 :: Bool -> g SetupBuildInfo SetupBuildInfo
setupBInfoFieldGrammar Bool
def = ([Dependency] -> Bool -> SetupBuildInfo)
-> Bool -> [Dependency] -> SetupBuildInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Dependency] -> Bool -> SetupBuildInfo
SetupBuildInfo Bool
def
([Dependency] -> SetupBuildInfo)
-> g SetupBuildInfo [Dependency] -> g SetupBuildInfo SetupBuildInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ([Dependency]
-> List CommaVCat (Identity Dependency) Dependency)
-> ALens' SetupBuildInfo [Dependency]
-> g SetupBuildInfo [Dependency]
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" (CommaVCat
-> [Dependency] -> List CommaVCat (Identity Dependency) Dependency
forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaVCat
CommaVCat) ALens' SetupBuildInfo [Dependency]
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 = CommaVCat
-> [Dependency] -> List CommaVCat (Identity Dependency) Dependency
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 = CommaVCat -> [Mixin] -> List CommaVCat (Identity Mixin) Mixin
forall sep a. sep -> [a] -> List sep (Identity a) a
alaList CommaVCat
CommaVCat
formatExtraSourceFiles :: [FilePath] -> List VCat FilePathNT FilePath
= VCat
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List VCat FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat FilePath -> FilePathNT
FilePathNT
formatExposedModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatExposedModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatExposedModules = VCat
-> (ModuleName -> MQuoted ModuleName)
-> [ModuleName]
-> List VCat (MQuoted ModuleName) ModuleName
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat ModuleName -> MQuoted ModuleName
forall a. a -> MQuoted a
MQuoted
formatHsSourceDirs :: [FilePath] -> List FSep FilePathNT FilePath
formatHsSourceDirs :: [FilePath] -> List FSep FilePathNT FilePath
formatHsSourceDirs = FSep
-> (FilePath -> FilePathNT)
-> [FilePath]
-> List FSep FilePathNT FilePath
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep FilePath -> FilePathNT
FilePathNT
formatOtherExtensions :: [Extension] -> List FSep (MQuoted Extension) Extension
formatOtherExtensions :: [Extension] -> List FSep (MQuoted Extension) Extension
formatOtherExtensions = FSep
-> (Extension -> MQuoted Extension)
-> [Extension]
-> List FSep (MQuoted Extension) Extension
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep Extension -> MQuoted Extension
forall a. a -> MQuoted a
MQuoted
formatOtherModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules = VCat
-> (ModuleName -> MQuoted ModuleName)
-> [ModuleName]
-> List VCat (MQuoted ModuleName) ModuleName
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' VCat
VCat ModuleName -> MQuoted ModuleName
forall a. a -> MQuoted a
MQuoted