    {-# 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 Doc
    left Doc
    right Doc
    sep [Doc]
    ds
        = case [Doc]
    ds of
            []  -> Doc
    left Doc -> Doc -> Doc
    <> Doc
    right
            [Doc
    d] -> Doc
    left Doc -> Doc -> Doc
    <> Doc
    d Doc -> Doc -> Doc
    <> Doc
    right
            [Doc]
    _   -> 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 Doc
    p []      = []
    punctuate Doc
    p [Doc
    d]     = [Doc
    d]
    punctuate Doc
    p (Doc
    d:[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 Doc -> Doc -> Doc
    f []       = Doc
    empty
    fold Doc -> Doc -> Doc
    f [Doc]
    ds       = (Doc -> Doc -> Doc) -> [Doc] -> Doc
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 Doc -> Doc -> Doc
    f [Doc]
    ds

    Doc
    x <> :: Doc -> Doc -> Doc
    <> Doc
    y          = Doc
    x Doc -> Doc -> Doc
    `beside` Doc
    y
    Doc
    x <+> :: Doc -> Doc -> Doc
    <+> Doc
    y         = Doc
    x Doc -> Doc -> Doc
    <> Doc
    space Doc -> Doc -> Doc
    <> Doc
    y
    Doc
    x </> :: Doc -> Doc -> Doc
    </> Doc
    y         = Doc
    x Doc -> Doc -> Doc
    <> Doc
    softline Doc -> Doc -> Doc
    <> Doc
    y
    Doc
    x <//> :: Doc -> Doc -> Doc
    <//> Doc
    y        = Doc
    x Doc -> Doc -> Doc
    <> Doc
    softbreak Doc -> Doc -> Doc
    <> Doc
    y
    Doc
    x <$> :: Doc -> Doc -> Doc
    <$> Doc
    y         = Doc
    x Doc -> Doc -> Doc
    <> Doc
    line Doc -> Doc -> Doc
    <> Doc
    y
    Doc
    x <$$> :: Doc -> Doc -> Doc
    <$$> 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 Doc
    l Doc
    r Doc
    x   = Doc
    l Doc -> Doc -> Doc
    <> Doc
    x Doc -> Doc -> Doc
    <> Doc
    r

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

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

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

    -- string is like "text" but replaces '\n' by "line"
    string :: [Char] -> Doc
    string [Char]
    ""       = Doc
    empty
    string (Char
    '\n':[Char]
    s) = Doc
    line Doc -> Doc -> Doc
    <> [Char] -> Doc
    string [Char]
    s
    string [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
    /=Char
    '\n') [Char]
    s) of
                        ([Char]
    xs,[Char]
    ys) -> [Char] -> Doc
    text [Char]
    xs Doc -> Doc -> Doc
    <> [Char] -> Doc
    string [Char]
    ys

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

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

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

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

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

    rational :: Rational -> Doc
    rational :: Rational -> Doc
    rational 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 [Char]
    "()"

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

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

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

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

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

    instance Pretty Double where
      pretty :: Double -> Doc
    pretty 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 (a
    x,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 (a
    x,b
    y,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 Maybe a
    Nothing        = Doc
    empty
      pretty (Just a
    x)       = a -> Doc
    forall a. Pretty a => a -> Doc
    pretty a
    x

    -----------------------------------------------------------
    -- semi primitive: fill and fillBreak
    -----------------------------------------------------------
    fillBreak :: Int -> Doc -> Doc
    fillBreak Int
    f Doc
    x   = Doc -> (Int -> Doc) -> Doc
    width Doc
    x (\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 Int
    f Doc
    d        = Doc -> (Int -> Doc) -> Doc
    width Doc
    d (\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 Doc
    d Int -> Doc
    f       = (Int -> Doc) -> Doc
    column (\Int
    k1 -> Doc
    d Doc -> Doc -> Doc
    <> (Int -> Doc) -> Doc
    column (\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 Int
    i 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 Int
    i Doc
    d        = Doc -> Doc
    align (Int -> Doc -> Doc
    nest Int
    i Doc
    d)

    align :: Doc -> Doc
    align Doc
    d         = (Int -> Doc) -> Doc
    column (\Int
    k ->
                      (Int -> Doc) -> Doc
    nesting (\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 Char
    '\n'       = Doc
    line
    char Char
    c          = Char -> Doc
    Char Char
    c

    text :: [Char] -> Doc
    text [Char]
    ""         = Doc
    Empty
    text [Char]
    s          = Int -> [Char] -> Doc
    Text ([Char] -> Int
    forall a. [a] -> 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 Doc
    x Doc
    y      = Doc -> Doc -> Doc
    Cat Doc
    x Doc
    y
    nest :: Int -> Doc -> Doc
    nest Int
    i Doc
    x        = Int -> Doc -> Doc
    Nest Int
    i Doc
    x
    column :: (Int -> Doc) -> Doc
    column Int -> Doc
    f        = (Int -> Doc) -> Doc
    Column Int -> Doc
    f
    nesting :: (Int -> Doc) -> Doc
    nesting Int -> Doc
    f       = (Int -> Doc) -> Doc
    Nesting Int -> Doc
    f
    group :: Doc -> Doc
    group Doc
    x         = Doc -> Doc -> Doc
    Union (Doc -> Doc
    flatten Doc
    x) Doc
    x

    flatten :: Doc -> Doc
    flatten :: Doc -> Doc
    flatten (Cat Doc
    x Doc
    y)       = Doc -> Doc -> Doc
    Cat (Doc -> Doc
    flatten Doc
    x) (Doc -> Doc
    flatten Doc
    y)
    flatten (Nest Int
    i Doc
    x)      = Int -> Doc -> Doc
    Nest Int
    i (Doc -> Doc
    flatten Doc
    x)
    flatten (Line Bool
    break)    = if Bool
    break then Doc
    Empty else Int -> [Char] -> Doc
    Text Int
    1 [Char]
    " "
    flatten (Union Doc
    x Doc
    y)     = Doc -> Doc
    flatten Doc
    x
    flatten (Column 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 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 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 Float
    rfrac Int
    w Doc
    x
        = Int -> Int -> Docs -> SimpleDoc
    best Int
    0 Int
    0 (Int -> Doc -> Docs -> Docs
    Cons Int
    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 Int
    0 (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    w (Float -> Int
    forall b. Integral b => Float -> b
    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 Int
    n Int
    k Docs
    Nil      = SimpleDoc
    SEmpty
          best Int
    n Int
    k (Cons Int
    i Doc
    d Docs
    ds)
            = case Doc
    d of
                Doc
    Empty       -> Int -> Int -> Docs -> SimpleDoc
    best Int
    n Int
    k Docs
    ds
                Char Char
    c      -> let k' :: Int
    k' = Int
    kInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    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 Int
    l [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 Bool
    _      -> Int -> SimpleDoc -> SimpleDoc
    SLine Int
    i (Int -> Int -> Docs -> SimpleDoc
    best Int
    i Int
    i Docs
    ds)
                Cat Doc
    x 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 Int
    j 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 Doc
    x 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 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 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 Int
    n Int
    k SimpleDoc
    x 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 Int
    w SimpleDoc
    x        | Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0         = Bool
    False
    fits Int
    w SimpleDoc
    SEmpty                   = Bool
    True
    fits Int
    w (SChar Char
    c SimpleDoc
    x)              = Int -> SimpleDoc -> Bool
    fits (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) SimpleDoc
    x
    fits Int
    w (SText Int
    l [Char]
    s SimpleDoc
    x)            = Int -> SimpleDoc -> Bool
    fits (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    l) SimpleDoc
    x
    fits Int
    w (SLine Int
    i SimpleDoc
    x)              = Bool
    True

    -----------------------------------------------------------
    -- renderCompact: renders documents without indentation
    --  fast and fewer characters output, good for machines
    -----------------------------------------------------------
    renderCompact :: Doc -> SimpleDoc
    renderCompact :: Doc -> SimpleDoc
    renderCompact Doc
    x
        = Int -> [Doc] -> SimpleDoc
    scan Int
    0 [Doc
    x]
        where
          scan :: Int -> [Doc] -> SimpleDoc
    scan Int
    k []     = SimpleDoc
    SEmpty
          scan Int
    k (Doc
    d:[Doc]
    ds) = case Doc
    d of
                            Doc
    Empty       -> Int -> [Doc] -> SimpleDoc
    scan Int
    k [Doc]
    ds
                            Char Char
    c      -> let k' :: Int
    k' = Int
    kInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    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 Int
    l [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 Bool
    _      -> Int -> SimpleDoc -> SimpleDoc
    SLine Int
    0 (Int -> [Doc] -> SimpleDoc
    scan Int
    0 [Doc]
    ds)
                            Cat Doc
    x 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 Int
    j Doc
    x    -> Int -> [Doc] -> SimpleDoc
    scan Int
    k (Doc
    xDoc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :[Doc]
    ds)
                            Union Doc
    x Doc
    y   -> Int -> [Doc] -> SimpleDoc
    scan Int
    k (Doc
    yDoc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :[Doc]
    ds)
                            Column Int -> Doc
    f    -> Int -> [Doc] -> SimpleDoc
    scan Int
    k (Int -> Doc
    f Int
    kDoc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :[Doc]
    ds)
                            Nesting Int -> Doc
    f   -> Int -> [Doc] -> SimpleDoc
    scan Int
    k (Int -> Doc
    f Int
    0Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :[Doc]
    ds)

    -----------------------------------------------------------
    -- Displayers:  displayS and displayIO
    -----------------------------------------------------------
    displayS :: SimpleDoc -> ShowS
    displayS :: SimpleDoc -> ShowS
    displayS SimpleDoc
    SEmpty             = ShowS
    forall a. a -> a
    id
    displayS (SChar Char
    c 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 Int
    l [Char]
    s 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 Int
    i SimpleDoc
    x)        = [Char] -> ShowS
    showString (Char
    '\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 SimpleDoc
    simpleDoc
        = SimpleDoc -> IO ()
    display SimpleDoc
    simpleDoc
        where
          display :: SimpleDoc -> IO ()
    display SimpleDoc
    SEmpty        = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          display (SChar Char
    c SimpleDoc
    x)   = do{ Handle -> Char -> IO ()
    hPutChar Handle
    handle Char
    c; SimpleDoc -> IO ()
    display SimpleDoc
    x}
          display (SText Int
    l [Char]
    s SimpleDoc
    x) = do{ Handle -> [Char] -> IO ()
    hPutStr Handle
    handle [Char]
    s; SimpleDoc -> IO ()
    display SimpleDoc
    x}
          display (SLine Int
    i SimpleDoc
    x)   = do{ Handle -> [Char] -> IO ()
    hPutStr Handle
    handle (Char
    '\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 Int
    d Doc
    doc       = SimpleDoc -> ShowS
    displayS (Float -> Int -> Doc -> SimpleDoc
    renderPretty Float
    0.4 Int
    80 Doc
    doc)

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

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

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

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

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