{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE BangPatterns #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveGeneric #-}
#endif
#ifndef TESTING
module Text.PrettyPrint.Annotated.HughesPJ (
Doc, TextDetails(..), AnnotDetails(..),
char, text, ptext, sizedText, zeroWidthText,
int, integer, float, double, rational,
semi, comma, colon, space, equals,
lparen, rparen, lbrack, rbrack, lbrace, rbrace,
parens, brackets, braces, quotes, doubleQuotes,
maybeParens, maybeBrackets, maybeBraces, maybeQuotes, maybeDoubleQuotes,
empty,
(<>), (<+>), hcat, hsep,
($$), ($+$), vcat,
sep, cat,
fsep, fcat,
nest,
hang, punctuate,
annotate,
isEmpty,
first, reduceDoc,
render,
renderSpans, Span(..),
renderDecorated,
renderDecoratedM,
Style(..),
style,
renderStyle,
Mode(..),
fullRender,
fullRenderAnn
) where
#endif
import Control.DeepSeq ( NFData(rnf) )
import Data.Function ( on )
#if __GLASGOW_HASKELL__ >= 803
import Prelude hiding ( (<>) )
#endif
#if __GLASGOW_HASKELL__ >= 800
import qualified Data.Semigroup as Semi ( Semigroup((<>)) )
#elif __GLASGOW_HASKELL__ < 709
import Data.Monoid ( Monoid(mempty, mappend) )
#endif
import Data.String ( IsString(fromString) )
import GHC.Generics
infixl 6 <>
infixl 6 <+>
infixl 5 $$, $+$
data Doc a
= Empty
| NilAbove (Doc a)
| TextBeside !(AnnotDetails a) (Doc a)
| Nest {-# UNPACK #-} !Int (Doc a)
| Union (Doc a) (Doc a)
| NoDoc
| Beside (Doc a) Bool (Doc a)
| Above (Doc a) Bool (Doc a)
#if __GLASGOW_HASKELL__ >= 701
deriving ((forall x. Doc a -> Rep (Doc a) x)
-> (forall x. Rep (Doc a) x -> Doc a) -> Generic (Doc a)
forall x. Rep (Doc a) x -> Doc a
forall x. Doc a -> Rep (Doc a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Doc a) x -> Doc a
forall a x. Doc a -> Rep (Doc a) x
$cfrom :: forall a x. Doc a -> Rep (Doc a) x
from :: forall x. Doc a -> Rep (Doc a) x
$cto :: forall a x. Rep (Doc a) x -> Doc a
to :: forall x. Rep (Doc a) x -> Doc a
Generic)
#endif
type RDoc = Doc
data AnnotDetails a = AnnotStart
| NoAnnot !TextDetails {-# UNPACK #-} !Int
| AnnotEnd a
deriving (Int -> AnnotDetails a -> ShowS
[AnnotDetails a] -> ShowS
AnnotDetails a -> String
(Int -> AnnotDetails a -> ShowS)
-> (AnnotDetails a -> String)
-> ([AnnotDetails a] -> ShowS)
-> Show (AnnotDetails a)
forall a. Show a => Int -> AnnotDetails a -> ShowS
forall a. Show a => [AnnotDetails a] -> ShowS
forall a. Show a => AnnotDetails a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AnnotDetails a -> ShowS
showsPrec :: Int -> AnnotDetails a -> ShowS
$cshow :: forall a. Show a => AnnotDetails a -> String
show :: AnnotDetails a -> String
$cshowList :: forall a. Show a => [AnnotDetails a] -> ShowS
showList :: [AnnotDetails a] -> ShowS
Show,AnnotDetails a -> AnnotDetails a -> Bool
(AnnotDetails a -> AnnotDetails a -> Bool)
-> (AnnotDetails a -> AnnotDetails a -> Bool)
-> Eq (AnnotDetails a)
forall a. Eq a => AnnotDetails a -> AnnotDetails a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => AnnotDetails a -> AnnotDetails a -> Bool
== :: AnnotDetails a -> AnnotDetails a -> Bool
$c/= :: forall a. Eq a => AnnotDetails a -> AnnotDetails a -> Bool
/= :: AnnotDetails a -> AnnotDetails a -> Bool
Eq)
instance Functor AnnotDetails where
fmap :: forall a b. (a -> b) -> AnnotDetails a -> AnnotDetails b
fmap a -> b
_ AnnotDetails a
AnnotStart = AnnotDetails b
forall a. AnnotDetails a
AnnotStart
fmap a -> b
_ (NoAnnot TextDetails
d Int
i) = TextDetails -> Int -> AnnotDetails b
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot TextDetails
d Int
i
fmap a -> b
f (AnnotEnd a
a) = b -> AnnotDetails b
forall a. a -> AnnotDetails a
AnnotEnd (a -> b
f a
a)
annotSize :: AnnotDetails a -> Int
annotSize :: forall a. AnnotDetails a -> Int
annotSize (NoAnnot TextDetails
_ Int
l) = Int
l
annotSize AnnotDetails a
_ = Int
0
data TextDetails = Chr {-# UNPACK #-} !Char
| Str String
| PStr String
#if __GLASGOW_HASKELL__ >= 701
deriving (Int -> TextDetails -> ShowS
[TextDetails] -> ShowS
TextDetails -> String
(Int -> TextDetails -> ShowS)
-> (TextDetails -> String)
-> ([TextDetails] -> ShowS)
-> Show TextDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextDetails -> ShowS
showsPrec :: Int -> TextDetails -> ShowS
$cshow :: TextDetails -> String
show :: TextDetails -> String
$cshowList :: [TextDetails] -> ShowS
showList :: [TextDetails] -> ShowS
Show, TextDetails -> TextDetails -> Bool
(TextDetails -> TextDetails -> Bool)
-> (TextDetails -> TextDetails -> Bool) -> Eq TextDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextDetails -> TextDetails -> Bool
== :: TextDetails -> TextDetails -> Bool
$c/= :: TextDetails -> TextDetails -> Bool
/= :: TextDetails -> TextDetails -> Bool
Eq, (forall x. TextDetails -> Rep TextDetails x)
-> (forall x. Rep TextDetails x -> TextDetails)
-> Generic TextDetails
forall x. Rep TextDetails x -> TextDetails
forall x. TextDetails -> Rep TextDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextDetails -> Rep TextDetails x
from :: forall x. TextDetails -> Rep TextDetails x
$cto :: forall x. Rep TextDetails x -> TextDetails
to :: forall x. Rep TextDetails x -> TextDetails
Generic)
#endif
#if __GLASGOW_HASKELL__ >= 800
instance Semi.Semigroup (Doc a) where
#ifndef TESTING
<> :: Doc a -> Doc a -> Doc a
(<>) = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(Text.PrettyPrint.Annotated.HughesPJ.<>)
#else
(<>) = (PrettyTestVersion.<>)
#endif
instance Monoid (Doc a) where
mempty :: Doc a
mempty = Doc a
forall a. Doc a
empty
mappend :: Doc a -> Doc a -> Doc a
mappend = Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
(Semi.<>)
#else
instance Monoid (Doc a) where
mempty = empty
mappend = (<>)
#endif
instance IsString (Doc a) where
fromString :: String -> Doc a
fromString = String -> Doc a
forall a. String -> Doc a
text
instance Show (Doc a) where
showsPrec :: Int -> Doc a -> ShowS
showsPrec Int
_ Doc a
doc String
cont = Mode
-> Int
-> Float
-> (TextDetails -> ShowS)
-> String
-> Doc a
-> String
forall a b.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc b -> a
fullRender (Style -> Mode
mode Style
style) (Style -> Int
lineLength Style
style)
(Style -> Float
ribbonsPerLine Style
style)
TextDetails -> ShowS
txtPrinter String
cont Doc a
doc
instance Eq (Doc a) where
== :: Doc a -> Doc a -> Bool
(==) = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (Doc a -> String) -> Doc a -> Doc a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Doc a -> String
forall a. Doc a -> String
render
instance Functor Doc where
fmap :: forall a b. (a -> b) -> Doc a -> Doc b
fmap a -> b
_ Doc a
Empty = Doc b
forall a. Doc a
Empty
fmap a -> b
f (NilAbove Doc a
d) = Doc b -> Doc b
forall a. Doc a -> Doc a
NilAbove ((a -> b) -> Doc a -> Doc b
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Doc a
d)
fmap a -> b
f (TextBeside AnnotDetails a
td Doc a
d) = AnnotDetails b -> Doc b -> Doc b
forall a. AnnotDetails a -> Doc a -> Doc a
TextBeside ((a -> b) -> AnnotDetails a -> AnnotDetails b
forall a b. (a -> b) -> AnnotDetails a -> AnnotDetails b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f AnnotDetails a
td) ((a -> b) -> Doc a -> Doc b
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Doc a
d)
fmap a -> b
f (Nest Int
k Doc a
d) = Int -> Doc b -> Doc b
forall a. Int -> Doc a -> Doc a
Nest Int
k ((a -> b) -> Doc a -> Doc b
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Doc a
d)
fmap a -> b
f (Union Doc a
ur Doc a
ul) = Doc b -> Doc b -> Doc b
forall a. Doc a -> Doc a -> Doc a
Union ((a -> b) -> Doc a -> Doc b
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Doc a
ur) ((a -> b) -> Doc a -> Doc b
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Doc a
ul)
fmap a -> b
_ Doc a
NoDoc = Doc b
forall a. Doc a
NoDoc
fmap a -> b
f (Beside Doc a
ld Bool
s Doc a
rd) = Doc b -> Bool -> Doc b -> Doc b
forall a. Doc a -> Bool -> Doc a -> Doc a
Beside ((a -> b) -> Doc a -> Doc b
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Doc a
ld) Bool
s ((a -> b) -> Doc a -> Doc b
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Doc a
rd)
fmap a -> b
f (Above Doc a
ud Bool
s Doc a
ld) = Doc b -> Bool -> Doc b -> Doc b
forall a. Doc a -> Bool -> Doc a -> Doc a
Above ((a -> b) -> Doc a -> Doc b
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Doc a
ud) Bool
s ((a -> b) -> Doc a -> Doc b
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Doc a
ld)
instance NFData a => NFData (Doc a) where
rnf :: Doc a -> ()
rnf Doc a
Empty = ()
rnf (NilAbove Doc a
d) = Doc a -> ()
forall a. NFData a => a -> ()
rnf Doc a
d
rnf (TextBeside AnnotDetails a
td Doc a
d) = AnnotDetails a -> ()
forall a. NFData a => a -> ()
rnf AnnotDetails a
td () -> () -> ()
forall a b. a -> b -> b
`seq` Doc a -> ()
forall a. NFData a => a -> ()
rnf Doc a
d
rnf (Nest Int
k Doc a
d) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
k () -> () -> ()
forall a b. a -> b -> b
`seq` Doc a -> ()
forall a. NFData a => a -> ()
rnf Doc a
d
rnf (Union Doc a
ur Doc a
ul) = Doc a -> ()
forall a. NFData a => a -> ()
rnf Doc a
ur () -> () -> ()
forall a b. a -> b -> b
`seq` Doc a -> ()
forall a. NFData a => a -> ()
rnf Doc a
ul
rnf Doc a
NoDoc = ()
rnf (Beside Doc a
ld Bool
s Doc a
rd) = Doc a -> ()
forall a. NFData a => a -> ()
rnf Doc a
ld () -> () -> ()
forall a b. a -> b -> b
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
s () -> () -> ()
forall a b. a -> b -> b
`seq` Doc a -> ()
forall a. NFData a => a -> ()
rnf Doc a
rd
rnf (Above Doc a
ud Bool
s Doc a
ld) = Doc a -> ()
forall a. NFData a => a -> ()
rnf Doc a
ud () -> () -> ()
forall a b. a -> b -> b
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
s () -> () -> ()
forall a b. a -> b -> b
`seq` Doc a -> ()
forall a. NFData a => a -> ()
rnf Doc a
ld
instance NFData a => NFData (AnnotDetails a) where
rnf :: AnnotDetails a -> ()
rnf AnnotDetails a
AnnotStart = ()
rnf (NoAnnot TextDetails
d Int
sl) = TextDetails -> ()
forall a. NFData a => a -> ()
rnf TextDetails
d () -> () -> ()
forall a b. a -> b -> b
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
sl
rnf (AnnotEnd a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
instance NFData TextDetails where
rnf :: TextDetails -> ()
rnf (Chr Char
c) = Char -> ()
forall a. NFData a => a -> ()
rnf Char
c
rnf (Str String
str) = String -> ()
forall a. NFData a => a -> ()
rnf String
str
rnf (PStr String
str) = String -> ()
forall a. NFData a => a -> ()
rnf String
str
annotate :: a -> Doc a -> Doc a
annotate :: forall a. a -> Doc a -> Doc a
annotate a
a Doc a
d = AnnotDetails a -> Doc a -> Doc a
forall a. AnnotDetails a -> Doc a -> Doc a
TextBeside AnnotDetails a
forall a. AnnotDetails a
AnnotStart
(Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
d) Bool
False
(Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ AnnotDetails a -> Doc a -> Doc a
forall a. AnnotDetails a -> Doc a -> Doc a
TextBeside (a -> AnnotDetails a
forall a. a -> AnnotDetails a
AnnotEnd a
a) Doc a
forall a. Doc a
Empty
char :: Char -> Doc a
char :: forall a. Char -> Doc a
char Char
c = AnnotDetails a -> RDoc a -> RDoc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ (TextDetails -> Int -> AnnotDetails a
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot (Char -> TextDetails
Chr Char
c) Int
1) RDoc a
forall a. Doc a
Empty
text :: String -> Doc a
text :: forall a. String -> Doc a
text String
s = case String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s of {Int
sl -> AnnotDetails a -> Doc a -> Doc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ (TextDetails -> Int -> AnnotDetails a
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot (String -> TextDetails
Str String
s) Int
sl) Doc a
forall a. Doc a
Empty}
ptext :: String -> Doc a
ptext :: forall a. String -> Doc a
ptext String
s = case String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s of {Int
sl -> AnnotDetails a -> Doc a -> Doc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ (TextDetails -> Int -> AnnotDetails a
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot (String -> TextDetails
PStr String
s) Int
sl) Doc a
forall a. Doc a
Empty}
sizedText :: Int -> String -> Doc a
sizedText :: forall a. Int -> String -> Doc a
sizedText Int
l String
s = AnnotDetails a -> RDoc a -> RDoc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ (TextDetails -> Int -> AnnotDetails a
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot (String -> TextDetails
Str String
s) Int
l) RDoc a
forall a. Doc a
Empty
zeroWidthText :: String -> Doc a
zeroWidthText :: forall a. String -> Doc a
zeroWidthText = Int -> String -> Doc a
forall a. Int -> String -> Doc a
sizedText Int
0
empty :: Doc a
empty :: forall a. Doc a
empty = Doc a
forall a. Doc a
Empty
isEmpty :: Doc a -> Bool
isEmpty :: forall a. Doc a -> Bool
isEmpty Doc a
Empty = Bool
True
isEmpty Doc a
_ = Bool
False
indent :: Int -> String
indent :: Int -> String
indent !Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '
semi :: Doc a
comma :: Doc a
colon :: Doc a
space :: Doc a
equals :: Doc a
lparen :: Doc a
rparen :: Doc a
lbrack :: Doc a
rbrack :: Doc a
lbrace :: Doc a
rbrace :: Doc a
semi :: forall a. Doc a
semi = Char -> Doc a
forall a. Char -> Doc a
char Char
';'
comma :: forall a. Doc a
comma = Char -> Doc a
forall a. Char -> Doc a
char Char
','
colon :: forall a. Doc a
colon = Char -> Doc a
forall a. Char -> Doc a
char Char
':'
space :: forall a. Doc a
space = Char -> Doc a
forall a. Char -> Doc a
char Char
' '
equals :: forall a. Doc a
equals = Char -> Doc a
forall a. Char -> Doc a
char Char
'='
lparen :: forall a. Doc a
lparen = Char -> Doc a
forall a. Char -> Doc a
char Char
'('
rparen :: forall a. Doc a
rparen = Char -> Doc a
forall a. Char -> Doc a
char Char
')'
lbrack :: forall a. Doc a
lbrack = Char -> Doc a
forall a. Char -> Doc a
char Char
'['
rbrack :: forall a. Doc a
rbrack = Char -> Doc a
forall a. Char -> Doc a
char Char
']'
lbrace :: forall a. Doc a
lbrace = Char -> Doc a
forall a. Char -> Doc a
char Char
'{'
rbrace :: forall a. Doc a
rbrace = Char -> Doc a
forall a. Char -> Doc a
char Char
'}'
spaceText, nlText :: AnnotDetails a
spaceText :: forall a. AnnotDetails a
spaceText = TextDetails -> Int -> AnnotDetails a
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot (Char -> TextDetails
Chr Char
' ') Int
1
nlText :: forall a. AnnotDetails a
nlText = TextDetails -> Int -> AnnotDetails a
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot (Char -> TextDetails
Chr Char
'\n') Int
1
int :: Int -> Doc a
integer :: Integer -> Doc a
float :: Float -> Doc a
double :: Double -> Doc a
rational :: Rational -> Doc a
int :: forall a. Int -> Doc a
int Int
n = String -> Doc a
forall a. String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
n)
integer :: forall a. Integer -> Doc a
integer Integer
n = String -> Doc a
forall a. String -> Doc a
text (Integer -> String
forall a. Show a => a -> String
show Integer
n)
float :: forall a. Float -> Doc a
float Float
n = String -> Doc a
forall a. String -> Doc a
text (Float -> String
forall a. Show a => a -> String
show Float
n)
double :: forall a. Double -> Doc a
double Double
n = String -> Doc a
forall a. String -> Doc a
text (Double -> String
forall a. Show a => a -> String
show Double
n)
rational :: forall a. Rational -> Doc a
rational Rational
n = String -> Doc a
forall a. String -> Doc a
text (Rational -> String
forall a. Show a => a -> String
show Rational
n)
parens :: Doc a -> Doc a
brackets :: Doc a -> Doc a
braces :: Doc a -> Doc a
quotes :: Doc a -> Doc a
doubleQuotes :: Doc a -> Doc a
quotes :: forall a. Doc a -> Doc a
quotes Doc a
p = Char -> Doc a
forall a. Char -> Doc a
char Char
'\'' Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
p Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Char -> Doc a
forall a. Char -> Doc a
char Char
'\''
doubleQuotes :: forall a. Doc a -> Doc a
doubleQuotes Doc a
p = Char -> Doc a
forall a. Char -> Doc a
char Char
'"' Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
p Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Char -> Doc a
forall a. Char -> Doc a
char Char
'"'
parens :: forall a. Doc a -> Doc a
parens Doc a
p = Char -> Doc a
forall a. Char -> Doc a
char Char
'(' Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
p Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Char -> Doc a
forall a. Char -> Doc a
char Char
')'
brackets :: forall a. Doc a -> Doc a
brackets Doc a
p = Char -> Doc a
forall a. Char -> Doc a
char Char
'[' Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
p Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Char -> Doc a
forall a. Char -> Doc a
char Char
']'
braces :: forall a. Doc a -> Doc a
braces Doc a
p = Char -> Doc a
forall a. Char -> Doc a
char Char
'{' Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
p Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Char -> Doc a
forall a. Char -> Doc a
char Char
'}'
maybeParens :: Bool -> Doc a -> Doc a
maybeParens :: forall a. Bool -> Doc a -> Doc a
maybeParens Bool
False = Doc a -> Doc a
forall a. a -> a
id
maybeParens Bool
True = Doc a -> Doc a
forall a. Doc a -> Doc a
parens
maybeBrackets :: Bool -> Doc a -> Doc a
maybeBrackets :: forall a. Bool -> Doc a -> Doc a
maybeBrackets Bool
False = Doc a -> Doc a
forall a. a -> a
id
maybeBrackets Bool
True = Doc a -> Doc a
forall a. Doc a -> Doc a
brackets
maybeBraces :: Bool -> Doc a -> Doc a
maybeBraces :: forall a. Bool -> Doc a -> Doc a
maybeBraces Bool
False = Doc a -> Doc a
forall a. a -> a
id
maybeBraces Bool
True = Doc a -> Doc a
forall a. Doc a -> Doc a
braces
maybeQuotes :: Bool -> Doc a -> Doc a
maybeQuotes :: forall a. Bool -> Doc a -> Doc a
maybeQuotes Bool
False = Doc a -> Doc a
forall a. a -> a
id
maybeQuotes Bool
True = Doc a -> Doc a
forall a. Doc a -> Doc a
quotes
maybeDoubleQuotes :: Bool -> Doc a -> Doc a
maybeDoubleQuotes :: forall a. Bool -> Doc a -> Doc a
maybeDoubleQuotes Bool
False = Doc a -> Doc a
forall a. a -> a
id
maybeDoubleQuotes Bool
True = Doc a -> Doc a
forall a. Doc a -> Doc a
doubleQuotes
reduceDoc :: Doc a -> RDoc a
reduceDoc :: forall a. Doc a -> Doc a
reduceDoc (Beside Doc a
p Bool
g Doc a
q) = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside Doc a
p Bool
g (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
q)
reduceDoc (Above Doc a
p Bool
g Doc a
q) = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
above Doc a
p Bool
g (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
q)
reduceDoc Doc a
p = Doc a
p
hcat :: [Doc a] -> Doc a
hcat :: forall a. [Doc a] -> Doc a
hcat = (IsEmpty, Doc a) -> Doc a
forall a b. (a, b) -> b
snd ((IsEmpty, Doc a) -> Doc a)
-> ([Doc a] -> (IsEmpty, Doc a)) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> (IsEmpty, Doc a)
forall a. Doc a -> (IsEmpty, Doc a)
reduceHoriz (Doc a -> (IsEmpty, Doc a))
-> ([Doc a] -> Doc a) -> [Doc a] -> (IsEmpty, Doc a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc a -> Doc a -> Doc a) -> Doc a -> [Doc a] -> Doc a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Doc a
p Doc a
q -> Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
Beside Doc a
p Bool
False Doc a
q) Doc a
forall a. Doc a
empty
hsep :: [Doc a] -> Doc a
hsep :: forall a. [Doc a] -> Doc a
hsep = (IsEmpty, Doc a) -> Doc a
forall a b. (a, b) -> b
snd ((IsEmpty, Doc a) -> Doc a)
-> ([Doc a] -> (IsEmpty, Doc a)) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> (IsEmpty, Doc a)
forall a. Doc a -> (IsEmpty, Doc a)
reduceHoriz (Doc a -> (IsEmpty, Doc a))
-> ([Doc a] -> Doc a) -> [Doc a] -> (IsEmpty, Doc a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc a -> Doc a -> Doc a) -> Doc a -> [Doc a] -> Doc a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Doc a
p Doc a
q -> Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
Beside Doc a
p Bool
True Doc a
q) Doc a
forall a. Doc a
empty
vcat :: [Doc a] -> Doc a
vcat :: forall a. [Doc a] -> Doc a
vcat = (IsEmpty, Doc a) -> Doc a
forall a b. (a, b) -> b
snd ((IsEmpty, Doc a) -> Doc a)
-> ([Doc a] -> (IsEmpty, Doc a)) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> (IsEmpty, Doc a)
forall a. Doc a -> (IsEmpty, Doc a)
reduceVert (Doc a -> (IsEmpty, Doc a))
-> ([Doc a] -> Doc a) -> [Doc a] -> (IsEmpty, Doc a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc a -> Doc a -> Doc a) -> Doc a -> [Doc a] -> Doc a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Doc a
p Doc a
q -> Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
Above Doc a
p Bool
False Doc a
q) Doc a
forall a. Doc a
empty
nest :: Int -> Doc a -> Doc a
nest :: forall a. Int -> Doc a -> Doc a
nest Int
k Doc a
p = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
mkNest Int
k (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
p)
hang :: Doc a -> Int -> Doc a -> Doc a
hang :: forall a. Doc a -> Int -> Doc a -> Doc a
hang Doc a
d1 Int
n Doc a
d2 = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
sep [Doc a
d1, Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
nest Int
n Doc a
d2]
punctuate :: Doc a -> [Doc a] -> [Doc a]
punctuate :: forall a. Doc a -> [Doc a] -> [Doc a]
punctuate Doc a
_ [] = []
punctuate Doc a
p (Doc a
x:[Doc a]
xs) = Doc a -> [Doc a] -> [Doc a]
go Doc a
x [Doc a]
xs
where go :: Doc a -> [Doc a] -> [Doc a]
go Doc a
y [] = [Doc a
y]
go Doc a
y (Doc a
z:[Doc a]
zs) = (Doc a
y Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
p) Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: Doc a -> [Doc a] -> [Doc a]
go Doc a
z [Doc a]
zs
mkNest :: Int -> Doc a -> Doc a
mkNest :: forall a. Int -> Doc a -> Doc a
mkNest Int
k Doc a
_ | Int
k Int -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = Doc a
forall a. HasCallStack => a
undefined
mkNest Int
k (Nest Int
k1 Doc a
p) = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
mkNest (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k1) Doc a
p
mkNest Int
_ Doc a
NoDoc = Doc a
forall a. Doc a
NoDoc
mkNest Int
_ Doc a
Empty = Doc a
forall a. Doc a
Empty
mkNest Int
0 Doc a
p = Doc a
p
mkNest Int
k Doc a
p = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
nest_ Int
k Doc a
p
mkUnion :: Doc a -> Doc a -> Doc a
mkUnion :: forall a. Doc a -> Doc a -> Doc a
mkUnion Doc a
Empty Doc a
_ = Doc a
forall a. Doc a
Empty
mkUnion Doc a
p Doc a
q = Doc a
p Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
`union_` Doc a
q
data IsEmpty = IsEmpty | NotEmpty
reduceHoriz :: Doc a -> (IsEmpty, Doc a)
reduceHoriz :: forall a. Doc a -> (IsEmpty, Doc a)
reduceHoriz (Beside Doc a
p Bool
g Doc a
q) = (Doc a -> Bool -> Doc a -> Doc a)
-> Doc a -> Bool -> (IsEmpty, Doc a) -> (IsEmpty, Doc a)
forall a.
(Doc a -> Bool -> Doc a -> Doc a)
-> Doc a -> Bool -> (IsEmpty, Doc a) -> (IsEmpty, Doc a)
eliminateEmpty Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
Beside ((IsEmpty, Doc a) -> Doc a
forall a b. (a, b) -> b
snd (Doc a -> (IsEmpty, Doc a)
forall a. Doc a -> (IsEmpty, Doc a)
reduceHoriz Doc a
p)) Bool
g (Doc a -> (IsEmpty, Doc a)
forall a. Doc a -> (IsEmpty, Doc a)
reduceHoriz Doc a
q)
reduceHoriz Doc a
doc = (IsEmpty
NotEmpty, Doc a
doc)
reduceVert :: Doc a -> (IsEmpty, Doc a)
reduceVert :: forall a. Doc a -> (IsEmpty, Doc a)
reduceVert (Above Doc a
p Bool
g Doc a
q) = (Doc a -> Bool -> Doc a -> Doc a)
-> Doc a -> Bool -> (IsEmpty, Doc a) -> (IsEmpty, Doc a)
forall a.
(Doc a -> Bool -> Doc a -> Doc a)
-> Doc a -> Bool -> (IsEmpty, Doc a) -> (IsEmpty, Doc a)
eliminateEmpty Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
Above ((IsEmpty, Doc a) -> Doc a
forall a b. (a, b) -> b
snd (Doc a -> (IsEmpty, Doc a)
forall a. Doc a -> (IsEmpty, Doc a)
reduceVert Doc a
p)) Bool
g (Doc a -> (IsEmpty, Doc a)
forall a. Doc a -> (IsEmpty, Doc a)
reduceVert Doc a
q)
reduceVert Doc a
doc = (IsEmpty
NotEmpty, Doc a
doc)
{-# INLINE eliminateEmpty #-}
eliminateEmpty ::
(Doc a -> Bool -> Doc a -> Doc a) ->
Doc a -> Bool -> (IsEmpty, Doc a) -> (IsEmpty, Doc a)
eliminateEmpty :: forall a.
(Doc a -> Bool -> Doc a -> Doc a)
-> Doc a -> Bool -> (IsEmpty, Doc a) -> (IsEmpty, Doc a)
eliminateEmpty Doc a -> Bool -> Doc a -> Doc a
_ Doc a
Empty Bool
_ (IsEmpty, Doc a)
q = (IsEmpty, Doc a)
q
eliminateEmpty Doc a -> Bool -> Doc a -> Doc a
cons Doc a
p Bool
g (IsEmpty, Doc a)
q =
(IsEmpty
NotEmpty,
case (IsEmpty, Doc a)
q of
(IsEmpty
NotEmpty, Doc a
q') -> Doc a -> Bool -> Doc a -> Doc a
cons Doc a
p Bool
g Doc a
q'
(IsEmpty
IsEmpty, Doc a
_) -> Doc a
p)
nilAbove_ :: RDoc a -> RDoc a
nilAbove_ :: forall a. Doc a -> Doc a
nilAbove_ = Doc a -> Doc a
forall a. Doc a -> Doc a
NilAbove
textBeside_ :: AnnotDetails a -> RDoc a -> RDoc a
textBeside_ :: forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ = AnnotDetails a -> Doc a -> Doc a
forall a. AnnotDetails a -> Doc a -> Doc a
TextBeside
nest_ :: Int -> RDoc a -> RDoc a
nest_ :: forall a. Int -> Doc a -> Doc a
nest_ = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
Nest
union_ :: RDoc a -> RDoc a -> RDoc a
union_ :: forall a. Doc a -> Doc a -> Doc a
union_ = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Union
($$) :: Doc a -> Doc a -> Doc a
Doc a
p $$ :: forall a. Doc a -> Doc a -> Doc a
$$ Doc a
q = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
above_ Doc a
p Bool
False Doc a
q
($+$) :: Doc a -> Doc a -> Doc a
Doc a
p $+$ :: forall a. Doc a -> Doc a -> Doc a
$+$ Doc a
q = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
above_ Doc a
p Bool
True Doc a
q
above_ :: Doc a -> Bool -> Doc a -> Doc a
above_ :: forall a. Doc a -> Bool -> Doc a -> Doc a
above_ Doc a
p Bool
_ Doc a
Empty = Doc a
p
above_ Doc a
Empty Bool
_ Doc a
q = Doc a
q
above_ Doc a
p Bool
g Doc a
q = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
Above Doc a
p Bool
g Doc a
q
above :: Doc a -> Bool -> RDoc a -> RDoc a
above :: forall a. Doc a -> Bool -> Doc a -> Doc a
above (Above Doc a
p Bool
g1 Doc a
q1) Bool
g2 Doc a
q2 = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
above Doc a
p Bool
g1 (Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
above Doc a
q1 Bool
g2 Doc a
q2)
above p :: Doc a
p@(Beside{}) Bool
g Doc a
q = Doc a -> Bool -> Int -> Doc a -> Doc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
p) Bool
g Int
0 (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
q)
above Doc a
p Bool
g Doc a
q = Doc a -> Bool -> Int -> Doc a -> Doc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest Doc a
p Bool
g Int
0 (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
q)
aboveNest :: RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest :: forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest RDoc a
_ Bool
_ Int
k RDoc a
_ | Int
k Int -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = RDoc a
forall a. HasCallStack => a
undefined
aboveNest RDoc a
NoDoc Bool
_ Int
_ RDoc a
_ = RDoc a
forall a. Doc a
NoDoc
aboveNest (RDoc a
p1 `Union` RDoc a
p2) Bool
g Int
k RDoc a
q = RDoc a -> Bool -> Int -> RDoc a -> RDoc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest RDoc a
p1 Bool
g Int
k RDoc a
q RDoc a -> RDoc a -> RDoc a
forall a. Doc a -> Doc a -> Doc a
`union_`
RDoc a -> Bool -> Int -> RDoc a -> RDoc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest RDoc a
p2 Bool
g Int
k RDoc a
q
aboveNest RDoc a
Empty Bool
_ Int
k RDoc a
q = Int -> RDoc a -> RDoc a
forall a. Int -> Doc a -> Doc a
mkNest Int
k RDoc a
q
aboveNest (Nest Int
k1 RDoc a
p) Bool
g Int
k RDoc a
q = Int -> RDoc a -> RDoc a
forall a. Int -> Doc a -> Doc a
nest_ Int
k1 (RDoc a -> Bool -> Int -> RDoc a -> RDoc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest RDoc a
p Bool
g (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k1) RDoc a
q)
aboveNest (NilAbove RDoc a
p) Bool
g Int
k RDoc a
q = RDoc a -> RDoc a
forall a. Doc a -> Doc a
nilAbove_ (RDoc a -> Bool -> Int -> RDoc a -> RDoc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest RDoc a
p Bool
g Int
k RDoc a
q)
aboveNest (TextBeside AnnotDetails a
s RDoc a
p) Bool
g Int
k RDoc a
q = AnnotDetails a -> RDoc a -> RDoc a
forall a. AnnotDetails a -> Doc a -> Doc a
TextBeside AnnotDetails a
s RDoc a
rest
where
!k1 :: Int
k1 = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- AnnotDetails a -> Int
forall a. AnnotDetails a -> Int
annotSize AnnotDetails a
s
rest :: RDoc a
rest = case RDoc a
p of
RDoc a
Empty -> Bool -> Int -> RDoc a -> RDoc a
forall a. Bool -> Int -> RDoc a -> RDoc a
nilAboveNest Bool
g Int
k1 RDoc a
q
RDoc a
_ -> RDoc a -> Bool -> Int -> RDoc a -> RDoc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest RDoc a
p Bool
g Int
k1 RDoc a
q
aboveNest (Above {}) Bool
_ Int
_ RDoc a
_ = String -> RDoc a
forall a. HasCallStack => String -> a
error String
"aboveNest Above"
aboveNest (Beside {}) Bool
_ Int
_ RDoc a
_ = String -> RDoc a
forall a. HasCallStack => String -> a
error String
"aboveNest Beside"
nilAboveNest :: Bool -> Int -> RDoc a -> RDoc a
nilAboveNest :: forall a. Bool -> Int -> RDoc a -> RDoc a
nilAboveNest Bool
_ Int
k RDoc a
_ | Int
k Int -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = RDoc a
forall a. HasCallStack => a
undefined
nilAboveNest Bool
_ Int
_ RDoc a
Empty = RDoc a
forall a. Doc a
Empty
nilAboveNest Bool
g Int
k (Nest Int
k1 RDoc a
q) = Bool -> Int -> RDoc a -> RDoc a
forall a. Bool -> Int -> RDoc a -> RDoc a
nilAboveNest Bool
g (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k1) RDoc a
q
nilAboveNest Bool
g Int
k RDoc a
q | Bool -> Bool
not Bool
g Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
= AnnotDetails a -> RDoc a -> RDoc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ (TextDetails -> Int -> AnnotDetails a
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot (String -> TextDetails
Str (Int -> String
indent Int
k)) Int
k) RDoc a
q
| Bool
otherwise
= RDoc a -> RDoc a
forall a. Doc a -> Doc a
nilAbove_ (Int -> RDoc a -> RDoc a
forall a. Int -> Doc a -> Doc a
mkNest Int
k RDoc a
q)
(<>) :: Doc a -> Doc a -> Doc a
Doc a
p <> :: forall a. Doc a -> Doc a -> Doc a
<> Doc a
q = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside_ Doc a
p Bool
False Doc a
q
(<+>) :: Doc a -> Doc a -> Doc a
Doc a
p <+> :: forall a. Doc a -> Doc a -> Doc a
<+> Doc a
q = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside_ Doc a
p Bool
True Doc a
q
beside_ :: Doc a -> Bool -> Doc a -> Doc a
beside_ :: forall a. Doc a -> Bool -> Doc a -> Doc a
beside_ Doc a
p Bool
_ Doc a
Empty = Doc a
p
beside_ Doc a
Empty Bool
_ Doc a
q = Doc a
q
beside_ Doc a
p Bool
g Doc a
q = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
Beside Doc a
p Bool
g Doc a
q
beside :: Doc a -> Bool -> RDoc a -> RDoc a
beside :: forall a. Doc a -> Bool -> Doc a -> Doc a
beside Doc a
NoDoc Bool
_ Doc a
_ = Doc a
forall a. Doc a
NoDoc
beside (Doc a
p1 `Union` Doc a
p2) Bool
g Doc a
q = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside Doc a
p1 Bool
g Doc a
q Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
`union_` Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside Doc a
p2 Bool
g Doc a
q
beside Doc a
Empty Bool
_ Doc a
q = Doc a
q
beside (Nest Int
k Doc a
p) Bool
g Doc a
q = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
nest_ Int
k (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$! Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside Doc a
p Bool
g Doc a
q
beside p :: Doc a
p@(Beside Doc a
p1 Bool
g1 Doc a
q1) Bool
g2 Doc a
q2
| Bool
g1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
g2 = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside Doc a
p1 Bool
g1 (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$! Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside Doc a
q1 Bool
g2 Doc a
q2
| Bool
otherwise = Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
p) Bool
g2 Doc a
q2
beside p :: Doc a
p@(Above{}) Bool
g Doc a
q = let !d :: Doc a
d = Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
p in Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside Doc a
d Bool
g Doc a
q
beside (NilAbove Doc a
p) Bool
g Doc a
q = Doc a -> Doc a
forall a. Doc a -> Doc a
nilAbove_ (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$! Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside Doc a
p Bool
g Doc a
q
beside (TextBeside AnnotDetails a
t Doc a
p) Bool
g Doc a
q = AnnotDetails a -> Doc a -> Doc a
forall a. AnnotDetails a -> Doc a -> Doc a
TextBeside AnnotDetails a
t Doc a
rest
where
rest :: Doc a
rest = case Doc a
p of
Doc a
Empty -> Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
nilBeside Bool
g Doc a
q
Doc a
_ -> Doc a -> Bool -> Doc a -> Doc a
forall a. Doc a -> Bool -> Doc a -> Doc a
beside Doc a
p Bool
g Doc a
q
nilBeside :: Bool -> RDoc a -> RDoc a
nilBeside :: forall a. Bool -> Doc a -> Doc a
nilBeside Bool
_ Doc a
Empty = Doc a
forall a. Doc a
Empty
nilBeside Bool
g (Nest Int
_ Doc a
p) = Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
nilBeside Bool
g Doc a
p
nilBeside Bool
g Doc a
p | Bool
g = AnnotDetails a -> Doc a -> Doc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ AnnotDetails a
forall a. AnnotDetails a
spaceText Doc a
p
| Bool
otherwise = Doc a
p
sep :: [Doc a] -> Doc a
sep :: forall a. [Doc a] -> Doc a
sep = Bool -> [Doc a] -> Doc a
forall a. Bool -> [Doc a] -> Doc a
sepX Bool
True
cat :: [Doc a] -> Doc a
cat :: forall a. [Doc a] -> Doc a
cat = Bool -> [Doc a] -> Doc a
forall a. Bool -> [Doc a] -> Doc a
sepX Bool
False
sepX :: Bool -> [Doc a] -> Doc a
sepX :: forall a. Bool -> [Doc a] -> Doc a
sepX Bool
_ [] = Doc a
forall a. Doc a
empty
sepX Bool
x (Doc a
p:[Doc a]
ps) = Bool -> Doc a -> Int -> [Doc a] -> Doc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
sep1 Bool
x (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
p) Int
0 [Doc a]
ps
sep1 :: Bool -> RDoc a -> Int -> [Doc a] -> RDoc a
sep1 :: forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
sep1 Bool
_ RDoc a
_ Int
k [RDoc a]
_ | Int
k Int -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = RDoc a
forall a. HasCallStack => a
undefined
sep1 Bool
_ RDoc a
NoDoc Int
_ [RDoc a]
_ = RDoc a
forall a. Doc a
NoDoc
sep1 Bool
g (RDoc a
p `Union` RDoc a
q) Int
k [RDoc a]
ys = Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
sep1 Bool
g RDoc a
p Int
k [RDoc a]
ys RDoc a -> RDoc a -> RDoc a
forall a. Doc a -> Doc a -> Doc a
`union_`
RDoc a -> Bool -> Int -> RDoc a -> RDoc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest RDoc a
q Bool
False Int
k (RDoc a -> RDoc a
forall a. Doc a -> Doc a
reduceDoc ([RDoc a] -> RDoc a
forall a. [Doc a] -> Doc a
vcat [RDoc a]
ys))
sep1 Bool
g RDoc a
Empty Int
k [RDoc a]
ys = Int -> RDoc a -> RDoc a
forall a. Int -> Doc a -> Doc a
mkNest Int
k (Bool -> [RDoc a] -> RDoc a
forall a. Bool -> [Doc a] -> Doc a
sepX Bool
g [RDoc a]
ys)
sep1 Bool
g (Nest Int
n RDoc a
p) Int
k [RDoc a]
ys = Int -> RDoc a -> RDoc a
forall a. Int -> Doc a -> Doc a
nest_ Int
n (Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
sep1 Bool
g RDoc a
p (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) [RDoc a]
ys)
sep1 Bool
_ (NilAbove RDoc a
p) Int
k [RDoc a]
ys = RDoc a -> RDoc a
forall a. Doc a -> Doc a
nilAbove_
(RDoc a -> Bool -> Int -> RDoc a -> RDoc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest RDoc a
p Bool
False Int
k (RDoc a -> RDoc a
forall a. Doc a -> Doc a
reduceDoc ([RDoc a] -> RDoc a
forall a. [Doc a] -> Doc a
vcat [RDoc a]
ys)))
sep1 Bool
g (TextBeside AnnotDetails a
s RDoc a
p) Int
k [RDoc a]
ys = AnnotDetails a -> RDoc a -> RDoc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ AnnotDetails a
s (Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
sepNB Bool
g RDoc a
p (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- AnnotDetails a -> Int
forall a. AnnotDetails a -> Int
annotSize AnnotDetails a
s) [RDoc a]
ys)
sep1 Bool
_ (Above {}) Int
_ [RDoc a]
_ = String -> RDoc a
forall a. HasCallStack => String -> a
error String
"sep1 Above"
sep1 Bool
_ (Beside {}) Int
_ [RDoc a]
_ = String -> RDoc a
forall a. HasCallStack => String -> a
error String
"sep1 Beside"
sepNB :: Bool -> Doc a -> Int -> [Doc a] -> Doc a
sepNB :: forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
sepNB Bool
g (Nest Int
_ Doc a
p) Int
k [Doc a]
ys
= Bool -> Doc a -> Int -> [Doc a] -> Doc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
sepNB Bool
g Doc a
p Int
k [Doc a]
ys
sepNB Bool
g Doc a
Empty Int
k [Doc a]
ys
= Doc a -> Doc a
forall a. Doc a -> Doc a
oneLiner (Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
nilBeside Bool
g (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
rest)) Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
`mkUnion`
Bool -> Int -> Doc a -> Doc a
forall a. Bool -> Int -> RDoc a -> RDoc a
nilAboveNest Bool
False Int
k (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc ([Doc a] -> Doc a
forall a. [Doc a] -> Doc a
vcat [Doc a]
ys))
where
rest :: Doc a
rest | Bool
g = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hsep [Doc a]
ys
| Bool
otherwise = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat [Doc a]
ys
sepNB Bool
g Doc a
p Int
k [Doc a]
ys
= Bool -> Doc a -> Int -> [Doc a] -> Doc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
sep1 Bool
g Doc a
p Int
k [Doc a]
ys
fcat :: [Doc a] -> Doc a
fcat :: forall a. [Doc a] -> Doc a
fcat = Bool -> [Doc a] -> Doc a
forall a. Bool -> [Doc a] -> Doc a
fill Bool
False
fsep :: [Doc a] -> Doc a
fsep :: forall a. [Doc a] -> Doc a
fsep = Bool -> [Doc a] -> Doc a
forall a. Bool -> [Doc a] -> Doc a
fill Bool
True
fill :: Bool -> [Doc a] -> RDoc a
fill :: forall a. Bool -> [Doc a] -> Doc a
fill Bool
_ [] = Doc a
forall a. Doc a
empty
fill Bool
g (Doc a
p:[Doc a]
ps) = Bool -> Doc a -> Int -> [Doc a] -> Doc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
fill1 Bool
g (Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc Doc a
p) Int
0 [Doc a]
ps
fill1 :: Bool -> RDoc a -> Int -> [Doc a] -> Doc a
fill1 :: forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
fill1 Bool
_ RDoc a
_ Int
k [RDoc a]
_ | Int
k Int -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = RDoc a
forall a. HasCallStack => a
undefined
fill1 Bool
_ RDoc a
NoDoc Int
_ [RDoc a]
_ = RDoc a
forall a. Doc a
NoDoc
fill1 Bool
g (RDoc a
p `Union` RDoc a
q) Int
k [RDoc a]
ys = Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
fill1 Bool
g RDoc a
p Int
k [RDoc a]
ys RDoc a -> RDoc a -> RDoc a
forall a. Doc a -> Doc a -> Doc a
`union_`
RDoc a -> Bool -> Int -> RDoc a -> RDoc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest RDoc a
q Bool
False Int
k (Bool -> [RDoc a] -> RDoc a
forall a. Bool -> [Doc a] -> Doc a
fill Bool
g [RDoc a]
ys)
fill1 Bool
g RDoc a
Empty Int
k [RDoc a]
ys = Int -> RDoc a -> RDoc a
forall a. Int -> Doc a -> Doc a
mkNest Int
k (Bool -> [RDoc a] -> RDoc a
forall a. Bool -> [Doc a] -> Doc a
fill Bool
g [RDoc a]
ys)
fill1 Bool
g (Nest Int
n RDoc a
p) Int
k [RDoc a]
ys = Int -> RDoc a -> RDoc a
forall a. Int -> Doc a -> Doc a
nest_ Int
n (Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
fill1 Bool
g RDoc a
p (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) [RDoc a]
ys)
fill1 Bool
g (NilAbove RDoc a
p) Int
k [RDoc a]
ys = RDoc a -> RDoc a
forall a. Doc a -> Doc a
nilAbove_ (RDoc a -> Bool -> Int -> RDoc a -> RDoc a
forall a. RDoc a -> Bool -> Int -> RDoc a -> RDoc a
aboveNest RDoc a
p Bool
False Int
k (Bool -> [RDoc a] -> RDoc a
forall a. Bool -> [Doc a] -> Doc a
fill Bool
g [RDoc a]
ys))
fill1 Bool
g (TextBeside AnnotDetails a
s RDoc a
p) Int
k [RDoc a]
ys = AnnotDetails a -> RDoc a -> RDoc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ AnnotDetails a
s (Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
fillNB Bool
g RDoc a
p (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- AnnotDetails a -> Int
forall a. AnnotDetails a -> Int
annotSize AnnotDetails a
s) [RDoc a]
ys)
fill1 Bool
_ (Above {}) Int
_ [RDoc a]
_ = String -> RDoc a
forall a. HasCallStack => String -> a
error String
"fill1 Above"
fill1 Bool
_ (Beside {}) Int
_ [RDoc a]
_ = String -> RDoc a
forall a. HasCallStack => String -> a
error String
"fill1 Beside"
fillNB :: Bool -> Doc a -> Int -> [Doc a] -> Doc a
fillNB :: forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
fillNB Bool
_ Doc a
_ Int
k [Doc a]
_ | Int
k Int -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = Doc a
forall a. HasCallStack => a
undefined
fillNB Bool
g (Nest Int
_ Doc a
p) Int
k [Doc a]
ys = Bool -> Doc a -> Int -> [Doc a] -> Doc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
fillNB Bool
g Doc a
p Int
k [Doc a]
ys
fillNB Bool
_ Doc a
Empty Int
_ [] = Doc a
forall a. Doc a
Empty
fillNB Bool
g Doc a
Empty Int
k (Doc a
Empty:[Doc a]
ys) = Bool -> Doc a -> Int -> [Doc a] -> Doc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
fillNB Bool
g Doc a
forall a. Doc a
Empty Int
k [Doc a]
ys
fillNB Bool
g Doc a
Empty Int
k (Doc a
y:[Doc a]
ys) = Bool -> Int -> Doc a -> [Doc a] -> Doc a
forall a. Bool -> Int -> Doc a -> [Doc a] -> Doc a
fillNBE Bool
g Int
k Doc a
y [Doc a]
ys
fillNB Bool
g Doc a
p Int
k [Doc a]
ys = Bool -> Doc a -> Int -> [Doc a] -> Doc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
fill1 Bool
g Doc a
p Int
k [Doc a]
ys
fillNBE :: Bool -> Int -> Doc a -> [Doc a] -> Doc a
fillNBE :: forall a. Bool -> Int -> Doc a -> [Doc a] -> Doc a
fillNBE Bool
g Int
k Doc a
y [Doc a]
ys
= Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
nilBeside Bool
g (Bool -> Doc a -> Int -> [Doc a] -> Doc a
forall a. Bool -> RDoc a -> Int -> [RDoc a] -> RDoc a
fill1 Bool
g ((Doc a -> Doc a
forall a. Doc a -> Doc a
elideNest (Doc a -> Doc a) -> (Doc a -> Doc a) -> Doc a -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> Doc a
forall a. Doc a -> Doc a
oneLiner (Doc a -> Doc a) -> (Doc a -> Doc a) -> Doc a -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> Doc a
forall a. Doc a -> Doc a
reduceDoc) Doc a
y) Int
k' [Doc a]
ys)
Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
`mkUnion` Bool -> Int -> Doc a -> Doc a
forall a. Bool -> Int -> RDoc a -> RDoc a
nilAboveNest Bool
False Int
k (Bool -> [Doc a] -> Doc a
forall a. Bool -> [Doc a] -> Doc a
fill Bool
g (Doc a
yDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ys))
where k' :: Int
k' = if Bool
g then Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
k
elideNest :: Doc a -> Doc a
elideNest :: forall a. Doc a -> Doc a
elideNest (Nest Int
_ Doc a
d) = Doc a
d
elideNest Doc a
d = Doc a
d
best :: Int
-> Int
-> RDoc a
-> RDoc a
best :: forall a. Int -> Int -> RDoc a -> RDoc a
best Int
w0 Int
r = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
get Int
w0
where
get :: Int -> Doc a -> Doc a
get Int
w Doc a
_ | Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool
False = Doc a
forall a. HasCallStack => a
undefined
get Int
_ Doc a
Empty = Doc a
forall a. Doc a
Empty
get Int
_ Doc a
NoDoc = Doc a
forall a. Doc a
NoDoc
get Int
w (NilAbove Doc a
p) = Doc a -> Doc a
forall a. Doc a -> Doc a
nilAbove_ (Int -> Doc a -> Doc a
get Int
w Doc a
p)
get Int
w (TextBeside AnnotDetails a
s Doc a
p) = AnnotDetails a -> Doc a -> Doc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ AnnotDetails a
s (Int -> Int -> Doc a -> Doc a
get1 Int
w (AnnotDetails a -> Int
forall a. AnnotDetails a -> Int
annotSize AnnotDetails a
s) Doc a
p)
get Int
w (Nest Int
k Doc a
p) = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
nest_ Int
k (Int -> Doc a -> Doc a
get (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) Doc a
p)
get Int
w (Doc a
p `Union` Doc a
q) = Int -> Int -> Doc a -> Doc a -> Doc a
forall a. Int -> Int -> Doc a -> Doc a -> Doc a
nicest Int
w Int
r (Int -> Doc a -> Doc a
get Int
w Doc a
p) (Int -> Doc a -> Doc a
get Int
w Doc a
q)
get Int
_ (Above {}) = String -> Doc a
forall a. HasCallStack => String -> a
error String
"best get Above"
get Int
_ (Beside {}) = String -> Doc a
forall a. HasCallStack => String -> a
error String
"best get Beside"
get1 :: Int -> Int -> Doc a -> Doc a
get1 Int
w Int
_ Doc a
_ | Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool
False = Doc a
forall a. HasCallStack => a
undefined
get1 Int
_ Int
_ Doc a
Empty = Doc a
forall a. Doc a
Empty
get1 Int
_ Int
_ Doc a
NoDoc = Doc a
forall a. Doc a
NoDoc
get1 Int
w Int
sl (NilAbove Doc a
p) = Doc a -> Doc a
forall a. Doc a -> Doc a
nilAbove_ (Int -> Doc a -> Doc a
get (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sl) Doc a
p)
get1 Int
w Int
sl (TextBeside AnnotDetails a
s Doc a
p) = AnnotDetails a -> Doc a -> Doc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ AnnotDetails a
s (Int -> Int -> Doc a -> Doc a
get1 Int
w (Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AnnotDetails a -> Int
forall a. AnnotDetails a -> Int
annotSize AnnotDetails a
s) Doc a
p)
get1 Int
w Int
sl (Nest Int
_ Doc a
p) = Int -> Int -> Doc a -> Doc a
get1 Int
w Int
sl Doc a
p
get1 Int
w Int
sl (Doc a
p `Union` Doc a
q) = Int -> Int -> Int -> Doc a -> Doc a -> Doc a
forall a. Int -> Int -> Int -> Doc a -> Doc a -> Doc a
nicest1 Int
w Int
r Int
sl (Int -> Int -> Doc a -> Doc a
get1 Int
w Int
sl Doc a
p)
(Int -> Int -> Doc a -> Doc a
get1 Int
w Int
sl Doc a
q)
get1 Int
_ Int
_ (Above {}) = String -> Doc a
forall a. HasCallStack => String -> a
error String
"best get1 Above"
get1 Int
_ Int
_ (Beside {}) = String -> Doc a
forall a. HasCallStack => String -> a
error String
"best get1 Beside"
nicest :: Int -> Int -> Doc a -> Doc a -> Doc a
nicest :: forall a. Int -> Int -> Doc a -> Doc a -> Doc a
nicest !Int
w !Int
r = Int -> Int -> Int -> Doc a -> Doc a -> Doc a
forall a. Int -> Int -> Int -> Doc a -> Doc a -> Doc a
nicest1 Int
w Int
r Int
0
nicest1 :: Int -> Int -> Int -> Doc a -> Doc a -> Doc a
nicest1 :: forall a. Int -> Int -> Int -> Doc a -> Doc a -> Doc a
nicest1 !Int
w !Int
r !Int
sl Doc a
p Doc a
q | Int -> Doc a -> Bool
forall a. Int -> Doc a -> Bool
fits ((Int
w Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
r) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sl) Doc a
p = Doc a
p
| Bool
otherwise = Doc a
q
fits :: Int
-> Doc a
-> Bool
fits :: forall a. Int -> Doc a -> Bool
fits Int
n Doc a
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
False
fits Int
_ Doc a
NoDoc = Bool
False
fits Int
_ Doc a
Empty = Bool
True
fits Int
_ (NilAbove Doc a
_) = Bool
True
fits Int
n (TextBeside AnnotDetails a
s Doc a
p) = Int -> Doc a -> Bool
forall a. Int -> Doc a -> Bool
fits (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- AnnotDetails a -> Int
forall a. AnnotDetails a -> Int
annotSize AnnotDetails a
s) Doc a
p
fits Int
_ (Above {}) = String -> Bool
forall a. HasCallStack => String -> a
error String
"fits Above"
fits Int
_ (Beside {}) = String -> Bool
forall a. HasCallStack => String -> a
error String
"fits Beside"
fits Int
_ (Union {}) = String -> Bool
forall a. HasCallStack => String -> a
error String
"fits Union"
fits Int
_ (Nest {}) = String -> Bool
forall a. HasCallStack => String -> a
error String
"fits Nest"
first :: Doc a -> Doc a -> Doc a
first :: forall a. Doc a -> Doc a -> Doc a
first Doc a
p Doc a
q | Doc a -> Bool
forall a. Doc a -> Bool
nonEmptySet Doc a
p = Doc a
p
| Bool
otherwise = Doc a
q
nonEmptySet :: Doc a -> Bool
nonEmptySet :: forall a. Doc a -> Bool
nonEmptySet Doc a
NoDoc = Bool
False
nonEmptySet (Doc a
_ `Union` Doc a
_) = Bool
True
nonEmptySet Doc a
Empty = Bool
True
nonEmptySet (NilAbove Doc a
_) = Bool
True
nonEmptySet (TextBeside AnnotDetails a
_ Doc a
p) = Doc a -> Bool
forall a. Doc a -> Bool
nonEmptySet Doc a
p
nonEmptySet (Nest Int
_ Doc a
p) = Doc a -> Bool
forall a. Doc a -> Bool
nonEmptySet Doc a
p
nonEmptySet (Above {}) = String -> Bool
forall a. HasCallStack => String -> a
error String
"nonEmptySet Above"
nonEmptySet (Beside {}) = String -> Bool
forall a. HasCallStack => String -> a
error String
"nonEmptySet Beside"
oneLiner :: Doc a -> Doc a
oneLiner :: forall a. Doc a -> Doc a
oneLiner Doc a
NoDoc = Doc a
forall a. Doc a
NoDoc
oneLiner Doc a
Empty = Doc a
forall a. Doc a
Empty
oneLiner (NilAbove Doc a
_) = Doc a
forall a. Doc a
NoDoc
oneLiner (TextBeside AnnotDetails a
s Doc a
p) = AnnotDetails a -> Doc a -> Doc a
forall a. AnnotDetails a -> Doc a -> Doc a
textBeside_ AnnotDetails a
s (Doc a -> Doc a
forall a. Doc a -> Doc a
oneLiner Doc a
p)
oneLiner (Nest Int
k Doc a
p) = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
nest_ Int
k (Doc a -> Doc a
forall a. Doc a -> Doc a
oneLiner Doc a
p)
oneLiner (Doc a
p `Union` Doc a
_) = Doc a -> Doc a
forall a. Doc a -> Doc a
oneLiner Doc a
p
oneLiner (Above {}) = String -> Doc a
forall a. HasCallStack => String -> a
error String
"oneLiner Above"
oneLiner (Beside {}) = String -> Doc a
forall a. HasCallStack => String -> a
error String
"oneLiner Beside"
data Style
= Style { Style -> Mode
mode :: Mode
, Style -> Int
lineLength :: Int
, Style -> Float
ribbonsPerLine :: Float
}
#if __GLASGOW_HASKELL__ >= 701
deriving (Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> String
show :: Style -> String
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
Show, Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
/= :: Style -> Style -> Bool
Eq, (forall x. Style -> Rep Style x)
-> (forall x. Rep Style x -> Style) -> Generic Style
forall x. Rep Style x -> Style
forall x. Style -> Rep Style x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Style -> Rep Style x
from :: forall x. Style -> Rep Style x
$cto :: forall x. Rep Style x -> Style
to :: forall x. Rep Style x -> Style
Generic)
#endif
style :: Style
style :: Style
style = Style { lineLength :: Int
lineLength = Int
100, ribbonsPerLine :: Float
ribbonsPerLine = Float
1.5, mode :: Mode
mode = Mode
PageMode }
data Mode = PageMode
| ZigZagMode
| LeftMode
| OneLineMode
#if __GLASGOW_HASKELL__ >= 701
deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> String
show :: Mode -> String
$cshowList :: [Mode] -> ShowS
showList :: [Mode] -> ShowS
Show, Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
Eq, (forall x. Mode -> Rep Mode x)
-> (forall x. Rep Mode x -> Mode) -> Generic Mode
forall x. Rep Mode x -> Mode
forall x. Mode -> Rep Mode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Mode -> Rep Mode x
from :: forall x. Mode -> Rep Mode x
$cto :: forall x. Rep Mode x -> Mode
to :: forall x. Rep Mode x -> Mode
Generic)
#endif
render :: Doc a -> String
render :: forall a. Doc a -> String
render = Mode
-> Int
-> Float
-> (TextDetails -> ShowS)
-> String
-> Doc a
-> String
forall a b.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc b -> a
fullRender (Style -> Mode
mode Style
style) (Style -> Int
lineLength Style
style) (Style -> Float
ribbonsPerLine Style
style)
TextDetails -> ShowS
txtPrinter String
""
renderStyle :: Style -> Doc a -> String
renderStyle :: forall a. Style -> Doc a -> String
renderStyle Style
s = Mode
-> Int
-> Float
-> (TextDetails -> ShowS)
-> String
-> Doc a
-> String
forall a b.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc b -> a
fullRender (Style -> Mode
mode Style
s) (Style -> Int
lineLength Style
s) (Style -> Float
ribbonsPerLine Style
s)
TextDetails -> ShowS
txtPrinter String
""
txtPrinter :: TextDetails -> String -> String
txtPrinter :: TextDetails -> ShowS
txtPrinter (Chr Char
c) String
s = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
s
txtPrinter (Str String
s1) String
s2 = String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2
txtPrinter (PStr String
s1) String
s2 = String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2
fullRender :: Mode
-> Int
-> Float
-> (TextDetails -> a -> a)
-> a
-> Doc b
-> a
fullRender :: forall a b.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc b -> a
fullRender Mode
m Int
l Float
r TextDetails -> a -> a
txt = Mode
-> Int -> Float -> (AnnotDetails b -> a -> a) -> a -> Doc b -> a
forall b a.
Mode
-> Int -> Float -> (AnnotDetails b -> a -> a) -> a -> Doc b -> a
fullRenderAnn Mode
m Int
l Float
r AnnotDetails b -> a -> a
forall {a}. AnnotDetails a -> a -> a
annTxt
where
annTxt :: AnnotDetails a -> a -> a
annTxt (NoAnnot TextDetails
s Int
_) = TextDetails -> a -> a
txt TextDetails
s
annTxt AnnotDetails a
_ = a -> a
forall a. a -> a
id
fullRenderAnn :: Mode
-> Int
-> Float
-> (AnnotDetails b -> a -> a)
-> a
-> Doc b
-> a
fullRenderAnn :: forall b a.
Mode
-> Int -> Float -> (AnnotDetails b -> a -> a) -> a -> Doc b -> a
fullRenderAnn Mode
OneLineMode Int
_ Float
_ AnnotDetails b -> a -> a
txt a
end Doc b
doc
= AnnotDetails b
-> (Doc b -> Doc b -> Doc b)
-> (AnnotDetails b -> a -> a)
-> a
-> Doc b
-> a
forall b a.
AnnotDetails b
-> (Doc b -> Doc b -> Doc b)
-> (AnnotDetails b -> a -> a)
-> a
-> Doc b
-> a
easyDisplay AnnotDetails b
forall a. AnnotDetails a
spaceText (\Doc b
_ Doc b
y -> Doc b
y) AnnotDetails b -> a -> a
txt a
end (Doc b -> Doc b
forall a. Doc a -> Doc a
reduceDoc Doc b
doc)
fullRenderAnn Mode
LeftMode Int
_ Float
_ AnnotDetails b -> a -> a
txt a
end Doc b
doc
= AnnotDetails b
-> (Doc b -> Doc b -> Doc b)
-> (AnnotDetails b -> a -> a)
-> a
-> Doc b
-> a
forall b a.
AnnotDetails b
-> (Doc b -> Doc b -> Doc b)
-> (AnnotDetails b -> a -> a)
-> a
-> Doc b
-> a
easyDisplay AnnotDetails b
forall a. AnnotDetails a
nlText Doc b -> Doc b -> Doc b
forall a. Doc a -> Doc a -> Doc a
first AnnotDetails b -> a -> a
txt a
end (Doc b -> Doc b
forall a. Doc a -> Doc a
reduceDoc Doc b
doc)
fullRenderAnn Mode
m Int
lineLen Float
ribbons AnnotDetails b -> a -> a
txt a
rest Doc b
doc
= Mode -> Int -> Int -> (AnnotDetails b -> a -> a) -> a -> Doc b -> a
forall b a.
Mode -> Int -> Int -> (AnnotDetails b -> a -> a) -> a -> Doc b -> a
display Mode
m Int
lineLen Int
ribbonLen AnnotDetails b -> a -> a
txt a
rest Doc b
doc'
where
doc' :: Doc b
doc' = Int -> Int -> Doc b -> Doc b
forall a. Int -> Int -> RDoc a -> RDoc a
best Int
bestLineLen Int
ribbonLen (Doc b -> Doc b
forall a. Doc a -> Doc a
reduceDoc Doc b
doc)
bestLineLen, ribbonLen :: Int
ribbonLen :: Int
ribbonLen = Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineLen Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
ribbons)
bestLineLen :: Int
bestLineLen = case Mode
m of
Mode
ZigZagMode -> Int
forall a. Bounded a => a
maxBound
Mode
_ -> Int
lineLen
easyDisplay :: AnnotDetails b
-> (Doc b -> Doc b -> Doc b)
-> (AnnotDetails b -> a -> a)
-> a
-> Doc b
-> a
easyDisplay :: forall b a.
AnnotDetails b
-> (Doc b -> Doc b -> Doc b)
-> (AnnotDetails b -> a -> a)
-> a
-> Doc b
-> a
easyDisplay AnnotDetails b
nlSpaceText Doc b -> Doc b -> Doc b
choose AnnotDetails b -> a -> a
txt a
end
= Doc b -> a
lay
where
lay :: Doc b -> a
lay Doc b
NoDoc = String -> a
forall a. HasCallStack => String -> a
error String
"easyDisplay: NoDoc"
lay (Union Doc b
p Doc b
q) = Doc b -> a
lay (Doc b -> Doc b -> Doc b
choose Doc b
p Doc b
q)
lay (Nest Int
_ Doc b
p) = Doc b -> a
lay Doc b
p
lay Doc b
Empty = a
end
lay (NilAbove Doc b
p) = AnnotDetails b
nlSpaceText AnnotDetails b -> a -> a
`txt` Doc b -> a
lay Doc b
p
lay (TextBeside AnnotDetails b
s Doc b
p) = AnnotDetails b
s AnnotDetails b -> a -> a
`txt` Doc b -> a
lay Doc b
p
lay (Above {}) = String -> a
forall a. HasCallStack => String -> a
error String
"easyDisplay Above"
lay (Beside {}) = String -> a
forall a. HasCallStack => String -> a
error String
"easyDisplay Beside"
display :: Mode -> Int -> Int -> (AnnotDetails b -> a -> a) -> a -> Doc b -> a
display :: forall b a.
Mode -> Int -> Int -> (AnnotDetails b -> a -> a) -> a -> Doc b -> a
display Mode
m !Int
page_width !Int
ribbon_width AnnotDetails b -> a -> a
txt a
end Doc b
doc
= case Int
page_width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ribbon_width of { Int
gap_width ->
case Int
gap_width Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2 of { Int
shift ->
let
lay :: Int -> Doc b -> a
lay Int
k Doc b
_ | Int
k Int -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = a
forall a. HasCallStack => a
undefined
lay Int
k (Nest Int
k1 Doc b
p) = Int -> Doc b -> a
lay (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k1) Doc b
p
lay Int
_ Doc b
Empty = a
end
lay Int
k (NilAbove Doc b
p) = AnnotDetails b
forall a. AnnotDetails a
nlText AnnotDetails b -> a -> a
`txt` Int -> Doc b -> a
lay Int
k Doc b
p
lay Int
k (TextBeside AnnotDetails b
s Doc b
p)
= case Mode
m of
Mode
ZigZagMode | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
gap_width
-> AnnotDetails b
forall a. AnnotDetails a
nlText AnnotDetails b -> a -> a
`txt` (
TextDetails -> Int -> AnnotDetails b
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot (String -> TextDetails
Str (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
shift Char
'/')) Int
shift AnnotDetails b -> a -> a
`txt` (
AnnotDetails b
forall a. AnnotDetails a
nlText AnnotDetails b -> a -> a
`txt`
Int -> AnnotDetails b -> Doc b -> a
lay1 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
shift) AnnotDetails b
s Doc b
p ))
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
-> AnnotDetails b
forall a. AnnotDetails a
nlText AnnotDetails b -> a -> a
`txt` (
TextDetails -> Int -> AnnotDetails b
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot (String -> TextDetails
Str (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
shift Char
'\\')) Int
shift AnnotDetails b -> a -> a
`txt` (
AnnotDetails b
forall a. AnnotDetails a
nlText AnnotDetails b -> a -> a
`txt`
Int -> AnnotDetails b -> Doc b -> a
lay1 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shift) AnnotDetails b
s Doc b
p ))
Mode
_ -> Int -> AnnotDetails b -> Doc b -> a
lay1 Int
k AnnotDetails b
s Doc b
p
lay Int
_ (Above {}) = String -> a
forall a. HasCallStack => String -> a
error String
"display lay Above"
lay Int
_ (Beside {}) = String -> a
forall a. HasCallStack => String -> a
error String
"display lay Beside"
lay Int
_ Doc b
NoDoc = String -> a
forall a. HasCallStack => String -> a
error String
"display lay NoDoc"
lay Int
_ (Union {}) = String -> a
forall a. HasCallStack => String -> a
error String
"display lay Union"
lay1 :: Int -> AnnotDetails b -> Doc b -> a
lay1 !Int
k AnnotDetails b
s Doc b
p = let !r :: Int
r = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AnnotDetails b -> Int
forall a. AnnotDetails a -> Int
annotSize AnnotDetails b
s
in TextDetails -> Int -> AnnotDetails b
forall a. TextDetails -> Int -> AnnotDetails a
NoAnnot (String -> TextDetails
Str (Int -> String
indent Int
k)) Int
k AnnotDetails b -> a -> a
`txt` (AnnotDetails b
s AnnotDetails b -> a -> a
`txt` Int -> Doc b -> a
lay2 Int
r Doc b
p)
lay2 :: Int -> Doc b -> a
lay2 Int
k Doc b
_ | Int
k Int -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = a
forall a. HasCallStack => a
undefined
lay2 Int
k (NilAbove Doc b
p) = AnnotDetails b
forall a. AnnotDetails a
nlText AnnotDetails b -> a -> a
`txt` Int -> Doc b -> a
lay Int
k Doc b
p
lay2 Int
k (TextBeside AnnotDetails b
s Doc b
p) = AnnotDetails b
s AnnotDetails b -> a -> a
`txt` Int -> Doc b -> a
lay2 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AnnotDetails b -> Int
forall a. AnnotDetails a -> Int
annotSize AnnotDetails b
s) Doc b
p
lay2 Int
k (Nest Int
_ Doc b
p) = Int -> Doc b -> a
lay2 Int
k Doc b
p
lay2 Int
_ Doc b
Empty = a
end
lay2 Int
_ (Above {}) = String -> a
forall a. HasCallStack => String -> a
error String
"display lay2 Above"
lay2 Int
_ (Beside {}) = String -> a
forall a. HasCallStack => String -> a
error String
"display lay2 Beside"
lay2 Int
_ Doc b
NoDoc = String -> a
forall a. HasCallStack => String -> a
error String
"display lay2 NoDoc"
lay2 Int
_ (Union {}) = String -> a
forall a. HasCallStack => String -> a
error String
"display lay2 Union"
in
Int -> Doc b -> a
lay Int
0 Doc b
doc
}}
data Span a = Span { forall a. Span a -> Int
spanStart :: !Int
, forall a. Span a -> Int
spanLength :: !Int
, forall a. Span a -> a
spanAnnotation :: a
} deriving (Int -> Span a -> ShowS
[Span a] -> ShowS
Span a -> String
(Int -> Span a -> ShowS)
-> (Span a -> String) -> ([Span a] -> ShowS) -> Show (Span a)
forall a. Show a => Int -> Span a -> ShowS
forall a. Show a => [Span a] -> ShowS
forall a. Show a => Span a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Span a -> ShowS
showsPrec :: Int -> Span a -> ShowS
$cshow :: forall a. Show a => Span a -> String
show :: Span a -> String
$cshowList :: forall a. Show a => [Span a] -> ShowS
showList :: [Span a] -> ShowS
Show,Span a -> Span a -> Bool
(Span a -> Span a -> Bool)
-> (Span a -> Span a -> Bool) -> Eq (Span a)
forall a. Eq a => Span a -> Span a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Span a -> Span a -> Bool
== :: Span a -> Span a -> Bool
$c/= :: forall a. Eq a => Span a -> Span a -> Bool
/= :: Span a -> Span a -> Bool
Eq)
instance Functor Span where
fmap :: forall a b. (a -> b) -> Span a -> Span b
fmap a -> b
f (Span Int
x Int
y a
a) = Int -> Int -> b -> Span b
forall a. Int -> Int -> a -> Span a
Span Int
x Int
y (a -> b
f a
a)
data Spans a = Spans { forall a. Spans a -> Int
sOffset :: !Int
, forall a. Spans a -> [Int -> Span a]
sStack :: [Int -> Span a]
, forall a. Spans a -> [Span a]
sSpans :: [Span a]
, forall a. Spans a -> String
sOutput :: String
}
renderSpans :: Doc ann -> (String,[Span ann])
renderSpans :: forall ann. Doc ann -> (String, [Span ann])
renderSpans = Spans ann -> (String, [Span ann])
forall {a}. Spans a -> (String, [Span a])
finalize
(Spans ann -> (String, [Span ann]))
-> (Doc ann -> Spans ann) -> Doc ann -> (String, [Span ann])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode
-> Int
-> Float
-> (AnnotDetails ann -> Spans ann -> Spans ann)
-> Spans ann
-> Doc ann
-> Spans ann
forall b a.
Mode
-> Int -> Float -> (AnnotDetails b -> a -> a) -> a -> Doc b -> a
fullRenderAnn (Style -> Mode
mode Style
style) (Style -> Int
lineLength Style
style) (Style -> Float
ribbonsPerLine Style
style)
AnnotDetails ann -> Spans ann -> Spans ann
forall {a}. AnnotDetails a -> Spans a -> Spans a
spanPrinter
Spans { sOffset :: Int
sOffset = Int
0, sStack :: [Int -> Span ann]
sStack = [], sSpans :: [Span ann]
sSpans = [], sOutput :: String
sOutput = String
"" }
where
finalize :: Spans a -> (String, [Span a])
finalize (Spans Int
size [Int -> Span a]
_ [Span a]
spans String
out) = (String
out, (Span a -> Span a) -> [Span a] -> [Span a]
forall a b. (a -> b) -> [a] -> [b]
map Span a -> Span a
forall {a}. Span a -> Span a
adjust [Span a]
spans)
where
adjust :: Span a -> Span a
adjust Span a
s = Span a
s { spanStart = size - spanStart s }
mkSpan :: a -> Int -> Int -> Span a
mkSpan a
a Int
end Int
start = Span { spanStart :: Int
spanStart = Int
start
, spanLength :: Int
spanLength = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end
, spanAnnotation :: a
spanAnnotation = a
a }
spanPrinter :: AnnotDetails a -> Spans a -> Spans a
spanPrinter AnnotDetails a
AnnotStart Spans a
s =
case Spans a -> [Int -> Span a]
forall a. Spans a -> [Int -> Span a]
sStack Spans a
s of
Int -> Span a
sp : [Int -> Span a]
rest -> Spans a
s { sSpans = sp (sOffset s) : sSpans s, sStack = rest }
[Int -> Span a]
_ -> String -> Spans a
forall a. HasCallStack => String -> a
error String
"renderSpans: stack underflow"
spanPrinter (AnnotEnd a
a) Spans a
s =
Spans a
s { sStack = mkSpan a (sOffset s) : sStack s }
spanPrinter (NoAnnot TextDetails
td Int
l) Spans a
s =
case TextDetails
td of
Chr Char
c -> Spans a
s { sOutput = c : sOutput s, sOffset = sOffset s + l }
Str String
t -> Spans a
s { sOutput = t ++ sOutput s, sOffset = sOffset s + l }
PStr String
t -> Spans a
s { sOutput = t ++ sOutput s, sOffset = sOffset s + l }
renderDecorated :: (ann -> String)
-> (ann -> String)
-> Doc ann -> String
renderDecorated :: forall ann. (ann -> String) -> (ann -> String) -> Doc ann -> String
renderDecorated ann -> String
startAnn ann -> String
endAnn =
(String, [ann]) -> String
forall {a} {b}. (a, b) -> a
finalize ((String, [ann]) -> String)
-> (Doc ann -> (String, [ann])) -> Doc ann -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode
-> Int
-> Float
-> (AnnotDetails ann -> (String, [ann]) -> (String, [ann]))
-> (String, [ann])
-> Doc ann
-> (String, [ann])
forall b a.
Mode
-> Int -> Float -> (AnnotDetails b -> a -> a) -> a -> Doc b -> a
fullRenderAnn (Style -> Mode
mode Style
style) (Style -> Int
lineLength Style
style) (Style -> Float
ribbonsPerLine Style
style)
AnnotDetails ann -> (String, [ann]) -> (String, [ann])
annPrinter
(String
"", [])
where
annPrinter :: AnnotDetails ann -> (String, [ann]) -> (String, [ann])
annPrinter AnnotDetails ann
AnnotStart (String
rest,[ann]
stack) =
case [ann]
stack of
ann
a : [ann]
as -> (ann -> String
startAnn ann
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest, [ann]
as)
[ann]
_ -> String -> (String, [ann])
forall a. HasCallStack => String -> a
error String
"renderDecorated: stack underflow"
annPrinter (AnnotEnd ann
a) (String
rest,[ann]
stack) =
(ann -> String
endAnn ann
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest, ann
a ann -> [ann] -> [ann]
forall a. a -> [a] -> [a]
: [ann]
stack)
annPrinter (NoAnnot TextDetails
s Int
_) (String
rest,[ann]
stack) =
(TextDetails -> ShowS
txtPrinter TextDetails
s String
rest, [ann]
stack)
finalize :: (a, b) -> a
finalize (a
str,b
_) = a
str
renderDecoratedM :: Monad m
=> (ann -> m r)
-> (ann -> m r)
-> (String -> m r)
-> m r
-> Doc ann -> m r
renderDecoratedM :: forall (m :: * -> *) ann r.
Monad m =>
(ann -> m r)
-> (ann -> m r) -> (String -> m r) -> m r -> Doc ann -> m r
renderDecoratedM ann -> m r
startAnn ann -> m r
endAnn String -> m r
txt m r
docEnd =
(m r, [ann]) -> m r
forall {a} {b}. (a, b) -> a
finalize ((m r, [ann]) -> m r)
-> (Doc ann -> (m r, [ann])) -> Doc ann -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode
-> Int
-> Float
-> (AnnotDetails ann -> (m r, [ann]) -> (m r, [ann]))
-> (m r, [ann])
-> Doc ann
-> (m r, [ann])
forall b a.
Mode
-> Int -> Float -> (AnnotDetails b -> a -> a) -> a -> Doc b -> a
fullRenderAnn (Style -> Mode
mode Style
style) (Style -> Int
lineLength Style
style) (Style -> Float
ribbonsPerLine Style
style)
AnnotDetails ann -> (m r, [ann]) -> (m r, [ann])
forall {b}. AnnotDetails ann -> (m b, [ann]) -> (m b, [ann])
annPrinter
(m r
docEnd, [])
where
annPrinter :: AnnotDetails ann -> (m b, [ann]) -> (m b, [ann])
annPrinter AnnotDetails ann
AnnotStart (m b
rest,[ann]
stack) =
case [ann]
stack of
ann
a : [ann]
as -> (ann -> m r
startAnn ann
a m r -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
rest, [ann]
as)
[ann]
_ -> String -> (m b, [ann])
forall a. HasCallStack => String -> a
error String
"renderDecorated: stack underflow"
annPrinter (AnnotEnd ann
a) (m b
rest,[ann]
stack) =
(ann -> m r
endAnn ann
a m r -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
rest, ann
a ann -> [ann] -> [ann]
forall a. a -> [a] -> [a]
: [ann]
stack)
annPrinter (NoAnnot TextDetails
td Int
_) (m b
rest,[ann]
stack) =
case TextDetails
td of
Chr Char
c -> (String -> m r
txt [Char
c] m r -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
rest, [ann]
stack)
Str String
s -> (String -> m r
txt String
s m r -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
rest, [ann]
stack)
PStr String
s -> (String -> m r
txt String
s m r -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
rest, [ann]
stack)
finalize :: (a, b) -> a
finalize (a
m,b
_) = a
m