{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Text.PrettyPrint.Leijen.Extended
(
Pretty (..)
, StyleDoc (..)
, StyleAnn(..)
, displayAnsi
, displayPlain
, renderDefault
, nest
, line
, linebreak
, group
, softline
, softbreak
, align
, hang
, indent
, encloseSep
, (<+>)
, hsep
, vsep
, fillSep
, sep
, hcat
, vcat
, fillCat
, cat
, punctuate
, fill
, fillBreak
, enclose
, squotes
, dquotes
, parens
, angles
, braces
, brackets
, string
, annotate
, noAnnotate
, styleAnn
) 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 (..) )
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
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
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 -> 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
$cshowsPrec :: Int -> StyleAnn -> ShowS
showsPrec :: Int -> StyleAnn -> ShowS
$cshow :: StyleAnn -> String
show :: StyleAnn -> String
$cshowList :: [StyleAnn] -> ShowS
showList :: [StyleAnn] -> ShowS
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
(<>)
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 -> ShowS
[StyleDoc] -> ShowS
StyleDoc -> String
(Int -> StyleDoc -> ShowS)
-> (StyleDoc -> String) -> ([StyleDoc] -> ShowS) -> Show StyleDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StyleDoc -> ShowS
showsPrec :: Int -> StyleDoc -> ShowS
$cshow :: StyleDoc -> String
show :: StyleDoc -> String
$cshowList :: [StyleDoc] -> ShowS
showList :: [StyleDoc] -> ShowS
Show)
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 -> 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
$cshowsPrec :: Int -> AnsiAnn -> ShowS
showsPrec :: Int -> AnsiAnn -> ShowS
$cshow :: AnsiAnn -> String
show :: AnsiAnn -> String
$cshowList :: [AnsiAnn] -> ShowS
showList :: [AnsiAnn] -> ShowS
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)
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
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
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 <- 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
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 a. a -> m a
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 AnsiAnn
-> ReaderT (Map SGRTag SGR) Identity (b, Utf8Builder)
-> ReaderT (Map SGRTag SGR) Identity (b, Utf8Builder)
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 [SGR]
sgrs) 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 -> 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 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'
(a
extra, b
contents) <- (Map SGRTag SGR -> Map SGRTag SGR) -> m (a, b) -> m (a, b)
forall a. (Map SGRTag SGR -> Map SGRTag SGR) -> m a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
extra, Map SGRTag SGR -> Map SGRTag SGR -> b
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 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} {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 ([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
(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
_ -> 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)
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
(Maybe (SimpleDoc a)
mafter, 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 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)
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
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
(<+>) :: 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)
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
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
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
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 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 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 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
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 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 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
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
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
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