{-# LANGUAGE CPP #-}
module Text.PrettyPrint.Leijen.Text (
Doc,
empty, isEmpty, char, text, textStrict, beside, nest, line, linebreak, group,
softline, softbreak, spacebreak,
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,
string, stringStrict, int, integer, float, double, rational, bool,
column, nesting, width,
Pretty(..),
SimpleDoc(..), renderPretty, renderCompact, renderOneLine,
displayB, displayT, displayTStrict, displayIO, putDoc, hPutDoc
) where
import Prelude ()
import Prelude.Compat hiding ((<$>))
import Data.String (IsString(..))
import System.IO (Handle, hPutChar, stdout)
import Data.Int (Int64)
import Data.List (intersperse)
import qualified Data.Text as TS
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.IO as T
#if MIN_VERSION_base (4,9,0)
import Data.Semigroup (Semigroup(..))
#else
import Data.Monoid ((<>))
#endif
infixr 5 </>,<//>,<$>,<$$>
infixr 6 <+>,<++>,`beside`
list :: [Doc] -> Doc
list :: [Doc] -> Doc
list = Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Doc
lbracket Doc
rbracket Doc
comma
tupled :: [Doc] -> Doc
tupled :: [Doc] -> Doc
tupled = Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Doc
lparen Doc
rparen Doc
comma
semiBraces :: [Doc] -> Doc
semiBraces :: [Doc] -> Doc
semiBraces = Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Doc
lbrace Doc
rbrace Doc
semi
encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep left :: Doc
left right :: Doc
right sp :: Doc
sp ds :: [Doc]
ds
= case [Doc]
ds of
[] -> Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right
[d :: Doc
d] -> Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right
_ -> Doc -> Doc
align ([Doc] -> Doc
cat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) (Doc
left Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat Doc
sp) [Doc]
ds) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right)
punctuate :: Doc -> [Doc] -> [Doc]
punctuate :: Doc -> [Doc] -> [Doc]
punctuate _ [] = []
punctuate _ [d :: Doc
d] = [Doc
d]
punctuate p :: Doc
p (d :: Doc
d:ds :: [Doc]
ds) = (Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
p) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
punctuate Doc
p [Doc]
ds
sep :: [Doc] -> Doc
sep :: [Doc] -> Doc
sep = Doc -> Doc
group (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vsep
fillSep :: [Doc] -> Doc
fillSep :: [Doc] -> Doc
fillSep = (Doc -> Doc -> Doc) -> [Doc] -> Doc
fold Doc -> Doc -> Doc
(</>)
hsep :: [Doc] -> Doc
hsep :: [Doc] -> Doc
hsep = (Doc -> Doc -> Doc) -> [Doc] -> Doc
fold Doc -> Doc -> Doc
(<+>)
vsep :: [Doc] -> Doc
vsep :: [Doc] -> Doc
vsep = (Doc -> Doc -> Doc) -> [Doc] -> Doc
fold Doc -> Doc -> Doc
(<$>)
cat :: [Doc] -> Doc
cat :: [Doc] -> Doc
cat = Doc -> Doc
group (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat
fillCat :: [Doc] -> Doc
fillCat :: [Doc] -> Doc
fillCat = (Doc -> Doc -> Doc) -> [Doc] -> Doc
fold Doc -> Doc -> Doc
(<//>)
hcat :: [Doc] -> Doc
hcat :: [Doc] -> Doc
hcat = (Doc -> Doc -> Doc) -> [Doc] -> Doc
fold Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>)
vcat :: [Doc] -> Doc
vcat :: [Doc] -> Doc
vcat = (Doc -> Doc -> Doc) -> [Doc] -> Doc
fold Doc -> Doc -> Doc
(<$$>)
fold :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
fold :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
fold _ [] = Doc
empty
fold f :: Doc -> Doc -> Doc
f ds :: [Doc]
ds = (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
f [Doc]
ds
(<+>) :: Doc -> Doc -> Doc
Empty <+> :: Doc -> Doc -> Doc
<+> y :: Doc
y = Doc
y
x :: Doc
x <+> Empty = Doc
x
x :: Doc
x <+> y :: Doc
y = Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y
(<++>) :: Doc -> Doc -> Doc
Empty <++> :: Doc -> Doc -> Doc
<++> y :: Doc
y = Doc
y
x :: Doc
x <++> Empty = Doc
x
x :: Doc
x <++> y :: Doc
y = Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
spacebreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y
(</>) :: Doc -> Doc -> Doc
</> :: Doc -> Doc -> Doc
(</>) = Bool -> Doc -> Doc -> Doc
splitWithBreak Bool
False
(<//>) :: Doc -> Doc -> Doc
<//> :: Doc -> Doc -> Doc
(<//>) = Bool -> Doc -> Doc -> Doc
splitWithBreak Bool
True
splitWithBreak :: Bool -> Doc -> Doc -> Doc
splitWithBreak :: Bool -> Doc -> Doc -> Doc
splitWithBreak _ Empty b :: Doc
b = Doc
b
splitWithBreak _ a :: Doc
a Empty = Doc
a
splitWithBreak f :: Bool
f a :: Doc
a b :: Doc
b = Doc
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
group (Bool -> Doc
Line Bool
f) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
b
(<$>) :: Doc -> Doc -> Doc
<$> :: Doc -> Doc -> Doc
(<$>) = Bool -> Doc -> Doc -> Doc
splitWithLine Bool
False
(<$$>) :: Doc -> Doc -> Doc
<$$> :: Doc -> Doc -> Doc
(<$$>) = Bool -> Doc -> Doc -> Doc
splitWithLine Bool
True
splitWithLine :: Bool -> Doc -> Doc -> Doc
splitWithLine :: Bool -> Doc -> Doc -> Doc
splitWithLine _ Empty b :: Doc
b = Doc
b
splitWithLine _ a :: Doc
a Empty = Doc
a
splitWithLine f :: Bool
f a :: Doc
a b :: Doc
b = Doc
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Bool -> Doc
Line Bool
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
b
softline :: Doc
softline :: Doc
softline = Doc -> Doc
group Doc
line
softbreak :: Doc
softbreak :: Doc
softbreak = Doc -> Doc
group Doc
linebreak
spacebreak :: Doc
spacebreak :: Doc
spacebreak = Int64 -> Doc
Spaces 1
squotes :: Doc -> Doc
squotes :: Doc -> Doc
squotes = Doc -> Doc -> Doc -> Doc
enclose Doc
squote Doc
squote
dquotes :: Doc -> Doc
dquotes :: Doc -> Doc
dquotes = Doc -> Doc -> Doc -> Doc
enclose Doc
dquote Doc
dquote
braces :: Doc -> Doc
braces :: Doc -> Doc
braces = Doc -> Doc -> Doc -> Doc
enclose Doc
lbrace Doc
rbrace
parens :: Doc -> Doc
parens :: Doc -> Doc
parens = Doc -> Doc -> Doc -> Doc
enclose Doc
lparen Doc
rparen
angles :: Doc -> Doc
angles :: Doc -> Doc
angles = Doc -> Doc -> Doc -> Doc
enclose Doc
langle Doc
rangle
brackets :: Doc -> Doc
brackets :: Doc -> Doc
brackets = Doc -> Doc -> Doc -> Doc
enclose Doc
lbracket Doc
rbracket
enclose :: Doc -> Doc -> Doc -> Doc
enclose :: Doc -> Doc -> Doc -> Doc
enclose l :: Doc
l r :: Doc
r x :: Doc
x = Doc
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
r
lparen :: Doc
lparen :: Doc
lparen = Char -> Doc
char '('
rparen :: Doc
rparen :: Doc
rparen = Char -> Doc
char ')'
langle :: Doc
langle :: Doc
langle = Char -> Doc
char '<'
rangle :: Doc
rangle :: Doc
rangle = Char -> Doc
char '>'
lbrace :: Doc
lbrace :: Doc
lbrace = Char -> Doc
char '{'
rbrace :: Doc
rbrace :: Doc
rbrace = Char -> Doc
char '}'
lbracket :: Doc
lbracket :: Doc
lbracket = Char -> Doc
char '['
rbracket :: Doc
rbracket :: Doc
rbracket = Char -> Doc
char ']'
squote :: Doc
squote :: Doc
squote = Char -> Doc
char '\''
dquote :: Doc
dquote :: Doc
dquote = Char -> Doc
char '"'
semi :: Doc
semi :: Doc
semi = Char -> Doc
char ';'
colon :: Doc
colon :: Doc
colon = Char -> Doc
char ':'
comma :: Doc
comma :: Doc
comma = Char -> Doc
char ','
space :: Doc
space :: Doc
space = Char -> Doc
char ' '
dot :: Doc
dot :: Doc
dot = Char -> Doc
char '.'
backslash :: Doc
backslash :: Doc
backslash = Char -> Doc
char '\\'
equals :: Doc
equals :: Doc
equals = Char -> Doc
char '='
string :: Text -> Doc
string :: Text -> Doc
string = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> (Text -> [Doc]) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
line ([Doc] -> [Doc]) -> (Text -> [Doc]) -> Text -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc) -> [Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc
text ([Text] -> [Doc]) -> (Text -> [Text]) -> Text -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
stringStrict :: TS.Text -> Doc
stringStrict :: Text -> Doc
stringStrict = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> (Text -> [Doc]) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
line ([Doc] -> [Doc]) -> (Text -> [Doc]) -> Text -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc) -> [Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc
textStrict ([Text] -> [Doc]) -> (Text -> [Text]) -> Text -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TS.lines
bool :: Bool -> Doc
bool :: Bool -> Doc
bool = Bool -> Doc
forall a. Show a => a -> Doc
text'
int :: Int -> Doc
int :: Int -> Doc
int = Int -> Doc
forall a. Show a => a -> Doc
text'
integer :: Integer -> Doc
integer :: Integer -> Doc
integer = Integer -> Doc
forall a. Show a => a -> Doc
text'
float :: Float -> Doc
float :: Float -> Doc
float = Float -> Doc
forall a. Show a => a -> Doc
text'
double :: Double -> Doc
double :: Double -> Doc
double = Double -> Doc
forall a. Show a => a -> Doc
text'
rational :: Rational -> Doc
rational :: Rational -> Doc
rational = Rational -> Doc
forall a. Show a => a -> Doc
text'
text' :: (Show a) => a -> Doc
text' :: a -> Doc
text' = Text -> Doc
text (Text -> Doc) -> (a -> Text) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
class Pretty a where
pretty :: a -> Doc
prettyList :: [a] -> Doc
prettyList = [Doc] -> Doc
list ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty
instance Pretty a => Pretty [a] where
pretty :: [a] -> Doc
pretty = [a] -> Doc
forall a. Pretty a => [a] -> Doc
prettyList
instance Pretty Doc where
pretty :: Doc -> Doc
pretty = Doc -> Doc
forall a. a -> a
id
instance Pretty Text where
pretty :: Text -> Doc
pretty = Text -> Doc
string
instance Pretty TS.Text where
pretty :: Text -> Doc
pretty = Text -> Doc
stringStrict
instance Pretty () where
pretty :: () -> Doc
pretty () = () -> Doc
forall a. Show a => a -> Doc
text' ()
instance Pretty Bool where
pretty :: Bool -> Doc
pretty = Bool -> Doc
bool
instance Pretty Char where
pretty :: Char -> Doc
pretty = Char -> Doc
char
prettyList :: String -> Doc
prettyList = Text -> Doc
string (Text -> Doc) -> (String -> Text) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance Pretty Int where
pretty :: Int -> Doc
pretty = Int -> Doc
int
instance Pretty Integer where
pretty :: Integer -> Doc
pretty = Integer -> Doc
integer
instance Pretty Float where
pretty :: Float -> Doc
pretty = Float -> Doc
float
instance Pretty Double where
pretty :: Double -> Doc
pretty = Double -> Doc
double
instance (Pretty a, Pretty b) => Pretty (a,b) where
pretty :: (a, b) -> Doc
pretty (x :: a
x,y :: b
y) = [Doc] -> Doc
tupled [a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x, b -> Doc
forall a. Pretty a => a -> Doc
pretty b
y]
instance (Pretty a, Pretty b, Pretty c) => Pretty (a,b,c) where
pretty :: (a, b, c) -> Doc
pretty (x :: a
x,y :: b
y,z :: c
z)= [Doc] -> Doc
tupled [a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x, b -> Doc
forall a. Pretty a => a -> Doc
pretty b
y, c -> Doc
forall a. Pretty a => a -> Doc
pretty c
z]
instance Pretty a => Pretty (Maybe a) where
pretty :: Maybe a -> Doc
pretty Nothing = Doc
empty
pretty (Just x :: a
x) = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x
fillBreak :: Int -> Doc -> Doc
fillBreak :: Int -> Doc -> Doc
fillBreak f :: Int
f x :: Doc
x = Doc -> (Int -> Doc) -> Doc
width Doc
x (\w :: Int
w ->
if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
f
then Int -> Doc -> Doc
nest Int
f Doc
linebreak
else Int -> Doc
spaced (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)
)
fill :: Int -> Doc -> Doc
fill :: Int -> Doc -> Doc
fill f :: Int
f d :: Doc
d = Doc -> (Int -> Doc) -> Doc
width Doc
d (\w :: Int
w ->
if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
f
then Doc
empty
else Int -> Doc
spaced (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)
)
width :: Doc -> (Int -> Doc) -> Doc
width :: Doc -> (Int -> Doc) -> Doc
width d :: Doc
d f :: Int -> Doc
f = (Int -> Doc) -> Doc
column (\k1 :: Int
k1 -> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Int -> Doc) -> Doc
column (\k2 :: Int
k2 -> Int -> Doc
f (Int
k2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k1)))
indent :: Int -> Doc -> Doc
indent :: Int -> Doc -> Doc
indent _ Empty = Doc
Empty
indent i :: Int
i d :: Doc
d = Int -> Doc -> Doc
hang Int
i (Int -> Doc
spaced Int
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d)
hang :: Int -> Doc -> Doc
hang :: Int -> Doc -> Doc
hang i :: Int
i d :: Doc
d = Doc -> Doc
align (Int -> Doc -> Doc
nest Int
i Doc
d)
align :: Doc -> Doc
align :: Doc -> Doc
align d :: Doc
d = (Int -> Doc) -> Doc
column (\k :: Int
k ->
(Int -> Doc) -> Doc
nesting (\i :: Int
i -> Int -> Doc -> Doc
nest (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Doc
d))
data Doc = Empty
| Char Char
| Text !Int64 Builder
| Line !Bool
| Cat Doc Doc
| Nest !Int64 Doc
| Union Doc Doc
| Column (Int64 -> Doc)
| Nesting (Int64 -> Doc)
| Spaces !Int64
instance IsString Doc where
fromString :: String -> Doc
fromString = Text -> Doc
string (Text -> Doc) -> (String -> Text) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
#if MIN_VERSION_base (4,9,0)
instance Semigroup Doc where
<> :: Doc -> Doc -> Doc
(<>) = Doc -> Doc -> Doc
beside
#endif
instance Monoid Doc where
mempty :: Doc
mempty = Doc
empty
mappend :: Doc -> Doc -> Doc
mappend = Doc -> Doc -> Doc
beside
data SimpleDoc = SEmpty
| SChar Char SimpleDoc
| SText !Int64 Builder SimpleDoc
| SLine !Int64 SimpleDoc
empty :: Doc
empty :: Doc
empty = Doc
Empty
isEmpty :: Doc -> Bool
isEmpty :: Doc -> Bool
isEmpty Empty = Bool
True
isEmpty _ = Bool
False
char :: Char -> Doc
char :: Char -> Doc
char '\n' = Doc
line
char c :: Char
c = Char -> Doc
Char Char
c
text :: Text -> Doc
text :: Text -> Doc
text s :: Text
s
| Text -> Bool
T.null Text
s = Doc
Empty
| Bool
otherwise = Int64 -> Builder -> Doc
Text (Text -> Int64
T.length Text
s) (Text -> Builder
B.fromLazyText Text
s)
textStrict :: TS.Text -> Doc
textStrict :: Text -> Doc
textStrict s :: Text
s
| Text -> Bool
TS.null Text
s = Doc
Empty
| Bool
otherwise = Int64 -> Builder -> Doc
Text (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Text -> Int
TS.length Text
s) (Text -> Builder
B.fromText Text
s)
line :: Doc
line :: Doc
line = Bool -> Doc
Line Bool
False
linebreak :: Doc
linebreak :: Doc
linebreak = Bool -> Doc
Line Bool
True
beside :: Doc -> Doc -> Doc
beside :: Doc -> Doc -> Doc
beside Empty r :: Doc
r = Doc
r
beside l :: Doc
l Empty = Doc
l
beside l :: Doc
l r :: Doc
r = Doc -> Doc -> Doc
Cat Doc
l Doc
r
nest :: Int -> Doc -> Doc
nest :: Int -> Doc -> Doc
nest _ Empty = Doc
Empty
nest i :: Int
i x :: Doc
x = Int64 -> Doc -> Doc
Nest (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) Doc
x
column :: (Int -> Doc) -> Doc
column :: (Int -> Doc) -> Doc
column f :: Int -> Doc
f = (Int64 -> Doc) -> Doc
Column (Int -> Doc
f (Int -> Doc) -> (Int64 -> Int) -> Int64 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
nesting :: (Int -> Doc) -> Doc
nesting :: (Int -> Doc) -> Doc
nesting f :: Int -> Doc
f = (Int64 -> Doc) -> Doc
Nesting (Int -> Doc
f (Int -> Doc) -> (Int64 -> Int) -> Int64 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
group :: Doc -> Doc
group :: Doc -> Doc
group x :: Doc
x = Doc -> Doc -> Doc
Union (Doc -> Doc
flatten Doc
x) Doc
x
flatten :: Doc -> Doc
flatten :: Doc -> Doc
flatten (Cat x :: Doc
x y :: Doc
y) = Doc -> Doc -> Doc
Cat (Doc -> Doc
flatten Doc
x) (Doc -> Doc
flatten Doc
y)
flatten (Nest i :: Int64
i x :: Doc
x) = Int64 -> Doc -> Doc
Nest Int64
i (Doc -> Doc
flatten Doc
x)
flatten (Line brk :: Bool
brk) = if Bool
brk then Doc
Empty else Int64 -> Builder -> Doc
Text 1 (Char -> Builder
B.singleton ' ')
flatten (Union x :: Doc
x _) = Doc -> Doc
flatten Doc
x
flatten (Column f :: Int64 -> Doc
f) = (Int64 -> Doc) -> Doc
Column (Doc -> Doc
flatten (Doc -> Doc) -> (Int64 -> Doc) -> Int64 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Doc
f)
flatten (Nesting f :: Int64 -> Doc
f) = (Int64 -> Doc) -> Doc
Nesting (Doc -> Doc
flatten (Doc -> Doc) -> (Int64 -> Doc) -> Int64 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Doc
f)
flatten other :: Doc
other = Doc
other
data Docs = Nil
| Cons !Int64 Doc Docs
renderPretty :: Float -> Int -> Doc -> SimpleDoc
renderPretty :: Float -> Int -> Doc -> SimpleDoc
renderPretty rfrac :: Float
rfrac w :: Int
w doc :: Doc
doc
= Int64 -> Int64 -> Docs -> SimpleDoc
best 0 0 (Int64 -> Doc -> Docs -> Docs
Cons 0 Doc
doc Docs
Nil)
where
r :: Int64
r = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max 0 (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
w64 (Float -> Int64
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)))
w64 :: Int64
w64 = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
best :: Int64 -> Int64 -> Docs -> SimpleDoc
best _ _ Nil = SimpleDoc
SEmpty
best n :: Int64
n k :: Int64
k (Cons i :: Int64
i d :: Doc
d ds :: Docs
ds)
= case Doc
d of
Empty -> Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
n Int64
k Docs
ds
Char c :: Char
c -> let k' :: Int64
k' = Int64
kInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+1 in Int64 -> SimpleDoc -> SimpleDoc
forall a b. a -> b -> b
seq Int64
k' (SimpleDoc -> SimpleDoc) -> SimpleDoc -> SimpleDoc
forall a b. (a -> b) -> a -> b
$ Char -> SimpleDoc -> SimpleDoc
SChar Char
c (Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
n Int64
k' Docs
ds)
Text l :: Int64
l s :: Builder
s -> let k' :: Int64
k' = Int64
kInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
l in Int64 -> SimpleDoc -> SimpleDoc
forall a b. a -> b -> b
seq Int64
k' (SimpleDoc -> SimpleDoc) -> SimpleDoc -> SimpleDoc
forall a b. (a -> b) -> a -> b
$ Int64 -> Builder -> SimpleDoc -> SimpleDoc
SText Int64
l Builder
s (Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
n Int64
k' Docs
ds)
Line _ -> Int64 -> SimpleDoc -> SimpleDoc
SLine Int64
i (Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
i Int64
i Docs
ds)
Cat x :: Doc
x y :: Doc
y -> Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
n Int64
k (Int64 -> Doc -> Docs -> Docs
Cons Int64
i Doc
x (Int64 -> Doc -> Docs -> Docs
Cons Int64
i Doc
y Docs
ds))
Nest j :: Int64
j x :: Doc
x -> let i' :: Int64
i' = Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
j in Int64 -> SimpleDoc -> SimpleDoc
forall a b. a -> b -> b
seq Int64
i' (Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
n Int64
k (Int64 -> Doc -> Docs -> Docs
Cons Int64
i' Doc
x Docs
ds))
Union x :: Doc
x y :: Doc
y -> Int64 -> Int64 -> SimpleDoc -> SimpleDoc -> SimpleDoc
nicest Int64
n Int64
k (Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
n Int64
k (Docs -> SimpleDoc) -> Docs -> SimpleDoc
forall a b. (a -> b) -> a -> b
$ Int64 -> Doc -> Docs -> Docs
Cons Int64
i Doc
x Docs
ds)
(Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
n Int64
k (Docs -> SimpleDoc) -> Docs -> SimpleDoc
forall a b. (a -> b) -> a -> b
$ Int64 -> Doc -> Docs -> Docs
Cons Int64
i Doc
y Docs
ds)
Column f :: Int64 -> Doc
f -> Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
n Int64
k (Int64 -> Doc -> Docs -> Docs
Cons Int64
i (Int64 -> Doc
f Int64
k) Docs
ds)
Nesting f :: Int64 -> Doc
f -> Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
n Int64
k (Int64 -> Doc -> Docs -> Docs
Cons Int64
i (Int64 -> Doc
f Int64
i) Docs
ds)
Spaces l :: Int64
l -> let k' :: Int64
k' = Int64
kInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
l in Int64 -> SimpleDoc -> SimpleDoc
forall a b. a -> b -> b
seq Int64
k' (SimpleDoc -> SimpleDoc) -> SimpleDoc -> SimpleDoc
forall a b. (a -> b) -> a -> b
$ Int64 -> Builder -> SimpleDoc -> SimpleDoc
SText Int64
l (Int64 -> Builder
spaces Int64
l) (Int64 -> Int64 -> Docs -> SimpleDoc
best Int64
n Int64
k' Docs
ds)
nicest :: Int64 -> Int64 -> SimpleDoc -> SimpleDoc -> SimpleDoc
nicest n :: Int64
n k :: Int64
k x :: SimpleDoc
x y :: SimpleDoc
y
| Int64 -> SimpleDoc -> Bool
fits Int64
wth SimpleDoc
x = SimpleDoc
x
| Bool
otherwise = SimpleDoc
y
where
wth :: Int64
wth = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (Int64
w64 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
k) (Int64
r Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
k Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n)
fits :: Int64 -> SimpleDoc -> Bool
fits :: Int64 -> SimpleDoc -> Bool
fits w :: Int64
w _ | Int64
w Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Bool
False
fits _ SEmpty = Bool
True
fits w :: Int64
w (SChar _ x :: SimpleDoc
x) = Int64 -> SimpleDoc -> Bool
fits (Int64
w Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- 1) SimpleDoc
x
fits w :: Int64
w (SText l :: Int64
l _ x :: SimpleDoc
x) = Int64 -> SimpleDoc -> Bool
fits (Int64
w Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
l) SimpleDoc
x
fits _ SLine{} = Bool
True
renderCompact :: Doc -> SimpleDoc
renderCompact :: Doc -> SimpleDoc
renderCompact dc :: Doc
dc
= Int64 -> [Doc] -> SimpleDoc
scan 0 [Doc
dc]
where
scan :: Int64 -> [Doc] -> SimpleDoc
scan _ [] = SimpleDoc
SEmpty
scan k :: Int64
k (d :: Doc
d:ds :: [Doc]
ds)
= case Doc
d of
Empty -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k [Doc]
ds
Char c :: Char
c -> let k' :: Int64
k' = Int64
kInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+1 in Int64 -> SimpleDoc -> SimpleDoc
forall a b. a -> b -> b
seq Int64
k' (Char -> SimpleDoc -> SimpleDoc
SChar Char
c (Int64 -> [Doc] -> SimpleDoc
scan Int64
k' [Doc]
ds))
Text l :: Int64
l s :: Builder
s -> let k' :: Int64
k' = Int64
kInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
l in Int64 -> SimpleDoc -> SimpleDoc
forall a b. a -> b -> b
seq Int64
k' (Int64 -> Builder -> SimpleDoc -> SimpleDoc
SText Int64
l Builder
s (Int64 -> [Doc] -> SimpleDoc
scan Int64
k' [Doc]
ds))
Line _ -> Int64 -> SimpleDoc -> SimpleDoc
SLine 0 (Int64 -> [Doc] -> SimpleDoc
scan 0 [Doc]
ds)
Cat x :: Doc
x y :: Doc
y -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k (Doc
xDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:Doc
yDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
Nest _ x :: Doc
x -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k (Doc
xDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
Union _ y :: Doc
y -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k (Doc
yDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
Column f :: Int64 -> Doc
f -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k (Int64 -> Doc
f Int64
kDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
Nesting f :: Int64 -> Doc
f -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k (Int64 -> Doc
f 0Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
Spaces _ -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k [Doc]
ds
renderOneLine :: Doc -> SimpleDoc
renderOneLine :: Doc -> SimpleDoc
renderOneLine dc :: Doc
dc
= Int64 -> [Doc] -> SimpleDoc
scan 0 [Doc
dc]
where
scan :: Int64 -> [Doc] -> SimpleDoc
scan _ [] = SimpleDoc
SEmpty
scan k :: Int64
k (d :: Doc
d:ds :: [Doc]
ds)
= case Doc
d of
Empty -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k [Doc]
ds
Char c :: Char
c -> let k' :: Int64
k' = Int64
kInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+1 in Int64 -> SimpleDoc -> SimpleDoc
forall a b. a -> b -> b
seq Int64
k' (Char -> SimpleDoc -> SimpleDoc
SChar Char
c (Int64 -> [Doc] -> SimpleDoc
scan Int64
k' [Doc]
ds))
Text l :: Int64
l s :: Builder
s -> let k' :: Int64
k' = Int64
kInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
l in Int64 -> SimpleDoc -> SimpleDoc
forall a b. a -> b -> b
seq Int64
k' (Int64 -> Builder -> SimpleDoc -> SimpleDoc
SText Int64
l Builder
s (Int64 -> [Doc] -> SimpleDoc
scan Int64
k' [Doc]
ds))
Line False -> let k' :: Int64
k' = Int64
kInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+1 in Int64 -> SimpleDoc -> SimpleDoc
forall a b. a -> b -> b
seq Int64
k' (Char -> SimpleDoc -> SimpleDoc
SChar ' ' (Int64 -> [Doc] -> SimpleDoc
scan Int64
k' [Doc]
ds))
Line _ -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k [Doc]
ds
Cat x :: Doc
x y :: Doc
y -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k (Doc
xDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:Doc
yDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
Nest _ x :: Doc
x -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k (Doc
xDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
Union _ y :: Doc
y -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k (Doc
yDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
Column f :: Int64 -> Doc
f -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k (Int64 -> Doc
f Int64
kDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
Nesting f :: Int64 -> Doc
f -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k (Int64 -> Doc
f 0Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
Spaces _ -> Int64 -> [Doc] -> SimpleDoc
scan Int64
k [Doc]
ds
displayB :: SimpleDoc -> Builder
displayB :: SimpleDoc -> Builder
displayB SEmpty = Builder
forall a. Monoid a => a
mempty
displayB (SChar c :: Char
c x :: SimpleDoc
x) = Char
c Char -> Builder -> Builder
`consB` SimpleDoc -> Builder
displayB SimpleDoc
x
displayB (SText _ s :: Builder
s x :: SimpleDoc
x) = Builder
s Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` SimpleDoc -> Builder
displayB SimpleDoc
x
displayB (SLine i :: Int64
i x :: SimpleDoc
x) = '\n' Char -> Builder -> Builder
`consB` (Int64 -> Builder
indentation Int64
i Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` SimpleDoc -> Builder
displayB SimpleDoc
x)
consB :: Char -> Builder -> Builder
c :: Char
c consB :: Char -> Builder -> Builder
`consB` b :: Builder
b = Char -> Builder
B.singleton Char
c Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
displayT :: SimpleDoc -> Text
displayT :: SimpleDoc -> Text
displayT = Builder -> Text
B.toLazyText (Builder -> Text) -> (SimpleDoc -> Builder) -> SimpleDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc -> Builder
displayB
displayTStrict :: SimpleDoc -> TS.Text
displayTStrict :: SimpleDoc -> Text
displayTStrict = Text -> Text
T.toStrict (Text -> Text) -> (SimpleDoc -> Text) -> SimpleDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc -> Text
displayT
displayIO :: Handle -> SimpleDoc -> IO ()
displayIO :: Handle -> SimpleDoc -> IO ()
displayIO handle :: Handle
handle = SimpleDoc -> IO ()
display
where
display :: SimpleDoc -> IO ()
display SEmpty = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
display (SChar c :: Char
c x :: SimpleDoc
x) = Handle -> Char -> IO ()
hPutChar Handle
handle Char
c IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleDoc -> IO ()
display SimpleDoc
x
display (SText _ s :: Builder
s x :: SimpleDoc
x) = Handle -> Text -> IO ()
T.hPutStr Handle
handle (Builder -> Text
B.toLazyText Builder
s) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleDoc -> IO ()
display SimpleDoc
x
display (SLine i :: Int64
i x :: SimpleDoc
x) = Handle -> Text -> IO ()
T.hPutStr Handle
handle Text
newLine IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleDoc -> IO ()
display SimpleDoc
x
where
newLine :: Text
newLine = Builder -> Text
B.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ '\n' Char -> Builder -> Builder
`consB` Int64 -> Builder
indentation Int64
i
instance Show Doc where
showsPrec :: Int -> Doc -> ShowS
showsPrec d :: Int
d doc :: Doc
doc = Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (SimpleDoc -> Text
displayT (SimpleDoc -> Text) -> SimpleDoc -> Text
forall a b. (a -> b) -> a -> b
$ Float -> Int -> Doc -> SimpleDoc
renderPretty 0.4 80 Doc
doc)
show :: Doc -> String
show doc :: Doc
doc = Text -> String
T.unpack (SimpleDoc -> Text
displayT (SimpleDoc -> Text) -> SimpleDoc -> Text
forall a b. (a -> b) -> a -> b
$ Float -> Int -> Doc -> SimpleDoc
renderPretty 0.4 80 Doc
doc)
instance Show SimpleDoc where
show :: SimpleDoc -> String
show simpleDoc :: SimpleDoc
simpleDoc = Text -> String
T.unpack (SimpleDoc -> Text
displayT SimpleDoc
simpleDoc)
putDoc :: Doc -> IO ()
putDoc :: Doc -> IO ()
putDoc = Handle -> Doc -> IO ()
hPutDoc Handle
stdout
hPutDoc :: Handle -> Doc -> IO ()
hPutDoc :: Handle -> Doc -> IO ()
hPutDoc handle :: Handle
handle doc :: Doc
doc = Handle -> SimpleDoc -> IO ()
displayIO Handle
handle (Float -> Int -> Doc -> SimpleDoc
renderPretty 0.4 80 Doc
doc)
spaces :: Int64 -> Builder
spaces :: Int64 -> Builder
spaces n :: Int64
n
| Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Builder
forall a. Monoid a => a
mempty
| Bool
otherwise = Text -> Builder
B.fromLazyText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> Text
T.replicate Int64
n (Char -> Text
T.singleton ' ')
spaced :: Int -> Doc
spaced :: Int -> Doc
spaced l :: Int
l = Int64 -> Doc
Spaces Int64
l'
where
l' :: Int64
l' = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
indentation :: Int64 -> Builder
indentation :: Int64 -> Builder
indentation = Int64 -> Builder
spaces