module Text.PrettyPrint.Annotated.WL (
Doc(..), putDoc, hPutDoc
, char, text, nest, line, linebreak, group, softline
, softbreak, hardline, flatAlt, flatten
, annotate, noAnnotate, docMapAnn
, simpleDocMapAnn, simpleDocScanAnn
, 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
, Pretty(..)
, SimpleDoc(..), renderPrettyDefault, renderPretty, renderCompact, renderSmart
, display, displayS, displayT, displayIO, displayDecoratedA, displayDecorated
, SpanList, displaySpans
, column, nesting, width, columns, ribbon
, mempty, (<>)
) where
import Data.Foldable hiding (fold)
import Data.Traversable
import Data.Int
import Data.Word
import Data.Bifunctor
import Data.Functor.Identity
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TL
import Data.List.NonEmpty (NonEmpty)
import Numeric.Natural (Natural)
import Control.Applicative
import Data.Sequence (Seq)
import Data.Semigroup
import System.IO (Handle,hPutStr,stdout)
import Control.DeepSeq (NFData)
import GHC.Generics (Generic)
import Data.String (IsString(..))
infixr 5 </>, <//>, <#>, <##>
infixr 6 <+>
list :: Foldable f => f (Doc a) -> Doc a
list :: f (Doc a) -> Doc a
list = Doc a -> Doc a -> Doc a -> f (Doc a) -> Doc a
forall (f :: * -> *) a.
Foldable f =>
Doc a -> Doc a -> Doc a -> f (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 :: Foldable f => f (Doc a) -> Doc a
tupled :: f (Doc a) -> Doc a
tupled = Doc a -> Doc a -> Doc a -> f (Doc a) -> Doc a
forall (f :: * -> *) a.
Foldable f =>
Doc a -> Doc a -> Doc a -> f (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
(<+>) :: Doc a -> Doc a -> Doc a
x :: Doc a
x <+> :: Doc a -> Doc a -> Doc a
<+> y :: Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
space Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y
semiBraces :: Foldable f => f (Doc a) -> Doc a
semiBraces :: f (Doc a) -> Doc a
semiBraces = Doc a -> Doc a -> Doc a -> f (Doc a) -> Doc a
forall (f :: * -> *) a.
Foldable f =>
Doc a -> Doc a -> Doc a -> f (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 :: Foldable f => Doc a -> Doc a -> Doc a -> f (Doc a) -> Doc a
encloseSep :: Doc a -> Doc a -> Doc a -> f (Doc a) -> Doc a
encloseSep left :: Doc a
left right :: Doc a
right sp :: Doc a
sp ds0 :: f (Doc a)
ds0
= case f (Doc a) -> [Doc a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Doc a)
ds0 of
[] -> Doc a
left Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
right
[d :: Doc a
d] -> Doc a
left Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
d Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
right
ds :: [Doc a]
ds -> Doc a -> Doc a
forall a. Doc a -> Doc a
group (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> Doc a
forall a. Doc a -> Doc a
align (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a
left'
Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> [Doc a] -> Doc a
forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
vcat ((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. Semigroup a => a -> a -> a
(<>) (Doc a
forall a. Monoid a => a
mempty Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: Doc a -> [Doc a]
forall a. a -> [a]
repeat (Doc a
sp Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
space)) [Doc a]
ds)
Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
right'
where left' :: Doc a
left' = Doc a
left Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
flatAlt Doc a
forall a. Doc a
space Doc a
forall a. Monoid a => a
mempty
right' :: Doc a
right' = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
flatAlt Doc a
forall a. Doc a
space Doc a
forall a. Monoid a => a
mempty Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
right
punctuate :: Traversable f => Doc a -> f (Doc a) -> f (Doc a)
punctuate :: Doc a -> f (Doc a) -> f (Doc a)
punctuate p :: Doc a
p xs :: f (Doc a)
xs = ([Doc a], f (Doc a)) -> f (Doc a)
forall a b. (a, b) -> b
snd (([Doc a], f (Doc a)) -> f (Doc a))
-> ([Doc a], f (Doc a)) -> f (Doc a)
forall a b. (a -> b) -> a -> b
$ ([Doc a] -> Doc a -> ([Doc a], Doc a))
-> [Doc a] -> f (Doc a) -> ([Doc a], f (Doc a))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\(d :: Doc a
d:ds :: [Doc a]
ds) _ -> ([Doc a]
ds, if [Doc a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc a]
ds then Doc a
d else Doc a
d Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
p)) (f (Doc a) -> [Doc a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Doc a)
xs) f (Doc a)
xs
sep :: Foldable f => f (Doc a) -> Doc a
sep :: f (Doc a) -> Doc a
sep = Doc a -> Doc a
forall a. Doc a -> Doc a
group (Doc a -> Doc a) -> (f (Doc a) -> Doc a) -> f (Doc a) -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Doc a) -> Doc a
forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
vsep
fillSep :: Foldable f => f (Doc a) -> Doc a
fillSep :: f (Doc a) -> Doc a
fillSep = (Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
forall (f :: * -> *) a.
Foldable f =>
(Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(</>)
hsep :: Foldable f => f (Doc a) -> Doc a
hsep :: f (Doc a) -> Doc a
hsep = (Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
forall (f :: * -> *) a.
Foldable f =>
(Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<+>)
vsep :: Foldable f => f (Doc a) -> Doc a
vsep :: f (Doc a) -> Doc a
vsep = (Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
forall (f :: * -> *) a.
Foldable f =>
(Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<#>)
cat :: Foldable f => f (Doc a) -> Doc a
cat :: f (Doc a) -> Doc a
cat = Doc a -> Doc a
forall a. Doc a -> Doc a
group (Doc a -> Doc a) -> (f (Doc a) -> Doc a) -> f (Doc a) -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Doc a) -> Doc a
forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
vcat
fillCat :: Foldable f => f (Doc a) -> Doc a
fillCat :: f (Doc a) -> Doc a
fillCat = (Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
forall (f :: * -> *) a.
Foldable f =>
(Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<//>)
hcat :: Foldable f => f (Doc a) -> Doc a
hcat :: f (Doc a) -> Doc a
hcat = (Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
forall (f :: * -> *) a.
Foldable f =>
(Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
(<>)
vcat :: Foldable f => f (Doc a) -> Doc a
vcat :: f (Doc a) -> Doc a
vcat = (Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
forall (f :: * -> *) a.
Foldable f =>
(Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<##>)
fold :: Foldable f => (Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
fold :: (Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
fold f :: Doc a -> Doc a -> Doc a
f xs :: f (Doc a)
xs | f (Doc a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f (Doc a)
xs = Doc a
forall a. Monoid a => a
mempty
| Bool
otherwise = (Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc a -> Doc a -> Doc a
f f (Doc a)
xs
instance Semigroup (Doc a) where
<> :: Doc a -> Doc a -> Doc a
(<>) = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Cat
instance Monoid (Doc a) where
mappend :: Doc a -> Doc a -> Doc a
mappend = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Cat
mempty :: Doc a
mempty = Doc a
forall a. Doc a
Empty
mconcat :: [Doc a] -> Doc a
mconcat = [Doc a] -> Doc a
forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
hcat
(</>) :: Doc a -> Doc a -> Doc a
x :: Doc a
x </> :: Doc a -> Doc a -> Doc a
</> y :: Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
softline Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y
(<//>) :: Doc a -> Doc a -> Doc a
x :: Doc a
x <//> :: Doc a -> Doc a -> Doc a
<//> y :: Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
softbreak Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y
(<#>) :: Doc a -> Doc a -> Doc a
x :: Doc a
x <#> :: Doc a -> Doc a -> Doc a
<#> y :: Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
line Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y
(<##>) :: Doc a -> Doc a -> Doc a
x :: Doc a
x <##> :: Doc a -> Doc a -> Doc a
<##> y :: Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
linebreak Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y
softline :: Doc a
softline :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: Doc a -> Doc a -> Doc a -> Doc a
enclose l :: Doc a
l r :: Doc a
r x :: Doc a
x = Doc a
l Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
r
lparen :: Doc a
lparen :: Doc a
lparen = Char -> Doc a
forall a. Char -> Doc a
char '('
rparen :: Doc a
rparen :: Doc a
rparen = Char -> Doc a
forall a. Char -> Doc a
char ')'
langle :: Doc a
langle :: Doc a
langle = Char -> Doc a
forall a. Char -> Doc a
char '<'
rangle :: Doc a
rangle :: Doc a
rangle = Char -> Doc a
forall a. Char -> Doc a
char '>'
lbrace :: Doc a
lbrace :: Doc a
lbrace = Char -> Doc a
forall a. Char -> Doc a
char '{'
rbrace :: Doc a
rbrace :: Doc a
rbrace = Char -> Doc a
forall a. Char -> Doc a
char '}'
lbracket :: Doc a
lbracket :: Doc a
lbracket = Char -> Doc a
forall a. Char -> Doc a
char '['
rbracket :: Doc a
rbracket :: Doc a
rbracket = Char -> Doc a
forall a. Char -> Doc a
char ']'
squote :: Doc a
squote :: Doc a
squote = Char -> Doc a
forall a. Char -> Doc a
char '\''
dquote :: Doc a
dquote :: Doc a
dquote = Char -> Doc a
forall a. Char -> Doc a
char '"'
semi :: Doc a
semi :: Doc a
semi = Char -> Doc a
forall a. Char -> Doc a
char ';'
colon :: Doc a
colon :: Doc a
colon = Char -> Doc a
forall a. Char -> Doc a
char ':'
comma :: Doc a
comma :: Doc a
comma = Char -> Doc a
forall a. Char -> Doc a
char ','
space :: Doc a
space :: Doc a
space = Char -> Doc a
forall a. Char -> Doc a
char ' '
dot :: Doc a
dot :: Doc a
dot = Char -> Doc a
forall a. Char -> Doc a
char '.'
backslash :: Doc a
backslash :: Doc a
backslash = Char -> Doc a
forall a. Char -> Doc a
char '\\'
equals :: Doc a
equals :: Doc a
equals = Char -> Doc a
forall a. Char -> Doc a
char '='
docMapAnn :: (a -> Doc a' -> Doc a') -> Doc a -> Doc a'
docMapAnn :: (a -> Doc a' -> Doc a') -> Doc a -> Doc a'
docMapAnn an :: a -> Doc a' -> Doc a'
an = Doc a -> Doc a'
go
where
go :: Doc a -> Doc a'
go Empty = Doc a'
forall a. Doc a
Empty
go (Char x :: Char
x) = Char -> Doc a'
forall a. Char -> Doc a
Char Char
x
go (Text i :: Int
i s :: String
s) = Int -> String -> Doc a'
forall a. Int -> String -> Doc a
Text Int
i String
s
go Line = Doc a'
forall a. Doc a
Line
go (FlatAlt l :: Doc a
l r :: Doc a
r) = Doc a' -> Doc a' -> Doc a'
forall a. Doc a -> Doc a -> Doc a
FlatAlt (Doc a -> Doc a'
go Doc a
l) (Doc a -> Doc a'
go Doc a
r)
go (Cat l :: Doc a
l r :: Doc a
r) = Doc a' -> Doc a' -> Doc a'
forall a. Doc a -> Doc a -> Doc a
Cat (Doc a -> Doc a'
go Doc a
l) (Doc a -> Doc a'
go Doc a
r)
go (Nest i :: Int
i d :: Doc a
d) = Int -> Doc a' -> Doc a'
forall a. Int -> Doc a -> Doc a
Nest Int
i (Doc a -> Doc a'
go Doc a
d)
go (Union l :: Doc a
l r :: Doc a
r) = Doc a' -> Doc a' -> Doc a'
forall a. Doc a -> Doc a -> Doc a
Union (Doc a -> Doc a'
go Doc a
l) (Doc a -> Doc a'
go Doc a
r)
go (Annotate a :: a
a d :: Doc a
d) = a -> Doc a' -> Doc a'
an a
a (Doc a -> Doc a'
go Doc a
d)
go (Column f :: Int -> Doc a
f) = (Int -> Doc a') -> Doc a'
forall a. (Int -> Doc a) -> Doc a
Column (Doc a -> Doc a'
go (Doc a -> Doc a') -> (Int -> Doc a) -> Int -> Doc a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc a
f)
go (Nesting k :: Int -> Doc a
k) = (Int -> Doc a') -> Doc a'
forall a. (Int -> Doc a) -> Doc a
Nesting (Doc a -> Doc a'
go (Doc a -> Doc a') -> (Int -> Doc a) -> Int -> Doc a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc a
k)
go (Columns k :: Maybe Int -> Doc a
k) = (Maybe Int -> Doc a') -> Doc a'
forall a. (Maybe Int -> Doc a) -> Doc a
Columns (Doc a -> Doc a'
go (Doc a -> Doc a') -> (Maybe Int -> Doc a) -> Maybe Int -> Doc a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc a
k)
go (Ribbon k :: Maybe Int -> Doc a
k) = (Maybe Int -> Doc a') -> Doc a'
forall a. (Maybe Int -> Doc a) -> Doc a
Ribbon (Doc a -> Doc a'
go (Doc a -> Doc a') -> (Maybe Int -> Doc a) -> Maybe Int -> Doc a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc a
k)
instance IsString (Doc a) where
fromString :: String -> Doc a
fromString = String -> Doc a
forall a b. Pretty a => a -> Doc b
pretty
class Pretty a where
pretty :: a -> Doc b
prettyList :: [a] -> Doc b
prettyList = [Doc b] -> Doc b
forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
list ([Doc b] -> Doc b) -> ([a] -> [Doc b]) -> [a] -> Doc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc b) -> [a] -> [Doc b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc b
forall a b. Pretty a => a -> Doc b
pretty
default pretty :: Show a => a -> Doc b
pretty = String -> Doc b
forall a. String -> Doc a
text (String -> Doc b) -> (a -> String) -> a -> Doc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
instance Pretty (Doc a) where
pretty :: Doc a -> Doc b
pretty = Doc a -> Doc b
forall a b. Doc a -> Doc b
noAnnotate
instance Pretty a => Pretty [a] where
pretty :: [a] -> Doc b
pretty = [a] -> Doc b
forall a b. Pretty a => [a] -> Doc b
prettyList
instance Pretty T.Text where
pretty :: Text -> Doc b
pretty = String -> Doc b
forall a b. Pretty a => a -> Doc b
pretty (String -> Doc b) -> (Text -> String) -> Text -> Doc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
instance Pretty TL.Text where
pretty :: Text -> Doc b
pretty = String -> Doc b
forall a b. Pretty a => a -> Doc b
pretty (String -> Doc b) -> (Text -> String) -> Text -> Doc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
instance Pretty () where
pretty :: () -> Doc b
pretty () = String -> Doc b
forall a. String -> Doc a
text "()"
instance Pretty Char where
pretty :: Char -> Doc b
pretty = Char -> Doc b
forall a. Char -> Doc a
char
prettyList :: String -> Doc b
prettyList "" = Doc b
forall a. Monoid a => a
mempty
prettyList ('\n':s :: String
s) = Doc b
forall a. Doc a
line Doc b -> Doc b -> Doc b
forall a. Semigroup a => a -> a -> a
<> String -> Doc b
forall a b. Pretty a => [a] -> Doc b
prettyList String
s
prettyList s :: String
s = let (xs :: String
xs,ys :: String
ys) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='\n') String
s in String -> Doc b
forall a. String -> Doc a
text String
xs Doc b -> Doc b -> Doc b
forall a. Semigroup a => a -> a -> a
<> String -> Doc b
forall a b. Pretty a => [a] -> Doc b
prettyList String
ys
instance Pretty a => Pretty (Seq a) where
pretty :: Seq a -> Doc b
pretty = [a] -> Doc b
forall a b. Pretty a => [a] -> Doc b
prettyList ([a] -> Doc b) -> (Seq a -> [a]) -> Seq a -> Doc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance Pretty a => Pretty (NonEmpty a) where
pretty :: NonEmpty a -> Doc b
pretty = [a] -> Doc b
forall a b. Pretty a => [a] -> Doc b
prettyList ([a] -> Doc b) -> (NonEmpty a -> [a]) -> NonEmpty a -> Doc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance (Pretty a, Pretty b) => Pretty (a,b) where
pretty :: (a, b) -> Doc b
pretty (x :: a
x, y :: b
y) = [Doc b] -> Doc b
forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
tupled [a -> Doc b
forall a b. Pretty a => a -> Doc b
pretty a
x, b -> Doc b
forall a b. Pretty a => a -> Doc b
pretty b
y]
instance (Pretty a, Pretty b, Pretty c) => Pretty (a,b,c) where
pretty :: (a, b, c) -> Doc b
pretty (x :: a
x, y :: b
y, z :: c
z) = [Doc b] -> Doc b
forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
tupled [a -> Doc b
forall a b. Pretty a => a -> Doc b
pretty a
x, b -> Doc b
forall a b. Pretty a => a -> Doc b
pretty b
y, c -> Doc b
forall a b. Pretty a => a -> Doc b
pretty c
z]
instance Pretty a => Pretty (Maybe a) where
pretty :: Maybe a -> Doc b
pretty = Doc b -> (a -> Doc b) -> Maybe a -> Doc b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc b
forall a. Monoid a => a
mempty a -> Doc b
forall a b. Pretty a => a -> Doc b
pretty
instance Pretty Bool
instance Pretty Int
instance Pretty Int8
instance Pretty Int16
instance Pretty Int32
instance Pretty Int64
instance Pretty Word
instance Pretty Word8
instance Pretty Word16
instance Pretty Word32
instance Pretty Word64
instance Pretty Integer
instance Pretty Natural
instance Pretty Float
instance Pretty Double
instance Pretty Rational
fillBreak :: Int -> Doc a -> Doc a
fillBreak :: Int -> Doc a -> Doc a
fillBreak f :: Int
f x :: Doc a
x = Doc a -> (Int -> Doc a) -> Doc a
forall a. Doc a -> (Int -> Doc a) -> Doc a
width Doc a
x ((Int -> Doc a) -> Doc a) -> (Int -> Doc a) -> Doc a
forall a b. (a -> b) -> a -> b
$ \w :: 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 :: Int -> Doc a -> Doc a
fill f :: Int
f d :: Doc a
d = Doc a -> (Int -> Doc a) -> Doc a
forall a. Doc a -> (Int -> Doc a) -> Doc a
width Doc a
d ((Int -> Doc a) -> Doc a) -> (Int -> Doc a) -> Doc a
forall a b. (a -> b) -> a -> b
$ \w :: Int
w ->
if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
f
then Doc a
forall a. Monoid a => a
mempty
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 :: Doc a -> (Int -> Doc a) -> Doc a
width d :: Doc a
d f :: Int -> Doc a
f = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
column (\k1 :: Int
k1 -> Doc a
d Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
column (\k2 :: 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 :: Int -> Doc a -> Doc a
indent i :: Int
i d :: 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. Semigroup a => a -> a -> a
<> Doc a
d)
hang :: Int -> Doc a -> Doc a
hang :: Int -> Doc a -> Doc a
hang i :: Int
i d :: 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 :: Doc a -> Doc a
align d :: Doc a
d = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
column ((Int -> Doc a) -> Doc a) -> (Int -> Doc a) -> Doc a
forall a b. (a -> b) -> a -> b
$ \k :: Int
k ->
(Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
nesting ((Int -> Doc a) -> Doc a) -> (Int -> Doc a) -> Doc a
forall a b. (a -> b) -> a -> b
$ \i :: 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 {-# UNPACK #-} !Char
| Text {-# UNPACK #-} !Int String
| Line
| FlatAlt (Doc a) (Doc a)
| Cat (Doc a) (Doc a)
| Nest {-# UNPACK #-} !Int (Doc a)
| Union (Doc a) (Doc a)
| Annotate a (Doc a)
| Column (Int -> Doc a)
| Nesting (Int -> Doc a)
| Columns (Maybe Int -> Doc a)
| Ribbon (Maybe Int -> Doc a)
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
$cto :: forall a x. Rep (Doc a) x -> Doc a
$cfrom :: forall a x. Doc a -> Rep (Doc a) x
Generic, a -> Doc b -> Doc a
(a -> b) -> Doc a -> Doc b
(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
<$ :: a -> Doc b -> Doc a
$c<$ :: forall a b. a -> Doc b -> Doc a
fmap :: (a -> b) -> Doc a -> Doc b
$cfmap :: forall a b. (a -> b) -> Doc a -> Doc b
Functor)
instance NFData a => NFData (Doc a)
annotate :: a -> Doc a -> Doc a
annotate :: 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 :: Doc a -> Doc a'
noAnnotate = (a -> Doc a' -> Doc a') -> Doc a -> Doc a'
forall a a'. (a -> Doc a' -> Doc a') -> Doc a -> Doc a'
docMapAnn ((a -> Doc a' -> Doc a') -> Doc a -> Doc a')
-> (a -> Doc a' -> Doc a') -> Doc a -> Doc a'
forall a b. (a -> b) -> a -> b
$ (Doc a' -> Doc a') -> a -> Doc a' -> Doc a'
forall a b. a -> b -> a
const Doc a' -> Doc a'
forall a. a -> a
id
data SimpleDoc a
= SEmpty
| SChar {-# UNPACK #-} !Char (SimpleDoc a)
| SText {-# UNPACK #-} !Int String (SimpleDoc a)
| SLine {-# UNPACK #-} !Int (SimpleDoc a)
| SPushAnn a (SimpleDoc a)
| SPopAnn a (SimpleDoc a)
deriving ((forall x. SimpleDoc a -> Rep (SimpleDoc a) x)
-> (forall x. Rep (SimpleDoc a) x -> SimpleDoc a)
-> Generic (SimpleDoc a)
forall x. Rep (SimpleDoc a) x -> SimpleDoc a
forall x. SimpleDoc a -> Rep (SimpleDoc a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SimpleDoc a) x -> SimpleDoc a
forall a x. SimpleDoc a -> Rep (SimpleDoc a) x
$cto :: forall a x. Rep (SimpleDoc a) x -> SimpleDoc a
$cfrom :: forall a x. SimpleDoc a -> Rep (SimpleDoc a) x
Generic, a -> SimpleDoc b -> SimpleDoc a
(a -> b) -> SimpleDoc a -> SimpleDoc b
(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
<$ :: a -> SimpleDoc b -> SimpleDoc a
$c<$ :: forall a b. a -> SimpleDoc b -> SimpleDoc a
fmap :: (a -> b) -> SimpleDoc a -> SimpleDoc b
$cfmap :: forall a b. (a -> b) -> SimpleDoc a -> SimpleDoc b
Functor, SimpleDoc a -> Bool
(a -> m) -> SimpleDoc a -> m
(a -> b -> b) -> b -> SimpleDoc a -> b
(forall m. Monoid m => SimpleDoc m -> m)
-> (forall m a. Monoid m => (a -> m) -> SimpleDoc a -> m)
-> (forall m a. Monoid m => (a -> m) -> SimpleDoc a -> m)
-> (forall a b. (a -> b -> b) -> b -> SimpleDoc a -> b)
-> (forall a b. (a -> b -> b) -> b -> SimpleDoc a -> b)
-> (forall b a. (b -> a -> b) -> b -> SimpleDoc a -> b)
-> (forall b a. (b -> a -> b) -> b -> SimpleDoc a -> b)
-> (forall a. (a -> a -> a) -> SimpleDoc a -> a)
-> (forall a. (a -> a -> a) -> SimpleDoc a -> a)
-> (forall a. SimpleDoc a -> [a])
-> (forall a. SimpleDoc a -> Bool)
-> (forall a. SimpleDoc a -> Int)
-> (forall a. Eq a => a -> SimpleDoc a -> Bool)
-> (forall a. Ord a => SimpleDoc a -> a)
-> (forall a. Ord a => SimpleDoc a -> a)
-> (forall a. Num a => SimpleDoc a -> a)
-> (forall a. Num a => SimpleDoc a -> a)
-> Foldable SimpleDoc
forall a. Eq a => a -> SimpleDoc a -> Bool
forall a. Num a => SimpleDoc a -> a
forall a. Ord a => SimpleDoc a -> a
forall m. Monoid m => SimpleDoc m -> m
forall a. SimpleDoc a -> Bool
forall a. SimpleDoc a -> Int
forall a. SimpleDoc a -> [a]
forall a. (a -> a -> a) -> SimpleDoc a -> a
forall m a. Monoid m => (a -> m) -> SimpleDoc a -> m
forall b a. (b -> a -> b) -> b -> SimpleDoc a -> b
forall a b. (a -> b -> b) -> b -> SimpleDoc a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: SimpleDoc a -> a
$cproduct :: forall a. Num a => SimpleDoc a -> a
sum :: SimpleDoc a -> a
$csum :: forall a. Num a => SimpleDoc a -> a
minimum :: SimpleDoc a -> a
$cminimum :: forall a. Ord a => SimpleDoc a -> a
maximum :: SimpleDoc a -> a
$cmaximum :: forall a. Ord a => SimpleDoc a -> a
elem :: a -> SimpleDoc a -> Bool
$celem :: forall a. Eq a => a -> SimpleDoc a -> Bool
length :: SimpleDoc a -> Int
$clength :: forall a. SimpleDoc a -> Int
null :: SimpleDoc a -> Bool
$cnull :: forall a. SimpleDoc a -> Bool
toList :: SimpleDoc a -> [a]
$ctoList :: forall a. SimpleDoc a -> [a]
foldl1 :: (a -> a -> a) -> SimpleDoc a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SimpleDoc a -> a
foldr1 :: (a -> a -> a) -> SimpleDoc a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> SimpleDoc a -> a
foldl' :: (b -> a -> b) -> b -> SimpleDoc a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SimpleDoc a -> b
foldl :: (b -> a -> b) -> b -> SimpleDoc a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SimpleDoc a -> b
foldr' :: (a -> b -> b) -> b -> SimpleDoc a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SimpleDoc a -> b
foldr :: (a -> b -> b) -> b -> SimpleDoc a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> SimpleDoc a -> b
foldMap' :: (a -> m) -> SimpleDoc a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SimpleDoc a -> m
foldMap :: (a -> m) -> SimpleDoc a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SimpleDoc a -> m
fold :: SimpleDoc m -> m
$cfold :: forall m. Monoid m => SimpleDoc m -> m
Foldable, Functor SimpleDoc
Foldable SimpleDoc
(Functor SimpleDoc, Foldable SimpleDoc) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SimpleDoc a -> f (SimpleDoc b))
-> (forall (f :: * -> *) a.
Applicative f =>
SimpleDoc (f a) -> f (SimpleDoc a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SimpleDoc a -> m (SimpleDoc b))
-> (forall (m :: * -> *) a.
Monad m =>
SimpleDoc (m a) -> m (SimpleDoc a))
-> Traversable SimpleDoc
(a -> f b) -> SimpleDoc a -> f (SimpleDoc b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SimpleDoc (m a) -> m (SimpleDoc a)
forall (f :: * -> *) a.
Applicative f =>
SimpleDoc (f a) -> f (SimpleDoc a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SimpleDoc a -> m (SimpleDoc b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SimpleDoc a -> f (SimpleDoc b)
sequence :: SimpleDoc (m a) -> m (SimpleDoc a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SimpleDoc (m a) -> m (SimpleDoc a)
mapM :: (a -> m b) -> SimpleDoc a -> m (SimpleDoc b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SimpleDoc a -> m (SimpleDoc b)
sequenceA :: SimpleDoc (f a) -> f (SimpleDoc a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SimpleDoc (f a) -> f (SimpleDoc a)
traverse :: (a -> f b) -> SimpleDoc a -> f (SimpleDoc b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SimpleDoc a -> f (SimpleDoc b)
$cp2Traversable :: Foldable SimpleDoc
$cp1Traversable :: Functor SimpleDoc
Traversable)
instance NFData a => NFData (SimpleDoc a)
char :: Char -> Doc a
char :: Char -> Doc a
char '\n' = Doc a
forall a. Doc a
line
char c :: Char
c = Char -> Doc a
forall a. Char -> Doc a
Char Char
c
text :: String -> Doc a
text :: String -> Doc a
text "" = Doc a
forall a. Doc a
Empty
text s :: 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 :: Doc a
line = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
FlatAlt Doc a
forall a. Doc a
Line Doc a
forall a. Doc a
space
linebreak :: Doc a
linebreak :: Doc a
linebreak = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
FlatAlt Doc a
forall a. Doc a
Line Doc a
forall a. Monoid a => a
mempty
hardline :: Doc a
hardline :: Doc a
hardline = Doc a
forall a. Doc a
Line
nest :: Int -> Doc a -> Doc a
nest :: Int -> Doc a -> Doc a
nest = Int -> Doc a -> Doc a
forall a. Int -> Doc a -> Doc a
Nest
column, nesting :: (Int -> Doc a) -> Doc a
column :: (Int -> Doc a) -> Doc a
column = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
Column
nesting :: (Int -> Doc a) -> Doc a
nesting = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
Nesting
columns :: (Maybe Int -> Doc a) -> Doc a
columns :: (Maybe Int -> Doc a) -> Doc a
columns = (Maybe Int -> Doc a) -> Doc a
forall a. (Maybe Int -> Doc a) -> Doc a
Columns
ribbon :: (Maybe Int -> Doc a) -> Doc a
ribbon :: (Maybe Int -> Doc a) -> Doc a
ribbon = (Maybe Int -> Doc a) -> Doc a
forall a. (Maybe Int -> Doc a) -> Doc a
Ribbon
group :: Doc a -> Doc a
group :: Doc a -> Doc a
group x :: 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
flatAlt :: Doc a -> Doc a -> Doc a
flatAlt :: Doc a -> Doc a -> Doc a
flatAlt = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
FlatAlt
flatten :: Doc a -> Doc a
flatten :: Doc a -> Doc a
flatten (FlatAlt _ y :: Doc a
y) = Doc a
y
flatten (Cat x :: Doc a
x y :: 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 i :: Int
i x :: 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 (Union x :: Doc a
x _) = Doc a -> Doc a
forall a. Doc a -> Doc a
flatten Doc a
x
flatten (Annotate a :: a
a x :: Doc a
x) = a -> Doc a -> Doc a
forall a. a -> Doc a -> Doc a
Annotate a
a (Doc a -> Doc a
forall a. Doc a -> Doc a
flatten Doc a
x)
flatten (Column f :: 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 f :: 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 (Columns f :: Maybe Int -> Doc a
f) = (Maybe Int -> Doc a) -> Doc a
forall a. (Maybe Int -> Doc a) -> Doc a
Columns (Doc a -> Doc a
forall a. Doc a -> Doc a
flatten (Doc a -> Doc a) -> (Maybe Int -> Doc a) -> Maybe Int -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc a
f)
flatten (Ribbon f :: Maybe Int -> Doc a
f) = (Maybe Int -> Doc a) -> Doc a
forall a. (Maybe Int -> Doc a) -> Doc a
Ribbon (Doc a -> Doc a
forall a. Doc a -> Doc a
flatten (Doc a -> Doc a) -> (Maybe Int -> Doc a) -> Maybe Int -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc a
f)
flatten a :: Doc a
a@Empty{} = Doc a
a
flatten a :: Doc a
a@Char{} = Doc a
a
flatten a :: Doc a
a@Text{} = Doc a
a
flatten a :: Doc a
a@Line{} = Doc a
a
data Docs a e
= Nil
| Cons {-# UNPACK #-} !Int (Doc a) (Docs a e)
renderPretty :: Float -> Int -> Doc a -> SimpleDoc a
renderPretty :: Float -> Int -> Doc a -> SimpleDoc a
renderPretty = (Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a)
-> Float -> Int -> Doc a -> SimpleDoc a
forall a.
(Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a)
-> Float -> Int -> Doc a -> SimpleDoc a
renderFits Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
forall a.
Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicest1
renderPrettyDefault :: Doc a -> SimpleDoc a
renderPrettyDefault :: Doc a -> SimpleDoc a
renderPrettyDefault = Float -> Int -> Doc a -> SimpleDoc a
forall a. Float -> Int -> Doc a -> SimpleDoc a
renderPretty 0.4 100
renderSmart :: Int -> Doc a -> SimpleDoc a
renderSmart :: Int -> Doc a -> SimpleDoc a
renderSmart = (Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a)
-> Float -> Int -> Doc a -> SimpleDoc a
forall a.
(Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a)
-> Float -> Int -> Doc a -> SimpleDoc a
renderFits Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
forall a.
Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicestR 1.0
renderFits :: (Int -> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a
-> SimpleDoc a)
-> Float -> Int -> Doc a -> SimpleDoc a
renderFits :: (Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a)
-> Float -> Int -> Doc a -> SimpleDoc a
renderFits nicest :: Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicest rfrac :: Float
rfrac w :: Int
w x :: Doc a
x
= Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a Any -> SimpleDoc a
forall e.
Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best 0 0 (\_ _ -> SimpleDoc a
forall a. SimpleDoc a
SEmpty) (Int -> Doc a -> Docs a Any -> Docs a Any
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons 0 Doc a
x Docs a Any
forall a e. Docs a e
Nil)
where
r :: Int
r = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 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 -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best n :: Int
n k :: Int
k z :: Int -> Int -> SimpleDoc a
z Nil = Int -> Int -> SimpleDoc a
z Int
n Int
k
best n :: Int
n k :: Int
k z :: Int -> Int -> SimpleDoc a
z (Cons i :: Int
i d :: Doc a
d ds :: Docs a e
ds) =
case Doc a
d of
Empty -> Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z Docs a e
ds
Char c :: Char
c -> let k' :: Int
k' = Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+1 in Int -> SimpleDoc a -> SimpleDoc a
forall a b. a -> b -> b
seq Int
k' (Char -> SimpleDoc a -> SimpleDoc a
forall a. Char -> SimpleDoc a -> SimpleDoc a
SChar Char
c (Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k' Int -> Int -> SimpleDoc a
z Docs a e
ds))
Text l :: Int
l s :: 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
forall a b. a -> b -> b
seq Int
k' (Int -> String -> SimpleDoc a -> SimpleDoc a
forall a. Int -> String -> SimpleDoc a -> SimpleDoc a
SText Int
l String
s (Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k' Int -> Int -> SimpleDoc a
z Docs a e
ds))
Line -> Int -> SimpleDoc a -> SimpleDoc a
forall a. Int -> SimpleDoc a -> SimpleDoc a
SLine Int
i (Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
i Int
i Int -> Int -> SimpleDoc a
z Docs a e
ds)
FlatAlt l :: Doc a
l _ -> Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i Doc a
l Docs a e
ds)
Cat x' :: Doc a
x' y :: Doc a
y -> Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i Doc a
x' (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i Doc a
y Docs a e
ds))
Nest j :: Int
j x' :: 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
forall a b. a -> b -> b
seq Int
i' (Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i' Doc a
x' Docs a e
ds))
Annotate a :: a
a d' :: Doc a
d' -> let z' :: Int -> Int -> SimpleDoc a
z' n' :: Int
n' k' :: Int
k' = a -> SimpleDoc a -> SimpleDoc a
forall a. a -> SimpleDoc a -> SimpleDoc a
SPopAnn a
a (SimpleDoc a -> SimpleDoc a) -> SimpleDoc a -> SimpleDoc a
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n' Int
k' Int -> Int -> SimpleDoc a
z Docs a e
ds
in a -> SimpleDoc a -> SimpleDoc a
forall a. a -> SimpleDoc a -> SimpleDoc a
SPushAnn a
a (Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z' (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i Doc a
d' Docs a e
forall a e. Docs a e
Nil))
Union p :: Doc a
p q :: Doc a
q -> Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicest Int
n Int
k Int
w Int
r (Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i Doc a
p Docs a e
ds))
(Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i Doc a
q Docs a e
ds))
Column f :: Int -> Doc a
f -> Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i (Int -> Doc a
f Int
k) Docs a e
ds)
Nesting f :: Int -> Doc a
f -> Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i (Int -> Doc a
f Int
i) Docs a e
ds)
Columns f :: Maybe Int -> Doc a
f -> Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i (Maybe Int -> Doc a
f (Maybe Int -> Doc a) -> Maybe Int -> Doc a
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) Docs a e
ds)
Ribbon f :: Maybe Int -> Doc a
f -> Int
-> Int -> (Int -> Int -> SimpleDoc a) -> Docs a e -> SimpleDoc a
best Int
n Int
k Int -> Int -> SimpleDoc a
z (Int -> Doc a -> Docs a e -> Docs a e
forall a e. Int -> Doc a -> Docs a e -> Docs a e
Cons Int
i (Maybe Int -> Doc a
f (Maybe Int -> Doc a) -> Maybe Int -> Doc a
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
r) Docs a e
ds)
nicest1 :: Int -> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicest1 :: Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicest1 n :: Int
n k :: Int
k p :: Int
p r :: Int
r x' :: SimpleDoc a
x' y :: SimpleDoc a
y | Int -> Int -> SimpleDoc a -> Bool
forall t a. t -> Int -> SimpleDoc a -> Bool
fits (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
k) Int
wid SimpleDoc a
x' = SimpleDoc a
x'
| Bool
otherwise = SimpleDoc a
y
where wid :: Int
wid = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
p 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 :: t -> Int -> SimpleDoc a -> Bool
fits _ w :: Int
w _ | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Bool
False
fits _ _ SEmpty = Bool
True
fits m :: t
m w :: Int
w (SChar _ x :: SimpleDoc a
x) = t -> Int -> SimpleDoc a -> Bool
fits t
m (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) SimpleDoc a
x
fits m :: t
m w :: Int
w (SText l :: Int
l _ x :: SimpleDoc a
x) = t -> Int -> SimpleDoc a -> Bool
fits t
m (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) SimpleDoc a
x
fits _ _ (SLine _ _) = Bool
True
fits m :: t
m w :: Int
w (SPushAnn _ x :: SimpleDoc a
x) = t -> Int -> SimpleDoc a -> Bool
fits t
m Int
w SimpleDoc a
x
fits m :: t
m w :: Int
w (SPopAnn _ x :: SimpleDoc a
x) = t -> Int -> SimpleDoc a -> Bool
fits t
m Int
w SimpleDoc a
x
nicestR :: Int -> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicestR :: Int
-> Int -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicestR n :: Int
n k :: Int
k p :: Int
p r :: Int
r x' :: SimpleDoc a
x' y :: SimpleDoc a
y =
if Int -> Int -> SimpleDoc a -> Double
forall a. Int -> Int -> SimpleDoc a -> Double
fits (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
k) Int
wid SimpleDoc a
x' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int -> SimpleDoc a -> Double
forall a. Int -> Int -> SimpleDoc a -> Double
fits (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
k) Int
wid SimpleDoc a
y then SimpleDoc a
x' else SimpleDoc a
y
where wid :: Int
wid = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
p 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)
inf :: Double
inf = 1.0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0 :: Double
fits :: Int -> Int -> SimpleDoc a -> Double
fits _ w :: Int
w _ | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Double
inf
fits _ _ SEmpty = 0
fits m :: Int
m w :: Int
w (SChar _ x :: SimpleDoc a
x) = Int -> Int -> SimpleDoc a -> Double
fits Int
m (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) SimpleDoc a
x
fits m :: Int
m w :: Int
w (SText l :: Int
l _ x :: SimpleDoc a
x) = Int -> Int -> SimpleDoc a -> Double
fits Int
m (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) SimpleDoc a
x
fits m :: Int
m _ (SLine i :: Int
i x :: SimpleDoc a
x) | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = 1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Int -> SimpleDoc a -> Double
fits Int
m (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) SimpleDoc a
x
| Bool
otherwise = 0
fits m :: Int
m w :: Int
w (SPushAnn _ x :: SimpleDoc a
x) = Int -> Int -> SimpleDoc a -> Double
fits Int
m Int
w SimpleDoc a
x
fits m :: Int
m w :: Int
w (SPopAnn _ x :: SimpleDoc a
x) = Int -> Int -> SimpleDoc a -> Double
fits Int
m Int
w SimpleDoc a
x
renderCompact :: Doc a -> SimpleDoc a
renderCompact :: Doc a -> SimpleDoc a
renderCompact x :: Doc a
x
= SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
forall a. SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
forall a. SimpleDoc a
SEmpty 0 [Doc a
x]
where
scan :: SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan z :: SimpleDoc a
z _ [] = SimpleDoc a
z
scan z :: SimpleDoc a
z k :: Int
k (d :: Doc a
d:ds :: [Doc a]
ds) =
case Doc a
d of
Empty -> SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k [Doc a]
ds
Char c :: Char
c -> let k' :: Int
k' = Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+1 in Int -> SimpleDoc a -> SimpleDoc a
forall a b. a -> b -> b
seq Int
k' (Char -> SimpleDoc a -> SimpleDoc a
forall a. Char -> SimpleDoc a -> SimpleDoc a
SChar Char
c (SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k' [Doc a]
ds))
Text l :: Int
l s :: 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
forall a b. a -> b -> b
seq Int
k' (Int -> String -> SimpleDoc a -> SimpleDoc a
forall a. Int -> String -> SimpleDoc a -> SimpleDoc a
SText Int
l String
s (SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k' [Doc a]
ds))
Annotate a :: a
a d' :: Doc a
d' -> a -> SimpleDoc a -> SimpleDoc a
forall a. a -> SimpleDoc a -> SimpleDoc a
SPushAnn a
a (SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan (a -> SimpleDoc a -> SimpleDoc a
forall a. a -> SimpleDoc a -> SimpleDoc a
SPopAnn a
a (SimpleDoc a -> SimpleDoc a) -> SimpleDoc a -> SimpleDoc a
forall a b. (a -> b) -> a -> b
$ SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k [Doc a]
ds) Int
k [Doc a
d'])
Line -> Int -> SimpleDoc a -> SimpleDoc a
forall a. Int -> SimpleDoc a -> SimpleDoc a
SLine 0 (SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z 0 [Doc a]
ds)
FlatAlt y :: Doc a
y _ -> SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k (Doc a
yDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Cat y :: Doc a
y z' :: Doc a
z' -> SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k (Doc a
yDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:Doc a
z'Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Nest _ y :: Doc a
y -> SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k (Doc a
yDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Union _ y :: Doc a
y -> SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k (Doc a
yDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Column f :: Int -> Doc a
f -> SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k (Int -> Doc a
f Int
kDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Nesting f :: Int -> Doc a
f -> SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k (Int -> Doc a
f 0Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Columns f :: Maybe Int -> Doc a
f -> SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k (Maybe Int -> Doc a
f Maybe Int
forall a. Maybe a
NothingDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
Ribbon f :: Maybe Int -> Doc a
f -> SimpleDoc a -> Int -> [Doc a] -> SimpleDoc a
scan SimpleDoc a
z Int
k (Maybe Int -> Doc a
f Maybe Int
forall a. Maybe a
NothingDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
simpleDocMapAnn :: (r -> a -> r)
-> (r -> a -> r)
-> (r -> SimpleDoc a' -> SimpleDoc a')
-> (r -> SimpleDoc a' -> SimpleDoc a')
-> r
-> SimpleDoc a -> SimpleDoc a'
simpleDocMapAnn :: (r -> a -> r)
-> (r -> a -> r)
-> (r -> SimpleDoc a' -> SimpleDoc a')
-> (r -> SimpleDoc a' -> SimpleDoc a')
-> r
-> SimpleDoc a
-> SimpleDoc a'
simpleDocMapAnn upPush :: r -> a -> r
upPush upPop :: r -> a -> r
upPop push :: r -> SimpleDoc a' -> SimpleDoc a'
push pop :: r -> SimpleDoc a' -> SimpleDoc a'
pop = r -> SimpleDoc a -> SimpleDoc a'
go
where
go :: r -> SimpleDoc a -> SimpleDoc a'
go _ SEmpty = SimpleDoc a'
forall a. SimpleDoc a
SEmpty
go r :: r
r (SChar c :: Char
c x :: SimpleDoc a
x) = Char -> SimpleDoc a' -> SimpleDoc a'
forall a. Char -> SimpleDoc a -> SimpleDoc a
SChar Char
c (r -> SimpleDoc a -> SimpleDoc a'
go r
r SimpleDoc a
x)
go r :: r
r (SText l :: Int
l s :: String
s x :: SimpleDoc a
x) = Int -> String -> SimpleDoc a' -> SimpleDoc a'
forall a. Int -> String -> SimpleDoc a -> SimpleDoc a
SText Int
l String
s (r -> SimpleDoc a -> SimpleDoc a'
go r
r SimpleDoc a
x)
go r :: r
r (SLine i :: Int
i x :: SimpleDoc a
x) = Int -> SimpleDoc a' -> SimpleDoc a'
forall a. Int -> SimpleDoc a -> SimpleDoc a
SLine Int
i (r -> SimpleDoc a -> SimpleDoc a'
go r
r SimpleDoc a
x)
go r :: r
r (SPushAnn a :: a
a x :: SimpleDoc a
x) = let r' :: r
r' = r -> a -> r
upPush r
r a
a in r -> SimpleDoc a' -> SimpleDoc a'
push r
r' (SimpleDoc a' -> SimpleDoc a') -> SimpleDoc a' -> SimpleDoc a'
forall a b. (a -> b) -> a -> b
$ r -> SimpleDoc a -> SimpleDoc a'
go r
r' SimpleDoc a
x
go r :: r
r (SPopAnn a :: a
a x :: SimpleDoc a
x) = let r' :: r
r' = r -> a -> r
upPop r
r a
a in r -> SimpleDoc a' -> SimpleDoc a'
pop r
r' (SimpleDoc a' -> SimpleDoc a') -> SimpleDoc a' -> SimpleDoc a'
forall a b. (a -> b) -> a -> b
$ r -> SimpleDoc a -> SimpleDoc a'
go r
r' SimpleDoc a
x
simpleDocScanAnn :: (r -> a -> r)
-> r
-> SimpleDoc a
-> SimpleDoc r
simpleDocScanAnn :: (r -> a -> r) -> r -> SimpleDoc a -> SimpleDoc r
simpleDocScanAnn f :: r -> a -> r
f r0 :: r
r0 = ([r] -> a -> [r])
-> ([r] -> a -> [r])
-> ([r] -> SimpleDoc r -> SimpleDoc r)
-> ([r] -> SimpleDoc r -> SimpleDoc r)
-> [r]
-> SimpleDoc a
-> SimpleDoc r
forall r a a'.
(r -> a -> r)
-> (r -> a -> r)
-> (r -> SimpleDoc a' -> SimpleDoc a')
-> (r -> SimpleDoc a' -> SimpleDoc a')
-> r
-> SimpleDoc a
-> SimpleDoc a'
simpleDocMapAnn [r] -> a -> [r]
merge [r] -> a -> [r]
forall a p. [a] -> p -> [a]
pop (r -> SimpleDoc r -> SimpleDoc r
forall a. a -> SimpleDoc a -> SimpleDoc a
SPushAnn (r -> SimpleDoc r -> SimpleDoc r)
-> ([r] -> r) -> [r] -> SimpleDoc r -> SimpleDoc r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> r
forall a. [a] -> a
head) (r -> SimpleDoc r -> SimpleDoc r
forall a. a -> SimpleDoc a -> SimpleDoc a
SPopAnn (r -> SimpleDoc r -> SimpleDoc r)
-> ([r] -> r) -> [r] -> SimpleDoc r -> SimpleDoc r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> r
forall a. [a] -> a
head) [r
r0]
where merge :: [r] -> a -> [r]
merge rs :: [r]
rs@(r :: r
r:_) x :: a
x = r -> a -> r
f r
r a
x r -> [r] -> [r]
forall a. a -> [a] -> [a]
: [r]
rs
merge [] _ = String -> [r]
forall a. HasCallStack => String -> a
error "Stack underflow"
pop :: [a] -> p -> [a]
pop (_:rs :: [a]
rs) _ = [a]
rs
pop [] _ = String -> [a]
forall a. HasCallStack => String -> a
error "Stack underflow"
displayDecoratedA :: (Applicative f, Monoid o)
=> (a -> f o)
-> (a -> f o)
-> (String -> f o)
-> SimpleDoc a
-> f o
displayDecoratedA :: (a -> f o) -> (a -> f o) -> (String -> f o) -> SimpleDoc a -> f o
displayDecoratedA push :: a -> f o
push pop :: a -> f o
pop str :: String -> f o
str = SimpleDoc a -> f o
go
where
go :: SimpleDoc a -> f o
go SEmpty = o -> f o
forall (f :: * -> *) a. Applicative f => a -> f a
pure o
forall a. Monoid a => a
mempty
go (SChar c :: Char
c x :: SimpleDoc a
x) = String -> f o
str (Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c) f o -> f o -> f o
<++> SimpleDoc a -> f o
go SimpleDoc a
x
go (SText _ s :: String
s x :: SimpleDoc a
x) = String -> f o
str String
s f o -> f o -> f o
<++> SimpleDoc a -> f o
go SimpleDoc a
x
go (SLine i :: Int
i x :: SimpleDoc a
x) = String -> f o
str ('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
spaces Int
i) f o -> f o -> f o
<++> SimpleDoc a -> f o
go SimpleDoc a
x
go (SPushAnn a :: a
a x :: SimpleDoc a
x) = a -> f o
push a
a f o -> f o -> f o
<++> SimpleDoc a -> f o
go SimpleDoc a
x
go (SPopAnn a :: a
a x :: SimpleDoc a
x) = a -> f o
pop a
a f o -> f o -> f o
<++> SimpleDoc a -> f o
go SimpleDoc a
x
<++> :: f o -> f o -> f o
(<++>) = (o -> o -> o) -> f o -> f o -> f o
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 o -> o -> o
forall a. Monoid a => a -> a -> a
mappend
{-# SPECIALIZE displayDecoratedA :: Monoid o => (a -> Identity o) -> (a -> Identity o) -> (String -> Identity o) -> SimpleDoc a -> Identity o #-}
{-# SPECIALIZE displayDecoratedA :: Monoid o => (a -> (o -> o)) -> (a -> (o -> o)) -> (String -> (o -> o)) -> SimpleDoc a -> (o -> o) #-}
displayDecorated :: Monoid o
=> (a -> o)
-> (a -> o)
-> (String -> o)
-> SimpleDoc a
-> o
displayDecorated :: (a -> o) -> (a -> o) -> (String -> o) -> SimpleDoc a -> o
displayDecorated push :: a -> o
push pop :: a -> o
pop str :: String -> o
str = Identity o -> o
forall a. Identity a -> a
runIdentity (Identity o -> o)
-> (SimpleDoc a -> Identity o) -> SimpleDoc a -> o
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(a -> Identity o)
-> (a -> Identity o)
-> (String -> Identity o)
-> SimpleDoc a
-> Identity o
forall (f :: * -> *) o a.
(Applicative f, Monoid o) =>
(a -> f o) -> (a -> f o) -> (String -> f o) -> SimpleDoc a -> f o
displayDecoratedA (o -> Identity o
forall (f :: * -> *) a. Applicative f => a -> f a
pure (o -> Identity o) -> (a -> o) -> a -> Identity o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> o
push) (o -> Identity o
forall (f :: * -> *) a. Applicative f => a -> f a
pure (o -> Identity o) -> (a -> o) -> a -> Identity o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> o
pop) (o -> Identity o
forall (f :: * -> *) a. Applicative f => a -> f a
pure (o -> Identity o) -> (String -> o) -> String -> Identity o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> o
str)
displayIO :: Handle -> SimpleDoc a -> IO ()
displayIO :: Handle -> SimpleDoc a -> IO ()
displayIO handle :: Handle
handle = (a -> IO ())
-> (a -> IO ()) -> (String -> IO ()) -> SimpleDoc a -> IO ()
forall (f :: * -> *) o a.
(Applicative f, Monoid o) =>
(a -> f o) -> (a -> f o) -> (String -> f o) -> SimpleDoc a -> f o
displayDecoratedA a -> IO ()
forall b. b -> IO ()
cpu a -> IO ()
forall b. b -> IO ()
cpu (Handle -> String -> IO ()
hPutStr Handle
handle)
where cpu :: b -> IO ()
cpu = IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
displayS :: SimpleDoc a -> ShowS
displayS :: SimpleDoc a -> String -> String
displayS = (a -> String -> String)
-> (a -> String -> String)
-> (String -> String -> String)
-> SimpleDoc a
-> String
-> String
forall (f :: * -> *) o a.
(Applicative f, Monoid o) =>
(a -> f o) -> (a -> f o) -> (String -> f o) -> SimpleDoc a -> f o
displayDecoratedA a -> String -> String
forall a b. a -> b -> b
ci a -> String -> String
forall a b. a -> b -> b
ci String -> String -> String
forall a. [a] -> [a] -> [a]
(++)
where ci :: b -> a -> a
ci = (a -> a) -> b -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id
display :: SimpleDoc a -> String
display :: 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 ""
displayT :: SimpleDoc a -> TL.Text
displayT :: SimpleDoc a -> Text
displayT = Builder -> Text
TL.toLazyText (Builder -> Text)
-> (SimpleDoc a -> Builder) -> SimpleDoc a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder)
-> (a -> Builder) -> (String -> Builder) -> SimpleDoc a -> Builder
forall o a.
Monoid o =>
(a -> o) -> (a -> o) -> (String -> o) -> SimpleDoc a -> o
displayDecorated a -> Builder
forall b. b -> Builder
cm a -> Builder
forall b. b -> Builder
cm String -> Builder
TL.fromString
where cm :: b -> Builder
cm = Builder -> b -> Builder
forall a b. a -> b -> a
const Builder
forall a. Monoid a => a
mempty
type SpanList a = [(Int, Int, a)]
displaySpans :: Monoid o => (String -> o) -> SimpleDoc a -> (o, SpanList a)
displaySpans :: (String -> o) -> SimpleDoc a -> (o, SpanList a)
displaySpans str :: String -> o
str = Int -> [Int] -> SimpleDoc a -> (o, SpanList a)
forall c. Int -> [Int] -> SimpleDoc c -> (o, [(Int, Int, c)])
go 0 []
where
go :: Int -> [Int] -> SimpleDoc c -> (o, [(Int, Int, c)])
go _ [] SEmpty = (o
forall a. Monoid a => a
mempty, [])
go i :: Int
i stk :: [Int]
stk (SChar c :: Char
c x :: SimpleDoc c
x) = (o -> o) -> (o, [(Int, Int, c)]) -> (o, [(Int, Int, c)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (o -> o -> o
forall a. Monoid a => a -> a -> a
mappend (o -> o -> o) -> o -> o -> o
forall a b. (a -> b) -> a -> b
$ String -> o
str (String -> o) -> String -> o
forall a b. (a -> b) -> a -> b
$ Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c) ((o, [(Int, Int, c)]) -> (o, [(Int, Int, c)]))
-> (o, [(Int, Int, c)]) -> (o, [(Int, Int, c)])
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> SimpleDoc c -> (o, [(Int, Int, c)])
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [Int]
stk SimpleDoc c
x
go i :: Int
i stk :: [Int]
stk (SText l :: Int
l s :: String
s x :: SimpleDoc c
x) = (o -> o) -> (o, [(Int, Int, c)]) -> (o, [(Int, Int, c)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (o -> o -> o
forall a. Monoid a => a -> a -> a
mappend (o -> o -> o) -> o -> o -> o
forall a b. (a -> b) -> a -> b
$ String -> o
str String
s) ((o, [(Int, Int, c)]) -> (o, [(Int, Int, c)]))
-> (o, [(Int, Int, c)]) -> (o, [(Int, Int, c)])
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> SimpleDoc c -> (o, [(Int, Int, c)])
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) [Int]
stk SimpleDoc c
x
go i :: Int
i stk :: [Int]
stk (SLine ind :: Int
ind x :: SimpleDoc c
x) = (o -> o) -> (o, [(Int, Int, c)]) -> (o, [(Int, Int, c)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (o -> o -> o
forall a. Monoid a => a -> a -> a
mappend (o -> o -> o) -> o -> o -> o
forall a b. (a -> b) -> a -> b
$ String -> o
str (String -> o) -> String -> o
forall a b. (a -> b) -> a -> b
$ '\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
spaces Int
ind) ((o, [(Int, Int, c)]) -> (o, [(Int, Int, c)]))
-> (o, [(Int, Int, c)]) -> (o, [(Int, Int, c)])
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> SimpleDoc c -> (o, [(Int, Int, c)])
go (1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ind) [Int]
stk SimpleDoc c
x
go i :: Int
i stk :: [Int]
stk (SPushAnn _ x :: SimpleDoc c
x) = Int -> [Int] -> SimpleDoc c -> (o, [(Int, Int, c)])
go Int
i (Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
stk) SimpleDoc c
x
go i :: Int
i (start :: Int
start:stk :: [Int]
stk) (SPopAnn ann :: c
ann x :: SimpleDoc c
x) = ([(Int, Int, c)] -> [(Int, Int, c)])
-> (o, [(Int, Int, c)]) -> (o, [(Int, Int, c)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Int
start, Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
start, c
ann)(Int, Int, c) -> [(Int, Int, c)] -> [(Int, Int, c)]
forall a. a -> [a] -> [a]
:) ((o, [(Int, Int, c)]) -> (o, [(Int, Int, c)]))
-> (o, [(Int, Int, c)]) -> (o, [(Int, Int, c)])
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> SimpleDoc c -> (o, [(Int, Int, c)])
go Int
i [Int]
stk SimpleDoc c
x
go _ _ SEmpty = String -> (o, [(Int, Int, c)])
forall a. HasCallStack => String -> a
error "Stack not empty"
go _ [] (SPopAnn _ _) = String -> (o, [(Int, Int, c)])
forall a. HasCallStack => String -> a
error "Stack underflow"
instance Show (Doc a) where
showsPrec :: Int -> Doc a -> String -> String
showsPrec _ = SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS (SimpleDoc a -> String -> String)
-> (Doc a -> SimpleDoc a) -> Doc a -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> SimpleDoc a
forall a. Doc a -> SimpleDoc a
renderPrettyDefault
putDoc :: Doc a -> IO ()
putDoc :: Doc a -> IO ()
putDoc = Handle -> Doc a -> IO ()
forall a. Handle -> Doc a -> IO ()
hPutDoc Handle
stdout
hPutDoc :: Handle -> Doc a -> IO ()
hPutDoc :: Handle -> Doc a -> IO ()
hPutDoc handle :: Handle
handle = Handle -> SimpleDoc a -> IO ()
forall a. Handle -> SimpleDoc a -> IO ()
displayIO Handle
handle (SimpleDoc a -> IO ()) -> (Doc a -> SimpleDoc a) -> Doc a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> SimpleDoc a
forall a. Doc a -> SimpleDoc a
renderPrettyDefault
spaces :: Int -> String
spaces :: Int -> String
spaces n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = ""
| Bool
otherwise = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n ' '