Cabal-syntax/src/Distribution/FieldGrammar/Class.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE ConstraintKinds #-}
   3 {-# LANGUAGE FunctionalDependencies #-}
   4 {-# LANGUAGE RankNTypes #-}
   5 {-# LANGUAGE ScopedTypeVariables #-}
   6 {-# LANGUAGE UndecidableSuperClasses #-}
   7
   8 module Distribution.FieldGrammar.Class
   9   ( FieldGrammar (..)
  10   , uniqueField
  11   , optionalField
  12   , optionalFieldDef
  13   , monoidalField
  14   , defaultFreeTextFieldDefST
  15   ) where
  16
  17 import Distribution.Compat.Lens
  18 import Distribution.Compat.Prelude
  19 import Prelude ()
  20
  21 import Distribution.CabalSpecVersion (CabalSpecVersion)
  22 import Distribution.Compat.Newtype (Newtype)
  23 import Distribution.FieldGrammar.Newtypes
  24 import Distribution.Fields.Field
  25 import Distribution.Utils.ShortText
  26
  27 -- | 'FieldGrammar' is parametrised by
  28 --
  29 -- * @s@ which is a structure we are parsing. We need this to provide prettyprinter
  30 -- functionality
  31 --
  32 -- * @a@ type of the field.
  33 --
  34 -- /Note:/ We'd like to have @forall s. Applicative (f s)@ context.
  35 class
  36   ( c SpecVersion
  37   , c TestedWith
  38   , c SpecLicense
  39   , c Token
  40   , c Token'
  41   , c FilePathNT
  42   ) =>
  43   FieldGrammar c g
  44     | g -> c
  45   where
  46   -- | Unfocus, zoom out, /blur/ 'FieldGrammar'.
  47   blurFieldGrammar :: ALens' a b -> g b d -> g a d
  48
  49   -- | Field which should be defined, exactly once.
  50   uniqueFieldAla
  51     :: (c b, Newtype a b)
  52     => FieldName
  53     -- ^ field name
  54     -> (a -> b)
  55     -- ^ 'Newtype' pack
  56     -> ALens' s a
  57     -- ^ lens into the field
  58     -> g s a
  59
  60   -- | Boolean field with a default value.
  61   booleanFieldDef
  62     :: FieldName
  63     -- ^ field name
  64     -> ALens' s Bool
  65     -- ^ lens into the field
  66     -> Bool
  67     -- ^ default
  68     -> g s Bool
  69
  70   -- | Optional field.
  71   optionalFieldAla
  72     :: (c b, Newtype a b)
  73     => FieldName
  74     -- ^ field name
  75     -> (a -> b)
  76     -- ^ 'pack'
  77     -> ALens' s (Maybe a)
  78     -- ^ lens into the field
  79     -> g s (Maybe a)
  80
  81   -- | Optional field with default value.
  82   optionalFieldDefAla
  83     :: (c b, Newtype a b, Eq a)
  84     => FieldName
  85     -- ^ field name
  86     -> (a -> b)
  87     -- ^ 'Newtype' pack
  88     -> ALens' s a
  89     -- ^ @'Lens'' s a@: lens into the field
  90     -> a
  91     -- ^ default value
  92     -> g s a
  93
  94   --  | Free text field is essentially 'optionalFieldDefAla` with @""@
  95   --  as the default and "accept everything" parser.
  96   --
  97   -- @since 3.0.0.0
  98   freeTextField
  99     :: FieldName
 100     -> ALens' s (Maybe String)
 101     -- ^ lens into the field
 102     -> g s (Maybe String)
 103
 104   --  | Free text field is essentially 'optionalFieldDefAla` with @""@
 105   --  as the default and "accept everything" parser.
 106   --
 107   -- @since 3.0.0.0
 108   freeTextFieldDef
 109     :: FieldName
 110     -> ALens' s String
 111     -- ^ lens into the field
 112     -> g s String
 113
 114   -- | @since 3.2.0.0
 115   freeTextFieldDefST
 116     :: FieldName
 117     -> ALens' s ShortText
 118     -- ^ lens into the field
 119     -> g s ShortText
 120
 121   -- | Monoidal field.
 122   --
 123   -- Values are combined with 'mappend'.
 124   --
 125   -- /Note:/ 'optionalFieldAla' is a @monoidalField@ with 'Last' monoid.
 126   monoidalFieldAla
 127     :: (c b, Monoid a, Newtype a b)
 128     => FieldName
 129     -- ^ field name
 130     -> (a -> b)
 131     -- ^ 'pack'
 132     -> ALens' s a
 133     -- ^ lens into the field
 134     -> g s a
 135
 136   -- | Parser matching all fields with a name starting with a prefix.
 137   prefixedFields
 138     :: FieldName
 139     -- ^ field name prefix
 140     -> ALens' s [(String, String)]
 141     -- ^ lens into the field
 142     -> g s [(String, String)]
 143
 144   -- | Known field, which we don't parse, nor pretty print.
 145   knownField :: FieldName -> g s ()
 146
 147   -- | Field which is parsed but not pretty printed.
 148   hiddenField :: g s a -> g s a
 149
 150   -- | Deprecated since
 151   deprecatedSince
 152     :: CabalSpecVersion
 153     -- ^ version
 154     -> String
 155     -- ^ deprecation message
 156     -> g s a
 157     -> g s a
 158
 159   -- | Removed in. If we encounter removed field, parsing fails.
 160   removedIn
 161     :: CabalSpecVersion
 162     -- ^ version
 163     -> String
 164     -- ^ removal message
 165     -> g s a
 166     -> g s a
 167
 168   -- | Annotate field with since spec-version.
 169   availableSince
 170     :: CabalSpecVersion
 171     -- ^ spec version
 172     -> a
 173     -- ^ default value
 174     -> g s a
 175     -> g s a
 176
 177   -- | Annotate field with since spec-version.
 178   -- This is used to recognise, but warn about the field.
 179   -- It is used to process @other-extensions@ field.
 180   --
 181   -- Default implementation is to not warn.
 182   --
 183   -- @since 3.4.0.0
 184   availableSinceWarn
 185     :: CabalSpecVersion
 186     -- ^ spec version
 187     -> g s a
 188     -> g s a
 189   availableSinceWarn _ = id
 190
 191 -- | Field which can be defined at most once.
 192 uniqueField
 193   :: (FieldGrammar c g, c (Identity a))
 194   => FieldName
 195   -- ^ field name
 196   -> ALens' s a
 197   -- ^ lens into the field
 198   -> g s a
 199 uniqueField fn l = uniqueFieldAla fn Identity l
 200
 201 -- | Field which can be defined at most once.
 202 optionalField
 203   :: (FieldGrammar c g, c (Identity a))
 204   => FieldName
 205   -- ^ field name
 206   -> ALens' s (Maybe a)
 207   -- ^ lens into the field
 208   -> g s (Maybe a)
 209 optionalField fn l = optionalFieldAla fn Identity l
 210
 211 -- | Optional field with default value.
 212 optionalFieldDef
 213   :: (FieldGrammar c g, Functor (g s), c (Identity a), Eq a)
 214   => FieldName
 215   -- ^ field name
 216   -> ALens' s a
 217   -- ^ @'Lens'' s a@: lens into the field
 218   -> a
 219   -- ^ default value
 220   -> g s a
 221 optionalFieldDef fn l x = optionalFieldDefAla fn Identity l x
 222
 223 -- | Field which can be define multiple times, and the results are @mappend@ed.
 224 monoidalField
 225   :: (FieldGrammar c g, c (Identity a), Monoid a)
 226   => FieldName
 227   -- ^ field name
 228   -> ALens' s a
 229   -- ^ lens into the field
 230   -> g s a
 231 monoidalField fn l = monoidalFieldAla fn Identity l
 232
 233 -- | Default implementation for 'freeTextFieldDefST'.
 234 defaultFreeTextFieldDefST
 235   :: (Functor (g s), FieldGrammar c g)
 236   => FieldName
 237   -> ALens' s ShortText
 238   -- ^ lens into the field
 239   -> g s ShortText
 240 defaultFreeTextFieldDefST fn l =
 241   toShortText <$> freeTextFieldDef fn (cloneLens l . st)
 242   where
 243     st :: Lens' ShortText String
 244     st f s = toShortText <$> f (fromShortText s)