    {-# LANGUAGE NoImplicitPrelude          #-}
    {-# LANGUAGE DefaultSignatures          #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE RankNTypes                 #-}
    {-# LANGUAGE ScopedTypeVariables        #-}
    {-# LANGUAGE TypeFamilies               #-}
    {-# LANGUAGE UndecidableInstances       #-}

    -- | This module is based, in part, on some of the interface for

    -- "Text.PrettyPrint.Annotated.Leijen".

    --

    module Text.PrettyPrint.Leijen.Extended
      (
        -- * Pretty-print typeclass

        Pretty (..)

        -- * Documents annotated by a style

      , StyleDoc (..)
      , StyleAnn (..)
      , displayAnsi
      , displayPlain
      , renderDefault

        -- * Selective use of the "Text.PrettyPrint.Annotated.Leijen" interface

        --

        -- | Documented omissions by reference to package

        -- @annotated-wl-pprint-0.7.0@.

        -- ** Documents, parametrized by their annotations

        --

        -- | Omitted compared to original:

        --

        -- @

        -- Doc, putDoc, hPutDoc

        -- @

        -- ** Basic combinators

        --

        -- | Omitted compared to the original:

        --

        -- @

        -- empty, char, text, (<>)

        -- @

        --

        -- Instead of @empty@, use 'mempty'.

        --

        -- Instead of @char@ and @text@, use 'fromString'.

        --

        -- A 'Monoid' instance for 'StyleDoc' is defined.

      , nest
      , line
      , linebreak
      , group
      , softline
      , softbreak

        -- ** Alignment

        --

        -- | The combinators in this section can not be described by Wadler's

        -- original combinators. They align their output relative to the current

        -- output position - in contrast to 'nest' which always aligns to the

        -- current nesting level. This deprives these combinators from being

        -- \`optimal\'. In practice however they prove to be very useful. The

        -- combinators in this section should be used with care, since they are more

        -- expensive than the other combinators. For example, 'align' shouldn't be

        -- used to pretty print all top-level declarations of a language, but using

        -- 'hang' for @let@ expressions is fine.

        --

        -- Omitted compared to the original:

        --

        -- @

        -- list, tupled, semiBraces

        -- @

      , align
      , hang
      , indent
      , encloseSep

        -- ** Operators

        --

        -- | Omitted compared to the original:

        --

        -- @

        -- (\<$\>), (\<\/\>), (\<$$\>), (\<\/\/\>)

        -- @

      , (<+>)

        -- ** List combinators

      , hsep
      , vsep
      , fillSep
      , sep
      , hcat
      , vcat
      , fillCat
      , cat
      , punctuate

        -- ** Fillers

      , fill
      , fillBreak

        -- ** Bracketing combinators

      , enclose
      , squotes
      , dquotes
      , parens
      , angles
      , braces
      , brackets

        -- ** Character documents

        -- | Entirely omitted:

        --

        -- @

        -- lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket,

        -- squote, dquote, semi, colon, comma, space, dot, backslash, equals,

        -- pipe

        -- @

        -- ** Primitive type documents

        -- | Omitted compared to the original:

        --

        -- @

        -- int, integer, float, double, rational, bool

        -- @

      , string

        -- ** Semantic annotations

      , annotate
      , noAnnotate
      , styleAnn

      -- ** Rendering

      -- | Entirely omitted:

      --

      -- @

      -- SimpleDoc (..), renderPretty, renderCompact, displayDecorated,

      -- displayDecoratedA, display, displayS, displayIO, SpanList (..),

      -- displaySpans

      -- @

      -- ** Undocumented

      -- | Entirely omitted:

      --

      -- @

      -- column, nesting, width

      -- @

      ) where

    import           Control.Monad.Reader ( local, runReader )
    import           Data.Array.IArray ( (!), (//) )
    import qualified Data.Text as T
    import           Distribution.ModuleName ( ModuleName )
    import           Distribution.System ( Arch (..), OS (..) )
    import qualified Distribution.Text ( display )
    import           Distribution.Utils.Generic ( lowercase )
    import           Path ( Dir, File, Path, SomeBase, prjSomeBase, toFilePath )
    import           RIO
    import qualified RIO.Map as M
    import           RIO.PrettyPrint.DefaultStyles ( defaultStyles )
    import           RIO.PrettyPrint.Types ( Style (Dir, File), Styles )
    import           RIO.PrettyPrint.StylesUpdate
                       ( HasStylesUpdate, StylesUpdate (..), stylesUpdateL )
    import           System.Console.ANSI ( ConsoleLayer (..), SGR (..), setSGRCode )
    import qualified Text.PrettyPrint.Annotated.Leijen as P
    import           Text.PrettyPrint.Annotated.Leijen ( Doc, SimpleDoc (..) )

    -- TODO: consider smashing together the code for wl-annotated-pprint and

    -- wl-pprint-text. The code here already handles doing the

    -- ansi-wl-pprint stuff (better!) atop wl-annotated-pprint. So the

    -- result would be a package unifying 3 different wl inspired packages.

    --

    -- Perhaps it can still have native string support, by adding a type

    -- parameter to Doc?

    instance Semigroup StyleDoc where
      StyleDoc Doc StyleAnn
    x <> :: StyleDoc -> StyleDoc -> StyleDoc
    <> StyleDoc Doc StyleAnn
    y = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn
    x Doc StyleAnn -> Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a -> Doc a
    P.<> Doc StyleAnn
    y)

    instance Monoid StyleDoc where
      mappend :: StyleDoc -> StyleDoc -> StyleDoc
    mappend = StyleDoc -> StyleDoc -> StyleDoc
    forall a. Semigroup a => a -> a -> a
    (<>)
      mempty :: StyleDoc
    mempty = Doc StyleAnn -> StyleDoc
    StyleDoc Doc StyleAnn
    forall a. Doc a
    P.empty

    --------------------------------------------------------------------------------

    -- Pretty-Print class

    class Pretty a where
      pretty :: a -> StyleDoc
      default pretty :: Show a => a -> StyleDoc
      pretty = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc) -> (a -> Doc StyleAnn) -> a -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc StyleAnn
    forall a. IsString a => String -> a
    fromString (String -> Doc StyleAnn) -> (a -> String) -> a -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

    instance Pretty StyleDoc where
      pretty :: StyleDoc -> StyleDoc
    pretty = StyleDoc -> StyleDoc
    forall a. a -> a
    id

    instance Pretty (Path b File) where
      pretty :: Path b File -> StyleDoc
    pretty = Style -> StyleDoc -> StyleDoc
    styleAnn Style
    File (StyleDoc -> StyleDoc)
    -> (Path b File -> StyleDoc) -> Path b File -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (Path b File -> Doc StyleAnn) -> Path b File -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc StyleAnn
    forall a. IsString a => String -> a
    fromString (String -> Doc StyleAnn)
    -> (Path b File -> String) -> Path b File -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path b File -> String
    forall b t. Path b t -> String
    toFilePath

    instance Pretty (Path b Dir) where
      pretty :: Path b Dir -> StyleDoc
    pretty = Style -> StyleDoc -> StyleDoc
    styleAnn Style
    Dir (StyleDoc -> StyleDoc)
    -> (Path b Dir -> StyleDoc) -> Path b Dir -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (Path b Dir -> Doc StyleAnn) -> Path b Dir -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc StyleAnn
    forall a. IsString a => String -> a
    fromString (String -> Doc StyleAnn)
    -> (Path b Dir -> String) -> Path b Dir -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path b Dir -> String
    forall b t. Path b t -> String
    toFilePath

    instance Pretty (SomeBase File) where
      pretty :: SomeBase File -> StyleDoc
    pretty = (forall b. Path b File -> StyleDoc) -> SomeBase File -> StyleDoc
    forall t a. (forall b. Path b t -> a) -> SomeBase t -> a
    prjSomeBase Path b File -> StyleDoc
    forall b. Path b File -> StyleDoc
    forall a. Pretty a => a -> StyleDoc
    pretty

    instance Pretty (SomeBase Dir) where
      pretty :: SomeBase Dir -> StyleDoc
    pretty = (forall b. Path b Dir -> StyleDoc) -> SomeBase Dir -> StyleDoc
    forall t a. (forall b. Path b t -> a) -> SomeBase t -> a
    prjSomeBase Path b Dir -> StyleDoc
    forall b. Path b Dir -> StyleDoc
    forall a. Pretty a => a -> StyleDoc
    pretty

    instance Pretty ModuleName where
      pretty :: ModuleName -> StyleDoc
    pretty = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (ModuleName -> Doc StyleAnn) -> ModuleName -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc StyleAnn
    forall a. IsString a => String -> a
    fromString (String -> Doc StyleAnn)
    -> (ModuleName -> String) -> ModuleName -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName -> String
    forall a. Pretty a => a -> String
    Distribution.Text.display

    instance Pretty Arch where
      pretty :: Arch -> StyleDoc
    pretty (OtherArch String
    name) = String -> StyleDoc
    forall a. IsString a => String -> a
    fromString String
    name
      pretty Arch
    other = String -> StyleDoc
    forall a. IsString a => String -> a
    fromString (String -> StyleDoc) -> String -> StyleDoc
    forall a b. (a -> b) -> a -> b
    $ String -> String
    lowercase (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Arch -> String
    forall a. Show a => a -> String
    show Arch
    other

    instance Pretty OS where
      pretty :: OS -> StyleDoc
    pretty (OtherOS String
    name) = String -> StyleDoc
    forall a. IsString a => String -> a
    fromString String
    name
      pretty OS
    other = String -> StyleDoc
    forall a. IsString a => String -> a
    fromString (String -> StyleDoc) -> String -> StyleDoc
    forall a b. (a -> b) -> a -> b
    $ String -> String
    lowercase (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ OS -> String
    forall a. Show a => a -> String
    show OS
    other

    --------------------------------------------------------------------------------

    -- Style Doc

    -- | A style annotation.

    newtype StyleAnn = StyleAnn (Maybe Style)
      deriving (StyleAnn -> StyleAnn -> Bool
    (StyleAnn -> StyleAnn -> Bool)
    -> (StyleAnn -> StyleAnn -> Bool) -> Eq StyleAnn
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: StyleAnn -> StyleAnn -> Bool
    == :: StyleAnn -> StyleAnn -> Bool
    $c/= :: StyleAnn -> StyleAnn -> Bool
    /= :: StyleAnn -> StyleAnn -> Bool
    Eq, Int -> StyleAnn -> String -> String
    [StyleAnn] -> String -> String
    StyleAnn -> String
    (Int -> StyleAnn -> String -> String)
    -> (StyleAnn -> String)
    -> ([StyleAnn] -> String -> String)
    -> Show StyleAnn
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> StyleAnn -> String -> String
    showsPrec :: Int -> StyleAnn -> String -> String
    $cshow :: StyleAnn -> String
    show :: StyleAnn -> String
    $cshowList :: [StyleAnn] -> String -> String
    showList :: [StyleAnn] -> String -> String
    Show, NonEmpty StyleAnn -> StyleAnn
    StyleAnn -> StyleAnn -> StyleAnn
    (StyleAnn -> StyleAnn -> StyleAnn)
    -> (NonEmpty StyleAnn -> StyleAnn)
    -> (forall b. Integral b => b -> StyleAnn -> StyleAnn)
    -> Semigroup StyleAnn
    forall b. Integral b => b -> StyleAnn -> StyleAnn
    forall a.
    (a -> a -> a)
    -> (NonEmpty a -> a)
    -> (forall b. Integral b => b -> a -> a)
    -> Semigroup a
    $c<> :: StyleAnn -> StyleAnn -> StyleAnn
    <> :: StyleAnn -> StyleAnn -> StyleAnn
    $csconcat :: NonEmpty StyleAnn -> StyleAnn
    sconcat :: NonEmpty StyleAnn -> StyleAnn
    $cstimes :: forall b. Integral b => b -> StyleAnn -> StyleAnn
    stimes :: forall b. Integral b => b -> StyleAnn -> StyleAnn
    Semigroup)

    instance Monoid StyleAnn where
      mempty :: StyleAnn
    mempty = Maybe Style -> StyleAnn
    StyleAnn Maybe Style
    forall a. Maybe a
    Nothing
      mappend :: StyleAnn -> StyleAnn -> StyleAnn
    mappend = StyleAnn -> StyleAnn -> StyleAnn
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- | A document annotated by a style.

    newtype StyleDoc = StyleDoc { StyleDoc -> Doc StyleAnn
    unStyleDoc :: Doc StyleAnn }
      deriving (String -> StyleDoc
    (String -> StyleDoc) -> IsString StyleDoc
    forall a. (String -> a) -> IsString a
    $cfromString :: String -> StyleDoc
    fromString :: String -> StyleDoc
    IsString, Int -> StyleDoc -> String -> String
    [StyleDoc] -> String -> String
    StyleDoc -> String
    (Int -> StyleDoc -> String -> String)
    -> (StyleDoc -> String)
    -> ([StyleDoc] -> String -> String)
    -> Show StyleDoc
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> StyleDoc -> String -> String
    showsPrec :: Int -> StyleDoc -> String -> String
    $cshow :: StyleDoc -> String
    show :: StyleDoc -> String
    $cshowList :: [StyleDoc] -> String -> String
    showList :: [StyleDoc] -> String -> String
    Show)

    -- | An ANSI code(s) annotation.

    newtype AnsiAnn = AnsiAnn [SGR]
      deriving (AnsiAnn -> AnsiAnn -> Bool
    (AnsiAnn -> AnsiAnn -> Bool)
    -> (AnsiAnn -> AnsiAnn -> Bool) -> Eq AnsiAnn
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AnsiAnn -> AnsiAnn -> Bool
    == :: AnsiAnn -> AnsiAnn -> Bool
    $c/= :: AnsiAnn -> AnsiAnn -> Bool
    /= :: AnsiAnn -> AnsiAnn -> Bool
    Eq, Int -> AnsiAnn -> String -> String
    [AnsiAnn] -> String -> String
    AnsiAnn -> String
    (Int -> AnsiAnn -> String -> String)
    -> (AnsiAnn -> String)
    -> ([AnsiAnn] -> String -> String)
    -> Show AnsiAnn
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> AnsiAnn -> String -> String
    showsPrec :: Int -> AnsiAnn -> String -> String
    $cshow :: AnsiAnn -> String
    show :: AnsiAnn -> String
    $cshowList :: [AnsiAnn] -> String -> String
    showList :: [AnsiAnn] -> String -> String
    Show, NonEmpty AnsiAnn -> AnsiAnn
    AnsiAnn -> AnsiAnn -> AnsiAnn
    (AnsiAnn -> AnsiAnn -> AnsiAnn)
    -> (NonEmpty AnsiAnn -> AnsiAnn)
    -> (forall b. Integral b => b -> AnsiAnn -> AnsiAnn)
    -> Semigroup AnsiAnn
    forall b. Integral b => b -> AnsiAnn -> AnsiAnn
    forall a.
    (a -> a -> a)
    -> (NonEmpty a -> a)
    -> (forall b. Integral b => b -> a -> a)
    -> Semigroup a
    $c<> :: AnsiAnn -> AnsiAnn -> AnsiAnn
    <> :: AnsiAnn -> AnsiAnn -> AnsiAnn
    $csconcat :: NonEmpty AnsiAnn -> AnsiAnn
    sconcat :: NonEmpty AnsiAnn -> AnsiAnn
    $cstimes :: forall b. Integral b => b -> AnsiAnn -> AnsiAnn
    stimes :: forall b. Integral b => b -> AnsiAnn -> AnsiAnn
    Semigroup, Semigroup AnsiAnn
    AnsiAnn
    Semigroup AnsiAnn =>
    AnsiAnn
    -> (AnsiAnn -> AnsiAnn -> AnsiAnn)
    -> ([AnsiAnn] -> AnsiAnn)
    -> Monoid AnsiAnn
    [AnsiAnn] -> AnsiAnn
    AnsiAnn -> AnsiAnn -> AnsiAnn
    forall a.
    Semigroup a =>
    a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
    $cmempty :: AnsiAnn
    mempty :: AnsiAnn
    $cmappend :: AnsiAnn -> AnsiAnn -> AnsiAnn
    mappend :: AnsiAnn -> AnsiAnn -> AnsiAnn
    $cmconcat :: [AnsiAnn] -> AnsiAnn
    mconcat :: [AnsiAnn] -> AnsiAnn
    Monoid)

    -- | Convert a 'SimpleDoc' annotated with 'StyleAnn' to one annotated with

    -- 'AnsiAnn', by reference to a 'Styles'.

    toAnsiDoc :: Styles -> SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    toAnsiDoc :: Styles -> SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    toAnsiDoc Styles
    styles = SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    go
     where
      go :: SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    go SimpleDoc StyleAnn
    SEmpty        = SimpleDoc AnsiAnn
    forall a. SimpleDoc a
    SEmpty
      go (SChar Char
    c SimpleDoc StyleAnn
    d)   = Char -> SimpleDoc AnsiAnn -> SimpleDoc AnsiAnn
    forall a. Char -> SimpleDoc a -> SimpleDoc a
    SChar Char
    c (SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    go SimpleDoc StyleAnn
    d)
      go (SText Int
    l String
    s SimpleDoc StyleAnn
    d) = Int -> String -> SimpleDoc AnsiAnn -> SimpleDoc AnsiAnn
    forall a. Int -> String -> SimpleDoc a -> SimpleDoc a
    SText Int
    l String
    s (SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    go SimpleDoc StyleAnn
    d)
      go (SLine Int
    i SimpleDoc StyleAnn
    d)   = Int -> SimpleDoc AnsiAnn -> SimpleDoc AnsiAnn
    forall a. Int -> SimpleDoc a -> SimpleDoc a
    SLine Int
    i (SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    go SimpleDoc StyleAnn
    d)
      go (SAnnotStart (StyleAnn (Just Style
    s)) SimpleDoc StyleAnn
    d) =
        AnsiAnn -> SimpleDoc AnsiAnn -> SimpleDoc AnsiAnn
    forall a. a -> SimpleDoc a -> SimpleDoc a
    SAnnotStart ([SGR] -> AnsiAnn
    AnsiAnn ((Text, [SGR]) -> [SGR]
    forall a b. (a, b) -> b
    snd ((Text, [SGR]) -> [SGR]) -> (Text, [SGR]) -> [SGR]
    forall a b. (a -> b) -> a -> b
    $ Styles
    styles Styles -> Style -> (Text, [SGR])
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    ! Style
    s)) (SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    go SimpleDoc StyleAnn
    d)
      go (SAnnotStart (StyleAnn Maybe Style
    Nothing) SimpleDoc StyleAnn
    d) = AnsiAnn -> SimpleDoc AnsiAnn -> SimpleDoc AnsiAnn
    forall a. a -> SimpleDoc a -> SimpleDoc a
    SAnnotStart ([SGR] -> AnsiAnn
    AnsiAnn []) (SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    go SimpleDoc StyleAnn
    d)
      go (SAnnotStop SimpleDoc StyleAnn
    d) = SimpleDoc AnsiAnn -> SimpleDoc AnsiAnn
    forall a. SimpleDoc a -> SimpleDoc a
    SAnnotStop (SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    go SimpleDoc StyleAnn
    d)

    displayPlain ::
         ( Pretty a, HasLogFunc env, HasStylesUpdate env, MonadReader env m
         , HasCallStack
         )
      => Int -> a -> m Utf8Builder
    displayPlain :: forall a env (m :: * -> *).
    (Pretty a, HasLogFunc env, HasStylesUpdate env, MonadReader env m,
     HasCallStack) =>
    Int -> a -> m Utf8Builder
    displayPlain Int
    w =
      SimpleDoc StyleAnn -> m Utf8Builder
    forall env (m :: * -> *).
    (HasLogFunc env, HasStylesUpdate env, MonadReader env m,
     HasCallStack) =>
    SimpleDoc StyleAnn -> m Utf8Builder
    displayAnsiSimple (SimpleDoc StyleAnn -> m Utf8Builder)
    -> (a -> SimpleDoc StyleAnn) -> a -> m Utf8Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Doc StyleAnn -> SimpleDoc StyleAnn
    forall a. Int -> Doc a -> SimpleDoc a
    renderDefault Int
    w (Doc StyleAnn -> SimpleDoc StyleAnn)
    -> (a -> Doc StyleAnn) -> a -> SimpleDoc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleAnn -> StyleAnn) -> Doc StyleAnn -> Doc StyleAnn
    forall a b. (a -> b) -> Doc a -> Doc b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (StyleAnn -> StyleAnn -> StyleAnn
    forall a b. a -> b -> a
    const StyleAnn
    forall a. Monoid a => a
    mempty) (Doc StyleAnn -> Doc StyleAnn)
    -> (a -> Doc StyleAnn) -> a -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc (StyleDoc -> Doc StyleAnn) -> (a -> StyleDoc) -> a -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> StyleDoc
    forall a. Pretty a => a -> StyleDoc
    pretty

    -- TODO: tweak these settings more?

    -- TODO: options for settings if this is released as a lib

    renderDefault :: Int -> Doc a -> SimpleDoc a
    renderDefault :: forall a. Int -> Doc a -> SimpleDoc a
    renderDefault = Float -> Int -> Doc a -> SimpleDoc a
    forall a. Float -> Int -> Doc a -> SimpleDoc a
    P.renderPretty Float
    1

    displayAnsi ::
         ( Pretty a, HasLogFunc env, HasStylesUpdate env, MonadReader env m
         , HasCallStack
         )
      => Int -> a -> m Utf8Builder
    displayAnsi :: forall a env (m :: * -> *).
    (Pretty a, HasLogFunc env, HasStylesUpdate env, MonadReader env m,
     HasCallStack) =>
    Int -> a -> m Utf8Builder
    displayAnsi Int
    w =
      SimpleDoc StyleAnn -> m Utf8Builder
    forall env (m :: * -> *).
    (HasLogFunc env, HasStylesUpdate env, MonadReader env m,
     HasCallStack) =>
    SimpleDoc StyleAnn -> m Utf8Builder
    displayAnsiSimple (SimpleDoc StyleAnn -> m Utf8Builder)
    -> (a -> SimpleDoc StyleAnn) -> a -> m Utf8Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Doc StyleAnn -> SimpleDoc StyleAnn
    forall a. Int -> Doc a -> SimpleDoc a
    renderDefault Int
    w (Doc StyleAnn -> SimpleDoc StyleAnn)
    -> (a -> Doc StyleAnn) -> a -> SimpleDoc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc (StyleDoc -> Doc StyleAnn) -> (a -> StyleDoc) -> a -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> StyleDoc
    forall a. Pretty a => a -> StyleDoc
    pretty

    {- Not used --------------------------------------------------------------------

    hDisplayAnsi
        :: (Display a, HasAnsiAnn (Ann a), MonadIO m)
        => Handle -> Int -> a -> m ()
    hDisplayAnsi h w x = liftIO $ do
        useAnsi <- hSupportsANSI h
        T.hPutStr h $ if useAnsi then displayAnsi w x else displayPlain w x

    -}

    displayAnsiSimple ::
         (HasLogFunc env, HasStylesUpdate env, MonadReader env m, HasCallStack)
      => SimpleDoc StyleAnn
      -> m Utf8Builder
    displayAnsiSimple :: forall env (m :: * -> *).
    (HasLogFunc env, HasStylesUpdate env, MonadReader env m,
     HasCallStack) =>
    SimpleDoc StyleAnn -> m Utf8Builder
    displayAnsiSimple SimpleDoc StyleAnn
    doc = do
      update <- Getting StylesUpdate env StylesUpdate -> m StylesUpdate
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting StylesUpdate env StylesUpdate
    forall env. HasStylesUpdate env => Lens' env StylesUpdate
    Lens' env StylesUpdate
    stylesUpdateL
      let styles = Styles
    defaultStyles Styles -> [(Style, (Text, [SGR]))] -> Styles
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)] -> a i e
    // StylesUpdate -> [(Style, (Text, [SGR]))]
    stylesUpdate StylesUpdate
    update
          doc' = Styles -> SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
    toAnsiDoc Styles
    styles SimpleDoc StyleAnn
    doc
      return $ flip runReader mempty $ displayDecoratedWrap go doc'
     where
      go :: AnsiAnn -> m (a, b) -> m (a, b)
    go (AnsiAnn [SGR]
    sgrs) m (a, b)
    inner = do
        old <- m (Map SGRTag SGR)
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        let sgrs' = (SGR -> Maybe (SGRTag, SGR)) -> [SGR] -> [(SGRTag, SGR)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (\SGR
    sgr -> if SGR
    sgr SGR -> SGR -> Bool
    forall a. Eq a => a -> a -> Bool
    == SGR
    Reset
                                        then Maybe (SGRTag, SGR)
    forall a. Maybe a
    Nothing
                                        else (SGRTag, SGR) -> Maybe (SGRTag, SGR)
    forall a. a -> Maybe a
    Just (SGR -> SGRTag
    getSGRTag SGR
    sgr, SGR
    sgr)) [SGR]
    sgrs
            new = if SGR
    Reset SGR -> [SGR] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [SGR]
    sgrs
                    then [(SGRTag, SGR)] -> Map SGRTag SGR
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(SGRTag, SGR)]
    sgrs'
                    else (Map SGRTag SGR -> (SGRTag, SGR) -> Map SGRTag SGR)
    -> Map SGRTag SGR -> [(SGRTag, SGR)] -> Map SGRTag SGR
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Map SGRTag SGR
    mp (SGRTag
    tag, SGR
    sgr) -> SGRTag -> SGR -> Map SGRTag SGR -> Map SGRTag SGR
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert SGRTag
    tag SGR
    sgr Map SGRTag SGR
    mp) Map SGRTag SGR
    old [(SGRTag, SGR)]
    sgrs'
        (extra, contents) <- local (const new) inner
        return (extra, transitionCodes old new <> contents <> transitionCodes new old)
      transitionCodes :: Map k SGR -> Map k SGR -> a
    transitionCodes Map k SGR
    old Map k SGR
    new =
        case ([SGR] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SGR]
    removals, [SGR] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SGR]
    additions) of
          (Bool
    True, Bool
    True) -> a
    forall a. Monoid a => a
    mempty
          (Bool
    True, Bool
    False) -> String -> a
    forall a. IsString a => String -> a
    fromString ([SGR] -> String
    setSGRCode [SGR]
    additions)
          (Bool
    False, Bool
    _) -> String -> a
    forall a. IsString a => String -> a
    fromString ([SGR] -> String
    setSGRCode (SGR
    Reset SGR -> [SGR] -> [SGR]
    forall a. a -> [a] -> [a]
    : Map k SGR -> [SGR]
    forall k a. Map k a -> [a]
    M.elems Map k SGR
    new))
       where
        ([SGR]
    removals, [SGR]
    additions) = [Either SGR SGR] -> ([SGR], [SGR])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers ([Either SGR SGR] -> ([SGR], [SGR]))
    -> [Either SGR SGR] -> ([SGR], [SGR])
    forall a b. (a -> b) -> a -> b
    $ Map k (Either SGR SGR) -> [Either SGR SGR]
    forall k a. Map k a -> [a]
    M.elems (Map k (Either SGR SGR) -> [Either SGR SGR])
    -> Map k (Either SGR SGR) -> [Either SGR SGR]
    forall a b. (a -> b) -> a -> b
    $
          (k -> SGR -> SGR -> Maybe (Either SGR SGR))
    -> (Map k SGR -> Map k (Either SGR SGR))
    -> (Map k SGR -> Map k (Either SGR SGR))
    -> Map k SGR
    -> Map k SGR
    -> Map k (Either SGR SGR)
    forall k a b c.
    Ord k =>
    (k -> a -> b -> Maybe c)
    -> (Map k a -> Map k c)
    -> (Map k b -> Map k c)
    -> Map k a
    -> Map k b
    -> Map k c
    M.mergeWithKey
            (\k
    _ SGR
    o SGR
    n -> if SGR
    o SGR -> SGR -> Bool
    forall a. Eq a => a -> a -> Bool
    == SGR
    n then Maybe (Either SGR SGR)
    forall a. Maybe a
    Nothing else Either SGR SGR -> Maybe (Either SGR SGR)
    forall a. a -> Maybe a
    Just (SGR -> Either SGR SGR
    forall a b. b -> Either a b
    Right SGR
    n))
            ((SGR -> Either SGR SGR) -> Map k SGR -> Map k (Either SGR SGR)
    forall a b. (a -> b) -> Map k a -> Map k b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap SGR -> Either SGR SGR
    forall a b. a -> Either a b
    Left)
            ((SGR -> Either SGR SGR) -> Map k SGR -> Map k (Either SGR SGR)
    forall a b. (a -> b) -> Map k a -> Map k b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap SGR -> Either SGR SGR
    forall a b. b -> Either a b
    Right)
            Map k SGR
    old
            Map k SGR
    new

    displayDecoratedWrap ::
         forall a m. Monad m
      => (forall b. a -> m (b, Utf8Builder) -> m (b, Utf8Builder))
      -> SimpleDoc a
      -> m Utf8Builder
    displayDecoratedWrap :: forall a (m :: * -> *).
    Monad m =>
    (forall b. a -> m (b, Utf8Builder) -> m (b, Utf8Builder))
    -> SimpleDoc a -> m Utf8Builder
    displayDecoratedWrap forall b. a -> m (b, Utf8Builder) -> m (b, Utf8Builder)
    f SimpleDoc a
    doc = do
      (mafter, result) <- SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
    go SimpleDoc a
    doc
      case mafter of
        Just SimpleDoc a
    _ -> String -> m Utf8Builder
    forall a. HasCallStack => String -> a
    error String
    "Invariant violated by input to displayDecoratedWrap: no \
                        \matching SAnnotStart for SAnnotStop."
        Maybe (SimpleDoc a)
    Nothing -> Utf8Builder -> m Utf8Builder
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Utf8Builder
    result
     where
      spaces :: Int -> Utf8Builder
    spaces Int
    n = Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display (Int -> Text -> Text
    T.replicate Int
    n Text
    " ")

      go :: SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
      go :: SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
    go SimpleDoc a
    SEmpty = (Maybe (SimpleDoc a), Utf8Builder)
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (SimpleDoc a)
    forall a. Maybe a
    Nothing, Utf8Builder
    forall a. Monoid a => a
    mempty)
      go (SChar Char
    c SimpleDoc a
    x) = ((Maybe (SimpleDoc a), Utf8Builder)
     -> (Maybe (SimpleDoc a), Utf8Builder))
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Utf8Builder -> Utf8Builder)
    -> (Maybe (SimpleDoc a), Utf8Builder)
    -> (Maybe (SimpleDoc a), Utf8Builder)
    forall a b.
    (a -> b) -> (Maybe (SimpleDoc a), a) -> (Maybe (SimpleDoc a), b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Char -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Char
    c Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>)) (SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
    go SimpleDoc a
    x)
      -- NOTE: Could actually use the length to guess at an initial

      -- allocation.  Better yet would be to just use Text in pprint..

      go (SText Int
    _l String
    s SimpleDoc a
    x) = ((Maybe (SimpleDoc a), Utf8Builder)
     -> (Maybe (SimpleDoc a), Utf8Builder))
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Utf8Builder -> Utf8Builder)
    -> (Maybe (SimpleDoc a), Utf8Builder)
    -> (Maybe (SimpleDoc a), Utf8Builder)
    forall a b.
    (a -> b) -> (Maybe (SimpleDoc a), a) -> (Maybe (SimpleDoc a), b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString String
    s Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>)) (SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
    go SimpleDoc a
    x)
      go (SLine Int
    n SimpleDoc a
    x) = ((Maybe (SimpleDoc a), Utf8Builder)
     -> (Maybe (SimpleDoc a), Utf8Builder))
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Utf8Builder -> Utf8Builder)
    -> (Maybe (SimpleDoc a), Utf8Builder)
    -> (Maybe (SimpleDoc a), Utf8Builder)
    forall a b.
    (a -> b) -> (Maybe (SimpleDoc a), a) -> (Maybe (SimpleDoc a), b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Char -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Char
    '\n' Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>) (Utf8Builder -> Utf8Builder)
    -> (Utf8Builder -> Utf8Builder) -> Utf8Builder -> Utf8Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Utf8Builder
    spaces Int
    n Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>))) (SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
    go SimpleDoc a
    x)
      go (SAnnotStart a
    ann SimpleDoc a
    x) = do
        (mafter, contents) <- a
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    forall b. a -> m (b, Utf8Builder) -> m (b, Utf8Builder)
    f a
    ann (SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
    go SimpleDoc a
    x)
        case mafter of
          Just SimpleDoc a
    after -> ((Maybe (SimpleDoc a), Utf8Builder)
     -> (Maybe (SimpleDoc a), Utf8Builder))
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Utf8Builder -> Utf8Builder)
    -> (Maybe (SimpleDoc a), Utf8Builder)
    -> (Maybe (SimpleDoc a), Utf8Builder)
    forall a b.
    (a -> b) -> (Maybe (SimpleDoc a), a) -> (Maybe (SimpleDoc a), b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Utf8Builder
    contents Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>)) (SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
    go SimpleDoc a
    after)
          Maybe (SimpleDoc a)
    Nothing -> String -> m (Maybe (SimpleDoc a), Utf8Builder)
    forall a. HasCallStack => String -> a
    error String
    "Invariant violated by input to displayDecoratedWrap: \
                           \no matching SAnnotStop for SAnnotStart."
      go (SAnnotStop SimpleDoc a
    x) = (Maybe (SimpleDoc a), Utf8Builder)
    -> m (Maybe (SimpleDoc a), Utf8Builder)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimpleDoc a -> Maybe (SimpleDoc a)
    forall a. a -> Maybe a
    Just SimpleDoc a
    x, Utf8Builder
    forall a. Monoid a => a
    mempty)

    {- Not used --------------------------------------------------------------------

    -- Foreground color combinators

    black, red, green, yellow, blue, magenta, cyan, white,
        dullblack, dullred, dullgreen, dullyellow, dullblue, dullmagenta, dullcyan, dullwhite,
        onblack, onred, ongreen, onyellow, onblue, onmagenta, oncyan, onwhite,
        ondullblack, ondullred, ondullgreen, ondullyellow, ondullblue, ondullmagenta, ondullcyan, ondullwhite
        :: Doc AnsiAnn -> Doc AnsiAnn
    (black, dullblack, onblack, ondullblack) = colorFunctions Black
    (red, dullred, onred, ondullred) = colorFunctions Red
    (green, dullgreen, ongreen, ondullgreen) = colorFunctions Green
    (yellow, dullyellow, onyellow, ondullyellow) = colorFunctions Yellow
    (blue, dullblue, onblue, ondullblue) = colorFunctions Blue
    (magenta, dullmagenta, onmagenta, ondullmagenta) = colorFunctions Magenta
    (cyan, dullcyan, oncyan, ondullcyan) = colorFunctions Cyan
    (white, dullwhite, onwhite, ondullwhite) = colorFunctions White

    type EndoAnsiDoc = Doc AnsiAnn -> Doc AnsiAnn

    colorFunctions :: Color -> (EndoAnsiDoc, EndoAnsiDoc, EndoAnsiDoc, EndoAnsiDoc)
    colorFunctions color =
        ( ansiAnn [SetColor Foreground Vivid color]
        , ansiAnn [SetColor Foreground Dull color]
        , ansiAnn [SetColor Background Vivid color]
        , ansiAnn [SetColor Background Dull color]
        )

    -}

    styleAnn :: Style -> StyleDoc -> StyleDoc
    styleAnn :: Style -> StyleDoc -> StyleDoc
    styleAnn Style
    s = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleAnn -> Doc StyleAnn -> Doc StyleAnn
    forall a. a -> Doc a -> Doc a
    P.annotate (Maybe Style -> StyleAnn
    StyleAnn (Style -> Maybe Style
    forall a. a -> Maybe a
    Just Style
    s)) (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    {- Not used --------------------------------------------------------------------

    -- Intensity combinators

    bold, faint, normal :: Doc AnsiAnn -> Doc AnsiAnn
    bold = ansiAnn [SetConsoleIntensity BoldIntensity]
    faint = ansiAnn [SetConsoleIntensity FaintIntensity]
    normal = ansiAnn [SetConsoleIntensity NormalIntensity]

    -}

    -- | Tags for each field of state in SGR (Select Graphics Rendition).

    --

    -- It's a bit of a hack that 'TagReset' is included.

    data SGRTag
      = TagReset
      | TagConsoleIntensity
      | TagItalicized
      | TagUnderlining
      | TagBlinkSpeed
      | TagVisible
      | TagSwapForegroundBackground
      | TagColorForeground
      | TagColorBackground
      | TagRGBColor
      | TagPaletteColor
      deriving (SGRTag -> SGRTag -> Bool
    (SGRTag -> SGRTag -> Bool)
    -> (SGRTag -> SGRTag -> Bool) -> Eq SGRTag
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SGRTag -> SGRTag -> Bool
    == :: SGRTag -> SGRTag -> Bool
    $c/= :: SGRTag -> SGRTag -> Bool
    /= :: SGRTag -> SGRTag -> Bool
    Eq, Eq SGRTag
    Eq SGRTag =>
    (SGRTag -> SGRTag -> Ordering)
    -> (SGRTag -> SGRTag -> Bool)
    -> (SGRTag -> SGRTag -> Bool)
    -> (SGRTag -> SGRTag -> Bool)
    -> (SGRTag -> SGRTag -> Bool)
    -> (SGRTag -> SGRTag -> SGRTag)
    -> (SGRTag -> SGRTag -> SGRTag)
    -> Ord SGRTag
    SGRTag -> SGRTag -> Bool
    SGRTag -> SGRTag -> Ordering
    SGRTag -> SGRTag -> SGRTag
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: SGRTag -> SGRTag -> Ordering
    compare :: SGRTag -> SGRTag -> Ordering
    $c< :: SGRTag -> SGRTag -> Bool
    < :: SGRTag -> SGRTag -> Bool
    $c<= :: SGRTag -> SGRTag -> Bool
    <= :: SGRTag -> SGRTag -> Bool
    $c> :: SGRTag -> SGRTag -> Bool
    > :: SGRTag -> SGRTag -> Bool
    $c>= :: SGRTag -> SGRTag -> Bool
    >= :: SGRTag -> SGRTag -> Bool
    $cmax :: SGRTag -> SGRTag -> SGRTag
    max :: SGRTag -> SGRTag -> SGRTag
    $cmin :: SGRTag -> SGRTag -> SGRTag
    min :: SGRTag -> SGRTag -> SGRTag
    Ord)

    getSGRTag :: SGR -> SGRTag
    getSGRTag :: SGR -> SGRTag
    getSGRTag Reset{}                       = SGRTag
    TagReset
    getSGRTag SetConsoleIntensity{}         = SGRTag
    TagConsoleIntensity
    getSGRTag SetItalicized{}               = SGRTag
    TagItalicized
    getSGRTag SetUnderlining{}              = SGRTag
    TagUnderlining
    getSGRTag SetBlinkSpeed{}               = SGRTag
    TagBlinkSpeed
    getSGRTag SetVisible{}                  = SGRTag
    TagVisible
    getSGRTag SetSwapForegroundBackground{} = SGRTag
    TagSwapForegroundBackground
    getSGRTag (SetColor ConsoleLayer
    Foreground ColorIntensity
    _ Color
    _)     = SGRTag
    TagColorForeground
    getSGRTag (SetColor ConsoleLayer
    Background ColorIntensity
    _ Color
    _)     = SGRTag
    TagColorBackground
    getSGRTag SetRGBColor{}                 = SGRTag
    TagRGBColor
    getSGRTag SetPaletteColor{}             = SGRTag
    TagPaletteColor

    -- | The document @(x \<+\> y)@ concatenates document @x@ and @y@ with a

    -- @(fromString \"\ \")@ in between. (infixr 6)

    (<+>) :: StyleDoc -> StyleDoc -> StyleDoc
    StyleDoc Doc StyleAnn
    x <+> :: StyleDoc -> StyleDoc -> StyleDoc
    <+> StyleDoc Doc StyleAnn
    y = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn
    x Doc StyleAnn -> Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a -> Doc a
    P.<+> Doc StyleAnn
    y)

    -- | The document @(align x)@ renders document @x@ with the nesting level set to

    -- the current column. It is used for example to implement 'hang'.

    --

    -- As an example, we will put a document right above another one, regardless of

    -- the current nesting level:

    --

    -- > x $$ y = align (x <> line <> y)

    --

    -- > test = fromString "hi" <+> (fromString "nice" $$ fromString "world")

    --

    -- which will be layed out as:

    --

    -- @

    -- hi nice

    --    world

    -- @

    align :: StyleDoc -> StyleDoc
    align :: StyleDoc -> StyleDoc
    align = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a
    P.align (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | Strip annotations from a document. This is useful for re-using the textual

    -- formatting of some sub-document, but applying a different high-level

    -- annotation.

    noAnnotate :: StyleDoc -> StyleDoc
    noAnnotate :: StyleDoc -> StyleDoc
    noAnnotate = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a
    P.noAnnotate (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | Document @(braces x)@ encloses document @x@ in braces, \"{\" and \"}\".

    braces :: StyleDoc -> StyleDoc
    braces :: StyleDoc -> StyleDoc
    braces = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a
    P.braces (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | Document @(angles x)@ encloses document @x@ in angles, \"\<\" and \"\>\".

    angles :: StyleDoc -> StyleDoc
    angles :: StyleDoc -> StyleDoc
    angles = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a
    P.angles (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | Document @(parens x)@ encloses document @x@ in parenthesis, \"(\" and

    -- \")\".

    parens :: StyleDoc -> StyleDoc
    parens :: StyleDoc -> StyleDoc
    parens = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a
    P.parens (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | Document @(dquotes x)@ encloses document @x@ with double quotes '\"'.

    dquotes :: StyleDoc -> StyleDoc
    dquotes :: StyleDoc -> StyleDoc
    dquotes = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a
    P.dquotes (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | Document @(squotes x)@ encloses document @x@ with single quotes \"'\".

    squotes :: StyleDoc -> StyleDoc
    squotes :: StyleDoc -> StyleDoc
    squotes = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a
    P.squotes (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | Document @(brackets x)@ encloses document @x@ in square brackets, \"[\" and

    -- \"]\".

    brackets :: StyleDoc -> StyleDoc
    brackets :: StyleDoc -> StyleDoc
    brackets = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a
    P.brackets (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @string s@ concatenates all characters in @s@ using @line@ for

    -- newline characters and @fromString@ for all other characters. It is used

    -- whenever the text contains newline characters.

    --

    -- @since 0.1.4.0

    string :: String -> StyleDoc
    string :: String -> StyleDoc
    string String
    "" = StyleDoc
    forall a. Monoid a => a
    mempty
    string (Char
    '\n':String
    s) = StyleDoc
    line StyleDoc -> StyleDoc -> StyleDoc
    forall a. Semigroup a => a -> a -> a
    <> String -> StyleDoc
    string String
    s
    string String
    s        = let (String
    xs, String
    ys) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Char
    '\n') String
    s
                      in  String -> StyleDoc
    forall a. IsString a => String -> a
    fromString String
    xs StyleDoc -> StyleDoc -> StyleDoc
    forall a. Semigroup a => a -> a -> a
    <> String -> StyleDoc
    string String
    ys

    annotate :: StyleAnn -> StyleDoc -> StyleDoc
    annotate :: StyleAnn -> StyleDoc -> StyleDoc
    annotate StyleAnn
    a = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleAnn -> Doc StyleAnn -> Doc StyleAnn
    forall a. a -> Doc a -> Doc a
    P.annotate StyleAnn
    a (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(nest i x)@ renders document @x@ with the current indentation

    -- level increased by i (See also 'hang', 'align' and 'indent').

    --

    -- >    nest 2 (fromString "hello" <> line <> fromString "world")

    -- > <> line

    -- > <> fromString "!"

    --

    -- outputs as:

    --

    -- @

    -- hello

    --   world

    -- !

    -- @

    nest :: Int -> StyleDoc -> StyleDoc
    nest :: Int -> StyleDoc -> StyleDoc
    nest Int
    a = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Doc StyleAnn -> Doc StyleAnn
    forall a. Int -> Doc a -> Doc a
    P.nest Int
    a (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The @line@ document advances to the next line and indents to the current

    -- nesting level. Document @line@ behaves like @(fromString \" \")@ if the line

    -- break is undone by 'group'.

    line :: StyleDoc
    line :: StyleDoc
    line = Doc StyleAnn -> StyleDoc
    StyleDoc Doc StyleAnn
    forall a. Doc a
    P.line

    -- | The @linebreak@ document advances to the next line and indents to the

    -- current nesting level. Document @linebreak@ behaves like 'mempty' if the line

    -- break is undone by 'group'.

    linebreak :: StyleDoc
    linebreak :: StyleDoc
    linebreak = Doc StyleAnn -> StyleDoc
    StyleDoc Doc StyleAnn
    forall a. Doc a
    P.linebreak

    -- | The document @(fill i x)@ renders document @x@. It than appends

    -- @(fromString \"\ \")@s until the width is equal to @i@. If the width of @x@

    -- is already larger, nothing is appended. This combinator is quite useful in

    -- practice to output a list of bindings. The following example demonstrates

    -- this.

    --

    -- > types = [ ("empty", "Doc a")

    -- >         , ("nest", "Int -> Doc a -> Doc a")

    -- >         , ("linebreak", "Doc a")

    -- >         ]

    -- >

    -- > ptype (name, tp) =

    -- >   fill 6 (fromString name) <+> fromString "::" <+> fromString tp

    -- >

    -- > test = fromString "let" <+> align (vcat (map ptype types))

    --

    -- Which is layed out as:

    --

    -- @

    -- let empty  :: Doc a

    --     nest   :: Int -> Doc a -> Doc a

    --     linebreak :: Doc a

    -- @

    fill :: Int -> StyleDoc -> StyleDoc
    fill :: Int -> StyleDoc -> StyleDoc
    fill Int
    a = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Doc StyleAnn -> Doc StyleAnn
    forall a. Int -> Doc a -> Doc a
    P.fill Int
    a (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(fillBreak i x)@ first renders document @x@. It then appends

    -- @(fromString \"\ \")@s until the width is equal to @i@. If the width of @x@

    -- is already larger than @i@, the nesting level is increased by @i@ and a

    -- @line@ is appended. When we redefine @ptype@ in the previous example to use

    -- @fillBreak@, we get a useful variation of the previous output:

    --

    -- > ptype (name, tp) =

    -- >   fillBreak 6 (fromString name) <+> fromString "::" <+> fromString tp

    --

    -- The output will now be:

    --

    -- @

    -- let empty  :: Doc a

    --     nest   :: Int -> Doc a -> Doc a

    --     linebreak

    --            :: Doc a

    -- @

    fillBreak :: Int -> StyleDoc -> StyleDoc
    fillBreak :: Int -> StyleDoc -> StyleDoc
    fillBreak Int
    a = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Doc StyleAnn -> Doc StyleAnn
    forall a. Int -> Doc a -> Doc a
    P.fillBreak Int
    a (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(enclose l r x)@ encloses document @x@ between documents @l@

    -- and @r@ using @(\<\>)@.

    --

    -- > enclose l r x   = l <> x <> r

    enclose :: StyleDoc -> StyleDoc -> StyleDoc -> StyleDoc
    enclose :: StyleDoc -> StyleDoc -> StyleDoc -> StyleDoc
    enclose StyleDoc
    l StyleDoc
    r StyleDoc
    x = StyleDoc
    l StyleDoc -> StyleDoc -> StyleDoc
    forall a. Semigroup a => a -> a -> a
    <> StyleDoc
    x StyleDoc -> StyleDoc -> StyleDoc
    forall a. Semigroup a => a -> a -> a
    <> StyleDoc
    r

    -- | The document @(cat xs)@ concatenates all documents @xs@ either

    -- horizontally with @(\<\>)@, if it fits the page, or vertically with

    -- @(\<\> linebreak \<\>)@.

    --

    -- > cat xs = group (vcat xs)

    cat :: [StyleDoc] -> StyleDoc
    cat :: [StyleDoc] -> StyleDoc
    cat = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> ([StyleDoc] -> Doc StyleAnn) -> [StyleDoc] -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc StyleAnn] -> Doc StyleAnn
    forall a. [Doc a] -> Doc a
    P.cat ([Doc StyleAnn] -> Doc StyleAnn)
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleDoc -> Doc StyleAnn) -> [StyleDoc] -> [Doc StyleAnn]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | @(punctuate p xs)@ concatenates all documents in @xs@ with document @p@

    -- except for the last document.

    --

    -- > someText = map fromString ["words", "in", "a", "tuple"]

    -- > test = parens (align (cat (punctuate comma someText)))

    --

    -- This is layed out on a page width of 20 as:

    --

    -- @

    -- (words,in,a,tuple)

    -- @

    --

    -- But when the page width is 15, it is layed out as:

    --

    -- @

    -- (words,

    --  in,

    --  a,

    --  tuple)

    -- @

    --

    -- (If you want put the commas in front of their elements instead of at the end,

    -- you should use 'encloseSep'.)

    punctuate :: StyleDoc -> [StyleDoc] -> [StyleDoc]
    punctuate :: StyleDoc -> [StyleDoc] -> [StyleDoc]
    punctuate (StyleDoc Doc StyleAnn
    x) = (Doc StyleAnn -> StyleDoc) -> [Doc StyleAnn] -> [StyleDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Doc StyleAnn -> StyleDoc
    StyleDoc ([Doc StyleAnn] -> [StyleDoc])
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> [StyleDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> [Doc StyleAnn] -> [Doc StyleAnn]
    forall a. Doc a -> [Doc a] -> [Doc a]
    P.punctuate Doc StyleAnn
    x ([Doc StyleAnn] -> [Doc StyleAnn])
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> [Doc StyleAnn]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleDoc -> Doc StyleAnn) -> [StyleDoc] -> [Doc StyleAnn]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(fillCat xs)@ concatenates documents @xs@ horizontally with

    -- @(\<\>)@ as long as its fits the page, than inserts a @linebreak@ and

    -- continues doing that for all documents in @xs@.

    --

    -- > fillCat xs = foldr (<> softbreak <>) mempty xs

    fillCat :: [StyleDoc] -> StyleDoc
    fillCat :: [StyleDoc] -> StyleDoc
    fillCat = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> ([StyleDoc] -> Doc StyleAnn) -> [StyleDoc] -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc StyleAnn] -> Doc StyleAnn
    forall a. [Doc a] -> Doc a
    P.fillCat ([Doc StyleAnn] -> Doc StyleAnn)
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleDoc -> Doc StyleAnn) -> [StyleDoc] -> [Doc StyleAnn]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(hcat xs)@ concatenates all documents @xs@ horizontally with

    -- @(\<\>)@.

    hcat :: [StyleDoc] -> StyleDoc
    hcat :: [StyleDoc] -> StyleDoc
    hcat = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> ([StyleDoc] -> Doc StyleAnn) -> [StyleDoc] -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc StyleAnn] -> Doc StyleAnn
    forall a. [Doc a] -> Doc a
    P.hcat ([Doc StyleAnn] -> Doc StyleAnn)
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleDoc -> Doc StyleAnn) -> [StyleDoc] -> [Doc StyleAnn]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(vcat xs)@ concatenates all documents @xs@ vertically with

    -- @(\<\> linebreak \<\>)@. If a 'group' undoes the line breaks inserted by

    -- 'vcat', all documents are directly concatenated.

    vcat :: [StyleDoc] -> StyleDoc
    vcat :: [StyleDoc] -> StyleDoc
    vcat = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> ([StyleDoc] -> Doc StyleAnn) -> [StyleDoc] -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc StyleAnn] -> Doc StyleAnn
    forall a. [Doc a] -> Doc a
    P.vcat ([Doc StyleAnn] -> Doc StyleAnn)
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleDoc -> Doc StyleAnn) -> [StyleDoc] -> [Doc StyleAnn]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(sep xs)@ concatenates all documents @xs@ either horizontally

    -- with @(\<+\>)@, if it fits the page, or vertically with @(\<\> line \<\>)@.

    --

    -- > sep xs = group (vsep xs)

    sep :: [StyleDoc] -> StyleDoc
    sep :: [StyleDoc] -> StyleDoc
    sep = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> ([StyleDoc] -> Doc StyleAnn) -> [StyleDoc] -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc StyleAnn] -> Doc StyleAnn
    forall a. [Doc a] -> Doc a
    P.sep ([Doc StyleAnn] -> Doc StyleAnn)
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleDoc -> Doc StyleAnn) -> [StyleDoc] -> [Doc StyleAnn]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(vsep xs)@ concatenates all documents @xs@ vertically with

    -- @(\<\> line \<\>)@. If a 'group' undoes the line breaks inserted by 'vsep',

    -- all documents are separated with a space.

    --

    -- > someText = map fromString (words ("text to lay out"))

    -- >

    -- > test = fromString "some" <+> vsep someText

    --

    -- This is layed out as:

    --

    -- @

    -- some text

    -- to

    -- lay

    -- out

    -- @

    --

    -- The 'align' combinator can be used to align the documents under their first

    -- element

    --

    -- > test = fromString "some" <+> align (vsep someText)

    --

    -- Which is printed as:

    --

    -- @

    -- some text

    --      to

    --      lay

    --      out

    -- @

    vsep :: [StyleDoc] -> StyleDoc
    vsep :: [StyleDoc] -> StyleDoc
    vsep = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> ([StyleDoc] -> Doc StyleAnn) -> [StyleDoc] -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc StyleAnn] -> Doc StyleAnn
    forall a. [Doc a] -> Doc a
    P.vsep ([Doc StyleAnn] -> Doc StyleAnn)
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleDoc -> Doc StyleAnn) -> [StyleDoc] -> [Doc StyleAnn]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(hsep xs)@ concatenates all documents @xs@ horizontally with

    -- @('<+>')@.

    hsep :: [StyleDoc] -> StyleDoc
    hsep :: [StyleDoc] -> StyleDoc
    hsep = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> ([StyleDoc] -> Doc StyleAnn) -> [StyleDoc] -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc StyleAnn] -> Doc StyleAnn
    forall a. [Doc a] -> Doc a
    P.hsep ([Doc StyleAnn] -> Doc StyleAnn)
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleDoc -> Doc StyleAnn) -> [StyleDoc] -> [Doc StyleAnn]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(fillSep xs)@ concatenates documents @xs@ horizontally with

    -- @('<+>')@ as long as its fits the page, than inserts a 'line' and continues

    -- doing that for all documents in @xs@.

    --

    -- > fillSep xs = foldr (<> softline <>) mempty xs

    fillSep :: [StyleDoc] -> StyleDoc
    fillSep :: [StyleDoc] -> StyleDoc
    fillSep = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> ([StyleDoc] -> Doc StyleAnn) -> [StyleDoc] -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc StyleAnn] -> Doc StyleAnn
    forall a. [Doc a] -> Doc a
    P.fillSep ([Doc StyleAnn] -> Doc StyleAnn)
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleDoc -> Doc StyleAnn) -> [StyleDoc] -> [Doc StyleAnn]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(encloseSep l r sep xs)@ concatenates the documents @xs@

    -- separated by @sep@ and encloses the resulting document by @l@ and @r@. The

    -- documents are rendered horizontally if that fits the page. Otherwise they are

    -- aligned vertically. All separators are put in front of the elements. For

    -- example, the combinator 'list' can be defined with 'encloseSep':

    --

    -- > list xs = encloseSep lbracket rbracket comma xs

    -- > test = fromString "list" <+> (list (map int [10, 200, 3000]))

    --

    -- Which is layed out with a page width of 20 as:

    --

    -- @

    -- list [10,200,3000]

    -- @

    --

    -- But when the page width is 15, it is layed out as:

    --

    -- @

    -- list [10

    --      ,200

    --      ,3000]

    -- @

    encloseSep :: StyleDoc -> StyleDoc -> StyleDoc -> [StyleDoc] -> StyleDoc
    encloseSep :: StyleDoc -> StyleDoc -> StyleDoc -> [StyleDoc] -> StyleDoc
    encloseSep (StyleDoc Doc StyleAnn
    x) (StyleDoc Doc StyleAnn
    y) (StyleDoc Doc StyleAnn
    z) =
      Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> ([StyleDoc] -> Doc StyleAnn) -> [StyleDoc] -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn
    -> Doc StyleAnn -> Doc StyleAnn -> [Doc StyleAnn] -> Doc StyleAnn
    forall a. Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
    P.encloseSep Doc StyleAnn
    x Doc StyleAnn
    y Doc StyleAnn
    z ([Doc StyleAnn] -> Doc StyleAnn)
    -> ([StyleDoc] -> [Doc StyleAnn]) -> [StyleDoc] -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StyleDoc -> Doc StyleAnn) -> [StyleDoc] -> [Doc StyleAnn]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @(indent i x)@ indents document @x@ with @i@ spaces.

    --

    -- > test = indent 4 (fillSep (map fromString

    -- >        (words "the indent combinator indents these words !")))

    --

    -- Which lays out with a page width of 20 as:

    --

    -- @

    --     the indent

    --     combinator

    --     indents these

    --     words !

    -- @

    indent :: Int -> StyleDoc -> StyleDoc
    indent :: Int -> StyleDoc -> StyleDoc
    indent Int
    a = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Doc StyleAnn -> Doc StyleAnn
    forall a. Int -> Doc a -> Doc a
    P.indent Int
    a (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The hang combinator implements hanging indentation. The document

    -- @(hang i x)@ renders document @x@ with a nesting level set to the current

    -- column plus @i@. The following example uses hanging indentation for some

    -- text:

    --

    -- > test = hang 4 (fillSep (map fromString

    -- >        (words "the hang combinator indents these words !")))

    --

    -- Which lays out on a page with a width of 20 characters as:

    --

    -- @

    -- the hang combinator

    --     indents these

    --     words !

    -- @

    --

    -- The @hang@ combinator is implemented as:

    --

    -- > hang i x = align (nest i x)

    hang :: Int -> StyleDoc -> StyleDoc
    hang :: Int -> StyleDoc -> StyleDoc
    hang Int
    a = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Doc StyleAnn -> Doc StyleAnn
    forall a. Int -> Doc a -> Doc a
    P.hang Int
    a (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc

    -- | The document @softbreak@ behaves like 'mempty' if the resulting output fits

    -- the page, otherwise it behaves like 'line'.

    --

    -- > softbreak = group linebreak

    softbreak :: StyleDoc
    softbreak :: StyleDoc
    softbreak = Doc StyleAnn -> StyleDoc
    StyleDoc Doc StyleAnn
    forall a. Doc a
    P.softbreak

    -- | The document @softline@ behaves like @(fromString \"\ \")@ if the resulting

    -- output fits the page, otherwise it behaves like 'line'.

    --

    -- > softline = group line

    softline :: StyleDoc
    softline :: StyleDoc
    softline = Doc StyleAnn -> StyleDoc
    StyleDoc Doc StyleAnn
    forall a. Doc a
    P.softline

    -- | The @group@ combinator is used to specify alternative layouts. The document

    -- @(group x)@ undoes all line breaks in document @x@. The resulting line is

    -- added to the current line if that fits the page. Otherwise, the document @x@

    -- is rendered without any changes.

    group :: StyleDoc -> StyleDoc
    group :: StyleDoc -> StyleDoc
    group = Doc StyleAnn -> StyleDoc
    StyleDoc (Doc StyleAnn -> StyleDoc)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> StyleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc StyleAnn -> Doc StyleAnn
    forall a. Doc a -> Doc a
    P.group (Doc StyleAnn -> Doc StyleAnn)
    -> (StyleDoc -> Doc StyleAnn) -> StyleDoc -> Doc StyleAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleDoc -> Doc StyleAnn
    unStyleDoc