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

-- | This module re-exports some of the interface for

-- "Text.PrettyPrint.Annotated.Leijen" along with additional definitions

-- useful for stack.

--

-- It defines a 'Monoid' instance for 'Doc'.

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

    Pretty (..)

    -- * Ansi terminal Doc

    --

    -- See "System.Console.ANSI" for 'SGR' values to use beyond the colors

    -- provided.

  , StyleDoc (..)
  , StyleAnn(..)
  -- hDisplayAnsi,

  , displayAnsi
  , displayPlain
  , renderDefault

  -- * Selective re-exports from "Text.PrettyPrint.Annotated.Leijen"

  --

  -- Documentation of omissions up-to-date with @annotated-wl-pprint-0.7.0@


  -- ** Documents, parametrized by their annotations

  --

  -- Omitted compared to original: @putDoc, hPutDoc@

  -- Doc,


  -- ** Basic combinators

  --

  -- Omitted compared to original: @empty, char, text, (<>)@

  --

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

  --

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

  , 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 original: @list, tupled, semiBraces@

  , align
  , hang
  , indent
  , encloseSep

  -- ** Operators

  --

  -- Omitted compared to 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

  -- Original 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 qualified Distribution.Text ( display )
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 forall a. Doc a -> Doc a -> Doc a
P.<> Doc StyleAnn
y)

instance Monoid StyleDoc where
  mappend :: StyleDoc -> StyleDoc -> StyleDoc
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: StyleDoc
mempty = Doc StyleAnn -> StyleDoc
StyleDoc 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

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

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

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

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

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

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

-- Style Doc


-- |A style annotation.

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

instance Monoid StyleAnn where
  mempty :: StyleAnn
mempty = Maybe Style -> StyleAnn
StyleAnn forall a. Maybe a
Nothing
  mappend :: StyleAnn -> StyleAnn -> StyleAnn
mappend = 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
forall a. (String -> a) -> IsString a
fromString :: String -> StyleDoc
$cfromString :: String -> StyleDoc
IsString, Int -> StyleDoc -> ShowS
[StyleDoc] -> ShowS
StyleDoc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StyleDoc] -> ShowS
$cshowList :: [StyleDoc] -> ShowS
show :: StyleDoc -> String
$cshow :: StyleDoc -> String
showsPrec :: Int -> StyleDoc -> ShowS
$cshowsPrec :: Int -> StyleDoc -> ShowS
Show)

-- |An ANSI code(s) annotation.

newtype AnsiAnn = AnsiAnn [SGR]
  deriving (AnsiAnn -> AnsiAnn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnsiAnn -> AnsiAnn -> Bool
$c/= :: AnsiAnn -> AnsiAnn -> Bool
== :: AnsiAnn -> AnsiAnn -> Bool
$c== :: AnsiAnn -> AnsiAnn -> Bool
Eq, Int -> AnsiAnn -> ShowS
[AnsiAnn] -> ShowS
AnsiAnn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnsiAnn] -> ShowS
$cshowList :: [AnsiAnn] -> ShowS
show :: AnsiAnn -> String
$cshow :: AnsiAnn -> String
showsPrec :: Int -> AnsiAnn -> ShowS
$cshowsPrec :: Int -> AnsiAnn -> ShowS
Show, NonEmpty AnsiAnn -> AnsiAnn
AnsiAnn -> AnsiAnn -> 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
stimes :: forall b. Integral b => b -> AnsiAnn -> AnsiAnn
$cstimes :: forall b. Integral b => b -> AnsiAnn -> AnsiAnn
sconcat :: NonEmpty AnsiAnn -> AnsiAnn
$csconcat :: NonEmpty AnsiAnn -> AnsiAnn
<> :: AnsiAnn -> AnsiAnn -> AnsiAnn
$c<> :: AnsiAnn -> AnsiAnn -> AnsiAnn
Semigroup, Semigroup AnsiAnn
AnsiAnn
[AnsiAnn] -> AnsiAnn
AnsiAnn -> AnsiAnn -> AnsiAnn
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [AnsiAnn] -> AnsiAnn
$cmconcat :: [AnsiAnn] -> AnsiAnn
mappend :: AnsiAnn -> AnsiAnn -> AnsiAnn
$cmappend :: AnsiAnn -> AnsiAnn -> AnsiAnn
mempty :: AnsiAnn
$cmempty :: 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        = forall a. SimpleDoc a
SEmpty
  go (SChar Char
c SimpleDoc StyleAnn
d)   = 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) = 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)   = 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) =
    forall a. a -> SimpleDoc a -> SimpleDoc a
SAnnotStart ([SGR] -> AnsiAnn
AnsiAnn (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Styles
styles 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) = forall a. a -> SimpleDoc a -> SimpleDoc a
SAnnotStart ([SGR] -> AnsiAnn
AnsiAnn []) (SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
go SimpleDoc StyleAnn
d)
  go (SAnnotStop SimpleDoc StyleAnn
d) = 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 =
  forall env (m :: * -> *).
(HasLogFunc env, HasStylesUpdate env, MonadReader env m,
 HasCallStack) =>
SimpleDoc StyleAnn -> m Utf8Builder
displayAnsiSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Doc a -> SimpleDoc a
renderDefault Int
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleDoc -> Doc StyleAnn
unStyleDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 =
  forall env (m :: * -> *).
(HasLogFunc env, HasStylesUpdate env, MonadReader env m,
 HasCallStack) =>
SimpleDoc StyleAnn -> m Utf8Builder
displayAnsiSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Doc a -> SimpleDoc a
renderDefault Int
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleDoc -> Doc StyleAnn
unStyleDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
  StylesUpdate
update <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasStylesUpdate env => Lens' env StylesUpdate
stylesUpdateL
  let styles :: Styles
styles = Styles
defaultStyles 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' :: SimpleDoc AnsiAnn
doc' = Styles -> SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
toAnsiDoc Styles
styles SimpleDoc StyleAnn
doc
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r a. Reader r a -> r -> a
runReader forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
Monad m =>
(forall b. a -> m (b, Utf8Builder) -> m (b, Utf8Builder))
-> SimpleDoc a -> m Utf8Builder
displayDecoratedWrap forall {m :: * -> *} {b} {a}.
(MonadReader (Map SGRTag SGR) m, Monoid b, IsString b) =>
AnsiAnn -> m (a, b) -> m (a, b)
go SimpleDoc AnsiAnn
doc'
 where
  go :: AnsiAnn -> m (a, b) -> m (a, b)
go (AnsiAnn [SGR]
sgrs) m (a, b)
inner = do
    Map SGRTag SGR
old <- forall r (m :: * -> *). MonadReader r m => m r
ask
    let sgrs' :: [(SGRTag, SGR)]
sgrs' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\SGR
sgr -> if SGR
sgr forall a. Eq a => a -> a -> Bool
== SGR
Reset
                                    then forall a. Maybe a
Nothing
                                    else forall a. a -> Maybe a
Just (SGR -> SGRTag
getSGRTag SGR
sgr, SGR
sgr)) [SGR]
sgrs
        new :: Map SGRTag SGR
new = if SGR
Reset forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SGR]
sgrs
                then forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(SGRTag, SGR)]
sgrs'
                else forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map SGRTag SGR
mp (SGRTag
tag, SGR
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'
    (a
extra, b
contents) <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall a b. a -> b -> a
const Map SGRTag SGR
new) m (a, b)
inner
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
extra, forall {k} {a}.
(Ord k, Monoid a, IsString a) =>
Map k SGR -> Map k SGR -> a
transitionCodes Map SGRTag SGR
old Map SGRTag SGR
new forall a. Semigroup a => a -> a -> a
<> b
contents forall a. Semigroup a => a -> a -> a
<> forall {k} {a}.
(Ord k, Monoid a, IsString a) =>
Map k SGR -> Map k SGR -> a
transitionCodes Map SGRTag SGR
new Map SGRTag SGR
old)
  transitionCodes :: Map k SGR -> Map k SGR -> a
transitionCodes Map k SGR
old Map k SGR
new =
    case (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SGR]
removals, forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SGR]
additions) of
      (Bool
True, Bool
True) -> forall a. Monoid a => a
mempty
      (Bool
True, Bool
False) -> forall a. IsString a => String -> a
fromString ([SGR] -> String
setSGRCode [SGR]
additions)
      (Bool
False, Bool
_) -> forall a. IsString a => String -> a
fromString ([SGR] -> String
setSGRCode (SGR
Reset forall a. a -> [a] -> [a]
: forall k a. Map k a -> [a]
M.elems Map k SGR
new))
   where
    ([SGR]
removals, [SGR]
additions) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$
      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 forall a. Eq a => a -> a -> Bool
== SGR
n then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right SGR
n))
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left)
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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
  (Maybe (SimpleDoc a)
mafter, Utf8Builder
result) <- SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
go SimpleDoc a
doc
  case Maybe (SimpleDoc a)
mafter of
    Just SimpleDoc a
_ -> forall a. HasCallStack => String -> a
error String
"Invariant violated by input to displayDecoratedWrap: no \
                    \matching SAnnotStart for SAnnotStop."
    Maybe (SimpleDoc a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Utf8Builder
result
 where
  spaces :: Int -> Utf8Builder
spaces Int
n = 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 = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Monoid a => a
mempty)
  go (SChar Char
c SimpleDoc a
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Display a => a -> Utf8Builder
display Char
c 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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IsString a => String -> a
fromString String
s 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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Display a => a -> Utf8Builder
display Char
'\n' forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Utf8Builder
spaces Int
n 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
    (Maybe (SimpleDoc a)
mafter, Utf8Builder
contents) <- forall b. a -> m (b, Utf8Builder) -> m (b, Utf8Builder)
f a
ann (SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
go SimpleDoc a
x)
    case Maybe (SimpleDoc a)
mafter of
      Just SimpleDoc a
after -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Utf8Builder
contents forall a. Semigroup a => a -> a -> a
<>)) (SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
go SimpleDoc a
after)
      Maybe (SimpleDoc a)
Nothing -> forall a. HasCallStack => String -> a
error String
"Invariant violated by input to displayDecoratedWrap: \
                       \no matching SAnnotStop for SAnnotStart."
  go (SAnnotStop SimpleDoc a
x) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just SimpleDoc a
x, 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Doc a -> Doc a
P.annotate (Maybe Style -> StyleAnn
StyleAnn (forall a. a -> Maybe a
Just Style
s)) 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SGRTag -> SGRTag -> Bool
$c/= :: SGRTag -> SGRTag -> Bool
== :: SGRTag -> SGRTag -> Bool
$c== :: SGRTag -> SGRTag -> Bool
Eq, Eq 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
min :: SGRTag -> SGRTag -> SGRTag
$cmin :: SGRTag -> SGRTag -> SGRTag
max :: SGRTag -> SGRTag -> SGRTag
$cmax :: SGRTag -> SGRTag -> SGRTag
>= :: SGRTag -> SGRTag -> Bool
$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
compare :: SGRTag -> SGRTag -> Ordering
$ccompare :: SGRTag -> SGRTag -> Ordering
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

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

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

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

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

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

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

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

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

brackets :: StyleDoc -> StyleDoc
brackets :: StyleDoc -> StyleDoc
brackets = Doc StyleAnn -> StyleDoc
StyleDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Doc a -> Doc a
P.brackets 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 @char@ 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
"" = forall a. Monoid a => a
mempty
string (Char
'\n':String
s) = StyleDoc
line forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
string String
s
string String
s        = let (String
xs, String
ys) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/=Char
'\n') String
s
                  in  forall a. IsString a => String -> a
fromString String
xs 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Doc a -> Doc a
P.annotate StyleAnn
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleDoc -> Doc StyleAnn
unStyleDoc

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
P.encloseSep Doc StyleAnn
x Doc StyleAnn
y Doc StyleAnn
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map StyleDoc -> Doc StyleAnn
unStyleDoc

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

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

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

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

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