    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE MultiParamTypeClasses #-}

    module Distribution.FieldGrammar.Pretty
      ( PrettyFieldGrammar
      , prettyFieldGrammar
      ) where

    import Distribution.CabalSpecVersion
    import Distribution.Compat.Lens
    import Distribution.Compat.Newtype
    import Distribution.Compat.Prelude
    import Distribution.Fields.Field (FieldName)
    import Distribution.Fields.Pretty (PrettyField (..))
    import Distribution.Pretty (Pretty (..), showFreeText, showFreeTextV3)
    import Distribution.Utils.Generic (toUTF8BS)
    import Text.PrettyPrint (Doc)
    import qualified Text.PrettyPrint as PP
    import Prelude ()

    import Distribution.FieldGrammar.Class

    newtype PrettyFieldGrammar s a = PrettyFG
      { forall s a.
    PrettyFieldGrammar s a -> CabalSpecVersion -> s -> [PrettyField ()]
    fieldGrammarPretty :: CabalSpecVersion -> s -> [PrettyField ()]
      }
      deriving ((forall a b.
     (a -> b) -> PrettyFieldGrammar s a -> PrettyFieldGrammar s b)
    -> (forall a b.
        a -> PrettyFieldGrammar s b -> PrettyFieldGrammar s a)
    -> Functor (PrettyFieldGrammar s)
    forall a b. a -> PrettyFieldGrammar s b -> PrettyFieldGrammar s a
    forall a b.
    (a -> b) -> PrettyFieldGrammar s a -> PrettyFieldGrammar s b
    forall s a b. a -> PrettyFieldGrammar s b -> PrettyFieldGrammar s a
    forall s a b.
    (a -> b) -> PrettyFieldGrammar s a -> PrettyFieldGrammar s b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall s a b.
    (a -> b) -> PrettyFieldGrammar s a -> PrettyFieldGrammar s b
    fmap :: forall a b.
    (a -> b) -> PrettyFieldGrammar s a -> PrettyFieldGrammar s b
    $c<$ :: forall s a b. a -> PrettyFieldGrammar s b -> PrettyFieldGrammar s a
    <$ :: forall a b. a -> PrettyFieldGrammar s b -> PrettyFieldGrammar s a
    Functor)

    instance Applicative (PrettyFieldGrammar s) where
      pure :: forall a. a -> PrettyFieldGrammar s a
    pure a
    _ = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG (\CabalSpecVersion
    _ s
    _ -> [PrettyField ()]
    forall a. Monoid a => a
    mempty)
      PrettyFG CabalSpecVersion -> s -> [PrettyField ()]
    f <*> :: forall a b.
    PrettyFieldGrammar s (a -> b)
    -> PrettyFieldGrammar s a -> PrettyFieldGrammar s b
    <*> PrettyFG CabalSpecVersion -> s -> [PrettyField ()]
    x = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s b
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG (\CabalSpecVersion
    v s
    s -> CabalSpecVersion -> s -> [PrettyField ()]
    f CabalSpecVersion
    v s
    s [PrettyField ()] -> [PrettyField ()] -> [PrettyField ()]
    forall a. Semigroup a => a -> a -> a
    <> CabalSpecVersion -> s -> [PrettyField ()]
    x CabalSpecVersion
    v s
    s)

    -- | We can use 'PrettyFieldGrammar' to pp print the @s@.
    --
    -- /Note:/ there is not trailing @($+$ text "")@.
    prettyFieldGrammar :: CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
    prettyFieldGrammar :: forall s a.
    CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
    prettyFieldGrammar = (PrettyFieldGrammar s a
     -> CabalSpecVersion -> s -> [PrettyField ()])
    -> CabalSpecVersion
    -> PrettyFieldGrammar s a
    -> s
    -> [PrettyField ()]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip PrettyFieldGrammar s a -> CabalSpecVersion -> s -> [PrettyField ()]
    forall s a.
    PrettyFieldGrammar s a -> CabalSpecVersion -> s -> [PrettyField ()]
    fieldGrammarPretty

    instance FieldGrammar Pretty PrettyFieldGrammar where
      blurFieldGrammar :: forall a b d.
    ALens' a b -> PrettyFieldGrammar b d -> PrettyFieldGrammar a d
    blurFieldGrammar ALens' a b
    f (PrettyFG CabalSpecVersion -> b -> [PrettyField ()]
    pp) = (CabalSpecVersion -> a -> [PrettyField ()])
    -> PrettyFieldGrammar a d
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG (\CabalSpecVersion
    v -> CabalSpecVersion -> b -> [PrettyField ()]
    pp CabalSpecVersion
    v (b -> [PrettyField ()]) -> (a -> b) -> a -> [PrettyField ()]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ALens' a b -> a -> b
    forall s t a b. ALens s t a b -> s -> a
    aview ALens' a b
    f)

      uniqueFieldAla :: forall b a s.
    (Pretty b, Newtype a b) =>
    FieldName -> (a -> b) -> ALens' s a -> PrettyFieldGrammar s a
    uniqueFieldAla FieldName
    fn a -> b
    _pack ALens' s a
    l = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG ((CabalSpecVersion -> s -> [PrettyField ()])
     -> PrettyFieldGrammar s a)
    -> (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    forall a b. (a -> b) -> a -> b
    $ \CabalSpecVersion
    _v s
    s ->
        FieldName -> Doc -> [PrettyField ()]
    ppField FieldName
    fn (b -> Doc
    forall a. Pretty a => a -> Doc
    pretty ((a -> b) -> a -> b
    forall o n. Newtype o n => (o -> n) -> o -> n
    pack' a -> b
    _pack (ALens' s a -> s -> a
    forall s t a b. ALens s t a b -> s -> a
    aview ALens' s a
    l s
    s)))

      booleanFieldDef :: forall s.
    FieldName -> ALens' s Bool -> Bool -> PrettyFieldGrammar s Bool
    booleanFieldDef FieldName
    fn ALens' s Bool
    l Bool
    def = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s Bool
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG CabalSpecVersion -> s -> [PrettyField ()]
    forall {p}. p -> s -> [PrettyField ()]
    pp
        where
          pp :: p -> s -> [PrettyField ()]
    pp p
    _v s
    s
            | Bool
    b Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    def = [PrettyField ()]
    forall a. Monoid a => a
    mempty
            | Bool
    otherwise = FieldName -> Doc -> [PrettyField ()]
    ppField FieldName
    fn (String -> Doc
    PP.text (Bool -> String
    forall a. Show a => a -> String
    show Bool
    b))
            where
              b :: Bool
    b = ALens' s Bool -> s -> Bool
    forall s t a b. ALens s t a b -> s -> a
    aview ALens' s Bool
    l s
    s

      optionalFieldAla :: forall b a s.
    (Pretty b, Newtype a b) =>
    FieldName
    -> (a -> b) -> ALens' s (Maybe a) -> PrettyFieldGrammar s (Maybe a)
    optionalFieldAla FieldName
    fn a -> b
    _pack ALens' s (Maybe a)
    l = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s (Maybe a)
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG CabalSpecVersion -> s -> [PrettyField ()]
    pp
        where
          pp :: CabalSpecVersion -> s -> [PrettyField ()]
    pp CabalSpecVersion
    v s
    s = case ALens' s (Maybe a) -> s -> Maybe a
    forall s t a b. ALens s t a b -> s -> a
    aview ALens' s (Maybe a)
    l s
    s of
            Maybe a
    Nothing -> [PrettyField ()]
    forall a. Monoid a => a
    mempty
            Just a
    a -> FieldName -> Doc -> [PrettyField ()]
    ppField FieldName
    fn (CabalSpecVersion -> b -> Doc
    forall a. Pretty a => CabalSpecVersion -> a -> Doc
    prettyVersioned CabalSpecVersion
    v ((a -> b) -> a -> b
    forall o n. Newtype o n => (o -> n) -> o -> n
    pack' a -> b
    _pack a
    a))

      optionalFieldDefAla :: forall b a s.
    (Pretty b, Newtype a b, Eq a) =>
    FieldName -> (a -> b) -> ALens' s a -> a -> PrettyFieldGrammar s a
    optionalFieldDefAla FieldName
    fn a -> b
    _pack ALens' s a
    l a
    def = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG CabalSpecVersion -> s -> [PrettyField ()]
    pp
        where
          pp :: CabalSpecVersion -> s -> [PrettyField ()]
    pp CabalSpecVersion
    v s
    s
            | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    def = [PrettyField ()]
    forall a. Monoid a => a
    mempty
            | Bool
    otherwise = FieldName -> Doc -> [PrettyField ()]
    ppField FieldName
    fn (CabalSpecVersion -> b -> Doc
    forall a. Pretty a => CabalSpecVersion -> a -> Doc
    prettyVersioned CabalSpecVersion
    v ((a -> b) -> a -> b
    forall o n. Newtype o n => (o -> n) -> o -> n
    pack' a -> b
    _pack a
    x))
            where
              x :: a
    x = ALens' s a -> s -> a
    forall s t a b. ALens s t a b -> s -> a
    aview ALens' s a
    l s
    s

      freeTextField :: forall s.
    FieldName
    -> ALens' s (Maybe String) -> PrettyFieldGrammar s (Maybe String)
    freeTextField FieldName
    fn ALens' s (Maybe String)
    l = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s (Maybe String)
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG CabalSpecVersion -> s -> [PrettyField ()]
    pp
        where
          pp :: CabalSpecVersion -> s -> [PrettyField ()]
    pp CabalSpecVersion
    v s
    s = [PrettyField ()]
    -> (String -> [PrettyField ()]) -> Maybe String -> [PrettyField ()]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [PrettyField ()]
    forall a. Monoid a => a
    mempty (FieldName -> Doc -> [PrettyField ()]
    ppField FieldName
    fn (Doc -> [PrettyField ()])
    -> (String -> Doc) -> String -> [PrettyField ()]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc
    showFT) (ALens' s (Maybe String) -> s -> Maybe String
    forall s t a b. ALens s t a b -> s -> a
    aview ALens' s (Maybe String)
    l s
    s)
            where
              showFT :: String -> Doc
    showFT
                | CabalSpecVersion
    v CabalSpecVersion -> CabalSpecVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= CabalSpecVersion
    CabalSpecV3_0 = String -> Doc
    showFreeTextV3
                | Bool
    otherwise = String -> Doc
    showFreeText

      -- it's ok to just show, as showFreeText of empty string is empty.
      freeTextFieldDef :: forall s.
    FieldName -> ALens' s String -> PrettyFieldGrammar s String
    freeTextFieldDef FieldName
    fn ALens' s String
    l = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s String
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG CabalSpecVersion -> s -> [PrettyField ()]
    pp
        where
          pp :: CabalSpecVersion -> s -> [PrettyField ()]
    pp CabalSpecVersion
    v s
    s = FieldName -> Doc -> [PrettyField ()]
    ppField FieldName
    fn (String -> Doc
    showFT (ALens' s String -> s -> String
    forall s t a b. ALens s t a b -> s -> a
    aview ALens' s String
    l s
    s))
            where
              showFT :: String -> Doc
    showFT
                | CabalSpecVersion
    v CabalSpecVersion -> CabalSpecVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= CabalSpecVersion
    CabalSpecV3_0 = String -> Doc
    showFreeTextV3
                | Bool
    otherwise = String -> Doc
    showFreeText

      freeTextFieldDefST :: forall s.
    FieldName -> ALens' s ShortText -> PrettyFieldGrammar s ShortText
    freeTextFieldDefST = FieldName -> ALens' s ShortText -> PrettyFieldGrammar s ShortText
    forall (g :: * -> * -> *) s (c :: * -> Constraint).
    (Functor (g s), FieldGrammar c g) =>
    FieldName -> ALens' s ShortText -> g s ShortText
    defaultFreeTextFieldDefST

      monoidalFieldAla :: forall b a s.
    (Pretty b, Monoid a, Newtype a b) =>
    FieldName -> (a -> b) -> ALens' s a -> PrettyFieldGrammar s a
    monoidalFieldAla FieldName
    fn a -> b
    _pack ALens' s a
    l = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG CabalSpecVersion -> s -> [PrettyField ()]
    pp
        where
          pp :: CabalSpecVersion -> s -> [PrettyField ()]
    pp CabalSpecVersion
    v s
    s = FieldName -> Doc -> [PrettyField ()]
    ppField FieldName
    fn (CabalSpecVersion -> b -> Doc
    forall a. Pretty a => CabalSpecVersion -> a -> Doc
    prettyVersioned CabalSpecVersion
    v ((a -> b) -> a -> b
    forall o n. Newtype o n => (o -> n) -> o -> n
    pack' a -> b
    _pack (ALens' s a -> s -> a
    forall s t a b. ALens s t a b -> s -> a
    aview ALens' s a
    l s
    s)))

      prefixedFields :: forall s.
    FieldName
    -> ALens' s [(String, String)]
    -> PrettyFieldGrammar s [(String, String)]
    prefixedFields FieldName
    _fnPfx ALens' s [(String, String)]
    l = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s [(String, String)]
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG (\CabalSpecVersion
    _ -> [(String, String)] -> [PrettyField ()]
    pp ([(String, String)] -> [PrettyField ()])
    -> (s -> [(String, String)]) -> s -> [PrettyField ()]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ALens' s [(String, String)] -> s -> [(String, String)]
    forall s t a b. ALens s t a b -> s -> a
    aview ALens' s [(String, String)]
    l)
        where
          pp :: [(String, String)] -> [PrettyField ()]
    pp [(String, String)]
    xs =
            -- always print the field, even its Doc is empty.
            -- i.e. don't use ppField
            [ () -> FieldName -> Doc -> PrettyField ()
    forall ann. ann -> FieldName -> Doc -> PrettyField ann
    PrettyField () (String -> FieldName
    toUTF8BS String
    n) (Doc -> PrettyField ()) -> Doc -> PrettyField ()
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (String -> Doc) -> [String] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Doc
    PP.text ([String] -> [Doc]) -> [String] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines String
    s
            | (String
    n, String
    s) <- [(String, String)]
    xs
            -- fnPfx `isPrefixOf` n
            ]

      knownField :: forall s. FieldName -> PrettyFieldGrammar s ()
    knownField FieldName
    _ = () -> PrettyFieldGrammar s ()
    forall a. a -> PrettyFieldGrammar s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      deprecatedSince :: forall s a.
    CabalSpecVersion
    -> String -> PrettyFieldGrammar s a -> PrettyFieldGrammar s a
    deprecatedSince CabalSpecVersion
    _ String
    _ PrettyFieldGrammar s a
    x = PrettyFieldGrammar s a
    x

      -- TODO: as PrettyFieldGrammar isn't aware of cabal-version: we output the field
      -- this doesn't affect roundtrip as `removedIn` fields cannot be parsed
      -- so invalid documents can be only manually constructed.
      removedIn :: forall s a.
    CabalSpecVersion
    -> String -> PrettyFieldGrammar s a -> PrettyFieldGrammar s a
    removedIn CabalSpecVersion
    _ String
    _ PrettyFieldGrammar s a
    x = PrettyFieldGrammar s a
    x
      availableSince :: forall a s.
    CabalSpecVersion
    -> a -> PrettyFieldGrammar s a -> PrettyFieldGrammar s a
    availableSince CabalSpecVersion
    _ a
    _ = PrettyFieldGrammar s a -> PrettyFieldGrammar s a
    forall a. a -> a
    id
      hiddenField :: forall s a. PrettyFieldGrammar s a -> PrettyFieldGrammar s a
    hiddenField PrettyFieldGrammar s a
    _ = (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    forall s a.
    (CabalSpecVersion -> s -> [PrettyField ()])
    -> PrettyFieldGrammar s a
    PrettyFG (\CabalSpecVersion
    _ -> s -> [PrettyField ()]
    forall a. Monoid a => a
    mempty)

    ppField :: FieldName -> Doc -> [PrettyField ()]
    ppField :: FieldName -> Doc -> [PrettyField ()]
    ppField FieldName
    name Doc
    fielddoc
      | Doc -> Bool
    PP.isEmpty Doc
    fielddoc = []
      | Bool
    otherwise = [() -> FieldName -> Doc -> PrettyField ()
    forall ann. ann -> FieldName -> Doc -> PrettyField ann
    PrettyField () FieldName
    name Doc
    fielddoc]