module Text.PrettyPrint.Annotated.Leijen (
Doc, putDoc, hPutDoc,
empty, char, text, (<>), nest, line, linebreak, group, softline,
softbreak,
align, hang, indent, encloseSep, list, tupled, semiBraces,
(<+>), (<$>), (</>), (<$$>), (<//>),
hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat, punctuate,
fill, fillBreak,
enclose, squotes, dquotes, parens, angles, braces, brackets,
lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket,
squote, dquote, semi, colon, comma, space, dot, backslash, equals,
pipe,
string, int, integer, float, double, rational, bool,
annotate, noAnnotate,
SimpleDoc(..), renderPretty, renderCompact, displayDecorated, displayDecoratedA, display, displayS, displayIO,
SpanList(..), displaySpans
, column, nesting, width
) where
import System.IO (Handle,hPutStr,hPutChar,stdout)
import Data.String
import Prelude ((.), ($), (/=), (<), (<=), (>), (>=), (-), (*), (+), (++),
Bool(..), Char, Double, Float, Functor, Int, Integer, IO, Rational, Show, ShowS,
id, error, flip, foldr1, fromIntegral, length, max, min, otherwise, repeat, replicate,
return, round, seq, show, showChar, showString, showsPrec, span, zipWith)
import Control.Applicative (Applicative(..), liftA2)
import Data.Monoid (Monoid(..))
infixr 5 </>,<//>,<$>,<$$>
infixr 6 <>,<+>
instance IsString (Doc a) where
fromString :: String -> Doc a
fromString = String -> Doc a
forall a. String -> Doc a
text
list :: [Doc a] -> Doc a
list :: forall a. [Doc a] -> Doc a
list = Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
forall a. Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
encloseSep Doc a
forall a. Doc a
lbracket Doc a
forall a. Doc a
rbracket Doc a
forall a. Doc a
comma
tupled :: [Doc a] -> Doc a
tupled :: forall a. [Doc a] -> Doc a
tupled = Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
forall a. Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
encloseSep Doc a
forall a. Doc a
lparen Doc a
forall a. Doc a
rparen Doc a
forall a. Doc a
comma
semiBraces :: [Doc a] -> Doc a
semiBraces :: forall a. [Doc a] -> Doc a
semiBraces = Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
forall a. Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
encloseSep Doc a
forall a. Doc a
lbrace Doc a
forall a. Doc a
rbrace Doc a
forall a. Doc a
semi
encloseSep :: Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
encloseSep :: forall a. Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
encloseSep Doc a
left Doc a
right Doc a
sep [Doc a]
ds
= case [Doc a]
ds of
[] -> Doc a
left Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
right
[Doc a
d] -> Doc a
left Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
d Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
right
[Doc a]
_ -> Doc a -> Doc a
forall a. Doc a -> Doc a
align ([Doc a] -> Doc a
forall a. [Doc a] -> Doc a
cat ((Doc a -> Doc a -> Doc a) -> [Doc a] -> [Doc a] -> [Doc a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<>) (Doc a
left Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: Doc a -> [Doc a]
forall a. a -> [a]
repeat Doc a
sep) [Doc a]
ds) Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
right)
punctuate :: Doc a -> [Doc a] -> [Doc a]
punctuate :: forall a. Doc a -> [Doc a] -> [Doc a]
punctuate Doc a
p [] = []
punctuate Doc a
p [Doc a
d] = [Doc a
d]
punctuate Doc a
p (Doc a
d:[Doc a]
ds) = (Doc a
d 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]
forall a. Doc a -> [Doc a] -> [Doc a]
punctuate Doc a
p [Doc a]
ds
sep :: [Doc a] -> Doc a
sep :: forall a. [Doc a] -> Doc a
sep = Doc a -> Doc a
forall a. Doc a -> Doc a
group (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
vsep
fillSep :: [Doc a] -> Doc a
fillSep :: forall a. [Doc a] -> Doc a
fillSep = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall {a}. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(</>)
hsep :: [Doc a] -> Doc a
hsep :: forall a. [Doc a] -> Doc a
hsep = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall {a}. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<+>)
vsep :: [Doc a] -> Doc a
vsep :: forall a. [Doc a] -> Doc a
vsep = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall {a}. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<$>)
cat :: [Doc a] -> Doc a
cat :: forall a. [Doc a] -> Doc a
cat = Doc a -> Doc a
forall a. Doc a -> Doc a
group (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
vcat
fillCat :: [Doc a] -> Doc a
fillCat :: forall a. [Doc a] -> Doc a
fillCat = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall {a}. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<//>)
hcat :: [Doc a] -> Doc a
hcat :: forall a. [Doc a] -> Doc a
hcat = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall {a}. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<>)
vcat :: [Doc a] -> Doc a
vcat :: forall a. [Doc a] -> Doc a
vcat = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall {a}. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<$$>)
fold :: (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
f [] = Doc a
forall a. Doc a
empty
fold Doc a -> Doc a -> Doc a
f [Doc a]
ds = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc a -> Doc a -> Doc a
f [Doc a]
ds
(<>) :: Doc a -> Doc a -> Doc a
Doc a
x <> :: forall a. Doc a -> Doc a -> Doc a
<> Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
`beside` Doc a
y
(<+>) :: Doc a -> Doc a -> Doc a
Doc a
x <+> :: forall a. Doc a -> Doc a -> Doc a
<+> Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
forall a. Doc a
space Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
y
(</>) :: Doc a -> Doc a -> Doc a
Doc a
x </> :: forall a. Doc a -> Doc a -> Doc a
</> Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
forall a. Doc a
softline Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
y
(<//>) :: Doc a -> Doc a -> Doc a
Doc a
x <//> :: forall a. Doc a -> Doc a -> Doc a
<//> Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
forall a. Doc a
softbreak Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
y
(<$>) :: Doc a -> Doc a -> Doc a
Doc a
x <$> :: forall a. Doc a -> Doc a -> Doc a
<$> Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
forall a. Doc a
line Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
y
(<$$>) :: Doc a -> Doc a -> Doc a
Doc a
x <$$> :: forall a. Doc a -> Doc a -> Doc a
<$$> Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
forall a. Doc a
linebreak Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
y
softline :: Doc a
softline :: forall a. Doc a
softline = Doc a -> Doc a
forall a. Doc a -> Doc a
group Doc a
forall a. Doc a
line
softbreak :: Doc a
softbreak :: forall a. Doc a
softbreak = Doc a -> Doc a
forall a. Doc a -> Doc a
group Doc a
forall a. Doc a
linebreak
squotes :: Doc a -> Doc a
squotes :: forall a. Doc a -> Doc a
squotes = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
enclose Doc a
forall a. Doc a
squote Doc a
forall a. Doc a
squote
dquotes :: Doc a -> Doc a
dquotes :: forall a. Doc a -> Doc a
dquotes = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
enclose Doc a
forall a. Doc a
dquote Doc a
forall a. Doc a
dquote
braces :: Doc a -> Doc a
braces :: forall a. Doc a -> Doc a
braces = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
enclose Doc a
forall a. Doc a
lbrace Doc a
forall a. Doc a
rbrace
parens :: Doc a -> Doc a
parens :: forall a. Doc a -> Doc a
parens = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
enclose Doc a
forall a. Doc a
lparen Doc a
forall a. Doc a
rparen
angles :: Doc a -> Doc a
angles :: forall a. Doc a -> Doc a
angles = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
enclose Doc a
forall a. Doc a
langle Doc a
forall a. Doc a
rangle
brackets :: Doc a -> Doc a
brackets :: forall a. Doc a -> Doc a
brackets = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
enclose Doc a
forall a. Doc a
lbracket Doc a
forall a. Doc a
rbracket
enclose :: Doc a -> Doc a -> Doc a -> Doc a
enclose :: forall a. Doc a -> Doc a -> Doc a -> Doc a
enclose Doc a
l Doc a
r Doc a
x = Doc a
l Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
r
lparen :: Doc a
lparen :: forall a. Doc a
lparen = Char -> Doc a
forall a. Char -> Doc a
char Char
'('
rparen :: Doc a
rparen :: forall a. Doc a
rparen = Char -> Doc a
forall a. Char -> Doc a
char Char
')'
langle :: Doc a
langle :: forall a. Doc a
langle = Char -> Doc a
forall a. Char -> Doc a
char Char
'<'
rangle :: Doc a
rangle :: forall a. Doc a
rangle = Char -> Doc a
forall a. Char -> Doc a
char Char
'>'
lbrace :: Doc a
lbrace :: forall a. Doc a
lbrace = Char -> Doc a
forall a. Char -> Doc a
char Char
'{'
rbrace :: Doc a
rbrace :: forall a. Doc a
rbrace = Char -> Doc a
forall a. Char -> Doc a
char Char
'}'
lbracket :: Doc a
lbracket :: forall a. Doc a
lbracket = Char -> Doc a
forall a. Char -> Doc a
char Char
'['
rbracket :: Doc a
rbracket :: forall a. Doc a
rbracket = Char -> Doc a
forall a. Char -> Doc a
char Char
']'
squote :: Doc a
squote :: forall a. Doc a
squote = Char -> Doc a
forall a. Char -> Doc a
char Char
'\''
dquote :: Doc a
dquote :: forall a. Doc a
dquote = Char -> Doc a
forall a. Char -> Doc a
char Char
'"'
semi :: Doc a
semi :: forall a. Doc a
semi = Char -> Doc a
forall a. Char -> Doc a
char Char
';'
colon :: Doc a
colon :: forall a. Doc a
colon = Char -> Doc a
forall a. Char -> Doc a
char Char
':'
comma :: Doc a
comma :: forall a. Doc a
comma = Char -> Doc a
forall a. Char -> Doc a
char Char
','
space :: Doc a
space :: forall a. Doc a
space = Char -> Doc a
forall a. Char -> Doc a
char Char
' '
dot :: Doc a
dot :: forall a. Doc a
dot = Char -> Doc a
forall a. Char -> Doc a
char Char
'.'
backslash :: Doc a
backslash :: forall a. Doc a
backslash = Char -> Doc a
forall a. Char -> Doc a
char Char
'\\'
equals :: Doc a
equals :: forall a. Doc a
equals = Char -> Doc a
forall a. Char -> Doc a
char Char
'='
pipe :: Doc a
pipe :: forall a. Doc a
pipe = Char -> Doc a
forall a. Char -> Doc a
char Char
'|'
string :: String -> Doc a
string :: forall a. String -> Doc a
string String
"" = Doc a
forall a. Doc a
empty
string (Char
'\n':String
s) = Doc a
forall a. Doc a
line Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> String -> Doc a
forall a. String -> Doc a
string String
s
string String
s = case ((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) of
(String
xs,String
ys) -> String -> Doc a
forall a. String -> Doc a
text String
xs Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> String -> Doc a
forall a. String -> Doc a
string String
ys
bool :: Bool -> Doc a
bool :: forall a. Bool -> Doc a
bool Bool
b = String -> Doc a
forall a. String -> Doc a
text (Bool -> String
forall a. Show a => a -> String
show Bool
b)
int :: Int -> Doc a
int :: forall a. Int -> Doc a
int Int
i = String -> Doc a
forall a. String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
i)
integer :: Integer -> Doc a
integer :: forall a. Integer -> Doc a
integer Integer
i = String -> Doc a
forall a. String -> Doc a
text (Integer -> String
forall a. Show a => a -> String
show Integer
i)
float :: Float -> Doc a
float :: forall a. Float -> Doc a
float Float
f = String -> Doc a
forall a. String -> Doc a
text (Float -> String
forall a. Show a => a -> String
show Float
f)
double :: Double -> Doc a
double :: forall a. Double -> Doc a
double Double
d = String -> Doc a
forall a. String -> Doc a
text (Double -> String
forall a. Show a => a -> String
show Double
d)
rational :: Rational -> Doc a
rational :: forall a. Rational -> Doc a
rational Rational
r = String -> Doc a
forall a. String -> Doc a
text (Rational -> String
forall a. Show a => a -> String
show Rational
r)
fillBreak :: Int -> Doc a -> Doc a
fillBreak :: forall a. Int -> Doc a -> Doc a
fillBreak Int
f Doc a
x = Doc a -> (Int -> Doc a) -> Doc a
forall a. Doc a -> (Int -> Doc a) -> Doc a
width Doc a
x (\Int
w ->
if (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
f) then Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
nest Int
f Doc a
forall a. Doc a
linebreak
else String -> Doc a
forall a. String -> Doc a
text (Int -> String
spaces (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)))
fill :: Int -> Doc a -> Doc a
fill :: forall a. Int -> Doc a -> Doc a
fill Int
f Doc a
d = Doc a -> (Int -> Doc a) -> Doc a
forall a. Doc a -> (Int -> Doc a) -> Doc a
width Doc a
d (\Int
w ->
if (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
f) then Doc a
forall a. Doc a
empty
else String -> Doc a
forall a. String -> Doc a
text (Int -> String
spaces (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)))
width :: Doc a -> (Int -> Doc a) -> Doc a
width :: forall a. Doc a -> (Int -> Doc a) -> Doc a
width Doc a
d Int -> Doc a
f = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
column (\Int
k1 -> Doc a
d Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
column (\Int
k2 -> Int -> Doc a
f (Int
k2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k1)))
indent :: Int -> Doc a -> Doc a
indent :: forall a. Int -> Doc a -> Doc a
indent Int
i Doc a
d = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
hang Int
i (String -> Doc a
forall a. String -> Doc a
text (Int -> String
spaces Int
i) Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
d)
hang :: Int -> Doc a -> Doc a
hang :: forall a. Int -> Doc a -> Doc a
hang Int
i Doc a
d = Doc a -> Doc a
forall a. Doc a -> Doc a
align (Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
nest Int
i Doc a
d)
align :: Doc a -> Doc a
align :: forall a. Doc a -> Doc a
align Doc a
d = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
column (\Int
k ->
(Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
nesting (\Int
i -> Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
nest (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Doc a
d))
data Doc a = Empty
| Char Char
| Text !Int String
| Line !Bool
| Cat (Doc a) (Doc a)
| Nest !Int (Doc a)
| Union (Doc a) (Doc a)
| Column (Int -> Doc a)
| Nesting (Int -> Doc a)
| Annotate a (Doc a)
| AnnotEnd
deriving (forall a b. (a -> b) -> Doc a -> Doc b)
-> (forall a b. a -> Doc b -> Doc a) -> Functor Doc
forall a b. a -> Doc b -> Doc a
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Doc b -> Doc a
$c<$ :: forall a b. a -> Doc b -> Doc a
fmap :: forall a b. (a -> b) -> Doc a -> Doc b
$cfmap :: forall a b. (a -> b) -> Doc a -> Doc b
Functor
type SpanList a = [(Int, Int, a)]
data SimpleDoc a = SEmpty
| SChar Char (SimpleDoc a)
| SText !Int String (SimpleDoc a)
| SLine !Int (SimpleDoc a)
| SAnnotStart a (SimpleDoc a)
| SAnnotStop (SimpleDoc a)
deriving (forall a b. (a -> b) -> SimpleDoc a -> SimpleDoc b)
-> (forall a b. a -> SimpleDoc b -> SimpleDoc a)
-> Functor SimpleDoc
forall a b. a -> SimpleDoc b -> SimpleDoc a
forall a b. (a -> b) -> SimpleDoc a -> SimpleDoc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SimpleDoc b -> SimpleDoc a
$c<$ :: forall a b. a -> SimpleDoc b -> SimpleDoc a
fmap :: forall a b. (a -> b) -> SimpleDoc a -> SimpleDoc b
$cfmap :: forall a b. (a -> b) -> SimpleDoc a -> SimpleDoc b
Functor
empty :: Doc a
empty :: forall a. Doc a
empty = Doc a
forall a. Doc a
Empty
char :: Char -> Doc a
char :: forall a. Char -> Doc a
char Char
'\n' = Doc a
forall a. Doc a
line
char Char
c = Char -> Doc a
forall a. Char -> Doc a
Char Char
c
text :: String -> Doc a
text :: forall a. String -> Doc a
text String
"" = Doc a
forall a. Doc a
Empty
text String
s = Int -> String -> Doc a
forall a. Int -> String -> Doc a
Text (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) String
s
line :: Doc a
line :: forall a. Doc a
line = Bool -> Doc a
forall a. Bool -> Doc a
Line Bool
False
linebreak :: Doc a
linebreak :: forall a. Doc a
linebreak = Bool -> Doc a
forall a. Bool -> Doc a
Line Bool
True
beside :: Doc a -> Doc a -> Doc a
beside Doc a
x Doc a
y = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Cat Doc a
x Doc a
y
nest :: Int -> Doc a -> Doc a
nest :: forall a. Int -> Doc a -> Doc a
nest Int
i Doc a
x = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
Nest Int
i Doc a
x
column, nesting :: (Int -> Doc a) -> Doc a
column :: forall a. (Int -> Doc a) -> Doc a
column Int -> Doc a
f = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
Column Int -> Doc a
f
nesting :: forall a. (Int -> Doc a) -> Doc a
nesting Int -> Doc a
f = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
Nesting Int -> Doc a
f
group :: Doc a -> Doc a
group :: forall a. Doc a -> Doc a
group Doc a
x = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Union (Doc a -> Doc a
forall a. Doc a -> Doc a
flatten Doc a
x) Doc a
x
flatten :: Doc a -> Doc a
flatten :: forall a. Doc a -> Doc a
flatten (Cat Doc a
x Doc a
y) = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Cat (Doc a -> Doc a
forall a. Doc a -> Doc a
flatten Doc a
x) (Doc a -> Doc a
forall a. Doc a -> Doc a
flatten Doc a
y)
flatten (Nest Int
i Doc a
x) = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
Nest Int
i (Doc a -> Doc a
forall a. Doc a -> Doc a
flatten Doc a
x)
flatten (Line Bool
break) = if Bool
break then Doc a
forall a. Doc a
Empty else Int -> String -> Doc a
forall a. Int -> String -> Doc a
Text Int
1 String
" "
flatten (Union Doc a
x Doc a
y) = Doc a -> Doc a
forall a. Doc a -> Doc a
flatten Doc a
x
flatten (Column Int -> Doc a
f) = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
Column (Doc a -> Doc a
forall a. Doc a -> Doc a
flatten (Doc a -> Doc a) -> (Int -> Doc a) -> Int -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc a
f)
flatten (Nesting Int -> Doc a
f) = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
Nesting (Doc a -> Doc a
forall a. Doc a -> Doc a
flatten (Doc a -> Doc a) -> (Int -> Doc a) -> Int -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc a
f)
flatten Doc a
other = Doc a
other
annotate :: a -> Doc a -> Doc a
annotate :: forall a. a -> Doc a -> Doc a
annotate = a -> Doc a -> Doc a
forall a. a -> Doc a -> Doc a
Annotate
noAnnotate :: Doc a -> Doc a
noAnnotate :: forall a. Doc a -> Doc a
noAnnotate (Cat Doc a
x Doc a
y) = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Cat (Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate Doc a
x) (Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate Doc a
y)
noAnnotate (Nest Int
i Doc a
x) = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
Nest Int
i (Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate Doc a
x)
noAnnotate (Union Doc a
x Doc a
y) = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Union (Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate Doc a
x) (Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate Doc a
y)
noAnnotate (Column Int -> Doc a
f) = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
Column (Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate (Doc a -> Doc a) -> (Int -> Doc a) -> Int -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc a
f)
noAnnotate (Nesting Int -> Doc a
f) = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
Nesting (Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate (Doc a -> Doc a) -> (Int -> Doc a) -> Int -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc a
f)
noAnnotate (Annotate a
_ Doc a
x) = Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate Doc a
x
noAnnotate Doc a
other = Doc a
other
data Docs a = Nil
| Cons !Int (Doc a) (Docs a)
renderPretty :: Float -> Int -> Doc a -> SimpleDoc a
renderPretty :: forall a. Float -> Int -> Doc a -> SimpleDoc a
renderPretty Float
rfrac Int
w Doc a
x
= Int -> Int -> Docs a -> SimpleDoc a
forall {a}. Int -> Int -> Docs a -> SimpleDoc a
best Int
0 Int
0 (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
0 Doc a
x Docs a
forall a. Docs a
Nil)
where
r :: Int
r = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
w (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
rfrac)))
best :: Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k Docs a
Nil = SimpleDoc a
forall a. SimpleDoc a
SEmpty
best Int
n Int
k (Cons Int
i Doc a
d Docs a
ds)
= case Doc a
d of
Doc a
Empty -> Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k Docs a
ds
Char Char
c -> let k' :: Int
k' = Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 in Int -> SimpleDoc a -> SimpleDoc a
seq Int
k' (Char -> SimpleDoc a -> SimpleDoc a
forall a. Char -> SimpleDoc a -> SimpleDoc a
SChar Char
c (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k' Docs a
ds))
Text Int
l String
s -> let k' :: Int
k' = Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l in Int -> SimpleDoc a -> SimpleDoc a
seq Int
k' (Int -> String -> SimpleDoc a -> SimpleDoc a
forall a. Int -> String -> SimpleDoc a -> SimpleDoc a
SText Int
l String
s (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k' Docs a
ds))
Line Bool
_ -> Int -> SimpleDoc a -> SimpleDoc a
forall a. Int -> SimpleDoc a -> SimpleDoc a
SLine Int
i (Int -> Int -> Docs a -> SimpleDoc a
best Int
i Int
i Docs a
ds)
Cat Doc a
x Doc a
y -> Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
x (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
y Docs a
ds))
Nest Int
j Doc a
x -> let i' :: Int
i' = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j in Int -> SimpleDoc a -> SimpleDoc a
seq Int
i' (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i' Doc a
x Docs a
ds))
Union Doc a
x Doc a
y -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
forall {a}. Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicest Int
n Int
k (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
x Docs a
ds))
(Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
y Docs a
ds))
Column Int -> Doc a
f -> Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i (Int -> Doc a
f Int
k) Docs a
ds)
Nesting Int -> Doc a
f -> Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i (Int -> Doc a
f Int
i) Docs a
ds)
Annotate a
a Doc a
d' -> a -> SimpleDoc a -> SimpleDoc a
forall a. a -> SimpleDoc a -> SimpleDoc a
SAnnotStart a
a (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
d' (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
forall a. Doc a
AnnotEnd Docs a
ds)))
Doc a
AnnotEnd -> SimpleDoc a -> SimpleDoc a
forall a. SimpleDoc a -> SimpleDoc a
SAnnotStop (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k Docs a
ds)
nicest :: Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicest Int
n Int
k SimpleDoc a
x SimpleDoc a
y | Int -> SimpleDoc a -> Bool
forall {a}. Int -> SimpleDoc a -> Bool
fits Int
width SimpleDoc a
x = SimpleDoc a
x
| Bool
otherwise = SimpleDoc a
y
where
width :: Int
width = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
fits :: Int -> SimpleDoc a -> Bool
fits Int
w SimpleDoc a
x | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
False
fits Int
w SimpleDoc a
SEmpty = Bool
True
fits Int
w (SChar Char
c SimpleDoc a
x) = Int -> SimpleDoc a -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SimpleDoc a
x
fits Int
w (SText Int
l String
s SimpleDoc a
x) = Int -> SimpleDoc a -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) SimpleDoc a
x
fits Int
w (SLine Int
i SimpleDoc a
x) = Bool
True
fits Int
w (SAnnotStart a
_ SimpleDoc a
x) = Int -> SimpleDoc a -> Bool
fits Int
w SimpleDoc a
x
fits Int
w (SAnnotStop SimpleDoc a
x) = Int -> SimpleDoc a -> Bool
fits Int
w SimpleDoc a
x
renderCompact :: Doc a -> SimpleDoc a
renderCompact :: forall a. Doc a -> SimpleDoc a
renderCompact Doc a
x
= Int -> [Doc a] -> SimpleDoc a
forall {a}. Int -> [Doc a] -> SimpleDoc a
scan Int
0 [Doc a
x]
where
scan :: Int -> [Doc a] -> SimpleDoc a
scan Int
k [] = SimpleDoc a
forall a. SimpleDoc a
SEmpty
scan Int
k (Doc a
d:[Doc a]
ds) = case Doc a
d of
Doc a
Empty -> Int -> [Doc a] -> SimpleDoc a
scan Int
k [Doc a]
ds
Char Char
c -> let k' :: Int
k' = Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 in Int -> SimpleDoc a -> SimpleDoc a
seq Int
k' (Char -> SimpleDoc a -> SimpleDoc a
forall a. Char -> SimpleDoc a -> SimpleDoc a
SChar Char
c (Int -> [Doc a] -> SimpleDoc a
scan Int
k' [Doc a]
ds))
Text Int
l String
s -> let k' :: Int
k' = Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l in Int -> SimpleDoc a -> SimpleDoc a
seq Int
k' (Int -> String -> SimpleDoc a -> SimpleDoc a
forall a. Int -> String -> SimpleDoc a -> SimpleDoc a
SText Int
l String
s (Int -> [Doc a] -> SimpleDoc a
scan Int
k' [Doc a]
ds))
Line Bool
_ -> Int -> SimpleDoc a -> SimpleDoc a
forall a. Int -> SimpleDoc a -> SimpleDoc a
SLine Int
0 (Int -> [Doc a] -> SimpleDoc a
scan Int
0 [Doc a]
ds)
Cat Doc a
x Doc a
y -> Int -> [Doc a] -> SimpleDoc a
scan Int
k (Doc a
xDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:Doc a
yDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Nest Int
j Doc a
x -> Int -> [Doc a] -> SimpleDoc a
scan Int
k (Doc a
xDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Union Doc a
x Doc a
y -> Int -> [Doc a] -> SimpleDoc a
scan Int
k (Doc a
yDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Column Int -> Doc a
f -> Int -> [Doc a] -> SimpleDoc a
scan Int
k (Int -> Doc a
f Int
kDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Nesting Int -> Doc a
f -> Int -> [Doc a] -> SimpleDoc a
scan Int
k (Int -> Doc a
f Int
0Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Annotate a
a Doc a
d' -> a -> SimpleDoc a -> SimpleDoc a
forall a. a -> SimpleDoc a -> SimpleDoc a
SAnnotStart a
a (Int -> [Doc a] -> SimpleDoc a
scan Int
k (Doc a
d'Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:Doc a
forall a. Doc a
AnnotEndDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds))
Doc a
AnnotEnd -> SimpleDoc a -> SimpleDoc a
forall a. SimpleDoc a -> SimpleDoc a
SAnnotStop (SimpleDoc a -> SimpleDoc a) -> SimpleDoc a -> SimpleDoc a
forall a b. (a -> b) -> a -> b
$ Int -> [Doc a] -> SimpleDoc a
scan Int
k [Doc a]
ds
display :: SimpleDoc a -> String
display :: forall a. SimpleDoc a -> String
display = (SimpleDoc a -> String -> String)
-> String -> SimpleDoc a -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS String
""
displayS :: SimpleDoc a -> ShowS
displayS :: forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
SEmpty = String -> String
forall a. a -> a
id
displayS (SChar Char
c SimpleDoc a
x) = Char -> String -> String
showChar Char
c (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
x
displayS (SText Int
l String
s SimpleDoc a
x) = String -> String -> String
showString String
s (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
x
displayS (SLine Int
i SimpleDoc a
x) = String -> String -> String
showString (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
indentation Int
i) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
x
displayS (SAnnotStart a
_ SimpleDoc a
x) = SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
x
displayS (SAnnotStop SimpleDoc a
x) = SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
x
displayIO :: Handle -> SimpleDoc a -> IO ()
displayIO :: forall a. Handle -> SimpleDoc a -> IO ()
displayIO Handle
handle SimpleDoc a
simpleDoc
= SimpleDoc a -> IO ()
forall {a}. SimpleDoc a -> IO ()
display SimpleDoc a
simpleDoc
where
display :: SimpleDoc a -> IO ()
display SimpleDoc a
SEmpty = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
display (SChar Char
c SimpleDoc a
x) = do{ Handle -> Char -> IO ()
hPutChar Handle
handle Char
c; SimpleDoc a -> IO ()
display SimpleDoc a
x}
display (SText Int
l String
s SimpleDoc a
x) = do{ Handle -> String -> IO ()
hPutStr Handle
handle String
s; SimpleDoc a -> IO ()
display SimpleDoc a
x}
display (SLine Int
i SimpleDoc a
x) = do{ Handle -> String -> IO ()
hPutStr Handle
handle (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
indentation Int
i); SimpleDoc a -> IO ()
display SimpleDoc a
x}
display (SAnnotStart a
_ SimpleDoc a
x) = SimpleDoc a -> IO ()
display SimpleDoc a
x
display (SAnnotStop SimpleDoc a
x) = SimpleDoc a -> IO ()
display SimpleDoc a
x
displaySpans :: SimpleDoc a -> (String, SpanList a)
displaySpans :: forall a. SimpleDoc a -> (String, SpanList a)
displaySpans SimpleDoc a
sd = Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display Int
0 [] SimpleDoc a
sd
where display :: Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display :: forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display Int
i [] SimpleDoc a
SEmpty = (String
"", [])
display Int
i [(Int, a)]
stk (SChar Char
c SimpleDoc a
x) = let (String
str, [(Int, Int, a)]
spans) = Int -> [(Int, a)] -> SimpleDoc a -> (String, [(Int, Int, a)])
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Int, a)]
stk SimpleDoc a
x
in (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
str, [(Int, Int, a)]
spans)
display Int
i [(Int, a)]
stk (SText Int
l String
s SimpleDoc a
x) = (String -> String)
-> (String, [(Int, Int, a)]) -> (String, [(Int, Int, a)])
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFst (String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++) (Int -> [(Int, a)] -> SimpleDoc a -> (String, [(Int, Int, a)])
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) [(Int, a)]
stk SimpleDoc a
x)
display Int
i [(Int, a)]
stk (SLine Int
ind SimpleDoc a
x) = (String -> String)
-> (String, [(Int, Int, a)]) -> (String, [(Int, Int, a)])
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFst ((Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
indentation Int
ind)String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Int -> [(Int, a)] -> SimpleDoc a -> (String, [(Int, Int, a)])
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ind) [(Int, a)]
stk SimpleDoc a
x)
display Int
i [(Int, a)]
stk (SAnnotStart a
ann SimpleDoc a
x) = Int -> [(Int, a)] -> SimpleDoc a -> (String, [(Int, Int, a)])
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display Int
i ((Int
i, a
ann)(Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:[(Int, a)]
stk) SimpleDoc a
x
display Int
i ((Int
start, a
ann):[(Int, a)]
stk) (SAnnotStop SimpleDoc a
x) = ([(Int, Int, a)] -> [(Int, Int, a)])
-> (String, [(Int, Int, a)]) -> (String, [(Int, Int, a)])
forall a b c. (a -> b) -> (c, a) -> (c, b)
mapSnd ((Int
start, Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
start, a
ann)(Int, Int, a) -> [(Int, Int, a)] -> [(Int, Int, a)]
forall a. a -> [a] -> [a]
:) (Int -> [(Int, a)] -> SimpleDoc a -> (String, [(Int, Int, a)])
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display Int
i [(Int, a)]
stk SimpleDoc a
x)
display Int
_ [] (SAnnotStop SimpleDoc a
_) = String -> (String, [(Int, Int, a)])
forall a. HasCallStack => String -> a
error String
"stack underflow"
display Int
_ [(Int, a)]
stk SimpleDoc a
SEmpty = String -> (String, [(Int, Int, a)])
forall a. HasCallStack => String -> a
error String
"Stack not consumed by rendering"
mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst :: forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFst a -> b
f (a
x, c
y) = (a -> b
f a
x, c
y)
mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd :: forall a b c. (a -> b) -> (c, a) -> (c, b)
mapSnd a -> b
f (c
x, a
y) = (c
x, a -> b
f a
y)
displayDecorated :: (a -> String -> String) -> SimpleDoc a -> String
displayDecorated :: forall a. (a -> String -> String) -> SimpleDoc a -> String
displayDecorated a -> String -> String
decor SimpleDoc a
sd = (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display String -> String
forall a. a -> a
id String -> String
forall a. a -> a
id [] SimpleDoc a
sd String
""
where display :: (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display String -> String
s String -> String
d [] SimpleDoc a
SEmpty = String -> String
d (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
s
display String -> String
s String -> String
d [(String -> String, String -> String)]
stk (SChar Char
c SimpleDoc a
x) = (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display (String -> String
s (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
c) String -> String
d [(String -> String, String -> String)]
stk SimpleDoc a
x
display String -> String
s String -> String
d [(String -> String, String -> String)]
stk (SText Int
l String
str SimpleDoc a
x) = (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display (String -> String
s (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
str) String -> String
d [(String -> String, String -> String)]
stk SimpleDoc a
x
display String -> String
s String -> String
d [(String -> String, String -> String)]
stk (SLine Int
ind SimpleDoc a
x) = (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display (String -> String
s (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
indentation Int
ind)) String -> String
d [(String -> String, String -> String)]
stk SimpleDoc a
x
display String -> String
s String -> String
d [(String -> String, String -> String)]
stk (SAnnotStart a
ann SimpleDoc a
x) = (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display String -> String
forall a. a -> a
id (a -> String -> String
decor a
ann) ((String -> String
s, String -> String
d)(String -> String, String -> String)
-> [(String -> String, String -> String)]
-> [(String -> String, String -> String)]
forall a. a -> [a] -> [a]
:[(String -> String, String -> String)]
stk) SimpleDoc a
x
display String -> String
s String -> String
d ((String -> String
sf', String -> String
d'):[(String -> String, String -> String)]
stk) (SAnnotStop SimpleDoc a
x) = let formatted :: String
formatted = String -> String
d (String -> String
s String
"")
in (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display (String -> String
sf' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
formatted) String -> String
d' [(String -> String, String -> String)]
stk SimpleDoc a
x
display String -> String
_ String -> String
_ [] (SAnnotStop SimpleDoc a
_) = String -> String -> String
forall a. HasCallStack => String -> a
error String
"stack underflow"
display String -> String
_ String -> String
_ [(String -> String, String -> String)]
stk SimpleDoc a
SEmpty = String -> String -> String
forall a. HasCallStack => String -> a
error String
"stack not consumed by rendering"
displayDecoratedA :: (Applicative f, Monoid b)
=> (String -> f b) -> (a -> f b) -> (a -> f b)
-> SimpleDoc a -> f b
displayDecoratedA :: forall (f :: * -> *) b a.
(Applicative f, Monoid b) =>
(String -> f b) -> (a -> f b) -> (a -> f b) -> SimpleDoc a -> f b
displayDecoratedA String -> f b
str a -> f b
start a -> f b
end SimpleDoc a
sd = [a] -> SimpleDoc a -> f b
display [] SimpleDoc a
sd
where display :: [a] -> SimpleDoc a -> f b
display [] SimpleDoc a
SEmpty = b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty
display [a]
stk (SChar Char
c SimpleDoc a
x) = (String -> f b
str [Char
c]) f b -> f b -> f b
<++> ([a] -> SimpleDoc a -> f b
display [a]
stk SimpleDoc a
x)
display [a]
stk (SText Int
l String
s SimpleDoc a
x) = (String -> f b
str String
s) f b -> f b -> f b
<++> ([a] -> SimpleDoc a -> f b
display [a]
stk SimpleDoc a
x)
display [a]
stk (SLine Int
ind SimpleDoc a
x) = (String -> f b
str (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
indentation Int
ind)) f b -> f b -> f b
<++> ([a] -> SimpleDoc a -> f b
display [a]
stk SimpleDoc a
x)
display [a]
stk (SAnnotStart a
ann SimpleDoc a
x) = (a -> f b
start a
ann) f b -> f b -> f b
<++> ([a] -> SimpleDoc a -> f b
display (a
anna -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
stk) SimpleDoc a
x)
display (a
ann:[a]
stk) (SAnnotStop SimpleDoc a
x) = (a -> f b
end a
ann) f b -> f b -> f b
<++> ([a] -> SimpleDoc a -> f b
display [a]
stk SimpleDoc a
x)
display [] (SAnnotStop SimpleDoc a
_) = String -> f b
forall a. HasCallStack => String -> a
error String
"stack underflow"
display [a]
stk SimpleDoc a
SEmpty = String -> f b
forall a. HasCallStack => String -> a
error String
"stack not consumed by rendering"
<++> :: f b -> f b -> f b
(<++>) = (b -> b -> b) -> f b -> f b -> f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Monoid a => a -> a -> a
mappend
instance Show (Doc a) where
showsPrec :: Int -> Doc a -> String -> String
showsPrec Int
d Doc a
doc = SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS (Float -> Int -> Doc a -> SimpleDoc a
forall a. Float -> Int -> Doc a -> SimpleDoc a
renderPretty Float
0.4 Int
80 Doc a
doc)
putDoc :: Doc a -> IO ()
putDoc :: forall a. Doc a -> IO ()
putDoc Doc a
doc = Handle -> Doc a -> IO ()
forall a. Handle -> Doc a -> IO ()
hPutDoc Handle
stdout Doc a
doc
hPutDoc :: Handle -> Doc a -> IO ()
hPutDoc :: forall a. Handle -> Doc a -> IO ()
hPutDoc Handle
handle Doc a
doc = Handle -> SimpleDoc a -> IO ()
forall a. Handle -> SimpleDoc a -> IO ()
displayIO Handle
handle (Float -> Int -> Doc a -> SimpleDoc a
forall a. Float -> Int -> Doc a -> SimpleDoc a
renderPretty Float
0.4 Int
80 Doc a
doc)
spaces :: Int -> String
spaces Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String
""
| Bool
otherwise = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '
indentation :: Int -> String
indentation Int
n = Int -> String
spaces Int
n