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

{-# LANGUAGE MultiParamTypeClasses #-}
{-# 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
  -- Entirely omitted:
  --
  -- @
  -- string, int, integer, float, double, rational, bool,
  -- @

  -- ** 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 (runReader, local)
import Data.Array.IArray ((!), (//))
import qualified Data.Text as T
import Distribution.ModuleName (ModuleName)
import qualified Distribution.Text (display)
import Path
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 (StylesUpdate (..), HasStylesUpdate, 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 x :: Doc StyleAnn
x <> :: StyleDoc -> StyleDoc -> StyleDoc
<> StyleDoc y :: 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 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

--------------------------------------------------------------------------------
-- 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
/= :: StyleAnn -> StyleAnn -> Bool
$c/= :: StyleAnn -> StyleAnn -> Bool
== :: StyleAnn -> StyleAnn -> Bool
$c== :: StyleAnn -> StyleAnn -> Bool
Eq, Int -> StyleAnn -> ShowS
[StyleAnn] -> ShowS
StyleAnn -> String
(Int -> StyleAnn -> ShowS)
-> (StyleAnn -> String) -> ([StyleAnn] -> ShowS) -> Show StyleAnn
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, b -> StyleAnn -> StyleAnn
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
stimes :: 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 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
fromString :: String -> StyleDoc
$cfromString :: String -> StyleDoc
IsString

-- |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
/= :: AnsiAnn -> AnsiAnn -> Bool
$c/= :: AnsiAnn -> AnsiAnn -> Bool
== :: AnsiAnn -> AnsiAnn -> Bool
$c== :: AnsiAnn -> AnsiAnn -> Bool
Eq, Int -> AnsiAnn -> ShowS
[AnsiAnn] -> ShowS
AnsiAnn -> String
(Int -> AnsiAnn -> ShowS)
-> (AnsiAnn -> String) -> ([AnsiAnn] -> ShowS) -> Show AnsiAnn
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, b -> AnsiAnn -> AnsiAnn
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
stimes :: 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
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
mconcat :: [AnsiAnn] -> AnsiAnn
$cmconcat :: [AnsiAnn] -> AnsiAnn
mappend :: AnsiAnn -> AnsiAnn -> AnsiAnn
$cmappend :: AnsiAnn -> AnsiAnn -> AnsiAnn
mempty :: AnsiAnn
$cmempty :: AnsiAnn
$cp1Monoid :: Semigroup 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
styles = SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
go
  where
    go :: SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
go SEmpty        = SimpleDoc AnsiAnn
forall a. SimpleDoc a
SEmpty
    go (SChar c :: Char
c d :: 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 l :: Int
l s :: String
s d :: 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 i :: Int
i d :: 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 s :: Style
s)) d :: 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 Nothing) d :: 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 d :: 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 :: Int -> a -> m Utf8Builder
displayPlain w :: 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 (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 :: Int -> Doc a -> SimpleDoc a
renderDefault = Float -> Int -> Doc a -> SimpleDoc a
forall a. Float -> Int -> Doc a -> SimpleDoc a
P.renderPretty 1

displayAnsi
    :: (Pretty a, HasLogFunc env, HasStylesUpdate env,
        MonadReader env m, HasCallStack)
    => Int -> a -> m Utf8Builder
displayAnsi :: Int -> a -> m Utf8Builder
displayAnsi w :: Int
w = do
    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 :: SimpleDoc StyleAnn -> m Utf8Builder
displayAnsiSimple doc :: SimpleDoc StyleAnn
doc = do
    StylesUpdate
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
stylesUpdateL
    let styles :: Styles
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' :: SimpleDoc AnsiAnn
doc' = Styles -> SimpleDoc StyleAnn -> SimpleDoc AnsiAnn
toAnsiDoc Styles
styles SimpleDoc StyleAnn
doc
    Utf8Builder -> m Utf8Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Utf8Builder -> m Utf8Builder) -> Utf8Builder -> m Utf8Builder
forall a b. (a -> b) -> a -> b
$
        (Reader (Map SGRTag SGR) Utf8Builder
 -> Map SGRTag SGR -> Utf8Builder)
-> Map SGRTag SGR
-> Reader (Map SGRTag SGR) Utf8Builder
-> Utf8Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader (Map SGRTag SGR) Utf8Builder
-> Map SGRTag SGR -> Utf8Builder
forall r a. Reader r a -> r -> a
runReader Map SGRTag SGR
forall a. Monoid a => a
mempty (Reader (Map SGRTag SGR) Utf8Builder -> Utf8Builder)
-> Reader (Map SGRTag SGR) Utf8Builder -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ (forall b.
 AnsiAnn
 -> ReaderT (Map SGRTag SGR) Identity (b, Utf8Builder)
 -> ReaderT (Map SGRTag SGR) Identity (b, Utf8Builder))
-> SimpleDoc AnsiAnn -> Reader (Map SGRTag SGR) Utf8Builder
forall a (m :: * -> *).
Monad m =>
(forall b. a -> m (b, Utf8Builder) -> m (b, Utf8Builder))
-> SimpleDoc a -> m Utf8Builder
displayDecoratedWrap forall b.
AnsiAnn
-> ReaderT (Map SGRTag SGR) Identity (b, Utf8Builder)
-> ReaderT (Map SGRTag SGR) Identity (b, Utf8Builder)
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 sgrs :: [SGR]
sgrs) inner :: m (a, b)
inner = do
        Map SGRTag SGR
old <- m (Map SGRTag SGR)
forall r (m :: * -> *). MonadReader r m => m r
ask
        let sgrs' :: [(SGRTag, SGR)]
sgrs' = (SGR -> Maybe (SGRTag, SGR)) -> [SGR] -> [(SGRTag, SGR)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\sgr :: 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 :: Map SGRTag SGR
new = if SGR
Reset SGR -> [SGR] -> 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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\mp :: Map SGRTag SGR
mp (tag :: SGRTag
tag, sgr :: 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 :: a
extra, contents :: b
contents) <- (Map SGRTag SGR -> Map SGRTag SGR) -> m (a, b) -> m (a, b)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Map SGRTag SGR -> Map SGRTag SGR -> Map SGRTag SGR
forall a b. a -> b -> a
const Map SGRTag SGR
new) m (a, b)
inner
        (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
extra, Map SGRTag SGR -> Map SGRTag SGR -> b
forall k p.
(Ord k, Monoid p, IsString p) =>
Map k SGR -> Map k SGR -> p
transitionCodes Map SGRTag SGR
old Map SGRTag SGR
new b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
contents b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Map SGRTag SGR -> Map SGRTag SGR -> b
forall k p.
(Ord k, Monoid p, IsString p) =>
Map k SGR -> Map k SGR -> p
transitionCodes Map SGRTag SGR
new Map SGRTag SGR
old)
    transitionCodes :: Map k SGR -> Map k SGR -> p
transitionCodes old :: Map k SGR
old new :: Map k SGR
new =
        case ([SGR] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SGR]
removals, [SGR] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SGR]
additions) of
            (True, True) -> p
forall a. Monoid a => a
mempty
            (True, False) -> String -> p
forall a. IsString a => String -> a
fromString ([SGR] -> String
setSGRCode [SGR]
additions)
            (False, _) -> String -> p
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
        (removals :: [SGR]
removals, additions :: [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
               (\_ o :: SGR
o n :: 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 (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 (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 b. a -> m (b, Utf8Builder) -> m (b, Utf8Builder))
-> SimpleDoc a -> m Utf8Builder
displayDecoratedWrap f :: forall b. a -> m (b, Utf8Builder) -> m (b, Utf8Builder)
f doc :: SimpleDoc a
doc = do
    (mafter :: Maybe (SimpleDoc a)
mafter, result :: Utf8Builder
result) <- SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
go SimpleDoc a
doc
    case Maybe (SimpleDoc a)
mafter of
      Just _ -> String -> m Utf8Builder
forall a. HasCallStack => String -> a
error "Invariant violated by input to displayDecoratedWrap: no matching SAnnotStart for SAnnotStop."
      Nothing -> Utf8Builder -> m Utf8Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Utf8Builder
result
  where
    spaces :: Int -> Utf8Builder
spaces n :: Int
n = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int -> Text -> Text
T.replicate Int
n " ")

    go :: SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
    go :: SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder)
go SEmpty = (Maybe (SimpleDoc a), Utf8Builder)
-> m (Maybe (SimpleDoc a), Utf8Builder)
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 c :: Char
c x :: SimpleDoc a
x) = ((Maybe (SimpleDoc a), Utf8Builder)
 -> (Maybe (SimpleDoc a), Utf8Builder))
-> m (Maybe (SimpleDoc a), Utf8Builder)
-> m (Maybe (SimpleDoc a), Utf8Builder)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Utf8Builder -> Utf8Builder)
-> (Maybe (SimpleDoc a), Utf8Builder)
-> (Maybe (SimpleDoc a), Utf8Builder)
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 _l :: Int
_l s :: String
s x :: SimpleDoc a
x) = ((Maybe (SimpleDoc a), Utf8Builder)
 -> (Maybe (SimpleDoc a), Utf8Builder))
-> m (Maybe (SimpleDoc a), Utf8Builder)
-> m (Maybe (SimpleDoc a), Utf8Builder)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Utf8Builder -> Utf8Builder)
-> (Maybe (SimpleDoc a), Utf8Builder)
-> (Maybe (SimpleDoc a), Utf8Builder)
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 n :: Int
n x :: SimpleDoc a
x) = ((Maybe (SimpleDoc a), Utf8Builder)
 -> (Maybe (SimpleDoc a), Utf8Builder))
-> m (Maybe (SimpleDoc a), Utf8Builder)
-> m (Maybe (SimpleDoc a), Utf8Builder)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Utf8Builder -> Utf8Builder)
-> (Maybe (SimpleDoc a), Utf8Builder)
-> (Maybe (SimpleDoc a), Utf8Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display '\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 ann :: a
ann x :: SimpleDoc a
x) = do
        (mafter :: Maybe (SimpleDoc a)
mafter, contents :: Utf8Builder
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 Maybe (SimpleDoc a)
mafter of
            Just after :: SimpleDoc a
after -> ((Maybe (SimpleDoc a), Utf8Builder)
 -> (Maybe (SimpleDoc a), Utf8Builder))
-> m (Maybe (SimpleDoc a), Utf8Builder)
-> m (Maybe (SimpleDoc a), Utf8Builder)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Utf8Builder -> Utf8Builder)
-> (Maybe (SimpleDoc a), Utf8Builder)
-> (Maybe (SimpleDoc a), Utf8Builder)
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)
            Nothing -> String -> m (Maybe (SimpleDoc a), Utf8Builder)
forall a. HasCallStack => String -> a
error "Invariant violated by input to displayDecoratedWrap: no matching SAnnotStop for SAnnotStart."
    go (SAnnotStop x :: SimpleDoc a
x) = (Maybe (SimpleDoc a), Utf8Builder)
-> m (Maybe (SimpleDoc a), Utf8Builder)
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 s :: 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
/= :: SGRTag -> SGRTag -> Bool
$c/= :: SGRTag -> SGRTag -> Bool
== :: SGRTag -> SGRTag -> Bool
$c== :: 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
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
$cp1Ord :: Eq 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 Foreground _ _)     = SGRTag
TagColorForeground
getSGRTag (SetColor Background _ _)     = SGRTag
TagColorBackground
getSGRTag SetRGBColor{}                 = SGRTag
TagRGBColor
getSGRTag SetPaletteColor{}             = SGRTag
TagPaletteColor

(<+>) :: StyleDoc -> StyleDoc -> StyleDoc
StyleDoc x :: Doc StyleAnn
x <+> :: StyleDoc -> StyleDoc -> StyleDoc
<+> StyleDoc y :: 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)

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

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

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

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

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

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

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

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

annotate :: StyleAnn -> StyleDoc -> StyleDoc
annotate :: StyleAnn -> StyleDoc -> StyleDoc
annotate a :: 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

nest :: Int -> StyleDoc -> StyleDoc
nest :: Int -> StyleDoc -> StyleDoc
nest a :: 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

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

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

fill :: Int -> StyleDoc -> StyleDoc
fill :: Int -> StyleDoc -> StyleDoc
fill a :: 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

fillBreak :: Int -> StyleDoc -> StyleDoc
fillBreak :: Int -> StyleDoc -> StyleDoc
fillBreak a :: 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

enclose :: StyleDoc -> StyleDoc -> StyleDoc -> StyleDoc
enclose :: StyleDoc -> StyleDoc -> StyleDoc -> StyleDoc
enclose l :: StyleDoc
l r :: StyleDoc
r x :: 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

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 :: StyleDoc -> [StyleDoc] -> [StyleDoc]
punctuate :: StyleDoc -> [StyleDoc] -> [StyleDoc]
punctuate (StyleDoc x :: 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

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

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

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

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

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

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

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

encloseSep :: StyleDoc -> StyleDoc -> StyleDoc -> [StyleDoc] -> StyleDoc
encloseSep :: StyleDoc -> StyleDoc -> StyleDoc -> [StyleDoc] -> StyleDoc
encloseSep (StyleDoc x :: Doc StyleAnn
x) (StyleDoc y :: Doc StyleAnn
y) (StyleDoc z :: 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

indent :: Int -> StyleDoc -> StyleDoc
indent :: Int -> StyleDoc -> StyleDoc
indent a :: 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

hang :: Int -> StyleDoc -> StyleDoc
hang :: Int -> StyleDoc -> StyleDoc
hang a :: 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

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

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

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