content: {-# OPTIONS_GHC -w #-}
  {-# OPTIONS_HADDOCK hide #-}
  {-# LANGUAGE CPP #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Text.PrettyPrint.Leijen
  -- Copyright   :  Daan Leijen (c) 2000, http://www.cs.uu.nl/~daan
  -- License     :  BSD-style (see the file LICENSE)
  --
  -- Maintainer  :  otakar.smrz cmu.edu
  -- Stability   :  provisional
  -- Portability :  portable
  --
  -- Pretty print module based on Philip Wadler's \"prettier printer\"
  --
  -- @
  --      \"A prettier printer\"
  --      Draft paper, April 1997, revised March 1998.
  --      <http://cm.bell-labs.com/cm/cs/who/wadler/papers/prettier/prettier.ps>
  -- @
  --
  -- PPrint is an implementation of the pretty printing combinators
  -- described by Philip Wadler (1997). In their bare essence, the
  -- combinators of Wadler are not expressive enough to describe some
  -- commonly occurring layouts. The PPrint library adds new primitives
  -- to describe these layouts and works well in practice.
  --
  -- The library is based on a single way to concatenate documents,
  -- which is associative and has both a left and right unit.  This
  -- simple design leads to an efficient and short implementation. The
  -- simplicity is reflected in the predictable behaviour of the
  -- combinators which make them easy to use in practice.
  --
  -- A thorough description of the primitive combinators and their
  -- implementation can be found in Philip Wadler's paper
  -- (1997). Additions and the main differences with his original paper
  -- are:
  --
  -- * The nil document is called empty.
  --
  -- * The above combinator is called '<$>'. The operator '</>' is used
  -- for soft line breaks.
  --
  -- * There are three new primitives: 'align', 'fill' and
  -- 'fillBreak'. These are very useful in practice.
  --
  -- * Lots of other useful combinators, like 'fillSep' and 'list'.
  --
  -- * There are two renderers, 'renderPretty' for pretty printing and
  -- 'renderCompact' for compact output. The pretty printing algorithm
  -- also uses a ribbon-width now for even prettier output.
  --
  -- * There are two displayers, 'displayS' for strings and 'displayIO' for
  -- file based output.
  --
  -- * There is a 'Pretty' class.
  --
  -- * The implementation uses optimised representations and strictness
  -- annotations.
  --
  -- Full documentation available at <http://www.cs.uu.nl/~daan/download/pprint/pprint.html>.
  -----------------------------------------------------------
  module Text.PrettyPrint.Leijen (
     -- * Documents
     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,
  
     -- * Primitive type documents
     string, int, integer, float, double, rational,
  
     -- * Pretty class
     Pretty(..),
  
     -- * Rendering
     SimpleDoc(..), renderPretty, renderCompact, displayS, displayIO
  
     -- * Undocumented
          , bool
  
          , column, nesting, width
  
          , isEmpty
          ) where
  
  import System.IO (Handle,hPutStr,hPutChar,stdout)
  #if __GLASGOW_HASKELL__ >= 710
  import Prelude hiding ((<$>))
  #endif
  
  infixr 5 </>,<//>,<$>,<$$>
  infixr 6 <>,<+>
  
  
  -----------------------------------------------------------
  -- 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] -> Doc
  list            = encloseSep lbracket rbracket 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] -> Doc
  tupled          = encloseSep lparen   rparen  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] -> Doc
  semiBraces      = encloseSep lbrace   rbrace  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 -> Doc -> Doc -> [Doc] -> Doc
  encloseSep left right sep ds
      = case ds of
          []  -> left <> right
          [d] -> left <> d <> right
          _   -> align (cat (zipWith (<>) (left : repeat sep) ds) <> 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 -> [Doc] -> [Doc]
  punctuate p []      = []
  punctuate p [d]     = [d]
  punctuate p (d:ds)  = (d <> p) : punctuate p 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] -> Doc
  sep             = group . 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] -> Doc
  fillSep         = fold (</>)
  
  -- | The document @(hsep xs)@ concatenates all documents @xs@
  -- horizontally with @(\<+\>)@.
  hsep :: [Doc] -> Doc
  hsep            = fold (<+>)
  
  
  -- | 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] -> Doc
  vsep            = fold (<$>)
  
  -- | 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] -> Doc
  cat             = group . 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] -> Doc
  fillCat         = fold (<//>)
  
  -- | The document @(hcat xs)@ concatenates all documents @xs@
  -- horizontally with @(\<\>)@.
  hcat :: [Doc] -> Doc
  hcat            = fold (<>)
  
  -- | 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] -> Doc
  vcat            = fold (<$$>)
  
  fold f []       = empty
  fold f ds       = foldr1 f 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 -> Doc -> Doc
  x <> y          = x `beside` y
  
  -- | The document @(x \<+\> y)@ concatenates document @x@ and @y@ with a
  -- @space@ in between.  (infixr 6)
  (<+>) :: Doc -> Doc -> Doc
  x <+> y         = x <> space <> 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 -> Doc -> Doc
  x </> y         = x <> softline <> 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 -> Doc -> Doc
  x <//> y        = x <> softbreak <> y
  
  -- | The document @(x \<$\> y)@ concatenates document @x@ and @y@ with a
  -- 'line' in between. (infixr 5)
  (<$>) :: Doc -> Doc -> Doc
  x <$> y         = x <> line <> y
  
  -- | The document @(x \<$$\> y)@ concatenates document @x@ and @y@ with
  -- a @linebreak@ in between. (infixr 5)
  (<$$>) :: Doc -> Doc -> Doc
  x <$$> y        = x <> linebreak <> y
  
  -- | The document @softline@ behaves like 'space' if the resulting
  -- output fits the page, otherwise it behaves like 'line'.
  --
  -- > softline = group line
  softline :: Doc
  softline        = group line
  
  -- | The document @softbreak@ behaves like 'empty' if the resulting
  -- output fits the page, otherwise it behaves like 'line'.
  --
  -- > softbreak  = group linebreak
  softbreak :: Doc
  softbreak       = group linebreak
  
  -- | Document @(squotes x)@ encloses document @x@ with single quotes
  -- \"'\".
  squotes :: Doc -> Doc
  squotes         = enclose squote squote
  
  -- | Document @(dquotes x)@ encloses document @x@ with double quotes
  -- '\"'.
  dquotes :: Doc -> Doc
  dquotes         = enclose dquote dquote
  
  -- | Document @(braces x)@ encloses document @x@ in braces, \"{\" and
  -- \"}\".
  braces :: Doc -> Doc
  braces          = enclose lbrace rbrace
  
  -- | Document @(parens x)@ encloses document @x@ in parenthesis, \"(\"
  -- and \")\".
  parens :: Doc -> Doc
  parens          = enclose lparen rparen
  
  -- | Document @(angles x)@ encloses document @x@ in angles, \"\<\" and
  -- \"\>\".
  angles :: Doc -> Doc
  angles          = enclose langle rangle
  
  -- | Document @(brackets x)@ encloses document @x@ in square brackets,
  -- \"[\" and \"]\".
  brackets :: Doc -> Doc
  brackets        = enclose lbracket 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 -> Doc -> Doc -> Doc
  enclose l r x   = l <> x <> r
  
  -- | The document @lparen@ contains a left parenthesis, \"(\".
  lparen :: Doc
  lparen          = char '('
  -- | The document @rparen@ contains a right parenthesis, \")\".
  rparen :: Doc
  rparen          = char ')'
  -- | The document @langle@ contains a left angle, \"\<\".
  langle :: Doc
  langle          = char '<'
  -- | The document @rangle@ contains a right angle, \">\".
  rangle :: Doc
  rangle          = char '>'
  -- | The document @lbrace@ contains a left brace, \"{\".
  lbrace :: Doc
  lbrace          = char '{'
  -- | The document @rbrace@ contains a right brace, \"}\".
  rbrace :: Doc
  rbrace          = char '}'
  -- | The document @lbracket@ contains a left square bracket, \"[\".
  lbracket :: Doc
  lbracket        = char '['
  -- | The document @rbracket@ contains a right square bracket, \"]\".
  rbracket :: Doc
  rbracket        = char ']'
  
  
  -- | The document @squote@ contains a single quote, \"'\".
  squote :: Doc
  squote          = char '\''
  -- | The document @dquote@ contains a double quote, '\"'.
  dquote :: Doc
  dquote          = char '"'
  -- | The document @semi@ contains a semi colon, \";\".
  semi :: Doc
  semi            = char ';'
  -- | The document @colon@ contains a colon, \":\".
  colon :: Doc
  colon           = char ':'
  -- | The document @comma@ contains a comma, \",\".
  comma :: Doc
  comma           = char ','
  -- | The document @space@ contains a single space, \" \".
  --
  -- > x <+> y   = x <> space <> y
  space :: Doc
  space           = char ' '
  -- | The document @dot@ contains a single dot, \".\".
  dot :: Doc
  dot             = char '.'
  -- | The document @backslash@ contains a back slash, \"\\\".
  backslash :: Doc
  backslash       = char '\\'
  -- | The document @equals@ contains an equal sign, \"=\".
  equals :: Doc
  equals          = 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
  string ""       = empty
  string ('\n':s) = line <> string s
  string s        = case (span (/='\n') s) of
                      (xs,ys) -> text xs <> string ys
  
  bool :: Bool -> Doc
  bool b          = text (show b)
  
  -- | The document @(int i)@ shows the literal integer @i@ using
  -- 'text'.
  int :: Int -> Doc
  int i           = text (show i)
  
  -- | The document @(integer i)@ shows the literal integer @i@ using
  -- 'text'.
  integer :: Integer -> Doc
  integer i       = text (show i)
  
  -- | The document @(float f)@ shows the literal float @f@ using
  -- 'text'.
  float :: Float -> Doc
  float f         = text (show f)
  
  -- | The document @(double d)@ shows the literal double @d@ using
  -- 'text'.
  double :: Double -> Doc
  double d        = text (show d)
  
  -- | The document @(rational r)@ shows the literal rational @r@ using
  -- 'text'.
  rational :: Rational -> Doc
  rational r      = text (show r)
  
  
  -----------------------------------------------------------
  -- overloading "pretty"
  -----------------------------------------------------------
  
  -- | The member @prettyList@ is only used to define the @instance Pretty
  -- a => Pretty [a]@. In normal circumstances only the @pretty@ function
  -- is used.
  class Pretty a where
    pretty        :: a -> Doc
    prettyList    :: [a] -> Doc
    prettyList    = list . map pretty
  
  instance Pretty a => Pretty [a] where
    pretty        = prettyList
  
  instance Pretty Doc where
    pretty        = id
  
  instance Pretty () where
    pretty ()     = text "()"
  
  instance Pretty Bool where
    pretty b      = bool b
  
  instance Pretty Char where
    pretty c      = char c
    prettyList s  = string s
  
  instance Pretty Int where
    pretty i      = int i
  
  instance Pretty Integer where
    pretty i      = integer i
  
  instance Pretty Float where
    pretty f      = float f
  
  instance Pretty Double where
    pretty d      = double d
  
  
  --instance Pretty Rational where
  --  pretty r      = rational r
  
  instance (Pretty a,Pretty b) => Pretty (a,b) where
    pretty (x,y)  = tupled [pretty x, pretty y]
  
  instance (Pretty a,Pretty b,Pretty c) => Pretty (a,b,c) where
    pretty (x,y,z)= tupled [pretty x, pretty y, pretty z]
  
  instance Pretty a => Pretty (Maybe a) where
    pretty Nothing        = empty
    pretty (Just x)       = pretty x
  
  
  
  -----------------------------------------------------------
  -- 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
  --     nest   :: Int -> Doc -> Doc
  --     linebreak
  --            :: Doc
  -- @
  fillBreak :: Int -> Doc -> Doc
  fillBreak f x   = width x (\w ->
                    if (w > f) then nest f linebreak
                               else text (spaces (f - 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")
  -- >          ,("nest","Int -> Doc -> Doc")
  -- >          ,("linebreak","Doc")]
  -- >
  -- > 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
  --     nest   :: Int -> Doc -> Doc
  --     linebreak :: Doc
  -- @
  fill :: Int -> Doc -> Doc
  fill f d        = width d (\w ->
                    if (w >= f) then empty
                                else text (spaces (f - w)))
  
  width :: Doc -> (Int -> Doc) -> Doc
  width d f       = column (\k1 -> d <> column (\k2 -> f (k2 - 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 -> Doc
  indent i d      = hang i (text (spaces i) <> 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 -> Doc
  hang i d        = align (nest i 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 -> Doc
  align d         = column (\k ->
                    nesting (\i -> nest (k - i) d))   --nesting might be negative :-)
  
  
  
  -----------------------------------------------------------
  -- Primitives
  -----------------------------------------------------------
  
  -- | The abstract data type @Doc@ represents pretty documents.
  --
  -- @Doc@ 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        = 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 Doc
                  | Nest !Int Doc
                  | Union Doc Doc         -- invariant: first lines of first doc longer than the first lines of the second doc
                  | Column  (Int -> Doc)
                  | Nesting (Int -> Doc)
  
  isEmpty :: Doc -> Bool
  isEmpty Empty = True
  isEmpty _     = False
  
  -- | The data type @SimpleDoc@ 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@ to your own output format.
  data SimpleDoc  = SEmpty
                  | SChar Char SimpleDoc
                  | SText !Int String SimpleDoc
                  | SLine !Int SimpleDoc
  
  
  -- | 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
  empty           = 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
  char '\n'       = line
  char c          = 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
  text ""         = Empty
  text s          = Text (length s) s
  
  -- | The @line@ document advances to the next line and indents to the
  -- current nesting level. Document @line@ behaves like @(text \" \")@
  -- if the line break is undone by 'group'.
  line :: Doc
  line            = Line 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
  linebreak       = Line True
  
  beside x y      = Cat x 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 -> Doc
  nest i x        = Nest i x
  
  column, nesting :: (Int -> Doc) -> Doc
  column f        = Column f
  nesting f       = Nesting 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 -> Doc
  group x         = Union (flatten x) x
  
  flatten :: Doc -> Doc
  flatten (Cat x y)       = Cat (flatten x) (flatten y)
  flatten (Nest i x)      = Nest i (flatten x)
  flatten (Line break)    = if break then Empty else Text 1 " "
  flatten (Union x y)     = flatten x
  flatten (Column f)      = Column (flatten . f)
  flatten (Nesting f)     = Nesting (flatten . f)
  flatten other           = other                     --Empty,Char,Text
  
  
  
  -----------------------------------------------------------
  -- Renderers
  -----------------------------------------------------------
  
  -----------------------------------------------------------
  -- renderPretty: the default pretty printing algorithm
  -----------------------------------------------------------
  
  -- list of indentation/document pairs; saves an indirection over [(Int,Doc)]
  data Docs   = Nil
              | Cons !Int Doc Docs
  
  
  -- | 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 -> SimpleDoc
  renderPretty rfrac w x
      = best 0 0 (Cons 0 x Nil)
      where
        -- r :: the ribbon width in characters
        r  = max 0 (min w (round (fromIntegral w * rfrac)))
  
        -- best :: n = indentation of current line
        --         k = current column
        --        (ie. (k >= n) && (k - n == count of inserted characters)
        best n k Nil      = SEmpty
        best n k (Cons i d ds)
          = case d of
              Empty       -> best n k ds
              Char c      -> let k' = k+1 in seq k' (SChar c (best n k' ds))
              Text l s    -> let k' = k+l in seq k' (SText l s (best n k' ds))
              Line _      -> SLine i (best i i ds)
              Cat x y     -> best n k (Cons i x (Cons i y ds))
              Nest j x    -> let i' = i+j in seq i' (best n k (Cons i' x ds))
              Union x y   -> nicest n k (best n k (Cons i x ds))
                                        (best n k (Cons i y ds))
  
              Column f    -> best n k (Cons i (f k) ds)
              Nesting f   -> best n k (Cons i (f i) 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 n k x y    | fits width x  = x
                          | otherwise     = y
                          where
                            width = min (w - k) (r - k + n)
  
  
  fits w x        | w < 0         = False
  fits w SEmpty                   = True
  fits w (SChar c x)              = fits (w - 1) x
  fits w (SText l s x)            = fits (w - l) x
  fits w (SLine i x)              = True
  
  
  -----------------------------------------------------------
  -- 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 -> SimpleDoc
  renderCompact x
      = scan 0 [x]
      where
        scan k []     = SEmpty
        scan k (d:ds) = case d of
                          Empty       -> scan k ds
                          Char c      -> let k' = k+1 in seq k' (SChar c (scan k' ds))
                          Text l s    -> let k' = k+l in seq k' (SText l s (scan k' ds))
                          Line _      -> SLine 0 (scan 0 ds)
                          Cat x y     -> scan k (x:y:ds)
                          Nest j x    -> scan k (x:ds)
                          Union x y   -> scan k (y:ds)
                          Column f    -> scan k (f k:ds)
                          Nesting f   -> scan k (f 0:ds)
  
  
  
  -----------------------------------------------------------
  -- Displayers:  displayS and displayIO
  -----------------------------------------------------------
  
  
  -- | @(displayS simpleDoc)@ takes the output @simpleDoc@ from a
  -- rendering function and transforms it to a 'ShowS' type (for use in
  -- the 'Show' class).
  --
  -- > showWidth :: Int -> Doc -> String
  -- > showWidth w x   = displayS (renderPretty 0.4 w x) ""
  displayS :: SimpleDoc -> ShowS
  displayS SEmpty             = id
  displayS (SChar c x)        = showChar c . displayS x
  displayS (SText l s x)      = showString s . displayS x
  displayS (SLine i x)        = showString ('\n':indentation i) . displayS x
  
  
  -- | @(displayIO handle simpleDoc)@ writes @simpleDoc@ to the file
  -- handle @handle@. This function is used for example by 'hPutDoc':
  --
  -- > hPutDoc handle doc  = displayIO handle (renderPretty 0.4 100 doc)
  displayIO :: Handle -> SimpleDoc -> IO ()
  displayIO handle simpleDoc
      = display simpleDoc
      where
        display SEmpty        = return ()
        display (SChar c x)   = do{ hPutChar handle c; display x}
        display (SText l s x) = do{ hPutStr handle s; display x}
        display (SLine i x)   = do{ hPutStr handle ('\n':indentation i); display x}
  
  
  -----------------------------------------------------------
  -- default pretty printers: show, putDoc and hPutDoc
  -----------------------------------------------------------
  instance Show Doc where
    showsPrec d doc       = displayS (renderPretty 0.4 80 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 -> IO ()
  putDoc doc              = hPutDoc stdout 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 -> IO ()
  hPutDoc handle doc      = displayIO handle (renderPretty 0.4 80 doc)
  
  
  
  -----------------------------------------------------------
  -- insert spaces
  -- "indentation" used to insert tabs but tabs seem to cause
  -- more trouble than they solve :-)
  -----------------------------------------------------------
  spaces n        | n <= 0    = ""
                  | otherwise = replicate n ' '
  
  indentation n   = spaces n
  
  --indentation n   | n >= 8    = '\t' : indentation (n-8)
  --                | otherwise = spaces n
  
  --  LocalWords:  PPrint combinators Wadler Wadler's encloseSep
  