#if __GLASGOW_HASKELL__ >= 800
#else
#endif
module Distribution.FieldGrammar.Class (
FieldGrammar (..),
uniqueField,
optionalField,
optionalFieldDef,
monoidalField,
defaultFreeTextFieldDefST,
) where
import Distribution.Compat.Lens
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.CabalSpecVersion (CabalSpecVersion)
import Distribution.Compat.Newtype (Newtype)
import Distribution.FieldGrammar.Newtypes
import Distribution.Fields.Field
import Distribution.Utils.ShortText
class
( c SpecVersion, c TestedWith, c SpecLicense, c Token, c Token', c FilePathNT
)
=> FieldGrammar c g | g -> c
where
blurFieldGrammar :: ALens' a b -> g b d -> g a d
uniqueFieldAla
:: (c b, Newtype a b)
=> FieldName
-> (a -> b)
-> ALens' s a
-> g s a
booleanFieldDef
:: FieldName
-> ALens' s Bool
-> Bool
-> g s Bool
optionalFieldAla
:: (c b, Newtype a b)
=> FieldName
-> (a -> b)
-> ALens' s (Maybe a)
-> g s (Maybe a)
optionalFieldDefAla
:: (c b, Newtype a b, Eq a)
=> FieldName
-> (a -> b)
-> ALens' s a
-> a
-> g s a
freeTextField
:: FieldName
-> ALens' s (Maybe String)
-> g s (Maybe String)
freeTextFieldDef
:: FieldName
-> ALens' s String
-> g s String
freeTextFieldDefST
:: FieldName
-> ALens' s ShortText
-> g s ShortText
monoidalFieldAla
:: (c b, Monoid a, Newtype a b)
=> 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
:: CabalSpecVersion
-> String
-> g s a
-> g s a
removedIn
:: CabalSpecVersion
-> String
-> g s a
-> g s a
availableSince
:: CabalSpecVersion
-> a
-> g s a
-> g s a
uniqueField
:: (FieldGrammar c g, c (Identity a))
=> FieldName
-> ALens' s a
-> g s a
uniqueField fn l = uniqueFieldAla fn Identity l
optionalField
:: (FieldGrammar c g, c (Identity a))
=> FieldName
-> ALens' s (Maybe a)
-> g s (Maybe a)
optionalField fn l = optionalFieldAla fn Identity l
optionalFieldDef
:: (FieldGrammar c g, Functor (g s), c (Identity a), Eq a)
=> FieldName
-> ALens' s a
-> a
-> g s a
optionalFieldDef fn l x = optionalFieldDefAla fn Identity l x
monoidalField
:: (FieldGrammar c g, c (Identity a), Monoid a)
=> FieldName
-> ALens' s a
-> g s a
monoidalField fn l = monoidalFieldAla fn Identity l
defaultFreeTextFieldDefST
:: (Functor (g s), FieldGrammar c g)
=> FieldName
-> ALens' s ShortText
-> g s ShortText
defaultFreeTextFieldDefST fn l =
toShortText <$> freeTextFieldDef fn (cloneLens l . st)
where
st :: Lens' ShortText String
st f s = toShortText <$> f (fromShortText s)