    {-# LANGUAGE CPP #-}

    --------------------------------------------------------------------------------
    {-| Module      :  PPrint
        Copyright   :  (c) Daan Leijen 2000, <http://www.cs.uu.nl/~daan>
        Version      : $version: $

        Maintainer  :  daan@cs.uu.nl
        Stability   :  provisional
        Portability :  portable

        Pretty print library based on Philip Wadlers "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>

        Haskell98 compatible
    -}
    ---------------------------------------------------------------------------------
    module UU.PPrint
            ( Doc
            , Pretty, pretty

            , show, putDoc, hPutDoc

            , (<>)
            , (<+>)
            , (</>), (<//>)
            , (<$>), (<$$>)

            , sep, fillSep, hsep, vsep
            , cat, fillCat, hcat, vcat
            , punctuate

            , align, hang, indent
            , fill, fillBreak

            , list, tupled, semiBraces, encloseSep
            , angles, langle, rangle
            , parens, lparen, rparen
            , braces, lbrace, rbrace
            , brackets, lbracket, rbracket
            , dquotes, dquote, squotes, squote

            , comma, space, dot, backslash
            , semi, colon, equals

            , string, bool, int, integer, float, double, rational

            , softline, softbreak
            , empty, char, text, line, linebreak, nest, group
            , column, nesting, width

            , SimpleDoc(..)
            , renderPretty, renderCompact
            , displayS, displayIO
            ) where

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

    #if __GLASGOW_HASKELL__ >= 800
    import Prelude hiding ((<$>),(<>))
    #elif __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.
    -----------------------------------------------------------
    list :: [Doc] -> Doc
    list            = Doc -> Doc -> Doc -> [Doc] -> Doc
    encloseSep Doc
    lbracket Doc
    rbracket Doc
    comma
    tupled :: [Doc] -> Doc
    tupled          = Doc -> Doc -> Doc -> [Doc] -> Doc
    encloseSep Doc
    lparen   Doc
    rparen  Doc
    comma
    semiBraces :: [Doc] -> Doc
    semiBraces      = Doc -> Doc -> Doc -> [Doc] -> Doc
    encloseSep Doc
    lbrace   Doc
    rbrace  Doc
    semi

    encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc
    encloseSep left :: Doc
    left right :: Doc
    right sep :: Doc
    sep ds :: [Doc]
    ds
        = case [Doc]
    ds of
            []  -> Doc
    left Doc -> Doc -> Doc
    <> Doc
    right
            [d :: Doc
    d] -> Doc
    left Doc -> Doc -> Doc
    <> Doc
    d Doc -> Doc -> Doc
    <> Doc
    right
            _   -> Doc -> Doc
    align ([Doc] -> Doc
    cat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Doc -> Doc -> Doc
    (<>) (Doc
    left Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : Doc -> [Doc]
    forall a. a -> [a]
    repeat Doc
    sep) [Doc]
    ds) Doc -> Doc -> Doc
    <> Doc
    right)

    -----------------------------------------------------------
    -- punctuate p [d1,d2,...,dn] => [d1 <> p,d2 <> p, ... ,dn]
    -----------------------------------------------------------
    punctuate :: Doc -> [Doc] -> [Doc]
    punctuate p :: Doc
    p []      = []
    punctuate p :: Doc
    p [d :: Doc
    d]     = [Doc
    d]
    punctuate p :: Doc
    p (d :: Doc
    d:ds :: [Doc]
    ds)  = (Doc
    d Doc -> Doc -> Doc
    <> Doc
    p) Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : Doc -> [Doc] -> [Doc]
    punctuate Doc
    p [Doc]
    ds

    -----------------------------------------------------------
    -- high-level combinators
    -----------------------------------------------------------
    sep :: [Doc] -> Doc
    sep             = Doc -> Doc
    group (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    vsep
    fillSep :: [Doc] -> Doc
    fillSep         = (Doc -> Doc -> Doc) -> [Doc] -> Doc
    fold Doc -> Doc -> Doc
    (</>)
    hsep :: [Doc] -> Doc
    hsep            = (Doc -> Doc -> Doc) -> [Doc] -> Doc
    fold Doc -> Doc -> Doc
    (<+>)
    vsep :: [Doc] -> Doc
    vsep            = (Doc -> Doc -> Doc) -> [Doc] -> Doc
    fold Doc -> Doc -> Doc
    (<$>)

    cat :: [Doc] -> Doc
    cat             = Doc -> Doc
    group (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    vcat
    fillCat :: [Doc] -> Doc
    fillCat         = (Doc -> Doc -> Doc) -> [Doc] -> Doc
    fold Doc -> Doc -> Doc
    (<//>)
    hcat :: [Doc] -> Doc
    hcat            = (Doc -> Doc -> Doc) -> [Doc] -> Doc
    fold Doc -> Doc -> Doc
    (<>)
    vcat :: [Doc] -> Doc
    vcat            = (Doc -> Doc -> Doc) -> [Doc] -> Doc
    fold Doc -> Doc -> Doc
    (<$$>)

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

    x :: Doc
    x <> :: Doc -> Doc -> Doc
    <> y :: Doc
    y          = Doc
    x Doc -> Doc -> Doc
    `beside` Doc
    y
    x :: Doc
    x <+> :: Doc -> Doc -> Doc
    <+> y :: Doc
    y         = Doc
    x Doc -> Doc -> Doc
    <> Doc
    space Doc -> Doc -> Doc
    <> Doc
    y
    x :: Doc
    x </> :: Doc -> Doc -> Doc
    </> y :: Doc
    y         = Doc
    x Doc -> Doc -> Doc
    <> Doc
    softline Doc -> Doc -> Doc
    <> Doc
    y
    x :: Doc
    x <//> :: Doc -> Doc -> Doc
    <//> y :: Doc
    y        = Doc
    x Doc -> Doc -> Doc
    <> Doc
    softbreak Doc -> Doc -> Doc
    <> Doc
    y
    x :: Doc
    x <$> :: Doc -> Doc -> Doc
    <$> y :: Doc
    y         = Doc
    x Doc -> Doc -> Doc
    <> Doc
    line Doc -> Doc -> Doc
    <> Doc
    y
    x :: Doc
    x <$$> :: Doc -> Doc -> Doc
    <$$> y :: Doc
    y        = Doc
    x Doc -> Doc -> Doc
    <> Doc
    linebreak Doc -> Doc -> Doc
    <> Doc
    y

    softline :: Doc
    softline        = Doc -> Doc
    group Doc
    line
    softbreak :: Doc
    softbreak       = Doc -> Doc
    group Doc
    linebreak

    squotes :: Doc -> Doc
    squotes         = Doc -> Doc -> Doc -> Doc
    enclose Doc
    squote Doc
    squote
    dquotes :: Doc -> Doc
    dquotes         = Doc -> Doc -> Doc -> Doc
    enclose Doc
    dquote Doc
    dquote
    braces :: Doc -> Doc
    braces          = Doc -> Doc -> Doc -> Doc
    enclose Doc
    lbrace Doc
    rbrace
    parens :: Doc -> Doc
    parens          = Doc -> Doc -> Doc -> Doc
    enclose Doc
    lparen Doc
    rparen
    angles :: Doc -> Doc
    angles          = Doc -> Doc -> Doc -> Doc
    enclose Doc
    langle Doc
    rangle
    brackets :: Doc -> Doc
    brackets        = Doc -> Doc -> Doc -> Doc
    enclose Doc
    lbracket Doc
    rbracket
    enclose :: Doc -> Doc -> Doc -> Doc
    enclose l :: Doc
    l r :: Doc
    r x :: Doc
    x   = Doc
    l Doc -> Doc -> Doc
    <> Doc
    x Doc -> Doc -> Doc
    <> Doc
    r

    lparen :: Doc
    lparen          = Char -> Doc
    char '('
    rparen :: Doc
    rparen          = Char -> Doc
    char ')'
    langle :: Doc
    langle          = Char -> Doc
    char '<'
    rangle :: Doc
    rangle          = Char -> Doc
    char '>'
    lbrace :: Doc
    lbrace          = Char -> Doc
    char '{'
    rbrace :: Doc
    rbrace          = Char -> Doc
    char '}'
    lbracket :: Doc
    lbracket        = Char -> Doc
    char '['
    rbracket :: Doc
    rbracket        = Char -> Doc
    char ']'

    squote :: Doc
    squote          = Char -> Doc
    char '\''
    dquote :: Doc
    dquote          = Char -> Doc
    char '"'
    semi :: Doc
    semi            = Char -> Doc
    char ';'
    colon :: Doc
    colon           = Char -> Doc
    char ':'
    comma :: Doc
    comma           = Char -> Doc
    char ','
    space :: Doc
    space           = Char -> Doc
    char ' '
    dot :: Doc
    dot             = Char -> Doc
    char '.'
    backslash :: Doc
    backslash       = Char -> Doc
    char '\\'
    equals :: Doc
    equals          = Char -> Doc
    char '='

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

    -- string is like "text" but replaces '\n' by "line"
    string :: [Char] -> Doc
    string ""       = Doc
    empty
    string ('\n':s :: [Char]
    s) = Doc
    line Doc -> Doc -> Doc
    <> [Char] -> Doc
    string [Char]
    s
    string s :: [Char]
    s        = case ((Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /='\n') [Char]
    s) of
                        (xs :: [Char]
    xs,ys :: [Char]
    ys) -> [Char] -> Doc
    text [Char]
    xs Doc -> Doc -> Doc
    <> [Char] -> Doc
    string [Char]
    ys

    bool :: Bool -> Doc
    bool :: Bool -> Doc
    bool b :: Bool
    b          = [Char] -> Doc
    text (Bool -> [Char]
    forall a. Show a => a -> [Char]
    show Bool
    b)

    int :: Int -> Doc
    int :: Int -> Doc
    int i :: Int
    i           = [Char] -> Doc
    text (Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i)

    integer :: Integer -> Doc
    integer :: Integer -> Doc
    integer i :: Integer
    i       = [Char] -> Doc
    text (Integer -> [Char]
    forall a. Show a => a -> [Char]
    show Integer
    i)

    float :: Float -> Doc
    float :: Float -> Doc
    float f :: Float
    f         = [Char] -> Doc
    text (Float -> [Char]
    forall a. Show a => a -> [Char]
    show Float
    f)

    double :: Double -> Doc
    double :: Double -> Doc
    double d :: Double
    d        = [Char] -> Doc
    text (Double -> [Char]
    forall a. Show a => a -> [Char]
    show Double
    d)

    rational :: Rational -> Doc
    rational :: Rational -> Doc
    rational r :: Rational
    r      = [Char] -> Doc
    text (Rational -> [Char]
    forall a. Show a => a -> [Char]
    show Rational
    r)

    -----------------------------------------------------------
    -- overloading "pretty"
    -----------------------------------------------------------
    class Pretty a where
      pretty        :: a -> Doc
      prettyList    :: [a] -> Doc
      prettyList    = [Doc] -> Doc
    list ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Doc) -> [a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Doc
    forall a. Pretty a => a -> Doc
    pretty

    instance Pretty a => Pretty [a] where
      pretty :: [a] -> Doc
    pretty        = [a] -> Doc
    forall a. Pretty a => [a] -> Doc
    prettyList

    instance Pretty Doc where
      pretty :: Doc -> Doc
    pretty        = Doc -> Doc
    forall a. a -> a
    id

    instance Pretty () where
      pretty :: () -> Doc
    pretty ()     = [Char] -> Doc
    text "()"

    instance Pretty Bool where
      pretty :: Bool -> Doc
    pretty b :: Bool
    b      = Bool -> Doc
    bool Bool
    b

    instance Pretty Char where
      pretty :: Char -> Doc
    pretty c :: Char
    c      = Char -> Doc
    char Char
    c
      prettyList :: [Char] -> Doc
    prettyList s :: [Char]
    s  = [Char] -> Doc
    string [Char]
    s

    instance Pretty Int where
      pretty :: Int -> Doc
    pretty i :: Int
    i      = Int -> Doc
    int Int
    i

    instance Pretty Integer where
      pretty :: Integer -> Doc
    pretty i :: Integer
    i      = Integer -> Doc
    integer Integer
    i

    instance Pretty Float where
      pretty :: Float -> Doc
    pretty f :: Float
    f      = Float -> Doc
    float Float
    f

    instance Pretty Double where
      pretty :: Double -> Doc
    pretty d :: Double
    d      = Double -> Doc
    double Double
    d

    --instance Pretty Rational where
    --  pretty r      = rational r

    instance (Pretty a,Pretty b) => Pretty (a,b) where
      pretty :: (a, b) -> Doc
    pretty (x :: a
    x,y :: b
    y)  = [Doc] -> Doc
    tupled [a -> Doc
    forall a. Pretty a => a -> Doc
    pretty a
    x, b -> Doc
    forall a. Pretty a => a -> Doc
    pretty b
    y]

    instance (Pretty a,Pretty b,Pretty c) => Pretty (a,b,c) where
      pretty :: (a, b, c) -> Doc
    pretty (x :: a
    x,y :: b
    y,z :: c
    z)= [Doc] -> Doc
    tupled [a -> Doc
    forall a. Pretty a => a -> Doc
    pretty a
    x, b -> Doc
    forall a. Pretty a => a -> Doc
    pretty b
    y, c -> Doc
    forall a. Pretty a => a -> Doc
    pretty c
    z]

    instance Pretty a => Pretty (Maybe a) where
      pretty :: Maybe a -> Doc
    pretty Nothing        = Doc
    empty
      pretty (Just x :: a
    x)       = a -> Doc
    forall a. Pretty a => a -> Doc
    pretty a
    x

    -----------------------------------------------------------
    -- semi primitive: fill and fillBreak
    -----------------------------------------------------------
    fillBreak :: Int -> Doc -> Doc
    fillBreak f :: Int
    f x :: Doc
    x   = Doc -> (Int -> Doc) -> Doc
    width Doc
    x (\w :: Int
    w ->
                      if (Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    f) then Int -> Doc -> Doc
    nest Int
    f Doc
    linebreak
                                 else [Char] -> Doc
    text (Int -> [Char]
    spaces (Int
    f Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    w)))

    fill :: Int -> Doc -> Doc
    fill f :: Int
    f d :: Doc
    d        = Doc -> (Int -> Doc) -> Doc
    width Doc
    d (\w :: Int
    w ->
                      if (Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    f) then Doc
    empty
                                  else [Char] -> Doc
    text (Int -> [Char]
    spaces (Int
    f Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    w)))

    width :: Doc -> (Int -> Doc) -> Doc
    width d :: Doc
    d f :: Int -> Doc
    f       = (Int -> Doc) -> Doc
    column (\k1 :: Int
    k1 -> Doc
    d Doc -> Doc -> Doc
    <> (Int -> Doc) -> Doc
    column (\k2 :: Int
    k2 -> Int -> Doc
    f (Int
    k2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    k1)))

    -----------------------------------------------------------
    -- semi primitive: Alignment and indentation
    -----------------------------------------------------------
    indent :: Int -> Doc -> Doc
    indent i :: Int
    i d :: Doc
    d      = Int -> Doc -> Doc
    hang Int
    i ([Char] -> Doc
    text (Int -> [Char]
    spaces Int
    i) Doc -> Doc -> Doc
    <> Doc
    d)

    hang :: Int -> Doc -> Doc
    hang i :: Int
    i d :: Doc
    d        = Doc -> Doc
    align (Int -> Doc -> Doc
    nest Int
    i Doc
    d)

    align :: Doc -> Doc
    align d :: Doc
    d         = (Int -> Doc) -> Doc
    column (\k :: Int
    k ->
                      (Int -> Doc) -> Doc
    nesting (\i :: Int
    i -> Int -> Doc -> Doc
    nest (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i) Doc
    d))   --nesting might be negative :-)

    -----------------------------------------------------------
    -- Primitives
    -----------------------------------------------------------
    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)

    data SimpleDoc  = SEmpty
                    | SChar Char SimpleDoc
                    | SText !Int String SimpleDoc
                    | SLine !Int SimpleDoc

    empty :: Doc
    empty           = Doc
    Empty

    char :: Char -> Doc
    char '\n'       = Doc
    line
    char c :: Char
    c          = Char -> Doc
    Char Char
    c

    text :: [Char] -> Doc
    text ""         = Doc
    Empty
    text s :: [Char]
    s          = Int -> [Char] -> Doc
    Text ([Char] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    s) [Char]
    s

    line :: Doc
    line            = Bool -> Doc
    Line Bool
    False
    linebreak :: Doc
    linebreak       = Bool -> Doc
    Line Bool
    True

    beside :: Doc -> Doc -> Doc
    beside x :: Doc
    x y :: Doc
    y      = Doc -> Doc -> Doc
    Cat Doc
    x Doc
    y
    nest :: Int -> Doc -> Doc
    nest i :: Int
    i x :: Doc
    x        = Int -> Doc -> Doc
    Nest Int
    i Doc
    x
    column :: (Int -> Doc) -> Doc
    column f :: Int -> Doc
    f        = (Int -> Doc) -> Doc
    Column Int -> Doc
    f
    nesting :: (Int -> Doc) -> Doc
    nesting f :: Int -> Doc
    f       = (Int -> Doc) -> Doc
    Nesting Int -> Doc
    f
    group :: Doc -> Doc
    group x :: Doc
    x         = Doc -> Doc -> Doc
    Union (Doc -> Doc
    flatten Doc
    x) Doc
    x

    flatten :: Doc -> Doc
    flatten :: Doc -> Doc
    flatten (Cat x :: Doc
    x y :: Doc
    y)       = Doc -> Doc -> Doc
    Cat (Doc -> Doc
    flatten Doc
    x) (Doc -> Doc
    flatten Doc
    y)
    flatten (Nest i :: Int
    i x :: Doc
    x)      = Int -> Doc -> Doc
    Nest Int
    i (Doc -> Doc
    flatten Doc
    x)
    flatten (Line break :: Bool
    break)    = if Bool
    break then Doc
    Empty else Int -> [Char] -> Doc
    Text 1 " "
    flatten (Union x :: Doc
    x y :: Doc
    y)     = Doc -> Doc
    flatten Doc
    x
    flatten (Column f :: Int -> Doc
    f)      = (Int -> Doc) -> Doc
    Column (Doc -> Doc
    flatten (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Doc
    f)
    flatten (Nesting f :: Int -> Doc
    f)     = (Int -> Doc) -> Doc
    Nesting (Doc -> Doc
    flatten (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Doc
    f)
    flatten other :: Doc
    other           = Doc
    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

    renderPretty :: Float -> Int -> Doc -> SimpleDoc
    renderPretty :: Float -> Int -> Doc -> SimpleDoc
    renderPretty rfrac :: Float
    rfrac w :: Int
    w x :: Doc
    x
        = Int -> Int -> Docs -> SimpleDoc
    best 0 0 (Int -> Doc -> Docs -> Docs
    Cons 0 Doc
    x Docs
    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 -> SimpleDoc
    best n :: Int
    n k :: Int
    k Nil      = SimpleDoc
    SEmpty
          best n :: Int
    n k :: Int
    k (Cons i :: Int
    i d :: Doc
    d ds :: Docs
    ds)
            = case Doc
    d of
                Empty       -> Int -> Int -> Docs -> SimpleDoc
    best Int
    n Int
    k Docs
    ds
                Char c :: Char
    c      -> let k' :: Int
    k' = Int
    kInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1 in Int -> SimpleDoc -> SimpleDoc
    forall a b. a -> b -> b
    seq Int
    k' (Char -> SimpleDoc -> SimpleDoc
    SChar Char
    c (Int -> Int -> Docs -> SimpleDoc
    best Int
    n Int
    k' Docs
    ds))
                Text l :: Int
    l s :: [Char]
    s    -> let k' :: Int
    k' = Int
    kInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    l in Int -> SimpleDoc -> SimpleDoc
    forall a b. a -> b -> b
    seq Int
    k' (Int -> [Char] -> SimpleDoc -> SimpleDoc
    SText Int
    l [Char]
    s (Int -> Int -> Docs -> SimpleDoc
    best Int
    n Int
    k' Docs
    ds))
                Line _      -> Int -> SimpleDoc -> SimpleDoc
    SLine Int
    i (Int -> Int -> Docs -> SimpleDoc
    best Int
    i Int
    i Docs
    ds)
                Cat x :: Doc
    x y :: Doc
    y     -> Int -> Int -> Docs -> SimpleDoc
    best Int
    n Int
    k (Int -> Doc -> Docs -> Docs
    Cons Int
    i Doc
    x (Int -> Doc -> Docs -> Docs
    Cons Int
    i Doc
    y Docs
    ds))
                Nest j :: Int
    j x :: Doc
    x    -> let i' :: Int
    i' = Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    j in Int -> SimpleDoc -> SimpleDoc
    forall a b. a -> b -> b
    seq Int
    i' (Int -> Int -> Docs -> SimpleDoc
    best Int
    n Int
    k (Int -> Doc -> Docs -> Docs
    Cons Int
    i' Doc
    x Docs
    ds))
                Union x :: Doc
    x y :: Doc
    y   -> Int -> Int -> SimpleDoc -> SimpleDoc -> SimpleDoc
    nicest Int
    n Int
    k (Int -> Int -> Docs -> SimpleDoc
    best Int
    n Int
    k (Int -> Doc -> Docs -> Docs
    Cons Int
    i Doc
    x Docs
    ds))
                                          (Int -> Int -> Docs -> SimpleDoc
    best Int
    n Int
    k (Int -> Doc -> Docs -> Docs
    Cons Int
    i Doc
    y Docs
    ds))

                Column f :: Int -> Doc
    f    -> Int -> Int -> Docs -> SimpleDoc
    best Int
    n Int
    k (Int -> Doc -> Docs -> Docs
    Cons Int
    i (Int -> Doc
    f Int
    k) Docs
    ds)
                Nesting f :: Int -> Doc
    f   -> Int -> Int -> Docs -> SimpleDoc
    best Int
    n Int
    k (Int -> Doc -> Docs -> Docs
    Cons Int
    i (Int -> Doc
    f Int
    i) Docs
    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 -> SimpleDoc -> SimpleDoc
    nicest n :: Int
    n k :: Int
    k x :: SimpleDoc
    x y :: SimpleDoc
    y    | Int -> SimpleDoc -> Bool
    fits Int
    width SimpleDoc
    x  = SimpleDoc
    x
                            | Bool
    otherwise     = SimpleDoc
    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 -> Bool
    fits w :: Int
    w x :: SimpleDoc
    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
    x)              = Int -> SimpleDoc -> Bool
    fits (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1) SimpleDoc
    x
    fits w :: Int
    w (SText l :: Int
    l s :: [Char]
    s x :: SimpleDoc
    x)            = Int -> SimpleDoc -> Bool
    fits (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    l) SimpleDoc
    x
    fits w :: Int
    w (SLine i :: Int
    i x :: SimpleDoc
    x)              = Bool
    True

    -----------------------------------------------------------
    -- renderCompact: renders documents without indentation
    --  fast and fewer characters output, good for machines
    -----------------------------------------------------------
    renderCompact :: Doc -> SimpleDoc
    renderCompact :: Doc -> SimpleDoc
    renderCompact x :: Doc
    x
        = Int -> [Doc] -> SimpleDoc
    scan 0 [Doc
    x]
        where
          scan :: Int -> [Doc] -> SimpleDoc
    scan k :: Int
    k []     = SimpleDoc
    SEmpty
          scan k :: Int
    k (d :: Doc
    d:ds :: [Doc]
    ds) = case Doc
    d of
                            Empty       -> Int -> [Doc] -> SimpleDoc
    scan Int
    k [Doc]
    ds
                            Char c :: Char
    c      -> let k' :: Int
    k' = Int
    kInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1 in Int -> SimpleDoc -> SimpleDoc
    forall a b. a -> b -> b
    seq Int
    k' (Char -> SimpleDoc -> SimpleDoc
    SChar Char
    c (Int -> [Doc] -> SimpleDoc
    scan Int
    k' [Doc]
    ds))
                            Text l :: Int
    l s :: [Char]
    s    -> let k' :: Int
    k' = Int
    kInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    l in Int -> SimpleDoc -> SimpleDoc
    forall a b. a -> b -> b
    seq Int
    k' (Int -> [Char] -> SimpleDoc -> SimpleDoc
    SText Int
    l [Char]
    s (Int -> [Doc] -> SimpleDoc
    scan Int
    k' [Doc]
    ds))
                            Line _      -> Int -> SimpleDoc -> SimpleDoc
    SLine 0 (Int -> [Doc] -> SimpleDoc
    scan 0 [Doc]
    ds)
                            Cat x :: Doc
    x y :: Doc
    y     -> Int -> [Doc] -> SimpleDoc
    scan Int
    k (Doc
    xDoc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :Doc
    yDoc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :[Doc]
    ds)
                            Nest j :: Int
    j x :: Doc
    x    -> Int -> [Doc] -> SimpleDoc
    scan Int
    k (Doc
    xDoc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :[Doc]
    ds)
                            Union x :: Doc
    x y :: Doc
    y   -> Int -> [Doc] -> SimpleDoc
    scan Int
    k (Doc
    yDoc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :[Doc]
    ds)
                            Column f :: Int -> Doc
    f    -> Int -> [Doc] -> SimpleDoc
    scan Int
    k (Int -> Doc
    f Int
    kDoc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :[Doc]
    ds)
                            Nesting f :: Int -> Doc
    f   -> Int -> [Doc] -> SimpleDoc
    scan Int
    k (Int -> Doc
    f 0Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :[Doc]
    ds)

    -----------------------------------------------------------
    -- Displayers:  displayS and displayIO
    -----------------------------------------------------------
    displayS :: SimpleDoc -> ShowS
    displayS :: SimpleDoc -> ShowS
    displayS SEmpty             = ShowS
    forall a. a -> a
    id
    displayS (SChar c :: Char
    c x :: SimpleDoc
    x)        = Char -> ShowS
    showChar Char
    c ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SimpleDoc -> ShowS
    displayS SimpleDoc
    x
    displayS (SText l :: Int
    l s :: [Char]
    s x :: SimpleDoc
    x)      = [Char] -> ShowS
    showString [Char]
    s ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SimpleDoc -> ShowS
    displayS SimpleDoc
    x
    displayS (SLine i :: Int
    i x :: SimpleDoc
    x)        = [Char] -> ShowS
    showString ('\n'Char -> ShowS
    forall a. a -> [a] -> [a]
    :Int -> [Char]
    indentation Int
    i) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SimpleDoc -> ShowS
    displayS SimpleDoc
    x

    displayIO :: Handle -> SimpleDoc -> IO ()
    displayIO :: Handle -> SimpleDoc -> IO ()
    displayIO handle :: Handle
    handle simpleDoc :: SimpleDoc
    simpleDoc
        = SimpleDoc -> IO ()
    display SimpleDoc
    simpleDoc
        where
          display :: SimpleDoc -> IO ()
    display SEmpty        = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          display (SChar c :: Char
    c x :: SimpleDoc
    x)   = do{ Handle -> Char -> IO ()
    hPutChar Handle
    handle Char
    c; SimpleDoc -> IO ()
    display SimpleDoc
    x}
          display (SText l :: Int
    l s :: [Char]
    s x :: SimpleDoc
    x) = do{ Handle -> [Char] -> IO ()
    hPutStr Handle
    handle [Char]
    s; SimpleDoc -> IO ()
    display SimpleDoc
    x}
          display (SLine i :: Int
    i x :: SimpleDoc
    x)   = do{ Handle -> [Char] -> IO ()
    hPutStr Handle
    handle ('\n'Char -> ShowS
    forall a. a -> [a] -> [a]
    :Int -> [Char]
    indentation Int
    i); SimpleDoc -> IO ()
    display SimpleDoc
    x}

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

    putDoc :: Doc -> IO ()
    putDoc :: Doc -> IO ()
    putDoc doc :: Doc
    doc              = Handle -> Doc -> IO ()
    hPutDoc Handle
    stdout Doc
    doc

    hPutDoc :: Handle -> Doc -> IO ()
    hPutDoc :: Handle -> Doc -> IO ()
    hPutDoc handle :: Handle
    handle doc :: Doc
    doc      = Handle -> SimpleDoc -> IO ()
    displayIO Handle
    handle (Float -> Int -> Doc -> SimpleDoc
    renderPretty 0.4 80 Doc
    doc)

    -----------------------------------------------------------
    -- insert spaces
    -- "indentation" used to insert tabs but tabs seem to cause
    -- more trouble than they solve :-)
    -----------------------------------------------------------
    spaces :: Int -> [Char]
    spaces n :: Int
    n        | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0    = ""
                    | Bool
    otherwise = Int -> Char -> [Char]
    forall a. Int -> a -> [a]
    replicate Int
    n ' '

    indentation :: Int -> [Char]
    indentation n :: Int
    n   = Int -> [Char]
    spaces Int
    n

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