module Text.PrettyPrint.Annotated.Leijen (
  -- * Documents, parametrized by their annotations
  Doc, putDoc, hPutDoc,

  -- * Basic combinators
  empty, char, text, (<>), nest, line, linebreak, group, softline,
  softbreak,
  -- * Alignment
  --
  -- The combinators in this section can not be described by Wadler's
  -- original combinators. They align their output relative to the
  -- current output position - in contrast to @nest@ which always
  -- aligns to the current nesting level. This deprives these
  -- combinators from being \`optimal\'. In practice however they
  -- prove to be very useful. The combinators in this section should
  -- be used with care, since they are more expensive than the other
  -- combinators. For example, @align@ shouldn't be used to pretty
  -- print all top-level declarations of a language, but using @hang@
  -- for let expressions is fine.
  align, hang, indent, encloseSep, list, tupled, semiBraces,
  -- * Operators
  (<+>), (<$>), (</>), (<$$>), (<//>),
  -- * List combinators
  hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat, punctuate,

  -- * Fillers
  fill, fillBreak,

  -- * Bracketing combinators
  enclose, squotes, dquotes, parens, angles, braces, brackets,

  -- * Character documents
  lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket,
  squote, dquote, semi, colon, comma, space, dot, backslash, equals,
  pipe,

  -- * Primitive type documents
  string, int, integer, float, double, rational, bool,

  -- * Pretty class
  --Pretty(..),

  -- * Semantic annotations
  annotate, noAnnotate,

  -- * Rendering
  SimpleDoc(..), renderPretty, renderCompact, displayDecorated, displayDecoratedA, display, displayS, displayIO,
  SpanList(..), displaySpans

  -- * Undocumented


  , column, nesting, width
) where

import System.IO (Handle,hPutStr,hPutChar,stdout)
import Data.String

-- Import Prelude names by hand, because "import Prelude hiding ((<$>)) fails on GHC 7.4
import Prelude ((.), ($), (/=), (<), (<=), (>), (>=), (-), (*), (+), (++),
                Bool(..), Char, Double, Float, Functor, Int, Integer, IO, Rational, Show, ShowS,
                id, error, flip, foldr1, fromIntegral, length, max, min, otherwise, repeat, replicate,
                return, round, seq, show, showChar, showString, showsPrec, span, zipWith)

import Control.Applicative (Applicative(..), liftA2)
import Data.Monoid (Monoid(..))

infixr 5 </>,<//>,<$>,<$$>
infixr 6 <>,<+>


instance IsString (Doc a) where
    fromString :: String -> Doc a
fromString = String -> Doc a
forall a. String -> Doc a
text

-----------------------------------------------------------
-- list, tupled and semiBraces pretty print a list of
-- documents either horizontally or vertically aligned.
-----------------------------------------------------------


-- | The document @(list xs)@ comma separates the documents @xs@ and
-- encloses them in square brackets. The documents are rendered
-- horizontally if that fits the page. Otherwise they are aligned
-- vertically. All comma separators are put in front of the elements.
list :: [Doc a] -> Doc a
list :: [Doc a] -> Doc a
list            = Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
forall a. Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
encloseSep Doc a
forall a. Doc a
lbracket Doc a
forall a. Doc a
rbracket Doc a
forall a. Doc a
comma

-- | The document @(tupled xs)@ comma separates the documents @xs@ and
-- encloses them in parenthesis. The documents are rendered
-- horizontally if that fits the page. Otherwise they are aligned
-- vertically. All comma separators are put in front of the elements.
tupled :: [Doc a] -> Doc a
tupled :: [Doc a] -> Doc a
tupled          = Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
forall a. Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
encloseSep Doc a
forall a. Doc a
lparen   Doc a
forall a. Doc a
rparen  Doc a
forall a. Doc a
comma


-- | The document @(semiBraces xs)@ separates the documents @xs@ with
-- semi colons and encloses them in braces. The documents are rendered
-- horizontally if that fits the page. Otherwise they are aligned
-- vertically. All semi colons are put in front of the elements.
semiBraces :: [Doc a] -> Doc a
semiBraces :: [Doc a] -> Doc a
semiBraces      = Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
forall a. Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
encloseSep Doc a
forall a. Doc a
lbrace   Doc a
forall a. Doc a
rbrace  Doc a
forall a. Doc a
semi

-- | The document @(encloseSep l r sep xs)@ concatenates the documents
-- @xs@ separated by @sep@ and encloses the resulting document by @l@
-- and @r@. The documents are rendered horizontally if that fits the
-- page. Otherwise they are aligned vertically. All separators are put
-- in front of the elements. For example, the combinator 'list' can be
-- defined with @encloseSep@:
--
-- > list xs = encloseSep lbracket rbracket comma xs
-- > test    = text "list" <+> (list (map int [10,200,3000]))
--
-- Which is layed out with a page width of 20 as:
--
-- @
-- list [10,200,3000]
-- @
--
-- But when the page width is 15, it is layed out as:
--
-- @
-- list [10
--      ,200
--      ,3000]
-- @
encloseSep :: Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
encloseSep :: Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a
encloseSep left :: Doc a
left right :: Doc a
right sep :: Doc a
sep ds :: [Doc a]
ds
   = case [Doc a]
ds of
       []  -> Doc a
left Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
right
       [d :: Doc a
d] -> Doc a
left Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
d Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
right
       _   -> Doc a -> Doc a
forall a. Doc a -> Doc a
align ([Doc a] -> Doc a
forall a. [Doc a] -> Doc a
cat ((Doc a -> Doc a -> Doc a) -> [Doc a] -> [Doc a] -> [Doc a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<>) (Doc a
left Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: Doc a -> [Doc a]
forall a. a -> [a]
repeat Doc a
sep) [Doc a]
ds) Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
right)


-----------------------------------------------------------
-- punctuate p [d1,d2,...,dn] => [d1 <> p,d2 <> p, ... ,dn]
-----------------------------------------------------------


-- | @(punctuate p xs)@ concatenates all documents in @xs@ with
-- document @p@ except for the last document.
--
-- > someText = map text ["words","in","a","tuple"]
-- > test     = parens (align (cat (punctuate comma someText)))
--
-- This is layed out on a page width of 20 as:
--
-- @
-- (words,in,a,tuple)
-- @
--
-- But when the page width is 15, it is layed out as:
--
-- @
-- (words,
--  in,
--  a,
--  tuple)
-- @
--
-- (If you want put the commas in front of their elements instead of
-- at the end, you should use 'tupled' or, in general, 'encloseSep'.)
punctuate :: Doc a -> [Doc a] -> [Doc a]
punctuate :: Doc a -> [Doc a] -> [Doc a]
punctuate p :: Doc a
p []      = []
punctuate p :: Doc a
p [d :: Doc a
d]     = [Doc a
d]
punctuate p :: Doc a
p (d :: Doc a
d:ds :: [Doc a]
ds)  = (Doc a
d Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
p) Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: Doc a -> [Doc a] -> [Doc a]
forall a. Doc a -> [Doc a] -> [Doc a]
punctuate Doc a
p [Doc a]
ds


-----------------------------------------------------------
-- high-level combinators
-----------------------------------------------------------


-- | The document @(sep xs)@ concatenates all documents @xs@ either
-- horizontally with @(\<+\>)@, if it fits the page, or vertically with
-- @(\<$\>)@.
--
-- > sep xs  = group (vsep xs)
sep :: [Doc a] -> Doc a
sep :: [Doc a] -> Doc a
sep             = Doc a -> Doc a
forall a. Doc a -> Doc a
group (Doc a -> Doc a) -> ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
vsep

-- | The document @(fillSep xs)@ concatenates documents @xs@
-- horizontally with @(\<+\>)@ as long as its fits the page, than
-- inserts a @line@ and continues doing that for all documents in
-- @xs@.
--
-- > fillSep xs  = foldr (</>) empty xs
fillSep :: [Doc a] -> Doc a
fillSep :: [Doc a] -> Doc a
fillSep         = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall a. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(</>)

-- | The document @(hsep xs)@ concatenates all documents @xs@
-- horizontally with ('<+>').
hsep :: [Doc a] -> Doc a
hsep :: [Doc a] -> Doc a
hsep            = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall a. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<+>)


-- | The document @(vsep xs)@ concatenates all documents @xs@
-- vertically with @(\<$\>)@. If a 'group' undoes the line breaks
-- inserted by @vsep@, all documents are separated with a space.
--
-- > someText = map text (words ("text to lay out"))
-- >
-- > test     = text "some" <+> vsep someText
--
-- This is layed out as:
--
-- @
-- some text
-- to
-- lay
-- out
-- @
--
-- The 'align' combinator can be used to align the documents under
-- their first element
--
-- > test     = text "some" <+> align (vsep someText)
--
-- Which is printed as:
--
-- @
-- some text
--      to
--      lay
--      out
-- @
vsep :: [Doc a] -> Doc a
vsep :: [Doc a] -> Doc a
vsep            = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall a. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<$>)

-- | The document @(cat xs)@ concatenates all documents @xs@ either
-- horizontally with @(\<\>)@, if it fits the page, or vertically with
-- @(\<$$\>)@.
--
-- > cat xs  = group (vcat xs)
cat :: [Doc a] -> Doc a
cat :: [Doc a] -> Doc a
cat             = Doc a -> Doc a
forall a. Doc a -> Doc a
group (Doc a -> Doc a) -> ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
vcat

-- | The document @(fillCat xs)@ concatenates documents @xs@
-- horizontally with @(\<\>)@ as long as its fits the page, than inserts
-- a @linebreak@ and continues doing that for all documents in @xs@.
--
-- > fillCat xs  = foldr (\<\/\/\>) empty xs
fillCat :: [Doc a] -> Doc a
fillCat :: [Doc a] -> Doc a
fillCat         = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall a. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<//>)

-- | The document @(hcat xs)@ concatenates all documents @xs@
-- horizontally with @(\<\>)@.
hcat :: [Doc a] -> Doc a
hcat :: [Doc a] -> Doc a
hcat            = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall a. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<>)

-- | The document @(vcat xs)@ concatenates all documents @xs@
-- vertically with @(\<$$\>)@. If a 'group' undoes the line breaks
-- inserted by @vcat@, all documents are directly concatenated.
vcat :: [Doc a] -> Doc a
vcat :: [Doc a] -> Doc a
vcat            = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall a. (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<$$>)

fold :: (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
fold f :: Doc a -> Doc a -> Doc a
f []       = Doc a
forall a. Doc a
empty
fold f :: Doc a -> Doc a -> Doc a
f ds :: [Doc a]
ds       = (Doc a -> Doc a -> Doc a) -> [Doc a] -> Doc a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc a -> Doc a -> Doc a
f [Doc a]
ds

-- | The document @(x \<\> y)@ concatenates document @x@ and document
-- @y@. It is an associative operation having 'empty' as a left and
-- right unit.  (infixr 6)
(<>) :: 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. Doc a -> Doc a -> Doc a
`beside` Doc a
y

-- | The document @(x \<+\> y)@ concatenates document @x@ and @y@ with a
-- @space@ in between.  (infixr 6)
(<+>) :: 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. Doc a -> Doc a -> Doc a
<> Doc a
forall a. Doc a
space Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
y

-- | The document @(x \<\/\> y)@ concatenates document @x@ and @y@ with a
-- 'softline' in between. This effectively puts @x@ and @y@ either
-- next to each other (with a @space@ in between) or underneath each
-- other. (infixr 5)
(</>) :: 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. Doc a -> Doc a -> Doc a
<> Doc a
forall a. Doc a
softline Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
y

-- | The document @(x \<\/\/\> y)@ concatenates document @x@ and @y@ with
-- a 'softbreak' in between. This effectively puts @x@ and @y@ either
-- right next to each other or underneath each other. (infixr 5)
(<//>) :: 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. Doc a -> Doc a -> Doc a
<> Doc a
forall a. Doc a
softbreak Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
y

-- | The document @(x \<$\> y)@ concatenates document @x@ and @y@ with a
-- 'line' in between. (infixr 5)
(<$>) :: 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. Doc a -> Doc a -> Doc a
<> Doc a
forall a. Doc a
line Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
y

-- | The document @(x \<$$\> y)@ concatenates document @x@ and @y@ with
-- a @linebreak@ in between. (infixr 5)
(<$$>) :: 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. Doc a -> Doc a -> Doc a
<> Doc a
forall a. Doc a
linebreak Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
y

-- | The document @softline@ behaves like 'space' if the resulting
-- output fits the page, otherwise it behaves like 'line'.
--
-- > softline = group line
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

-- | The document @softbreak@ behaves like 'empty' if the resulting
-- output fits the page, otherwise it behaves like 'line'.
--
-- > softbreak  = group linebreak
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

-- | Document @(squotes x)@ encloses document @x@ with single quotes
-- \"'\".
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

-- | Document @(dquotes x)@ encloses document @x@ with double quotes
-- '\"'.
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

-- | Document @(braces x)@ encloses document @x@ in braces, \"{\" and
-- \"}\".
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

-- | Document @(parens x)@ encloses document @x@ in parenthesis, \"(\"
-- and \")\".
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

-- | Document @(angles x)@ encloses document @x@ in angles, \"\<\" and
-- \"\>\".
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

-- | Document @(brackets x)@ encloses document @x@ in square brackets,
-- \"[\" and \"]\".
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

-- | The document @(enclose l r x)@ encloses document @x@ between
-- documents @l@ and @r@ using @(\<\>)@.
--
-- > enclose l r x   = l <> x <> r
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. Doc a -> Doc a -> Doc a
<> Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> Doc a
r

-- | The document @lparen@ contains a left parenthesis, \"(\".
lparen :: Doc a
lparen :: Doc a
lparen          = Char -> Doc a
forall a. Char -> Doc a
char '('
-- | The document @rparen@ contains a right parenthesis, \")\".
rparen :: Doc a
rparen :: Doc a
rparen          = Char -> Doc a
forall a. Char -> Doc a
char ')'
-- | The document @langle@ contains a left angle, \"\<\".
langle :: Doc a
langle :: Doc a
langle          = Char -> Doc a
forall a. Char -> Doc a
char '<'
-- | The document @rangle@ contains a right angle, \">\".
rangle :: Doc a
rangle :: Doc a
rangle          = Char -> Doc a
forall a. Char -> Doc a
char '>'
-- | The document @lbrace@ contains a left brace, \"{\".
lbrace :: Doc a
lbrace :: Doc a
lbrace          = Char -> Doc a
forall a. Char -> Doc a
char '{'
-- | The document @rbrace@ contains a right brace, \"}\".
rbrace :: Doc a
rbrace :: Doc a
rbrace          = Char -> Doc a
forall a. Char -> Doc a
char '}'
-- | The document @lbracket@ contains a left square bracket, \"[\".
lbracket :: Doc a
lbracket :: Doc a
lbracket        = Char -> Doc a
forall a. Char -> Doc a
char '['
-- | The document @rbracket@ contains a right square bracket, \"]\".
rbracket :: Doc a
rbracket :: Doc a
rbracket        = Char -> Doc a
forall a. Char -> Doc a
char ']'


-- | The document @squote@ contains a single quote, \"'\".
squote :: Doc a
squote :: Doc a
squote          = Char -> Doc a
forall a. Char -> Doc a
char '\''
-- | The document @dquote@ contains a double quote, '\"'.
dquote :: Doc a
dquote :: Doc a
dquote          = Char -> Doc a
forall a. Char -> Doc a
char '"'
-- | The document @semi@ contains a semi colon, \";\".
semi :: Doc a
semi :: Doc a
semi            = Char -> Doc a
forall a. Char -> Doc a
char ';'
-- | The document @colon@ contains a colon, \":\".
colon :: Doc a
colon :: Doc a
colon           = Char -> Doc a
forall a. Char -> Doc a
char ':'
-- | The document @comma@ contains a comma, \",\".
comma :: Doc a
comma :: Doc a
comma           = Char -> Doc a
forall a. Char -> Doc a
char ','
-- | The document @space@ contains a single space, \" \".
--
-- > x <+> y   = x <> space <> y
space :: Doc a
space :: Doc a
space           = Char -> Doc a
forall a. Char -> Doc a
char ' '
-- | The document @dot@ contains a single dot, \".\".
dot :: Doc a
dot :: Doc a
dot             = Char -> Doc a
forall a. Char -> Doc a
char '.'
-- | The document @backslash@ contains a back slash, \"\\\".
backslash :: Doc a
backslash :: Doc a
backslash       = Char -> Doc a
forall a. Char -> Doc a
char '\\'
-- | The document @equals@ contains an equal sign, \"=\".
equals :: Doc a
equals :: Doc a
equals          = Char -> Doc a
forall a. Char -> Doc a
char '='
-- | The document @pipe@ contains a pipe character, \"\|\".
pipe :: Doc a
pipe :: Doc a
pipe            = Char -> Doc a
forall a. Char -> Doc a
char '|'

-----------------------------------------------------------
-- Combinators for prelude types
-----------------------------------------------------------

-- string is like "text" but replaces '\n' by "line"

-- | The document @(string s)@ concatenates all characters in @s@
-- using @line@ for newline characters and @char@ for all other
-- characters. It is used instead of 'text' whenever the text contains
-- newline characters.
string :: String -> Doc a
string :: String -> Doc a
string ""       = Doc a
forall a. Doc a
empty
string ('\n':s :: String
s) = Doc a
forall a. Doc a
line Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> String -> Doc a
forall a. String -> Doc a
string String
s
string s :: String
s        = case ((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='\n') String
s) of
                   (xs :: String
xs,ys :: String
ys) -> String -> Doc a
forall a. String -> Doc a
text String
xs Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<> String -> Doc a
forall a. String -> Doc a
string String
ys

-- | The document @(bool b)@ is @text "True"@ when @b@ is true, and @text
-- "False"@ otherwise.
bool :: Bool -> Doc a
bool :: Bool -> Doc a
bool b :: Bool
b          = String -> Doc a
forall a. String -> Doc a
text (Bool -> String
forall a. Show a => a -> String
show Bool
b)

-- | The document @(int i)@ shows the literal integer @i@ using
-- 'text'.
int :: Int -> Doc a
int :: Int -> Doc a
int i :: Int
i           = String -> Doc a
forall a. String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
i)

-- | The document @(integer i)@ shows the literal integer @i@ using
-- 'text'.
integer :: Integer -> Doc a
integer :: Integer -> Doc a
integer i :: Integer
i       = String -> Doc a
forall a. String -> Doc a
text (Integer -> String
forall a. Show a => a -> String
show Integer
i)

-- | The document @(float f)@ shows the literal float @f@ using
-- 'text'.
float :: Float -> Doc a
float :: Float -> Doc a
float f :: Float
f         = String -> Doc a
forall a. String -> Doc a
text (Float -> String
forall a. Show a => a -> String
show Float
f)

-- | The document @(double d)@ shows the literal double @d@ using
-- 'text'.
double :: Double -> Doc a
double :: Double -> Doc a
double d :: Double
d        = String -> Doc a
forall a. String -> Doc a
text (Double -> String
forall a. Show a => a -> String
show Double
d)

-- | The document @(rational r)@ shows the literal rational @r@ using
-- 'text'.
rational :: Rational -> Doc a
rational :: Rational -> Doc a
rational r :: Rational
r      = String -> Doc a
forall a. String -> Doc a
text (Rational -> String
forall a. Show a => a -> String
show Rational
r)





-----------------------------------------------------------
-- semi primitive: fill and fillBreak
-----------------------------------------------------------

-- | The document @(fillBreak i x)@ first renders document @x@. It
-- than appends @space@s until the width is equal to @i@. If the
-- width of @x@ is already larger than @i@, the nesting level is
-- increased by @i@ and a @line@ is appended. When we redefine @ptype@
-- in the previous example to use @fillBreak@, we get a useful
-- variation of the previous output:
--
-- > ptype (name,tp)
-- >        = fillBreak 6 (text name) <+> text "::" <+> text tp
--
-- The output will now be:
--
-- @
-- let empty  :: Doc a
--     nest   :: Int -> Doc a -> Doc a
--     linebreak
--            :: Doc a
-- @
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 (\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)))


-- | The document @(fill i x)@ renders document @x@. It than appends
-- @space@s until the width is equal to @i@. If the width of @x@ is
-- already larger, nothing is appended. This combinator is quite
-- useful in practice to output a list of bindings. The following
-- example demonstrates this.
--
-- > types  = [("empty","Doc a")
-- >          ,("nest","Int -> Doc a -> Doc a")
-- >          ,("linebreak","Doc a")]
-- >
-- > ptype (name,tp)
-- >        = fill 6 (text name) <+> text "::" <+> text tp
-- >
-- > test   = text "let" <+> align (vcat (map ptype types))
--
-- Which is layed out as:
--
-- @
-- let empty  :: Doc a
--     nest   :: Int -> Doc a -> Doc a
--     linebreak :: Doc a
-- @
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 (\w :: Int
w ->
                 if (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
f) then Doc a
forall a. Doc a
empty
                             else String -> Doc a
forall a. String -> Doc a
text (Int -> String
spaces (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)))

width :: Doc a -> (Int -> Doc a) -> Doc a
width :: 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. Doc a -> Doc a -> Doc 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)))


-----------------------------------------------------------
-- semi primitive: Alignment and indentation
-----------------------------------------------------------

-- | The document @(indent i x)@ indents document @x@ with @i@ spaces.
--
-- > test  = indent 4 (fillSep (map text
-- >         (words "the indent combinator indents these words !")))
--
-- Which lays out with a page width of 20 as:
--
-- @
--     the indent
--     combinator
--     indents these
--     words !
-- @
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. Doc a -> Doc a -> Doc a
<> Doc a
d)

-- | The hang combinator implements hanging indentation. The document
-- @(hang i x)@ renders document @x@ with a nesting level set to the
-- current column plus @i@. The following example uses hanging
-- indentation for some text:
--
-- > test  = hang 4 (fillSep (map text
-- >         (words "the hang combinator indents these words !")))
--
-- Which lays out on a page with a width of 20 characters as:
--
-- @
-- the hang combinator
--     indents these
--     words !
-- @
--
-- The @hang@ combinator is implemented as:
--
-- > hang i x  = align (nest i x)
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)

-- | The document @(align x)@ renders document @x@ with the nesting
-- level set to the current column. It is used for example to
-- implement 'hang'.
--
-- As an example, we will put a document right above another one,
-- regardless of the current nesting level:
--
-- > x $$ y  = align (x <$> y)
--
-- > test    = text "hi" <+> (text "nice" $$ text "world")
--
-- which will be layed out as:
--
-- @
-- hi nice
--    world
-- @
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 (\k :: Int
k ->
                 (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
nesting (\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))   --nesting might be negative :-)



-----------------------------------------------------------
-- Primitives
-----------------------------------------------------------

-- | The abstract data type @Doc a@ represents pretty documents.
--
-- @Doc a@ is an instance of the 'Show' class. @(show doc)@ pretty
-- prints document @doc@ with a page width of 100 characters and a
-- ribbon width of 40 characters.
--
-- > show (text "hello" <$> text "world")
--
-- Which would return the string \"hello\\nworld\", i.e.
--
-- @
-- hello
-- world
-- @
data Doc a     = Empty
               | Char Char             -- invariant: char is not '\n'
               | Text !Int String      -- invariant: text doesn't contain '\n'
               | Line !Bool            -- True <=> when undone by group, do not insert a space
               | Cat (Doc a) (Doc a)
               | Nest !Int (Doc a)
               | Union (Doc a) (Doc a)         -- invariant: first lines of first doc longer than the first lines of the second doc
               | Column  (Int -> Doc a)
               | Nesting (Int -> Doc a)
               | Annotate a (Doc a) -- The contained document, annotated by the info
               | AnnotEnd           -- Only used during rendering - indicates the end of an annotation
  deriving 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
type SpanList a = [(Int, Int, a)]

-- | The data type @SimpleDoc a@ represents rendered documents and is
-- used by the display functions.
--
-- The @Int@ in @SText@ contains the length of the string. The @Int@
-- in @SLine@ contains the indentation for that line. The library
-- provides two default display functions 'displayS' and
-- 'displayIO'. You can provide your own display function by writing a
-- function from a @SimpleDoc a@ to your own output format.
data SimpleDoc a  = SEmpty
               | SChar Char (SimpleDoc a)
               | SText !Int String (SimpleDoc a)
               | SLine !Int (SimpleDoc a)
               | SAnnotStart a (SimpleDoc a)
               | SAnnotStop (SimpleDoc a)
  deriving 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

-- | The empty document is, indeed, empty. Although @empty@ has no
-- content, it does have a \'height\' of 1 and behaves exactly like
-- @(text \"\")@ (and is therefore not a unit of @\<$\>@).
empty :: Doc a
empty :: Doc a
empty           = Doc a
forall a. Doc a
Empty

-- | The document @(char c)@ contains the literal character @c@. The
-- character shouldn't be a newline (@'\n'@), the function 'line'
-- should be used for line breaks.
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

-- | The document @(text s)@ contains the literal string @s@. The
-- string shouldn't contain any newline (@'\n'@) characters. If the
-- string contains newline characters, the function 'string' should be
-- used.
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

-- | The @line@ document advances to the next line and indents to the
-- current nesting level. Doc aument @line@ behaves like @(text \" \")@
-- if the line break is undone by 'group'.
line :: Doc a
line :: Doc a
line            = Bool -> Doc a
forall a. Bool -> Doc a
Line Bool
False

-- | The @linebreak@ document advances to the next line and indents to
-- the current nesting level. Document @linebreak@ behaves like
-- 'empty' if the line break is undone by 'group'.
linebreak :: Doc a
linebreak :: Doc a
linebreak       = Bool -> Doc a
forall a. Bool -> Doc a
Line Bool
True

beside :: Doc a -> Doc a -> Doc a
beside 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
x Doc a
y

-- | The document @(nest i x)@ renders document @x@ with the current
-- indentation level increased by i (See also 'hang', 'align' and
-- 'indent').
--
-- > nest 2 (text "hello" <$> text "world") <$> text "!"
--
-- outputs as:
--
-- @
-- hello
--   world
-- !
-- @
nest :: Int -> Doc a -> Doc a
nest :: Int -> Doc a -> Doc a
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
x

column, nesting :: (Int -> Doc a) -> Doc a
column :: (Int -> Doc a) -> Doc a
column f :: Int -> Doc a
f        = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
Column Int -> Doc a
f
nesting :: (Int -> Doc a) -> Doc a
nesting f :: Int -> Doc a
f       = (Int -> Doc a) -> Doc a
forall a. (Int -> Doc a) -> Doc a
Nesting Int -> Doc a
f

-- | The @group@ combinator is used to specify alternative
-- layouts. The document @(group x)@ undoes all line breaks in
-- document @x@. The resulting line is added to the current line if
-- that fits the page. Otherwise, the document @x@ is rendered without
-- any changes.
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

flatten :: Doc a -> Doc a
flatten :: Doc a -> Doc a
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 (Line break :: Bool
break)    = if Bool
break then Doc a
forall a. Doc a
Empty else Int -> String -> Doc a
forall a. Int -> String -> Doc a
Text 1 " "
flatten (Union x :: Doc a
x y :: Doc a
y)     = 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 other :: Doc a
other           = Doc a
other                     --Empty,Char,Text

-----------------------------------------------------------
-- Semantic annotations
-----------------------------------------------------------

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

-- | Strip annotations from a document. This is useful for re-using the
-- textual formatting of some sub-document, but applying a different
-- high-level annotation.
noAnnotate :: Doc a -> Doc a
noAnnotate :: Doc a -> Doc a
noAnnotate (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
noAnnotate Doc a
x) (Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate Doc a
y)
noAnnotate (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
noAnnotate Doc a
x)
noAnnotate (Union x :: Doc a
x y :: Doc a
y) = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Union (Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate Doc a
x) (Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate Doc a
y)
noAnnotate (Column 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
noAnnotate (Doc a -> Doc a) -> (Int -> Doc a) -> Int -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc a
f)
noAnnotate (Nesting 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
noAnnotate (Doc a -> Doc a) -> (Int -> Doc a) -> Int -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc a
f)
noAnnotate (Annotate _ x :: Doc a
x) = Doc a -> Doc a
forall a. Doc a -> Doc a
noAnnotate Doc a
x
noAnnotate other :: Doc a
other = Doc a
other

-----------------------------------------------------------
-- Renderers
-----------------------------------------------------------

-----------------------------------------------------------
-- renderPretty: the default pretty printing algorithm
-----------------------------------------------------------

-- list of indentation/document pairs; saves an indirection over [(Int,Doc a)]
data Docs a = Nil
            | Cons !Int (Doc a) (Docs a)


-- | This is the default pretty printer which is used by 'show',
-- 'putDoc' and 'hPutDoc'. @(renderPretty ribbonfrac width x)@ renders
-- document @x@ with a page width of @width@ and a ribbon width of
-- @(ribbonfrac * width)@ characters. The ribbon width is the maximal
-- amount of non-indentation characters on a line. The parameter
-- @ribbonfrac@ should be between @0.0@ and @1.0@. If it is lower or
-- higher, the ribbon width will be 0 or @width@ respectively.
renderPretty :: Float -> Int -> Doc a -> SimpleDoc a
renderPretty :: Float -> Int -> Doc a -> SimpleDoc a
renderPretty rfrac :: Float
rfrac w :: Int
w x :: Doc a
x
   = Int -> Int -> Docs a -> SimpleDoc a
forall a. Int -> Int -> Docs a -> SimpleDoc a
best 0 0 (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons 0 Doc a
x Docs a
forall a. Docs a
Nil)
   where
     -- r :: the ribbon width in characters
     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 :: n = indentation of current line
     --         k = current column
     --        (ie. (k >= n) && (k - n == count of inserted characters)
     best :: Int -> Int -> Docs a -> SimpleDoc a
best n :: Int
n k :: Int
k Nil      = SimpleDoc a
forall a. SimpleDoc a
SEmpty
     best n :: Int
n k :: Int
k (Cons i :: Int
i d :: Doc a
d ds :: Docs a
ds)
       = case Doc a
d of
           Empty       -> Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k Docs 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 (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k' Docs 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 (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k' Docs a
ds))
           Line _      -> Int -> SimpleDoc a -> SimpleDoc a
forall a. Int -> SimpleDoc a -> SimpleDoc a
SLine Int
i (Int -> Int -> Docs a -> SimpleDoc a
best Int
i Int
i Docs a
ds)
           Cat x :: Doc a
x y :: Doc a
y     -> Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
x (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
y Docs a
ds))
           Nest 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 -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i' Doc a
x Docs a
ds))
           Union x :: Doc a
x y :: Doc a
y   -> Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
forall a. Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicest Int
n Int
k (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
x Docs a
ds))
                                     (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
y Docs a
ds))

           Column f :: Int -> Doc a
f    -> Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i (Int -> Doc a
f Int
k) Docs a
ds)
           Nesting f :: Int -> Doc a
f   -> Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i (Int -> Doc a
f Int
i) Docs a
ds)
           Annotate a :: a
a d' :: Doc a
d' -> a -> SimpleDoc a -> SimpleDoc a
forall a. a -> SimpleDoc a -> SimpleDoc a
SAnnotStart a
a (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
d' (Int -> Doc a -> Docs a -> Docs a
forall a. Int -> Doc a -> Docs a -> Docs a
Cons Int
i Doc a
forall a. Doc a
AnnotEnd Docs a
ds)))
           AnnotEnd    -> SimpleDoc a -> SimpleDoc a
forall a. SimpleDoc a -> SimpleDoc a
SAnnotStop (Int -> Int -> Docs a -> SimpleDoc a
best Int
n Int
k Docs a
ds)

     --nicest :: r = ribbon width, w = page width,
     --          n = indentation of current line, k = current column
     --          x and y, the (simple) documents to chose from.
     --          precondition: first lines of x are longer than the first lines of y.
     nicest :: Int -> Int -> SimpleDoc a -> SimpleDoc a -> SimpleDoc a
nicest n :: Int
n k :: Int
k x :: SimpleDoc a
x y :: SimpleDoc a
y    | Int -> SimpleDoc a -> Bool
forall a. Int -> SimpleDoc a -> Bool
fits Int
width SimpleDoc a
x  = SimpleDoc a
x
                       | Bool
otherwise     = SimpleDoc a
y
                       where
                         width :: Int
width = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)


fits :: Int -> SimpleDoc a -> Bool
fits w :: Int
w x :: SimpleDoc a
x        | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0         = Bool
False
fits w :: Int
w SEmpty                   = Bool
True
fits w :: Int
w (SChar c :: Char
c x :: SimpleDoc a
x)              = Int -> SimpleDoc a -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) SimpleDoc a
x
fits w :: Int
w (SText l :: Int
l s :: String
s x :: SimpleDoc a
x)            = Int -> SimpleDoc a -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) SimpleDoc a
x
fits w :: Int
w (SLine i :: Int
i x :: SimpleDoc a
x)              = Bool
True
fits w :: Int
w (SAnnotStart _ x :: SimpleDoc a
x)        = Int -> SimpleDoc a -> Bool
fits Int
w SimpleDoc a
x
fits w :: Int
w (SAnnotStop x :: SimpleDoc a
x)           = Int -> SimpleDoc a -> Bool
fits Int
w SimpleDoc a
x


-----------------------------------------------------------
-- renderCompact: renders documents without indentation
--  fast and fewer characters output, good for machines
-----------------------------------------------------------


-- | @(renderCompact x)@ renders document @x@ without adding any
-- indentation. Since no \'pretty\' printing is involved, this
-- renderer is very fast. The resulting output contains fewer
-- characters than a pretty printed version and can be used for output
-- that is read by other programs.
renderCompact :: Doc a -> SimpleDoc a
renderCompact :: Doc a -> SimpleDoc a
renderCompact x :: Doc a
x
   = Int -> [Doc a] -> SimpleDoc a
forall a. Int -> [Doc a] -> SimpleDoc a
scan 0 [Doc a
x]
   where
     scan :: Int -> [Doc a] -> SimpleDoc a
scan k :: Int
k []     = SimpleDoc a
forall a. SimpleDoc a
SEmpty
     scan k :: Int
k (d :: Doc a
d:ds :: [Doc a]
ds) = case Doc a
d of
                       Empty         -> Int -> [Doc a] -> SimpleDoc a
scan 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 (Int -> [Doc a] -> SimpleDoc a
scan 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 (Int -> [Doc a] -> SimpleDoc a
scan Int
k' [Doc a]
ds))
                       Line _        -> Int -> SimpleDoc a -> SimpleDoc a
forall a. Int -> SimpleDoc a -> SimpleDoc a
SLine 0 (Int -> [Doc a] -> SimpleDoc a
scan 0 [Doc a]
ds)
                       Cat x :: Doc a
x y :: Doc a
y       -> Int -> [Doc a] -> SimpleDoc a
scan Int
k (Doc a
xDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:Doc a
yDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
                       Nest j :: Int
j x :: Doc a
x      -> Int -> [Doc a] -> SimpleDoc a
scan Int
k (Doc a
xDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
                       Union x :: Doc a
x y :: Doc a
y     -> Int -> [Doc a] -> SimpleDoc a
scan Int
k (Doc a
yDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
                       Column f :: Int -> Doc a
f      -> Int -> [Doc a] -> SimpleDoc a
scan Int
k (Int -> Doc a
f Int
kDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
                       Nesting f :: Int -> Doc a
f     -> Int -> [Doc a] -> SimpleDoc a
scan Int
k (Int -> Doc a
f 0Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds)
                       Annotate a :: a
a d' :: Doc a
d' -> a -> SimpleDoc a -> SimpleDoc a
forall a. a -> SimpleDoc a -> SimpleDoc a
SAnnotStart a
a (Int -> [Doc a] -> SimpleDoc a
scan Int
k (Doc a
d'Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:Doc a
forall a. Doc a
AnnotEndDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
ds))
                       AnnotEnd      -> SimpleDoc a -> SimpleDoc a
forall a. SimpleDoc a -> SimpleDoc a
SAnnotStop (SimpleDoc a -> SimpleDoc a) -> SimpleDoc a -> SimpleDoc a
forall a b. (a -> b) -> a -> b
$ Int -> [Doc a] -> SimpleDoc a
scan Int
k [Doc a]
ds



-----------------------------------------------------------
-- Displayers:  displayS and displayIO (and display)
-----------------------------------------------------------

-- | @(display simpleDoc)@ transforms the @simpleDoc@ to a 'String'.
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 ""

-- | @(displayS simpleDoc a)@ takes the output @simpleDoc a@ from a
-- rendering function and transforms it to a 'ShowS' type (for use in
-- the 'Show' class).
--
-- > showWidth :: Int -> Doc a -> String
-- > showWidth w x   = displayS (renderPretty 0.4 w x) ""
displayS :: SimpleDoc a -> ShowS
displayS :: SimpleDoc a -> String -> String
displayS SEmpty             = String -> String
forall a. a -> a
id
displayS (SChar c :: Char
c x :: SimpleDoc a
x)        = Char -> String -> String
showChar Char
c (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
x
displayS (SText l :: Int
l s :: String
s x :: SimpleDoc a
x)      = String -> String -> String
showString String
s (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
x
displayS (SLine i :: Int
i x :: SimpleDoc a
x)        = String -> String -> String
showString ('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
indentation Int
i) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
x
displayS (SAnnotStart _ x :: SimpleDoc a
x)  = SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
x
displayS (SAnnotStop x :: SimpleDoc a
x)     = SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS SimpleDoc a
x

-- | @(displayIO handle simpleDoc a)@ writes @simpleDoc a@ to the file
-- handle @handle@. This function is used for example by 'hPutDoc a':
--
-- > hPutDoc a handle doc  = displayIO handle (renderPretty 0.4 100 doc)
displayIO :: Handle -> SimpleDoc a -> IO ()
displayIO :: Handle -> SimpleDoc a -> IO ()
displayIO handle :: Handle
handle simpleDoc :: SimpleDoc a
simpleDoc
   = SimpleDoc a -> IO ()
forall a. SimpleDoc a -> IO ()
display SimpleDoc a
simpleDoc
   where
     display :: SimpleDoc a -> IO ()
display SEmpty            = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     display (SChar c :: Char
c x :: SimpleDoc a
x)       = do{ Handle -> Char -> IO ()
hPutChar Handle
handle Char
c; SimpleDoc a -> IO ()
display SimpleDoc a
x}
     display (SText l :: Int
l s :: String
s x :: SimpleDoc a
x)     = do{ Handle -> String -> IO ()
hPutStr Handle
handle String
s; SimpleDoc a -> IO ()
display SimpleDoc a
x}
     display (SLine i :: Int
i x :: SimpleDoc a
x)       = do{ Handle -> String -> IO ()
hPutStr Handle
handle ('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
indentation Int
i); SimpleDoc a -> IO ()
display SimpleDoc a
x}
     display (SAnnotStart _ x :: SimpleDoc a
x) = SimpleDoc a -> IO ()
display SimpleDoc a
x
     display (SAnnotStop x :: SimpleDoc a
x)    = SimpleDoc a -> IO ()
display SimpleDoc a
x

-- | Generate a pair of a string and a list of source span/annotation pairs
displaySpans :: SimpleDoc a -> (String, SpanList a)
displaySpans :: SimpleDoc a -> (String, SpanList a)
displaySpans sd :: SimpleDoc a
sd = Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display 0 [] SimpleDoc a
sd
  where display :: Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
        display :: Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display i :: Int
i []                 SEmpty              = ("", [])
        display i :: Int
i stk :: [(Int, a)]
stk                (SChar c :: Char
c x :: SimpleDoc a
x)         = let (str :: String
str, spans :: SpanList a
spans) = Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [(Int, a)]
stk SimpleDoc a
x
                                                           in (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
str, SpanList a
spans)
        display i :: Int
i stk :: [(Int, a)]
stk                (SText l :: Int
l s :: String
s x :: SimpleDoc a
x)       = (String -> String) -> (String, SpanList a) -> (String, SpanList a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFst (String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++) (Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) [(Int, a)]
stk SimpleDoc a
x)
        display i :: Int
i stk :: [(Int, a)]
stk                (SLine ind :: Int
ind x :: SimpleDoc a
x)       = (String -> String) -> (String, SpanList a) -> (String, SpanList a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFst (('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
indentation Int
ind)String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display (1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ind) [(Int, a)]
stk SimpleDoc a
x)
        display i :: Int
i stk :: [(Int, a)]
stk                (SAnnotStart ann :: a
ann x :: SimpleDoc a
x) = Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display Int
i ((Int
i, a
ann)(Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:[(Int, a)]
stk) SimpleDoc a
x
        display i :: Int
i ((start :: Int
start, ann :: a
ann):stk :: [(Int, a)]
stk) (SAnnotStop x :: SimpleDoc a
x)      = (SpanList a -> SpanList a)
-> (String, SpanList a) -> (String, SpanList a)
forall a b c. (a -> b) -> (c, a) -> (c, b)
mapSnd ((Int
start, Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
start, a
ann)(Int, Int, a) -> SpanList a -> SpanList a
forall a. a -> [a] -> [a]
:) (Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
display Int
i [(Int, a)]
stk SimpleDoc a
x)

        -- malformed documents
        display _ []  (SAnnotStop _) = String -> (String, SpanList a)
forall a. HasCallStack => String -> a
error "stack underflow"
        display _ stk :: [(Int, a)]
stk SEmpty         = String -> (String, SpanList a)
forall a. HasCallStack => String -> a
error "Stack not consumed by rendering"

        mapFst :: (a -> b) -> (a, c) -> (b, c)
        mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst f :: a -> b
f (x :: a
x, y :: c
y) = (a -> b
f a
x, c
y)

        mapSnd :: (a -> b) -> (c, a) -> (c, b)
        mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd f :: a -> b
f (x :: c
x, y :: a
y) = (c
x, a -> b
f a
y)

-- | Render a string, where annotated regions are decorated by a user-provided function.
displayDecorated :: (a -> String -> String) -> SimpleDoc a -> String
displayDecorated :: (a -> String -> String) -> SimpleDoc a -> String
displayDecorated decor :: a -> String -> String
decor sd :: SimpleDoc a
sd = (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display String -> String
forall a. a -> a
id String -> String
forall a. a -> a
id [] SimpleDoc a
sd ""
  where display :: (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display s :: String -> String
s d :: String -> String
d []                SEmpty              = String -> String
d (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
s
        display s :: String -> String
s d :: String -> String
d stk :: [(String -> String, String -> String)]
stk               (SChar c :: Char
c x :: SimpleDoc a
x)         = (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display (String -> String
s (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
c) String -> String
d [(String -> String, String -> String)]
stk SimpleDoc a
x
        display s :: String -> String
s d :: String -> String
d stk :: [(String -> String, String -> String)]
stk               (SText l :: Int
l str :: String
str x :: SimpleDoc a
x)     = (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display (String -> String
s (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
str) String -> String
d [(String -> String, String -> String)]
stk SimpleDoc a
x
        display s :: String -> String
s d :: String -> String
d stk :: [(String -> String, String -> String)]
stk               (SLine ind :: Int
ind x :: SimpleDoc a
x)       = (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display (String -> String
s (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString ('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
indentation Int
ind)) String -> String
d [(String -> String, String -> String)]
stk SimpleDoc a
x
        display s :: String -> String
s d :: String -> String
d stk :: [(String -> String, String -> String)]
stk               (SAnnotStart ann :: a
ann x :: SimpleDoc a
x) = (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display String -> String
forall a. a -> a
id (a -> String -> String
decor a
ann) ((String -> String
s, String -> String
d)(String -> String, String -> String)
-> [(String -> String, String -> String)]
-> [(String -> String, String -> String)]
forall a. a -> [a] -> [a]
:[(String -> String, String -> String)]
stk) SimpleDoc a
x
        display s :: String -> String
s d :: String -> String
d ((sf' :: String -> String
sf', d' :: String -> String
d'):stk :: [(String -> String, String -> String)]
stk)   (SAnnotStop x :: SimpleDoc a
x)      = let formatted :: String
formatted = String -> String
d (String -> String
s "")
                                                            in (String -> String)
-> (String -> String)
-> [(String -> String, String -> String)]
-> SimpleDoc a
-> String
-> String
display (String -> String
sf' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
formatted) String -> String
d' [(String -> String, String -> String)]
stk SimpleDoc a
x
        -- malformed documents
        display _ _ [] (SAnnotStop _) = String -> String -> String
forall a. HasCallStack => String -> a
error "stack underflow"
        display _ _ stk :: [(String -> String, String -> String)]
stk SEmpty = String -> String -> String
forall a. HasCallStack => String -> a
error "stack not consumed by rendering"

displayDecoratedA :: (Applicative f, Monoid b)
                  => (String -> f b) -> (a -> f b) -> (a -> f b)
                  -> SimpleDoc a -> f b
displayDecoratedA :: (String -> f b) -> (a -> f b) -> (a -> f b) -> SimpleDoc a -> f b
displayDecoratedA str :: String -> f b
str start :: a -> f b
start end :: a -> f b
end sd :: SimpleDoc a
sd = [a] -> SimpleDoc a -> f b
display [] SimpleDoc a
sd
  where display :: [a] -> SimpleDoc a -> f b
display []        SEmpty              = b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty
        display stk :: [a]
stk       (SChar c :: Char
c x :: SimpleDoc a
x)         = (String -> f b
str [Char
c]) f b -> f b -> f b
<++> ([a] -> SimpleDoc a -> f b
display [a]
stk SimpleDoc a
x)
        display stk :: [a]
stk       (SText l :: Int
l s :: String
s x :: SimpleDoc a
x)       = (String -> f b
str String
s) f b -> f b -> f b
<++> ([a] -> SimpleDoc a -> f b
display [a]
stk SimpleDoc a
x)
        display stk :: [a]
stk       (SLine ind :: Int
ind x :: SimpleDoc a
x)       = (String -> f b
str ('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
indentation Int
ind)) f b -> f b -> f b
<++> ([a] -> SimpleDoc a -> f b
display [a]
stk SimpleDoc a
x)
        display stk :: [a]
stk       (SAnnotStart ann :: a
ann x :: SimpleDoc a
x) = (a -> f b
start a
ann) f b -> f b -> f b
<++> ([a] -> SimpleDoc a -> f b
display (a
anna -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
stk) SimpleDoc a
x)
        display (ann :: a
ann:stk :: [a]
stk) (SAnnotStop x :: SimpleDoc a
x)      = (a -> f b
end a
ann) f b -> f b -> f b
<++> ([a] -> SimpleDoc a -> f b
display [a]
stk SimpleDoc a
x)

        -- malformed documents
        display []        (SAnnotStop _)      = String -> f b
forall a. HasCallStack => String -> a
error "stack underflow"
        display stk :: [a]
stk       SEmpty              = String -> f b
forall a. HasCallStack => String -> a
error "stack not consumed by rendering"

        <++> :: f b -> f b -> f b
(<++>) = (b -> b -> b) -> f b -> f b -> f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Monoid a => a -> a -> a
mappend

-----------------------------------------------------------
-- default pretty printers: show, putDoc and hPutDoc
-----------------------------------------------------------
instance Show (Doc a) where
 showsPrec :: Int -> Doc a -> String -> String
showsPrec d :: Int
d doc :: Doc a
doc       = SimpleDoc a -> String -> String
forall a. SimpleDoc a -> String -> String
displayS (Float -> Int -> Doc a -> SimpleDoc a
forall a. Float -> Int -> Doc a -> SimpleDoc a
renderPretty 0.4 80 Doc a
doc)

-- | The action @(putDoc doc)@ pretty prints document @doc@ to the
-- standard output, with a page width of 100 characters and a ribbon
-- width of 40 characters.
--
-- > main :: IO ()
-- > main = do{ putDoc (text "hello" <+> text "world") }
--
-- Which would output
--
-- @
-- hello world
-- @
putDoc :: Doc a -> IO ()
putDoc :: Doc a -> IO ()
putDoc doc :: Doc a
doc              = Handle -> Doc a -> IO ()
forall a. Handle -> Doc a -> IO ()
hPutDoc Handle
stdout Doc a
doc

-- | @(hPutDoc handle doc)@ pretty prints document @doc@ to the file
-- handle @handle@ with a page width of 100 characters and a ribbon
-- width of 40 characters.
--
-- > main = do{ handle <- openFile "MyFile" WriteMode
-- >          ; hPutDoc handle (vcat (map text
-- >                            ["vertical","text"]))
-- >          ; hClose handle
-- >          }
hPutDoc :: Handle -> Doc a -> IO ()
hPutDoc :: Handle -> Doc a -> IO ()
hPutDoc handle :: Handle
handle doc :: Doc a
doc      = Handle -> SimpleDoc a -> IO ()
forall a. Handle -> SimpleDoc a -> IO ()
displayIO Handle
handle (Float -> Int -> Doc a -> SimpleDoc a
forall a. Float -> Int -> Doc a -> SimpleDoc a
renderPretty 0.4 80 Doc a
doc)



-----------------------------------------------------------
-- insert spaces
-- "indentation" used to insert tabs but tabs seem to cause
-- more trouble than they solve :-)
-----------------------------------------------------------
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 ' '

indentation :: Int -> String
indentation n :: Int
n   = Int -> String
spaces Int
n

--indentation n   | n >= 8    = '\t' : indentation (n-8)
--                | otherwise = spaces n