    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE DeriveFoldable #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE DeriveTraversable #-}
    {-# LANGUAGE LambdaCase #-}

    -- | Cabal-like file AST types: 'Field', 'Section' etc,
    --
    -- This (intermediate) data type is used for pretty-printing.
    --
    -- @since 3.0.0.0
    module Distribution.Fields.Pretty
      ( -- * Fields
        CommentPosition (..)
      , PrettyField (..)
      , showFields
      , showFields'

        -- * Transformation from 'P.Field'
      , fromParsecFields
      , genericFromParsecFields
      , prettyFieldLines
      , prettySectionArgs
      ) where

    import Distribution.Compat.Prelude
    import Distribution.Pretty (showToken)
    import Prelude ()

    import Distribution.Fields.Field (FieldName)
    import Distribution.Utils.Generic (fromUTF8BS)

    import qualified Distribution.Fields.Parser as P

    import qualified Data.ByteString as BS
    import qualified Text.PrettyPrint as PP

    -- | This type is used to discern when a comment block should go
    --   before or after a cabal-like file field, otherwise it would
    --   be hardcoded to a single position. It is often used in
    --   conjunction with @PrettyField@.
    data CommentPosition = CommentBefore [String] | CommentAfter [String] | NoComment

    data PrettyField ann
      = PrettyField ann FieldName PP.Doc
      | PrettySection ann FieldName [PP.Doc] [PrettyField ann]
      | PrettyEmpty
      deriving ((forall a b. (a -> b) -> PrettyField a -> PrettyField b)
    -> (forall a b. a -> PrettyField b -> PrettyField a)
    -> Functor PrettyField
    forall a b. a -> PrettyField b -> PrettyField a
    forall a b. (a -> b) -> PrettyField a -> PrettyField b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> PrettyField a -> PrettyField b
    fmap :: forall a b. (a -> b) -> PrettyField a -> PrettyField b
    $c<$ :: forall a b. a -> PrettyField b -> PrettyField a
    <$ :: forall a b. a -> PrettyField b -> PrettyField a
    Functor, (forall m. Monoid m => PrettyField m -> m)
    -> (forall m a. Monoid m => (a -> m) -> PrettyField a -> m)
    -> (forall m a. Monoid m => (a -> m) -> PrettyField a -> m)
    -> (forall a b. (a -> b -> b) -> b -> PrettyField a -> b)
    -> (forall a b. (a -> b -> b) -> b -> PrettyField a -> b)
    -> (forall b a. (b -> a -> b) -> b -> PrettyField a -> b)
    -> (forall b a. (b -> a -> b) -> b -> PrettyField a -> b)
    -> (forall a. (a -> a -> a) -> PrettyField a -> a)
    -> (forall a. (a -> a -> a) -> PrettyField a -> a)
    -> (forall a. PrettyField a -> [a])
    -> (forall a. PrettyField a -> Bool)
    -> (forall a. PrettyField a -> Int)
    -> (forall a. Eq a => a -> PrettyField a -> Bool)
    -> (forall a. Ord a => PrettyField a -> a)
    -> (forall a. Ord a => PrettyField a -> a)
    -> (forall a. Num a => PrettyField a -> a)
    -> (forall a. Num a => PrettyField a -> a)
    -> Foldable PrettyField
    forall a. Eq a => a -> PrettyField a -> Bool
    forall a. Num a => PrettyField a -> a
    forall a. Ord a => PrettyField a -> a
    forall m. Monoid m => PrettyField m -> m
    forall a. PrettyField a -> Bool
    forall a. PrettyField a -> Int
    forall a. PrettyField a -> [a]
    forall a. (a -> a -> a) -> PrettyField a -> a
    forall m a. Monoid m => (a -> m) -> PrettyField a -> m
    forall b a. (b -> a -> b) -> b -> PrettyField a -> b
    forall a b. (a -> b -> b) -> b -> PrettyField a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> Int)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    $cfold :: forall m. Monoid m => PrettyField m -> m
    fold :: forall m. Monoid m => PrettyField m -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> PrettyField a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> PrettyField a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> PrettyField a -> m
    foldMap' :: forall m a. Monoid m => (a -> m) -> PrettyField a -> m
    $cfoldr :: forall a b. (a -> b -> b) -> b -> PrettyField a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> PrettyField a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> PrettyField a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> PrettyField a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> PrettyField a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> PrettyField a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> PrettyField a -> b
    foldl' :: forall b a. (b -> a -> b) -> b -> PrettyField a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> PrettyField a -> a
    foldr1 :: forall a. (a -> a -> a) -> PrettyField a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> PrettyField a -> a
    foldl1 :: forall a. (a -> a -> a) -> PrettyField a -> a
    $ctoList :: forall a. PrettyField a -> [a]
    toList :: forall a. PrettyField a -> [a]
    $cnull :: forall a. PrettyField a -> Bool
    null :: forall a. PrettyField a -> Bool
    $clength :: forall a. PrettyField a -> Int
    length :: forall a. PrettyField a -> Int
    $celem :: forall a. Eq a => a -> PrettyField a -> Bool
    elem :: forall a. Eq a => a -> PrettyField a -> Bool
    $cmaximum :: forall a. Ord a => PrettyField a -> a
    maximum :: forall a. Ord a => PrettyField a -> a
    $cminimum :: forall a. Ord a => PrettyField a -> a
    minimum :: forall a. Ord a => PrettyField a -> a
    $csum :: forall a. Num a => PrettyField a -> a
    sum :: forall a. Num a => PrettyField a -> a
    $cproduct :: forall a. Num a => PrettyField a -> a
    product :: forall a. Num a => PrettyField a -> a
    Foldable, Functor PrettyField
    Foldable PrettyField
    (Functor PrettyField, Foldable PrettyField) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> PrettyField a -> f (PrettyField b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        PrettyField (f a) -> f (PrettyField a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> PrettyField a -> m (PrettyField b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        PrettyField (m a) -> m (PrettyField a))
    -> Traversable PrettyField
    forall (t :: * -> *).
    (Functor t, Foldable t) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a.
    Monad m =>
    PrettyField (m a) -> m (PrettyField a)
    forall (f :: * -> *) a.
    Applicative f =>
    PrettyField (f a) -> f (PrettyField a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PrettyField a -> m (PrettyField b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PrettyField a -> f (PrettyField b)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PrettyField a -> f (PrettyField b)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PrettyField a -> f (PrettyField b)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    PrettyField (f a) -> f (PrettyField a)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    PrettyField (f a) -> f (PrettyField a)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PrettyField a -> m (PrettyField b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PrettyField a -> m (PrettyField b)
    $csequence :: forall (m :: * -> *) a.
    Monad m =>
    PrettyField (m a) -> m (PrettyField a)
    sequence :: forall (m :: * -> *) a.
    Monad m =>
    PrettyField (m a) -> m (PrettyField a)
    Traversable)

    -- | Prettyprint a list of fields.
    --
    -- Note: the first argument should return 'String's without newlines
    -- and properly prefixes (with @--@) to count as comments.
    -- This unsafety is left in place so one could generate empty lines
    -- between comment lines.
    showFields :: (ann -> CommentPosition) -> [PrettyField ann] -> String
    showFields :: forall ann. (ann -> CommentPosition) -> [PrettyField ann] -> String
    showFields ann -> CommentPosition
    rann = (ann -> CommentPosition)
    -> (ann -> [String] -> [String])
    -> Int
    -> [PrettyField ann]
    -> String
    forall ann.
    (ann -> CommentPosition)
    -> (ann -> [String] -> [String])
    -> Int
    -> [PrettyField ann]
    -> String
    showFields' ann -> CommentPosition
    rann (([String] -> [String]) -> ann -> [String] -> [String]
    forall a b. a -> b -> a
    const [String] -> [String]
    forall a. a -> a
    id) Int
    4

    -- | 'showFields' with user specified indentation.
    showFields'
      :: (ann -> CommentPosition)
      -- ^ Convert an annotation to lined to precede the field or section.
      -> (ann -> [String] -> [String])
      -- ^ Post-process non-annotation produced lines.
      -> Int
      -- ^ Indentation level.
      -> [PrettyField ann]
      -- ^ Fields/sections to show.
      -> String
    showFields' :: forall ann.
    (ann -> CommentPosition)
    -> (ann -> [String] -> [String])
    -> Int
    -> [PrettyField ann]
    -> String
    showFields' ann -> CommentPosition
    rann ann -> [String] -> [String]
    post Int
    n = [String] -> String
    unlines ([String] -> String)
    -> ([PrettyField ann] -> [String]) -> [PrettyField ann] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Opts ann -> [PrettyField ann] -> [String]
    forall ann. Opts ann -> [PrettyField ann] -> [String]
    renderFields ((ann -> CommentPosition)
    -> (String -> String) -> (ann -> [String] -> [String]) -> Opts ann
    forall ann.
    (ann -> CommentPosition)
    -> (String -> String) -> (ann -> [String] -> [String]) -> Opts ann
    Opts ann -> CommentPosition
    rann String -> String
    indent ann -> [String] -> [String]
    post)
      where
        -- few hardcoded, "unrolled"  variants.
        indent :: String -> String
    indent
          | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    4 = String -> String
    indent4
          | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2 = String -> String
    indent2
          | Bool
    otherwise = (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    n Int
    1) Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)

        indent4 :: String -> String
        indent4 :: String -> String
    indent4 [] = []
        indent4 String
    xs = Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    xs

        indent2 :: String -> String
        indent2 :: String -> String
    indent2 [] = []
        indent2 String
    xs = Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    xs

    data Opts ann = Opts
      { forall ann. Opts ann -> ann -> CommentPosition
    _optAnnotation :: ann -> CommentPosition
      , forall ann. Opts ann -> String -> String
    _optIndent :: String -> String
      , forall ann. Opts ann -> ann -> [String] -> [String]
    _optPostprocess :: ann -> [String] -> [String]
      }

    renderFields :: Opts ann -> [PrettyField ann] -> [String]
    renderFields :: forall ann. Opts ann -> [PrettyField ann] -> [String]
    renderFields Opts ann
    opts [PrettyField ann]
    fields = [Block] -> [String]
    flattenBlocks [Block]
    blocks
      where
        len :: Int
    len = Int -> [PrettyField ann] -> Int
    forall {ann}. Int -> [PrettyField ann] -> Int
    maxNameLength Int
    0 [PrettyField ann]
    fields
        blocks :: [Block]
    blocks =
          (Block -> Bool) -> [Block] -> [Block]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([String] -> Bool) -> (Block -> [String]) -> Block -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Block -> [String]
    _contentsBlock) ([Block] -> [Block]) -> [Block] -> [Block]
    forall a b. (a -> b) -> a -> b
    $ -- empty blocks cause extra newlines #8236
            (PrettyField ann -> Block) -> [PrettyField ann] -> [Block]
    forall a b. (a -> b) -> [a] -> [b]
    map (Opts ann -> Int -> PrettyField ann -> Block
    forall ann. Opts ann -> Int -> PrettyField ann -> Block
    renderField Opts ann
    opts Int
    len) [PrettyField ann]
    fields

        maxNameLength :: Int -> [PrettyField ann] -> Int
    maxNameLength !Int
    acc [] = Int
    acc
        maxNameLength !Int
    acc (PrettyField ann
    _ FieldName
    name Doc
    _ : [PrettyField ann]
    rest) = Int -> [PrettyField ann] -> Int
    maxNameLength (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    acc (FieldName -> Int
    BS.length FieldName
    name)) [PrettyField ann]
    rest
        maxNameLength !Int
    acc (PrettySection{} : [PrettyField ann]
    rest) = Int -> [PrettyField ann] -> Int
    maxNameLength Int
    acc [PrettyField ann]
    rest
        maxNameLength !Int
    acc (PrettyField ann
    PrettyEmpty : [PrettyField ann]
    rest) = Int -> [PrettyField ann] -> Int
    maxNameLength Int
    acc [PrettyField ann]
    rest

    -- | Block of lines with flags for optional blank lines before and after
    data Block = Block
      { Block -> Margin
    _beforeBlock :: Margin
      , Block -> Margin
    _afterBlock :: Margin
      , Block -> [String]
    _contentsBlock :: [String]
      }

    data Margin = Margin | NoMargin
      deriving (Margin -> Margin -> Bool
    (Margin -> Margin -> Bool)
    -> (Margin -> Margin -> Bool) -> Eq Margin
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Margin -> Margin -> Bool
    == :: Margin -> Margin -> Bool
    $c/= :: Margin -> Margin -> Bool
    /= :: Margin -> Margin -> Bool
    Eq)

    -- | Collapse margins, any margin = margin
    instance Semigroup Margin where
      Margin
    NoMargin <> :: Margin -> Margin -> Margin
    <> Margin
    NoMargin = Margin
    NoMargin
      Margin
    _ <> Margin
    _ = Margin
    Margin

    flattenBlocks :: [Block] -> [String]
    flattenBlocks :: [Block] -> [String]
    flattenBlocks = [Block] -> [String]
    go0
      where
        go0 :: [Block] -> [String]
    go0 [] = []
        go0 (Block Margin
    _before Margin
    after [String]
    strs : [Block]
    blocks) = [String]
    strs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ Margin -> [Block] -> [String]
    go Margin
    after [Block]
    blocks

        go :: Margin -> [Block] -> [String]
    go Margin
    _surr' [] = []
        go Margin
    surr' (Block Margin
    before Margin
    after [String]
    strs : [Block]
    blocks) = [String] -> [String]
    ins ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    strs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ Margin -> [Block] -> [String]
    go Margin
    after [Block]
    blocks
          where
            ins :: [String] -> [String]
    ins
              | Margin
    surr' Margin -> Margin -> Margin
    forall a. Semigroup a => a -> a -> a
    <> Margin
    before Margin -> Margin -> Bool
    forall a. Eq a => a -> a -> Bool
    == Margin
    Margin = (String
    "" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :)
              | Bool
    otherwise = [String] -> [String]
    forall a. a -> a
    id

    renderField :: Opts ann -> Int -> PrettyField ann -> Block
    renderField :: forall ann. Opts ann -> Int -> PrettyField ann -> Block
    renderField (Opts ann -> CommentPosition
    rann String -> String
    indent ann -> [String] -> [String]
    post) Int
    fw (PrettyField ann
    ann FieldName
    name Doc
    doc) =
      Margin -> Margin -> [String] -> Block
    Block Margin
    before Margin
    after [String]
    content
      where
        content :: [String]
    content = case CommentPosition
    comments of
          CommentBefore [String]
    cs -> [String]
    cs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ ann -> [String] -> [String]
    post ann
    ann [String]
    lines'
          CommentAfter [String]
    cs -> ann -> [String] -> [String]
    post ann
    ann [String]
    lines' [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    cs
          CommentPosition
    NoComment -> ann -> [String] -> [String]
    post ann
    ann [String]
    lines'
        comments :: CommentPosition
    comments = ann -> CommentPosition
    rann ann
    ann
        before :: Margin
    before = case CommentPosition
    comments of
          CommentBefore [] -> Margin
    NoMargin
          CommentAfter [] -> Margin
    NoMargin
          CommentPosition
    NoComment -> Margin
    NoMargin
          CommentPosition
    _ -> Margin
    Margin

        ([String]
    lines', Margin
    after) = case String -> [String]
    lines String
    narrow of
          [] -> ([String
    name' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":"], Margin
    NoMargin)
          [String
    singleLine]
            | String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    singleLine Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    60 ->
                ([String
    name' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    fw Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    name') Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    narrow], Margin
    NoMargin)
          [String]
    _ -> ((String
    name' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":") String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    indent (String -> [String]
    lines (Doc -> String
    PP.render Doc
    doc)), Margin
    Margin)

        name' :: String
    name' = FieldName -> String
    fromUTF8BS FieldName
    name
        narrow :: String
    narrow = Style -> Doc -> String
    PP.renderStyle Style
    narrowStyle Doc
    doc

        narrowStyle :: PP.Style
        narrowStyle :: Style
    narrowStyle = Style
    PP.style{PP.lineLength = PP.lineLength PP.style - fw}
    renderField opts :: Opts ann
    opts@(Opts ann -> CommentPosition
    rann String -> String
    indent ann -> [String] -> [String]
    post) Int
    _ (PrettySection ann
    ann FieldName
    name [Doc]
    args [PrettyField ann]
    fields) =
      Margin -> Margin -> [String] -> Block
    Block Margin
    Margin Margin
    Margin ([String] -> Block) -> [String] -> Block
    forall a b. (a -> b) -> a -> b
    $
        [String] -> [String]
    attachComments
          (ann -> [String] -> [String]
    post ann
    ann [Doc -> String
    PP.render (Doc -> String) -> Doc -> String
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    PP.hsep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ String -> Doc
    PP.text (FieldName -> String
    fromUTF8BS FieldName
    name) Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : [Doc]
    args])
          [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    indent (Opts ann -> [PrettyField ann] -> [String]
    forall ann. Opts ann -> [PrettyField ann] -> [String]
    renderFields Opts ann
    opts [PrettyField ann]
    fields)
      where
        attachComments :: [String] -> [String]
    attachComments [String]
    content = case ann -> CommentPosition
    rann ann
    ann of
          CommentBefore [String]
    cs -> [String]
    cs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    content
          CommentAfter [String]
    cs -> [String]
    content [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    cs
          CommentPosition
    NoComment -> [String]
    content
    renderField Opts ann
    _ Int
    _ PrettyField ann
    PrettyEmpty = Margin -> Margin -> [String] -> Block
    Block Margin
    NoMargin Margin
    NoMargin [String]
    forall a. Monoid a => a
    mempty

    -------------------------------------------------------------------------------
    -- Transform from Parsec.Field
    -------------------------------------------------------------------------------

    genericFromParsecFields
      :: Applicative f
      => (FieldName -> [P.FieldLine ann] -> f PP.Doc)
      -- ^ transform field contents
      -> (FieldName -> [P.SectionArg ann] -> f [PP.Doc])
      -- ^ transform section arguments
      -> [P.Field ann]
      -> f [PrettyField ann]
    genericFromParsecFields :: forall (f :: * -> *) ann.
    Applicative f =>
    (FieldName -> [FieldLine ann] -> f Doc)
    -> (FieldName -> [SectionArg ann] -> f [Doc])
    -> [Field ann]
    -> f [PrettyField ann]
    genericFromParsecFields FieldName -> [FieldLine ann] -> f Doc
    f FieldName -> [SectionArg ann] -> f [Doc]
    g = [Field ann] -> f [PrettyField ann]
    goMany
      where
        goMany :: [Field ann] -> f [PrettyField ann]
    goMany = (Field ann -> f (PrettyField ann))
    -> [Field ann] -> f [PrettyField ann]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse Field ann -> f (PrettyField ann)
    go

        go :: Field ann -> f (PrettyField ann)
    go (P.Field (P.Name ann
    ann FieldName
    name) [FieldLine ann]
    fls) = ann -> FieldName -> Doc -> PrettyField ann
    forall ann. ann -> FieldName -> Doc -> PrettyField ann
    PrettyField ann
    ann FieldName
    name (Doc -> PrettyField ann) -> f Doc -> f (PrettyField ann)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FieldName -> [FieldLine ann] -> f Doc
    f FieldName
    name [FieldLine ann]
    fls
        go (P.Section (P.Name ann
    ann FieldName
    name) [SectionArg ann]
    secargs [Field ann]
    fs) = ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
    forall ann.
    ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
    PrettySection ann
    ann FieldName
    name ([Doc] -> [PrettyField ann] -> PrettyField ann)
    -> f [Doc] -> f ([PrettyField ann] -> PrettyField ann)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FieldName -> [SectionArg ann] -> f [Doc]
    g FieldName
    name [SectionArg ann]
    secargs f ([PrettyField ann] -> PrettyField ann)
    -> f [PrettyField ann] -> f (PrettyField ann)
    forall a b. f (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Field ann] -> f [PrettyField ann]
    goMany [Field ann]
    fs

    -- | Used in 'fromParsecFields'.
    prettyFieldLines :: FieldName -> [P.FieldLine ann] -> PP.Doc
    prettyFieldLines :: forall ann. FieldName -> [FieldLine ann] -> Doc
    prettyFieldLines FieldName
    _ [FieldLine ann]
    fls =
      [Doc] -> Doc
    PP.vcat
        [ String -> Doc
    PP.text (String -> Doc) -> String -> Doc
    forall a b. (a -> b) -> a -> b
    $ FieldName -> String
    fromUTF8BS FieldName
    bs
        | P.FieldLine ann
    _ FieldName
    bs <- [FieldLine ann]
    fls
        ]

    -- | Used in 'fromParsecFields'.
    prettySectionArgs :: FieldName -> [P.SectionArg ann] -> [PP.Doc]
    prettySectionArgs :: forall ann. FieldName -> [SectionArg ann] -> [Doc]
    prettySectionArgs FieldName
    _ = (SectionArg ann -> Doc) -> [SectionArg ann] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ((SectionArg ann -> Doc) -> [SectionArg ann] -> [Doc])
    -> (SectionArg ann -> Doc) -> [SectionArg ann] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ \case
      P.SecArgName ann
    _ FieldName
    bs -> String -> Doc
    showToken (String -> Doc) -> String -> Doc
    forall a b. (a -> b) -> a -> b
    $ FieldName -> String
    fromUTF8BS FieldName
    bs
      P.SecArgStr ann
    _ FieldName
    bs -> String -> Doc
    showToken (String -> Doc) -> String -> Doc
    forall a b. (a -> b) -> a -> b
    $ FieldName -> String
    fromUTF8BS FieldName
    bs
      P.SecArgOther ann
    _ FieldName
    bs -> String -> Doc
    PP.text (String -> Doc) -> String -> Doc
    forall a b. (a -> b) -> a -> b
    $ FieldName -> String
    fromUTF8BS FieldName
    bs

    -- | Simple variant of 'genericFromParsecField'
    fromParsecFields :: [P.Field ann] -> [PrettyField ann]
    fromParsecFields :: forall ann. [Field ann] -> [PrettyField ann]
    fromParsecFields =
      Identity [PrettyField ann] -> [PrettyField ann]
    forall a. Identity a -> a
    runIdentity
        (Identity [PrettyField ann] -> [PrettyField ann])
    -> ([Field ann] -> Identity [PrettyField ann])
    -> [Field ann]
    -> [PrettyField ann]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FieldName -> [FieldLine ann] -> Identity Doc)
    -> (FieldName -> [SectionArg ann] -> Identity [Doc])
    -> [Field ann]
    -> Identity [PrettyField ann]
    forall (f :: * -> *) ann.
    Applicative f =>
    (FieldName -> [FieldLine ann] -> f Doc)
    -> (FieldName -> [SectionArg ann] -> f [Doc])
    -> [Field ann]
    -> f [PrettyField ann]
    genericFromParsecFields
          (Doc -> Identity Doc
    forall a. a -> Identity a
    Identity (Doc -> Identity Doc)
    -> (FieldName -> [FieldLine ann] -> Doc)
    -> FieldName
    -> [FieldLine ann]
    -> Identity Doc
    forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
    .: FieldName -> [FieldLine ann] -> Doc
    forall ann. FieldName -> [FieldLine ann] -> Doc
    prettyFieldLines)
          ([Doc] -> Identity [Doc]
    forall a. a -> Identity a
    Identity ([Doc] -> Identity [Doc])
    -> (FieldName -> [SectionArg ann] -> [Doc])
    -> FieldName
    -> [SectionArg ann]
    -> Identity [Doc]
    forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
    .: FieldName -> [SectionArg ann] -> [Doc]
    forall ann. FieldName -> [SectionArg ann] -> [Doc]
    prettySectionArgs)
      where
        (.:) :: (a -> b) -> (c -> d -> a) -> (c -> d -> b)
        (a -> b
    f .: :: forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
    .: c -> d -> a
    g) c
    x d
    y = a -> b
    f (c -> d -> a
    g c
    x d
    y)