{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableSuperClasses #-}

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

-- | 'FieldGrammar' is parametrised by
--
-- * @s@ which is a structure we are parsing. We need this to provide prettyprinter
-- functionality
--
-- * @a@ type of the field.
--
-- /Note:/ We'd like to have @forall s. Applicative (f s)@ context.
class
  ( c SpecVersion
  , c TestedWith
  , c SpecLicense
  , c Token
  , c Token'
  , c FilePathNT
  ) =>
  FieldGrammar c g
    | g -> c
  where
  -- | Unfocus, zoom out, /blur/ 'FieldGrammar'.
  blurFieldGrammar :: ALens' a b -> g b d -> g a d

  -- | Field which should be defined, exactly once.
  uniqueFieldAla
    :: (c b, Newtype a b)
    => FieldName
    -- ^ field name
    -> (a -> b)
    -- ^ 'Newtype' pack
    -> ALens' s a
    -- ^ lens into the field
    -> g s a

  -- | Boolean field with a default value.
  booleanFieldDef
    :: FieldName
    -- ^ field name
    -> ALens' s Bool
    -- ^ lens into the field
    -> Bool
    -- ^ default
    -> g s Bool

  -- | Optional field.
  optionalFieldAla
    :: (c b, Newtype a b)
    => FieldName
    -- ^ field name
    -> (a -> b)
    -- ^ 'pack'
    -> ALens' s (Maybe a)
    -- ^ lens into the field
    -> g s (Maybe a)

  -- | Optional field with default value.
  optionalFieldDefAla
    :: (c b, Newtype a b, Eq a)
    => FieldName
    -- ^ field name
    -> (a -> b)
    -- ^ 'Newtype' pack
    -> ALens' s a
    -- ^ @'Lens'' s a@: lens into the field
    -> a
    -- ^ default value
    -> g s a

  --  | Free text field is essentially 'optionalFieldDefAla` with @""@
  --  as the default and "accept everything" parser.
  --
  -- @since 3.0.0.0
  freeTextField
    :: FieldName
    -> ALens' s (Maybe String)
    -- ^ lens into the field
    -> g s (Maybe String)

  --  | Free text field is essentially 'optionalFieldDefAla` with @""@
  --  as the default and "accept everything" parser.
  --
  -- @since 3.0.0.0
  freeTextFieldDef
    :: FieldName
    -> ALens' s String
    -- ^ lens into the field
    -> g s String

  -- | @since 3.2.0.0
  freeTextFieldDefST
    :: FieldName
    -> ALens' s ShortText
    -- ^ lens into the field
    -> g s ShortText

  -- | Monoidal field.
  --
  -- Values are combined with 'mappend'.
  --
  -- /Note:/ 'optionalFieldAla' is a @monoidalField@ with 'Last' monoid.
  monoidalFieldAla
    :: (c b, Monoid a, Newtype a b)
    => FieldName
    -- ^ field name
    -> (a -> b)
    -- ^ 'pack'
    -> ALens' s a
    -- ^ lens into the field
    -> g s a

  -- | Parser matching all fields with a name starting with a prefix.
  prefixedFields
    :: FieldName
    -- ^ field name prefix
    -> ALens' s [(String, String)]
    -- ^ lens into the field
    -> g s [(String, String)]

  -- | Known field, which we don't parse, nor pretty print.
  knownField :: FieldName -> g s ()

  -- | Field which is parsed but not pretty printed.
  hiddenField :: g s a -> g s a

  -- | Deprecated since
  deprecatedSince
    :: CabalSpecVersion
    -- ^ version
    -> String
    -- ^ deprecation message
    -> g s a
    -> g s a

  -- | Removed in. If we encounter removed field, parsing fails.
  removedIn
    :: CabalSpecVersion
    -- ^ version
    -> String
    -- ^ removal message
    -> g s a
    -> g s a

  -- | Annotate field with since spec-version.
  availableSince
    :: CabalSpecVersion
    -- ^ spec version
    -> a
    -- ^ default value
    -> g s a
    -> g s a

  -- | Annotate field with since spec-version.
  -- This is used to recognise, but warn about the field.
  -- It is used to process @other-extensions@ field.
  --
  -- Default implementation is to not warn.
  --
  -- @since 3.4.0.0
  availableSinceWarn
    :: CabalSpecVersion
    -- ^ spec version
    -> g s a
    -> g s a
  availableSinceWarn CabalSpecVersion
_ = g s a -> g s a
forall a. a -> a
id

-- | Field which can be defined at most once.
uniqueField
  :: (FieldGrammar c g, c (Identity a))
  => FieldName
  -- ^ field name
  -> ALens' s a
  -- ^ lens into the field
  -> g s a
uniqueField :: forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
fn ALens' s a
l = FieldName -> (a -> Identity a) -> ALens' s a -> g s a
forall b a s.
(c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
uniqueFieldAla FieldName
fn a -> Identity a
forall a. a -> Identity a
Identity ALens' s a
l

-- | Field which can be defined at most once.
optionalField
  :: (FieldGrammar c g, c (Identity a))
  => FieldName
  -- ^ field name
  -> ALens' s (Maybe a)
  -- ^ lens into the field
  -> g s (Maybe a)
optionalField :: forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField FieldName
fn ALens' s (Maybe a)
l = FieldName
-> (a -> Identity a) -> ALens' s (Maybe a) -> g s (Maybe a)
forall b a s.
(c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
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
fn a -> Identity a
forall a. a -> Identity a
Identity ALens' s (Maybe a)
l

-- | Optional field with default value.
optionalFieldDef
  :: (FieldGrammar c g, Functor (g s), c (Identity a), Eq a)
  => FieldName
  -- ^ field name
  -> ALens' s a
  -- ^ @'Lens'' s a@: lens into the field
  -> a
  -- ^ default value
  -> g s a
optionalFieldDef :: 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
fn ALens' s a
l a
x = FieldName -> (a -> Identity a) -> ALens' s a -> a -> g s a
forall b a s.
(c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
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
fn a -> Identity a
forall a. a -> Identity a
Identity ALens' s a
l a
x

-- | Field which can be define multiple times, and the results are @mappend@ed.
monoidalField
  :: (FieldGrammar c g, c (Identity a), Monoid a)
  => FieldName
  -- ^ field name
  -> ALens' s a
  -- ^ lens into the field
  -> g s a
monoidalField :: forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a), Monoid a) =>
FieldName -> ALens' s a -> g s a
monoidalField FieldName
fn ALens' s a
l = FieldName -> (a -> Identity a) -> ALens' s a -> g s a
forall b a s.
(c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
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
fn a -> Identity a
forall a. a -> Identity a
Identity ALens' s a
l

-- | Default implementation for 'freeTextFieldDefST'.
defaultFreeTextFieldDefST
  :: (Functor (g s), FieldGrammar c g)
  => FieldName
  -> ALens' s ShortText
  -- ^ lens into the field
  -> g s ShortText
defaultFreeTextFieldDefST :: forall (g :: * -> * -> *) s (c :: * -> Constraint).
(Functor (g s), FieldGrammar c g) =>
FieldName -> ALens' s ShortText -> g s ShortText
defaultFreeTextFieldDefST FieldName
fn ALens' s ShortText
l =
  String -> ShortText
toShortText (String -> ShortText) -> g s String -> g s ShortText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName -> ALens' s String -> g s String
forall s. FieldName -> ALens' s String -> g s String
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef FieldName
fn (ALens' s ShortText
-> LensLike (Pretext String String) s s ShortText ShortText
forall (f :: * -> *) s t a b.
Functor f =>
ALens s t a b -> LensLike f s t a b
cloneLens ALens' s ShortText
l LensLike (Pretext String String) s s ShortText ShortText
-> ((String -> Pretext String String String)
    -> ShortText -> Pretext String String ShortText)
-> ALens' s String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Pretext String String String)
-> ShortText -> Pretext String String ShortText
Lens' ShortText String
st)
  where
    st :: Lens' ShortText String
    st :: Lens' ShortText String
st String -> f String
f ShortText
s = String -> ShortText
toShortText (String -> ShortText) -> f String -> f ShortText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f (ShortText -> String
fromShortText ShortText
s)