module Distribution.FieldGrammar.Class (
FieldGrammar (..),
uniqueField,
optionalField,
optionalFieldDef,
monoidalField,
deprecatedField',
) where
import Distribution.Compat.Lens
import Distribution.Compat.Prelude
import Prelude ()
import Data.Functor.Identity (Identity (..))
import Distribution.Compat.Newtype (Newtype)
import Distribution.Parsec.Class (Parsec)
import Distribution.Parsec.Field
import Distribution.Pretty (Pretty)
class FieldGrammar g where
blurFieldGrammar :: ALens' a b -> g b c -> g a c
uniqueFieldAla
:: (Parsec b, Pretty b, Newtype b a)
=> FieldName
-> (a -> b)
-> ALens' s a
-> g s a
booleanFieldDef
:: FieldName
-> ALens' s Bool
-> Bool
-> g s Bool
optionalFieldAla
:: (Parsec b, Pretty b, Newtype b a)
=> FieldName
-> (a -> b)
-> ALens' s (Maybe a)
-> g s (Maybe a)
optionalFieldDefAla
:: (Parsec b, Pretty b, Newtype b a, Eq a)
=> FieldName
-> (a -> b)
-> ALens' s a
-> a
-> g s a
monoidalFieldAla
:: (Parsec b, Pretty b, Monoid a, Newtype b a)
=> FieldName
-> (a -> b)
-> ALens' s a
-> g s a
prefixedFields
:: FieldName
-> ALens' s [(String, String)]
-> g s [(String, String)]
knownField :: FieldName -> g s ()
hiddenField :: g s a -> g s a
deprecatedSince
:: [Int]
-> String
-> g s a
-> g s a
availableSince
:: [Int]
-> a
-> g s a
-> g s a
uniqueField
:: (FieldGrammar g, Parsec a, Pretty a)
=> FieldName
-> ALens' s a
-> g s a
uniqueField fn = uniqueFieldAla fn Identity
optionalField
:: (FieldGrammar g, Parsec a, Pretty a)
=> FieldName
-> ALens' s (Maybe a)
-> g s (Maybe a)
optionalField fn = optionalFieldAla fn Identity
optionalFieldDef
:: (FieldGrammar g, Functor (g s), Parsec a, Pretty a, Eq a)
=> FieldName
-> ALens' s a
-> a
-> g s a
optionalFieldDef fn = optionalFieldDefAla fn Identity
monoidalField
:: (FieldGrammar g, Parsec a, Pretty a, Monoid a)
=> FieldName
-> ALens' s a
-> g s a
monoidalField fn = monoidalFieldAla fn Identity
deprecatedField'
:: FieldGrammar g
=> String
-> g s a
-> g s a
deprecatedField' = deprecatedSince []