    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Text.Html
    -- Copyright   :  (c) Andy Gill and OGI, 1999-2001
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  Andy Gill <andy@galconn.com>
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- An Html combinator library
    --
    -----------------------------------------------------------------------------

    module Text.Html (
          module Text.Html,
          ) where

    import qualified Text.Html.BlockTable as BT

    infixr 3 </>  -- combining table cells
    infixr 4 <->  -- combining table cells
    infixr 2 +++  -- combining Html
    infixr 7 <<   -- nesting Html
    infixl 8 !    -- adding optional arguments

    -- A important property of Html is that all strings inside the
    -- structure are already in Html friendly format.
    -- For example, use of &gt;,etc.

    data HtmlElement
    {-
     -    ..just..plain..normal..text... but using &copy; and &amb;, etc.
     -}
          = HtmlString String
    {-
     -    <thetag {..attrs..}> ..content.. </thetag>
     -}
          | HtmlTag {                   -- tag with internal markup
                  HtmlElement -> String
    markupTag      :: String,
                  HtmlElement -> [HtmlAttr]
    markupAttrs    :: [HtmlAttr],
                  HtmlElement -> Html
    markupContent  :: Html
                  }

    {- These are the index-value pairs.
     - The empty string is a synonym for tags with no arguments.
     - (not strictly HTML, but anyway).
     -}

    data HtmlAttr = HtmlAttr String String

    newtype Html = Html { Html -> [HtmlElement]
    getHtmlElements :: [HtmlElement] }

    -- Read MARKUP as the class of things that can be validly rendered
    -- inside MARKUP tag brackets. So this can be one or more Html's,
    -- or a String, for example.

    class HTML a where
          toHtml     :: a -> Html
          toHtmlFromList :: [a] -> Html

          toHtmlFromList [a]
    xs = [HtmlElement] -> Html
    Html ([[HtmlElement]] -> [HtmlElement]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [HtmlElement]
    x | (Html [HtmlElement]
    x) <- (a -> Html) -> [a] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Html
    forall a. HTML a => a -> Html
    toHtml [a]
    xs])

    instance HTML Html where
          toHtml :: Html -> Html
    toHtml Html
    a    = Html
    a

    instance HTML Char where
          toHtml :: Char -> Html
    toHtml       Char
    a = String -> Html
    forall a. HTML a => a -> Html
    toHtml [Char
    a]
          toHtmlFromList :: String -> Html
    toHtmlFromList []  = [HtmlElement] -> Html
    Html []
          toHtmlFromList String
    str = [HtmlElement] -> Html
    Html [String -> HtmlElement
    HtmlString (String -> String
    stringToHtmlString String
    str)]

    instance (HTML a) => HTML [a] where
          toHtml :: [a] -> Html
    toHtml [a]
    xs = [a] -> Html
    forall a. HTML a => [a] -> Html
    toHtmlFromList [a]
    xs

    class ADDATTRS a where
          (!) :: a -> [HtmlAttr] -> a

    instance (ADDATTRS b) => ADDATTRS (a -> b) where
          a -> b
    fn ! :: (a -> b) -> [HtmlAttr] -> a -> b
    ! [HtmlAttr]
    attr = \ a
    arg -> a -> b
    fn a
    arg b -> [HtmlAttr] -> b
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [HtmlAttr]
    attr

    instance ADDATTRS Html where
          (Html [HtmlElement]
    htmls) ! :: Html -> [HtmlAttr] -> Html
    ! [HtmlAttr]
    attr = [HtmlElement] -> Html
    Html ((HtmlElement -> HtmlElement) -> [HtmlElement] -> [HtmlElement]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> HtmlElement
    addAttrs [HtmlElement]
    htmls)
            where
                  addAttrs :: HtmlElement -> HtmlElement
    addAttrs (html :: HtmlElement
    html@(HtmlTag { markupAttrs :: HtmlElement -> [HtmlAttr]
    markupAttrs = [HtmlAttr]
    markupAttrs }) )
                                  = HtmlElement
    html { markupAttrs = markupAttrs ++ attr }
                  addAttrs HtmlElement
    html = HtmlElement
    html

    (<<)            :: (HTML a) => (Html -> b) -> a        -> b
    Html -> b
    fn << :: forall a b. HTML a => (Html -> b) -> a -> b
    << a
    arg = Html -> b
    fn (a -> Html
    forall a. HTML a => a -> Html
    toHtml a
    arg)

    concatHtml :: (HTML a) => [a] -> Html
    concatHtml :: forall a. HTML a => [a] -> Html
    concatHtml [a]
    as = [HtmlElement] -> Html
    Html ([[HtmlElement]] -> [HtmlElement]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((a -> [HtmlElement]) -> [a] -> [[HtmlElement]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Html -> [HtmlElement]
    getHtmlElements(Html -> [HtmlElement]) -> (a -> Html) -> a -> [HtmlElement]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .a -> Html
    forall a. HTML a => a -> Html
    toHtml) [a]
    as))

    (+++) :: (HTML a,HTML b) => a -> b -> Html
    a
    a +++ :: forall a b. (HTML a, HTML b) => a -> b -> Html
    +++ b
    b = [HtmlElement] -> Html
    Html (Html -> [HtmlElement]
    getHtmlElements (a -> Html
    forall a. HTML a => a -> Html
    toHtml a
    a) [HtmlElement] -> [HtmlElement] -> [HtmlElement]
    forall a. [a] -> [a] -> [a]
    ++ Html -> [HtmlElement]
    getHtmlElements (b -> Html
    forall a. HTML a => a -> Html
    toHtml b
    b))

    noHtml :: Html
    noHtml :: Html
    noHtml = [HtmlElement] -> Html
    Html []

    isNoHtml :: Html -> Bool
    isNoHtml (Html [HtmlElement]
    xs) = [HtmlElement] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [HtmlElement]
    xs

    tag  :: String -> Html -> Html
    tag :: String -> Html -> Html
    tag String
    str       Html
    htmls = [HtmlElement] -> Html
    Html [
          HtmlTag {
                  markupTag :: String
    markupTag = String
    str,
                  markupAttrs :: [HtmlAttr]
    markupAttrs = [],
                  markupContent :: Html
    markupContent = Html
    htmls }]

    itag :: String -> Html
    itag :: String -> Html
    itag String
    str = String -> Html -> Html
    tag String
    str Html
    noHtml

    emptyAttr :: String -> HtmlAttr
    emptyAttr :: String -> HtmlAttr
    emptyAttr String
    s = String -> String -> HtmlAttr
    HtmlAttr String
    s String
    ""

    intAttr :: String -> Int -> HtmlAttr
    intAttr :: String -> Int -> HtmlAttr
    intAttr String
    s Int
    i = String -> String -> HtmlAttr
    HtmlAttr String
    s (Int -> String
    forall a. Show a => a -> String
    show Int
    i)

    strAttr :: String -> String -> HtmlAttr
    strAttr :: String -> String -> HtmlAttr
    strAttr String
    s String
    t = String -> String -> HtmlAttr
    HtmlAttr String
    s String
    t

    {-
    foldHtml :: (String -> [HtmlAttr] -> [a] -> a)
          -> (String -> a)
          -> Html
          -> a
    foldHtml f g (HtmlTag str attr fmls)
          = f str attr (map (foldHtml f g) fmls)
    foldHtml f g (HtmlString  str)
          = g str

    -}
    -- Processing Strings into Html friendly things.
    -- This converts a String to a Html String.
    stringToHtmlString :: String -> String
    stringToHtmlString :: String -> String
    stringToHtmlString = (Char -> String) -> String -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Char -> String
    fixChar
        where
          fixChar :: Char -> String
    fixChar Char
    '<' = String
    "&lt;"
          fixChar Char
    '>' = String
    "&gt;"
          fixChar Char
    '&' = String
    "&amp;"
          fixChar Char
    '"' = String
    "&quot;"
          fixChar Char
    c   = [Char
    c]

    -- ---------------------------------------------------------------------------
    -- Classes

    instance Show Html where
          showsPrec :: Int -> Html -> String -> String
    showsPrec Int
    _ Html
    html = String -> String -> String
    showString (Html -> String
    forall html. HTML html => html -> String
    prettyHtml Html
    html)
          showList :: [Html] -> String -> String
    showList [Html]
    htmls   = String -> String -> String
    showString ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((Html -> String) -> [Html] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Html -> String
    forall a. Show a => a -> String
    show [Html]
    htmls))

    instance Show HtmlAttr where
          showsPrec :: Int -> HtmlAttr -> String -> String
    showsPrec Int
    _ (HtmlAttr String
    str String
    val) =
                  String -> String -> String
    showString String
    str (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                  String -> String -> String
    showString String
    "=" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                  String -> String -> String
    forall a. Show a => a -> String -> String
    shows String
    val

    -- ---------------------------------------------------------------------------
    -- Data types

    type URL = String

    -- ---------------------------------------------------------------------------
    -- Basic primitives

    -- This is not processed for special chars.
    -- use stringToHtml or lineToHtml instead, for user strings,
    -- because they  understand special chars, like '<'.

    primHtml      :: String                                -> Html
    primHtml :: String -> Html
    primHtml String
    x    = [HtmlElement] -> Html
    Html [String -> HtmlElement
    HtmlString String
    x]

    -- ---------------------------------------------------------------------------
    -- Basic Combinators

    stringToHtml          :: String                       -> Html
    stringToHtml :: String -> Html
    stringToHtml = String -> Html
    primHtml (String -> Html) -> (String -> String) -> String -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    stringToHtmlString

    -- This converts a string, but keeps spaces as non-line-breakable

    lineToHtml            :: String                       -> Html
    lineToHtml :: String -> Html
    lineToHtml = String -> Html
    primHtml (String -> Html) -> (String -> String) -> String -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> String) -> String -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Char -> String
    htmlizeChar2 (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    stringToHtmlString
       where
          htmlizeChar2 :: Char -> String
    htmlizeChar2 Char
    ' ' = String
    "&nbsp;"
          htmlizeChar2 Char
    c   = [Char
    c]

    -- ---------------------------------------------------------------------------
    -- Html Constructors

    -- (automatically generated)

    address             :: Html -> Html
    anchor              :: Html -> Html
    applet              :: Html -> Html
    area                ::         Html
    basefont            ::         Html
    big                 :: Html -> Html
    blockquote          :: Html -> Html
    body                :: Html -> Html
    bold                :: Html -> Html
    br                  ::         Html
    caption             :: Html -> Html
    center              :: Html -> Html
    cite                :: Html -> Html
    ddef                :: Html -> Html
    define              :: Html -> Html
    dlist               :: Html -> Html
    dterm               :: Html -> Html
    emphasize           :: Html -> Html
    fieldset            :: Html -> Html
    font                :: Html -> Html
    form                :: Html -> Html
    frame               :: Html -> Html
    frameset            :: Html -> Html
    h1                  :: Html -> Html
    h2                  :: Html -> Html
    h3                  :: Html -> Html
    h4                  :: Html -> Html
    h5                  :: Html -> Html
    h6                  :: Html -> Html
    header              :: Html -> Html
    hr                  ::         Html
    image               ::         Html
    input               ::         Html
    italics             :: Html -> Html
    keyboard            :: Html -> Html
    legend              :: Html -> Html
    li                  :: Html -> Html
    meta                ::         Html
    noframes            :: Html -> Html
    olist               :: Html -> Html
    option              :: Html -> Html
    paragraph           :: Html -> Html
    param               ::         Html
    pre                 :: Html -> Html
    sample              :: Html -> Html
    select              :: Html -> Html
    small               :: Html -> Html
    strong              :: Html -> Html
    style               :: Html -> Html
    sub                 :: Html -> Html
    sup                 :: Html -> Html
    table               :: Html -> Html
    td                  :: Html -> Html
    textarea            :: Html -> Html
    th                  :: Html -> Html
    thebase             ::         Html
    thecode             :: Html -> Html
    thediv              :: Html -> Html
    thehtml             :: Html -> Html
    thelink             :: Html -> Html
    themap              :: Html -> Html
    thespan             :: Html -> Html
    thetitle            :: Html -> Html
    tr                  :: Html -> Html
    tt                  :: Html -> Html
    ulist               :: Html -> Html
    underline           :: Html -> Html
    variable            :: Html -> Html

    address :: Html -> Html
    address             =  String -> Html -> Html
    tag String
    "ADDRESS"
    anchor :: Html -> Html
    anchor              =  String -> Html -> Html
    tag String
    "A"
    applet :: Html -> Html
    applet              =  String -> Html -> Html
    tag String
    "APPLET"
    area :: Html
    area                = String -> Html
    itag String
    "AREA"
    basefont :: Html
    basefont            = String -> Html
    itag String
    "BASEFONT"
    big :: Html -> Html
    big                 =  String -> Html -> Html
    tag String
    "BIG"
    blockquote :: Html -> Html
    blockquote          =  String -> Html -> Html
    tag String
    "BLOCKQUOTE"
    body :: Html -> Html
    body                =  String -> Html -> Html
    tag String
    "BODY"
    bold :: Html -> Html
    bold                =  String -> Html -> Html
    tag String
    "B"
    br :: Html
    br                  = String -> Html
    itag String
    "BR"
    caption :: Html -> Html
    caption             =  String -> Html -> Html
    tag String
    "CAPTION"
    center :: Html -> Html
    center              =  String -> Html -> Html
    tag String
    "CENTER"
    cite :: Html -> Html
    cite                =  String -> Html -> Html
    tag String
    "CITE"
    ddef :: Html -> Html
    ddef                =  String -> Html -> Html
    tag String
    "DD"
    define :: Html -> Html
    define              =  String -> Html -> Html
    tag String
    "DFN"
    dlist :: Html -> Html
    dlist               =  String -> Html -> Html
    tag String
    "DL"
    dterm :: Html -> Html
    dterm               =  String -> Html -> Html
    tag String
    "DT"
    emphasize :: Html -> Html
    emphasize           =  String -> Html -> Html
    tag String
    "EM"
    fieldset :: Html -> Html
    fieldset            =  String -> Html -> Html
    tag String
    "FIELDSET"
    font :: Html -> Html
    font                =  String -> Html -> Html
    tag String
    "FONT"
    form :: Html -> Html
    form                =  String -> Html -> Html
    tag String
    "FORM"
    frame :: Html -> Html
    frame               =  String -> Html -> Html
    tag String
    "FRAME"
    frameset :: Html -> Html
    frameset            =  String -> Html -> Html
    tag String
    "FRAMESET"
    h1 :: Html -> Html
    h1                  =  String -> Html -> Html
    tag String
    "H1"
    h2 :: Html -> Html
    h2                  =  String -> Html -> Html
    tag String
    "H2"
    h3 :: Html -> Html
    h3                  =  String -> Html -> Html
    tag String
    "H3"
    h4 :: Html -> Html
    h4                  =  String -> Html -> Html
    tag String
    "H4"
    h5 :: Html -> Html
    h5                  =  String -> Html -> Html
    tag String
    "H5"
    h6 :: Html -> Html
    h6                  =  String -> Html -> Html
    tag String
    "H6"
    header :: Html -> Html
    header              =  String -> Html -> Html
    tag String
    "HEAD"
    hr :: Html
    hr                  = String -> Html
    itag String
    "HR"
    image :: Html
    image               = String -> Html
    itag String
    "IMG"
    input :: Html
    input               = String -> Html
    itag String
    "INPUT"
    italics :: Html -> Html
    italics             =  String -> Html -> Html
    tag String
    "I"
    keyboard :: Html -> Html
    keyboard            =  String -> Html -> Html
    tag String
    "KBD"
    legend :: Html -> Html
    legend              =  String -> Html -> Html
    tag String
    "LEGEND"
    li :: Html -> Html
    li                  =  String -> Html -> Html
    tag String
    "LI"
    meta :: Html
    meta                = String -> Html
    itag String
    "META"
    noframes :: Html -> Html
    noframes            =  String -> Html -> Html
    tag String
    "NOFRAMES"
    olist :: Html -> Html
    olist               =  String -> Html -> Html
    tag String
    "OL"
    option :: Html -> Html
    option              =  String -> Html -> Html
    tag String
    "OPTION"
    paragraph :: Html -> Html
    paragraph           =  String -> Html -> Html
    tag String
    "P"
    param :: Html
    param               = String -> Html
    itag String
    "PARAM"
    pre :: Html -> Html
    pre                 =  String -> Html -> Html
    tag String
    "PRE"
    sample :: Html -> Html
    sample              =  String -> Html -> Html
    tag String
    "SAMP"
    select :: Html -> Html
    select              =  String -> Html -> Html
    tag String
    "SELECT"
    small :: Html -> Html
    small               =  String -> Html -> Html
    tag String
    "SMALL"
    strong :: Html -> Html
    strong              =  String -> Html -> Html
    tag String
    "STRONG"
    style :: Html -> Html
    style               =  String -> Html -> Html
    tag String
    "STYLE"
    sub :: Html -> Html
    sub                 =  String -> Html -> Html
    tag String
    "SUB"
    sup :: Html -> Html
    sup                 =  String -> Html -> Html
    tag String
    "SUP"
    table :: Html -> Html
    table               =  String -> Html -> Html
    tag String
    "TABLE"
    td :: Html -> Html
    td                  =  String -> Html -> Html
    tag String
    "TD"
    textarea :: Html -> Html
    textarea            =  String -> Html -> Html
    tag String
    "TEXTAREA"
    th :: Html -> Html
    th                  =  String -> Html -> Html
    tag String
    "TH"
    thebase :: Html
    thebase             = String -> Html
    itag String
    "BASE"
    thecode :: Html -> Html
    thecode             =  String -> Html -> Html
    tag String
    "CODE"
    thediv :: Html -> Html
    thediv              =  String -> Html -> Html
    tag String
    "DIV"
    thehtml :: Html -> Html
    thehtml             =  String -> Html -> Html
    tag String
    "HTML"
    thelink :: Html -> Html
    thelink             =  String -> Html -> Html
    tag String
    "LINK"
    themap :: Html -> Html
    themap              =  String -> Html -> Html
    tag String
    "MAP"
    thespan :: Html -> Html
    thespan             =  String -> Html -> Html
    tag String
    "SPAN"
    thetitle :: Html -> Html
    thetitle            =  String -> Html -> Html
    tag String
    "TITLE"
    tr :: Html -> Html
    tr                  =  String -> Html -> Html
    tag String
    "TR"
    tt :: Html -> Html
    tt                  =  String -> Html -> Html
    tag String
    "TT"
    ulist :: Html -> Html
    ulist               =  String -> Html -> Html
    tag String
    "UL"
    underline :: Html -> Html
    underline           =  String -> Html -> Html
    tag String
    "U"
    variable :: Html -> Html
    variable            =  String -> Html -> Html
    tag String
    "VAR"

    -- ---------------------------------------------------------------------------
    -- Html Attributes

    -- (automatically generated)

    action              :: String -> HtmlAttr
    align               :: String -> HtmlAttr
    alink               :: String -> HtmlAttr
    alt                 :: String -> HtmlAttr
    altcode             :: String -> HtmlAttr
    archive             :: String -> HtmlAttr
    background          :: String -> HtmlAttr
    base                :: String -> HtmlAttr
    bgcolor             :: String -> HtmlAttr
    border              :: Int    -> HtmlAttr
    bordercolor         :: String -> HtmlAttr
    cellpadding         :: Int    -> HtmlAttr
    cellspacing         :: Int    -> HtmlAttr
    checked             ::           HtmlAttr
    clear               :: String -> HtmlAttr
    code                :: String -> HtmlAttr
    codebase            :: String -> HtmlAttr
    color               :: String -> HtmlAttr
    cols                :: String -> HtmlAttr
    colspan             :: Int    -> HtmlAttr
    compact             ::           HtmlAttr
    content             :: String -> HtmlAttr
    coords              :: String -> HtmlAttr
    enctype             :: String -> HtmlAttr
    face                :: String -> HtmlAttr
    frameborder         :: Int    -> HtmlAttr
    height              :: Int    -> HtmlAttr
    href                :: String -> HtmlAttr
    hspace              :: Int    -> HtmlAttr
    httpequiv           :: String -> HtmlAttr
    identifier          :: String -> HtmlAttr
    ismap               ::           HtmlAttr
    lang                :: String -> HtmlAttr
    link                :: String -> HtmlAttr
    marginheight        :: Int    -> HtmlAttr
    marginwidth         :: Int    -> HtmlAttr
    maxlength           :: Int    -> HtmlAttr
    method              :: String -> HtmlAttr
    multiple            ::           HtmlAttr
    name                :: String -> HtmlAttr
    nohref              ::           HtmlAttr
    noresize            ::           HtmlAttr
    noshade             ::           HtmlAttr
    nowrap              ::           HtmlAttr
    rel                 :: String -> HtmlAttr
    rev                 :: String -> HtmlAttr
    rows                :: String -> HtmlAttr
    rowspan             :: Int    -> HtmlAttr
    rules               :: String -> HtmlAttr
    scrolling           :: String -> HtmlAttr
    selected            ::           HtmlAttr
    shape               :: String -> HtmlAttr
    size                :: String -> HtmlAttr
    src                 :: String -> HtmlAttr
    start               :: Int    -> HtmlAttr
    target              :: String -> HtmlAttr
    text                :: String -> HtmlAttr
    theclass            :: String -> HtmlAttr
    thestyle            :: String -> HtmlAttr
    thetype             :: String -> HtmlAttr
    title               :: String -> HtmlAttr
    usemap              :: String -> HtmlAttr
    valign              :: String -> HtmlAttr
    value               :: String -> HtmlAttr
    version             :: String -> HtmlAttr
    vlink               :: String -> HtmlAttr
    vspace              :: Int    -> HtmlAttr
    width               :: String -> HtmlAttr

    action :: String -> HtmlAttr
    action              =   String -> String -> HtmlAttr
    strAttr String
    "ACTION"
    align :: String -> HtmlAttr
    align               =   String -> String -> HtmlAttr
    strAttr String
    "ALIGN"
    alink :: String -> HtmlAttr
    alink               =   String -> String -> HtmlAttr
    strAttr String
    "ALINK"
    alt :: String -> HtmlAttr
    alt                 =   String -> String -> HtmlAttr
    strAttr String
    "ALT"
    altcode :: String -> HtmlAttr
    altcode             =   String -> String -> HtmlAttr
    strAttr String
    "ALTCODE"
    archive :: String -> HtmlAttr
    archive             =   String -> String -> HtmlAttr
    strAttr String
    "ARCHIVE"
    background :: String -> HtmlAttr
    background          =   String -> String -> HtmlAttr
    strAttr String
    "BACKGROUND"
    base :: String -> HtmlAttr
    base                =   String -> String -> HtmlAttr
    strAttr String
    "BASE"
    bgcolor :: String -> HtmlAttr
    bgcolor             =   String -> String -> HtmlAttr
    strAttr String
    "BGCOLOR"
    border :: Int -> HtmlAttr
    border              =   String -> Int -> HtmlAttr
    intAttr String
    "BORDER"
    bordercolor :: String -> HtmlAttr
    bordercolor         =   String -> String -> HtmlAttr
    strAttr String
    "BORDERCOLOR"
    cellpadding :: Int -> HtmlAttr
    cellpadding         =   String -> Int -> HtmlAttr
    intAttr String
    "CELLPADDING"
    cellspacing :: Int -> HtmlAttr
    cellspacing         =   String -> Int -> HtmlAttr
    intAttr String
    "CELLSPACING"
    checked :: HtmlAttr
    checked             = String -> HtmlAttr
    emptyAttr String
    "CHECKED"
    clear :: String -> HtmlAttr
    clear               =   String -> String -> HtmlAttr
    strAttr String
    "CLEAR"
    code :: String -> HtmlAttr
    code                =   String -> String -> HtmlAttr
    strAttr String
    "CODE"
    codebase :: String -> HtmlAttr
    codebase            =   String -> String -> HtmlAttr
    strAttr String
    "CODEBASE"
    color :: String -> HtmlAttr
    color               =   String -> String -> HtmlAttr
    strAttr String
    "COLOR"
    cols :: String -> HtmlAttr
    cols                =   String -> String -> HtmlAttr
    strAttr String
    "COLS"
    colspan :: Int -> HtmlAttr
    colspan             =   String -> Int -> HtmlAttr
    intAttr String
    "COLSPAN"
    compact :: HtmlAttr
    compact             = String -> HtmlAttr
    emptyAttr String
    "COMPACT"
    content :: String -> HtmlAttr
    content             =   String -> String -> HtmlAttr
    strAttr String
    "CONTENT"
    coords :: String -> HtmlAttr
    coords              =   String -> String -> HtmlAttr
    strAttr String
    "COORDS"
    enctype :: String -> HtmlAttr
    enctype             =   String -> String -> HtmlAttr
    strAttr String
    "ENCTYPE"
    face :: String -> HtmlAttr
    face                =   String -> String -> HtmlAttr
    strAttr String
    "FACE"
    frameborder :: Int -> HtmlAttr
    frameborder         =   String -> Int -> HtmlAttr
    intAttr String
    "FRAMEBORDER"
    height :: Int -> HtmlAttr
    height              =   String -> Int -> HtmlAttr
    intAttr String
    "HEIGHT"
    href :: String -> HtmlAttr
    href                =   String -> String -> HtmlAttr
    strAttr String
    "HREF"
    hspace :: Int -> HtmlAttr
    hspace              =   String -> Int -> HtmlAttr
    intAttr String
    "HSPACE"
    httpequiv :: String -> HtmlAttr
    httpequiv           =   String -> String -> HtmlAttr
    strAttr String
    "HTTP-EQUIV"
    identifier :: String -> HtmlAttr
    identifier          =   String -> String -> HtmlAttr
    strAttr String
    "ID"
    ismap :: HtmlAttr
    ismap               = String -> HtmlAttr
    emptyAttr String
    "ISMAP"
    lang :: String -> HtmlAttr
    lang                =   String -> String -> HtmlAttr
    strAttr String
    "LANG"
    link :: String -> HtmlAttr
    link                =   String -> String -> HtmlAttr
    strAttr String
    "LINK"
    marginheight :: Int -> HtmlAttr
    marginheight        =   String -> Int -> HtmlAttr
    intAttr String
    "MARGINHEIGHT"
    marginwidth :: Int -> HtmlAttr
    marginwidth         =   String -> Int -> HtmlAttr
    intAttr String
    "MARGINWIDTH"
    maxlength :: Int -> HtmlAttr
    maxlength           =   String -> Int -> HtmlAttr
    intAttr String
    "MAXLENGTH"
    method :: String -> HtmlAttr
    method              =   String -> String -> HtmlAttr
    strAttr String
    "METHOD"
    multiple :: HtmlAttr
    multiple            = String -> HtmlAttr
    emptyAttr String
    "MULTIPLE"
    name :: String -> HtmlAttr
    name                =   String -> String -> HtmlAttr
    strAttr String
    "NAME"
    nohref :: HtmlAttr
    nohref              = String -> HtmlAttr
    emptyAttr String
    "NOHREF"
    noresize :: HtmlAttr
    noresize            = String -> HtmlAttr
    emptyAttr String
    "NORESIZE"
    noshade :: HtmlAttr
    noshade             = String -> HtmlAttr
    emptyAttr String
    "NOSHADE"
    nowrap :: HtmlAttr
    nowrap              = String -> HtmlAttr
    emptyAttr String
    "NOWRAP"
    rel :: String -> HtmlAttr
    rel                 =   String -> String -> HtmlAttr
    strAttr String
    "REL"
    rev :: String -> HtmlAttr
    rev                 =   String -> String -> HtmlAttr
    strAttr String
    "REV"
    rows :: String -> HtmlAttr
    rows                =   String -> String -> HtmlAttr
    strAttr String
    "ROWS"
    rowspan :: Int -> HtmlAttr
    rowspan             =   String -> Int -> HtmlAttr
    intAttr String
    "ROWSPAN"
    rules :: String -> HtmlAttr
    rules               =   String -> String -> HtmlAttr
    strAttr String
    "RULES"
    scrolling :: String -> HtmlAttr
    scrolling           =   String -> String -> HtmlAttr
    strAttr String
    "SCROLLING"
    selected :: HtmlAttr
    selected            = String -> HtmlAttr
    emptyAttr String
    "SELECTED"
    shape :: String -> HtmlAttr
    shape               =   String -> String -> HtmlAttr
    strAttr String
    "SHAPE"
    size :: String -> HtmlAttr
    size                =   String -> String -> HtmlAttr
    strAttr String
    "SIZE"
    src :: String -> HtmlAttr
    src                 =   String -> String -> HtmlAttr
    strAttr String
    "SRC"
    start :: Int -> HtmlAttr
    start               =   String -> Int -> HtmlAttr
    intAttr String
    "START"
    target :: String -> HtmlAttr
    target              =   String -> String -> HtmlAttr
    strAttr String
    "TARGET"
    text :: String -> HtmlAttr
    text                =   String -> String -> HtmlAttr
    strAttr String
    "TEXT"
    theclass :: String -> HtmlAttr
    theclass            =   String -> String -> HtmlAttr
    strAttr String
    "CLASS"
    thestyle :: String -> HtmlAttr
    thestyle            =   String -> String -> HtmlAttr
    strAttr String
    "STYLE"
    thetype :: String -> HtmlAttr
    thetype             =   String -> String -> HtmlAttr
    strAttr String
    "TYPE"
    title :: String -> HtmlAttr
    title               =   String -> String -> HtmlAttr
    strAttr String
    "TITLE"
    usemap :: String -> HtmlAttr
    usemap              =   String -> String -> HtmlAttr
    strAttr String
    "USEMAP"
    valign :: String -> HtmlAttr
    valign              =   String -> String -> HtmlAttr
    strAttr String
    "VALIGN"
    value :: String -> HtmlAttr
    value               =   String -> String -> HtmlAttr
    strAttr String
    "VALUE"
    version :: String -> HtmlAttr
    version             =   String -> String -> HtmlAttr
    strAttr String
    "VERSION"
    vlink :: String -> HtmlAttr
    vlink               =   String -> String -> HtmlAttr
    strAttr String
    "VLINK"
    vspace :: Int -> HtmlAttr
    vspace              =   String -> Int -> HtmlAttr
    intAttr String
    "VSPACE"
    width :: String -> HtmlAttr
    width               =   String -> String -> HtmlAttr
    strAttr String
    "WIDTH"

    -- ---------------------------------------------------------------------------
    -- Html Constructors

    -- (automatically generated)

    validHtmlTags :: [String]
    validHtmlTags :: [String]
    validHtmlTags = [
          String
    "ADDRESS",
          String
    "A",
          String
    "APPLET",
          String
    "BIG",
          String
    "BLOCKQUOTE",
          String
    "BODY",
          String
    "B",
          String
    "CAPTION",
          String
    "CENTER",
          String
    "CITE",
          String
    "DD",
          String
    "DFN",
          String
    "DL",
          String
    "DT",
          String
    "EM",
          String
    "FIELDSET",
          String
    "FONT",
          String
    "FORM",
          String
    "FRAME",
          String
    "FRAMESET",
          String
    "H1",
          String
    "H2",
          String
    "H3",
          String
    "H4",
          String
    "H5",
          String
    "H6",
          String
    "HEAD",
          String
    "I",
          String
    "KBD",
          String
    "LEGEND",
          String
    "LI",
          String
    "NOFRAMES",
          String
    "OL",
          String
    "OPTION",
          String
    "P",
          String
    "PRE",
          String
    "SAMP",
          String
    "SELECT",
          String
    "SMALL",
          String
    "STRONG",
          String
    "STYLE",
          String
    "SUB",
          String
    "SUP",
          String
    "TABLE",
          String
    "TD",
          String
    "TEXTAREA",
          String
    "TH",
          String
    "CODE",
          String
    "DIV",
          String
    "HTML",
          String
    "LINK",
          String
    "MAP",
          String
    "TITLE",
          String
    "TR",
          String
    "TT",
          String
    "UL",
          String
    "U",
          String
    "VAR"]

    validHtmlITags :: [String]
    validHtmlITags :: [String]
    validHtmlITags = [
          String
    "AREA",
          String
    "BASEFONT",
          String
    "BR",
          String
    "HR",
          String
    "IMG",
          String
    "INPUT",
          String
    "META",
          String
    "PARAM",
          String
    "BASE"]

    validHtmlAttrs :: [String]
    validHtmlAttrs :: [String]
    validHtmlAttrs = [
          String
    "ACTION",
          String
    "ALIGN",
          String
    "ALINK",
          String
    "ALT",
          String
    "ALTCODE",
          String
    "ARCHIVE",
          String
    "BACKGROUND",
          String
    "BASE",
          String
    "BGCOLOR",
          String
    "BORDER",
          String
    "BORDERCOLOR",
          String
    "CELLPADDING",
          String
    "CELLSPACING",
          String
    "CHECKED",
          String
    "CLEAR",
          String
    "CODE",
          String
    "CODEBASE",
          String
    "COLOR",
          String
    "COLS",
          String
    "COLSPAN",
          String
    "COMPACT",
          String
    "CONTENT",
          String
    "COORDS",
          String
    "ENCTYPE",
          String
    "FACE",
          String
    "FRAMEBORDER",
          String
    "HEIGHT",
          String
    "HREF",
          String
    "HSPACE",
          String
    "HTTP-EQUIV",
          String
    "ID",
          String
    "ISMAP",
          String
    "LANG",
          String
    "LINK",
          String
    "MARGINHEIGHT",
          String
    "MARGINWIDTH",
          String
    "MAXLENGTH",
          String
    "METHOD",
          String
    "MULTIPLE",
          String
    "NAME",
          String
    "NOHREF",
          String
    "NORESIZE",
          String
    "NOSHADE",
          String
    "NOWRAP",
          String
    "REL",
          String
    "REV",
          String
    "ROWS",
          String
    "ROWSPAN",
          String
    "RULES",
          String
    "SCROLLING",
          String
    "SELECTED",
          String
    "SHAPE",
          String
    "SIZE",
          String
    "SRC",
          String
    "START",
          String
    "TARGET",
          String
    "TEXT",
          String
    "CLASS",
          String
    "STYLE",
          String
    "TYPE",
          String
    "TITLE",
          String
    "USEMAP",
          String
    "VALIGN",
          String
    "VALUE",
          String
    "VERSION",
          String
    "VLINK",
          String
    "VSPACE",
          String
    "WIDTH"]

    -- ---------------------------------------------------------------------------
    -- Html colors

    aqua          :: String
    black         :: String
    blue          :: String
    fuchsia       :: String
    gray          :: String
    green         :: String
    lime          :: String
    maroon        :: String
    navy          :: String
    olive         :: String
    purple        :: String
    red           :: String
    silver        :: String
    teal          :: String
    yellow        :: String
    white         :: String

    aqua :: String
    aqua          = String
    "aqua"
    black :: String
    black         = String
    "black"
    blue :: String
    blue          = String
    "blue"
    fuchsia :: String
    fuchsia       = String
    "fuchsia"
    gray :: String
    gray          = String
    "gray"
    green :: String
    green         = String
    "green"
    lime :: String
    lime          = String
    "lime"
    maroon :: String
    maroon        = String
    "maroon"
    navy :: String
    navy          = String
    "navy"
    olive :: String
    olive         = String
    "olive"
    purple :: String
    purple        = String
    "purple"
    red :: String
    red           = String
    "red"
    silver :: String
    silver        = String
    "silver"
    teal :: String
    teal          = String
    "teal"
    yellow :: String
    yellow        = String
    "yellow"
    white :: String
    white         = String
    "white"

    -- ---------------------------------------------------------------------------
    -- Basic Combinators

    linesToHtml :: [String]       -> Html

    linesToHtml :: [String] -> Html
    linesToHtml []     = Html
    noHtml
    linesToHtml (String
    x:[]) = String -> Html
    lineToHtml String
    x
    linesToHtml (String
    x:[String]
    xs) = String -> Html
    lineToHtml String
    x Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++ Html
    br Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++ [String] -> Html
    linesToHtml [String]
    xs

    -- ---------------------------------------------------------------------------
    -- Html abbriviations

    primHtmlChar  :: String -> Html
    copyright     :: Html
    spaceHtml     :: Html
    bullet        :: Html
    p             :: Html -> Html

    primHtmlChar :: String -> Html
    primHtmlChar  = \ String
    x -> String -> Html
    primHtml (String
    "&" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ";")
    copyright :: Html
    copyright     = String -> Html
    primHtmlChar String
    "copy"
    spaceHtml :: Html
    spaceHtml     = String -> Html
    primHtmlChar String
    "nbsp"
    bullet :: Html
    bullet        = String -> Html
    primHtmlChar String
    "#149"

    p :: Html -> Html
    p             = Html -> Html
    paragraph

    -- ---------------------------------------------------------------------------
    -- Html tables

    class HTMLTABLE ht where
          cell :: ht -> HtmlTable

    instance HTMLTABLE HtmlTable where
          cell :: HtmlTable -> HtmlTable
    cell = HtmlTable -> HtmlTable
    forall a. a -> a
    id

    instance HTMLTABLE Html where
          cell :: Html -> HtmlTable
    cell Html
    h =
             let
                  cellFn :: Int -> Int -> Html
    cellFn Int
    x Int
    y = Html
    h Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! (Int -> (Int -> HtmlAttr) -> [HtmlAttr] -> [HtmlAttr]
    forall {t} {a}. (Eq t, Num t) => t -> (t -> a) -> [a] -> [a]
    add Int
    x Int -> HtmlAttr
    colspan ([HtmlAttr] -> [HtmlAttr]) -> [HtmlAttr] -> [HtmlAttr]
    forall a b. (a -> b) -> a -> b
    $ Int -> (Int -> HtmlAttr) -> [HtmlAttr] -> [HtmlAttr]
    forall {t} {a}. (Eq t, Num t) => t -> (t -> a) -> [a] -> [a]
    add Int
    y Int -> HtmlAttr
    rowspan ([HtmlAttr] -> [HtmlAttr]) -> [HtmlAttr] -> [HtmlAttr]
    forall a b. (a -> b) -> a -> b
    $ [])
                  add :: t -> (t -> a) -> [a] -> [a]
    add t
    1 t -> a
    fn [a]
    rest = [a]
    rest
                  add t
    n t -> a
    fn [a]
    rest = t -> a
    fn t
    n a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    rest
                  r :: BlockTable (Int -> Int -> Html)
    r = (Int -> Int -> Html) -> BlockTable (Int -> Int -> Html)
    forall a. a -> BlockTable a
    BT.single Int -> Int -> Html
    cellFn
             in
                  BlockTable (Int -> Int -> Html) -> HtmlTable
    mkHtmlTable BlockTable (Int -> Int -> Html)
    r

    -- We internally represent the Cell inside a Table with an
    -- object of the type
    -- \pre{
    -- 	   Int -> Int -> Html
    -- }
    -- When we render it later, we find out how many columns
    -- or rows this cell will span over, and can
    -- include the correct colspan/rowspan command.

    newtype HtmlTable
          = HtmlTable (BT.BlockTable (Int -> Int -> Html))

    (</>),above,(<->),beside :: (HTMLTABLE ht1,HTMLTABLE ht2)
                           => ht1 -> ht2 -> HtmlTable
    aboves,besides                 :: (HTMLTABLE ht) => [ht] -> HtmlTable
    simpleTable            :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html

    mkHtmlTable :: BT.BlockTable (Int -> Int -> Html) -> HtmlTable
    mkHtmlTable :: BlockTable (Int -> Int -> Html) -> HtmlTable
    mkHtmlTable BlockTable (Int -> Int -> Html)
    r = BlockTable (Int -> Int -> Html) -> HtmlTable
    HtmlTable BlockTable (Int -> Int -> Html)
    r

    -- We give both infix and nonfix, take your pick.
    -- Notice that there is no concept of a row/column
    -- of zero items.

    above :: forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    above   ht1
    a ht2
    b = (BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html))
    -> HtmlTable -> HtmlTable -> HtmlTable
    combine BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    forall a. BlockTable a -> BlockTable a -> BlockTable a
    BT.above (ht1 -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell ht1
    a) (ht2 -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell ht2
    b)
    </> :: forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    (</>)         = ht1 -> ht2 -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    above
    beside :: forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    beside  ht1
    a ht2
    b = (BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html))
    -> HtmlTable -> HtmlTable -> HtmlTable
    combine BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    forall a. BlockTable a -> BlockTable a -> BlockTable a
    BT.beside (ht1 -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell ht1
    a) (ht2 -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell ht2
    b)
    <-> :: forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    (<->) = ht1 -> ht2 -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    beside

    combine :: (BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html))
    -> HtmlTable -> HtmlTable -> HtmlTable
    combine BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    fn (HtmlTable BlockTable (Int -> Int -> Html)
    a) (HtmlTable BlockTable (Int -> Int -> Html)
    b) = BlockTable (Int -> Int -> Html) -> HtmlTable
    mkHtmlTable (BlockTable (Int -> Int -> Html)
    a BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    `fn` BlockTable (Int -> Int -> Html)
    b)

    -- Both aboves and besides presume a non-empty list.
    -- here is no concept of a empty row or column in these
    -- table combinators.

    aboves :: forall ht. HTMLTABLE ht => [ht] -> HtmlTable
    aboves []  = String -> HtmlTable
    forall a. HasCallStack => String -> a
    error String
    "aboves []"
    aboves [ht]
    xs  = (HtmlTable -> HtmlTable -> HtmlTable) -> [HtmlTable] -> HtmlTable
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 HtmlTable -> HtmlTable -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    (</>) ((ht -> HtmlTable) -> [ht] -> [HtmlTable]
    forall a b. (a -> b) -> [a] -> [b]
    map ht -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell [ht]
    xs)
    besides :: forall ht. HTMLTABLE ht => [ht] -> HtmlTable
    besides [] = String -> HtmlTable
    forall a. HasCallStack => String -> a
    error String
    "besides []"
    besides [ht]
    xs = (HtmlTable -> HtmlTable -> HtmlTable) -> [HtmlTable] -> HtmlTable
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 HtmlTable -> HtmlTable -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    (<->) ((ht -> HtmlTable) -> [ht] -> [HtmlTable]
    forall a b. (a -> b) -> [a] -> [b]
    map ht -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell [ht]
    xs)

    -- renderTable takes the HtmlTable, and renders it back into
    -- and Html object.

    renderTable :: BT.BlockTable (Int -> Int -> Html) -> Html
    renderTable :: BlockTable (Int -> Int -> Html) -> Html
    renderTable BlockTable (Int -> Int -> Html)
    theTable
          = [Html] -> Html
    forall a. HTML a => [a] -> Html
    concatHtml
              [Html -> Html
    tr (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [Int -> Int -> Html
    theCell Int
    x Int
    y | (Int -> Int -> Html
    theCell,(Int
    x,Int
    y)) <- [(Int -> Int -> Html, (Int, Int))]
    theRow ]
                          | [(Int -> Int -> Html, (Int, Int))]
    theRow <- BlockTable (Int -> Int -> Html)
    -> [[(Int -> Int -> Html, (Int, Int))]]
    forall a. BlockTable a -> [[(a, (Int, Int))]]
    BT.getMatrix BlockTable (Int -> Int -> Html)
    theTable]

    instance HTML HtmlTable where
          toHtml :: HtmlTable -> Html
    toHtml (HtmlTable BlockTable (Int -> Int -> Html)
    tab) = BlockTable (Int -> Int -> Html) -> Html
    renderTable BlockTable (Int -> Int -> Html)
    tab

    instance Show HtmlTable where
          showsPrec :: Int -> HtmlTable -> String -> String
    showsPrec Int
    _ (HtmlTable BlockTable (Int -> Int -> Html)
    tab) = Html -> String -> String
    forall a. Show a => a -> String -> String
    shows (BlockTable (Int -> Int -> Html) -> Html
    renderTable BlockTable (Int -> Int -> Html)
    tab)

    -- If you can't be bothered with the above, then you
    -- can build simple tables with simpleTable.
    -- Just provide the attributes for the whole table,
    -- attributes for the cells (same for every cell),
    -- and a list of lists of cell contents,
    -- and this function will build the table for you.
    -- It does presume that all the lists are non-empty,
    -- and there is at least one list.
    --
    -- Different length lists means that the last cell
    -- gets padded. If you want more power, then
    -- use the system above, or build tables explicitly.

    simpleTable :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html
    simpleTable [HtmlAttr]
    attr [HtmlAttr]
    cellAttr [[Html]]
    lst
          = Html -> Html
    table (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [HtmlAttr]
    attr
              (Html -> Html) -> HtmlTable -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<  ([HtmlTable] -> HtmlTable
    forall ht. HTMLTABLE ht => [ht] -> HtmlTable
    aboves
                  ([HtmlTable] -> HtmlTable)
    -> ([[Html]] -> [HtmlTable]) -> [[Html]] -> HtmlTable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Html] -> HtmlTable) -> [[Html]] -> [HtmlTable]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Html] -> HtmlTable
    forall ht. HTMLTABLE ht => [ht] -> HtmlTable
    besides ([Html] -> HtmlTable) -> ([Html] -> [Html]) -> [Html] -> HtmlTable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Html -> Html) -> [Html] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Html -> Html
    td (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [HtmlAttr]
    cellAttr) (Html -> Html) -> (Html -> Html) -> Html -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Html -> Html
    forall a. HTML a => a -> Html
    toHtml))
                  ) [[Html]]
    lst

    -- ---------------------------------------------------------------------------
    -- Tree Displaying Combinators

    -- The basic idea is you render your structure in the form
    -- of this tree, and then use treeHtml to turn it into a Html
    -- object with the structure explicit.

    data HtmlTree
          = HtmlLeaf Html
          | HtmlNode Html [HtmlTree] Html

    treeHtml :: [String] -> HtmlTree -> Html
    treeHtml :: [String] -> HtmlTree -> Html
    treeHtml [String]
    colors HtmlTree
    h = Html -> Html
    table (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [
                        Int -> HtmlAttr
    border Int
    0,
                        Int -> HtmlAttr
    cellpadding Int
    0,
                        Int -> HtmlAttr
    cellspacing Int
    2] (Html -> Html) -> HtmlTable -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> HtmlTree -> HtmlTable
    treeHtml' [String]
    colors HtmlTree
    h
         where
          manycolors :: [a] -> [[a]]
    manycolors = (a -> [a] -> [a]) -> [a] -> [a] -> [[a]]
    forall a b. (a -> b -> b) -> b -> [a] -> [b]
    scanr (:) []

          treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable
          treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable
    treeHtmls [[String]]
    c [HtmlTree]
    ts = [HtmlTable] -> HtmlTable
    forall ht. HTMLTABLE ht => [ht] -> HtmlTable
    aboves (([String] -> HtmlTree -> HtmlTable)
    -> [[String]] -> [HtmlTree] -> [HtmlTable]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith [String] -> HtmlTree -> HtmlTable
    treeHtml' [[String]]
    c [HtmlTree]
    ts)

          treeHtml' :: [String] -> HtmlTree -> HtmlTable
          treeHtml' :: [String] -> HtmlTree -> HtmlTable
    treeHtml' (String
    c:[String]
    _) (HtmlLeaf Html
    leaf) = Html -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell
                                             (Html -> Html
    td (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    width String
    "100%"]
                                                (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html -> Html
    bold
                                                   (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html
    leaf)
          treeHtml' (String
    c:cs :: [String]
    cs@(String
    c2:[String]
    _)) (HtmlNode Html
    hopen [HtmlTree]
    ts Html
    hclose) =
              if [HtmlTree] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [HtmlTree]
    ts Bool -> Bool -> Bool
    && Html -> Bool
    isNoHtml Html
    hclose
              then
                  Html -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell Html
    hd
              else if [HtmlTree] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [HtmlTree]
    ts
              then
                  Html
    hd Html -> HtmlTable -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    </> Html
    bar Html -> Html -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    `beside` (Html -> Html
    td (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    bgcolor String
    c2] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html
    spaceHtml)
                     HtmlTable -> Html -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    </> Html
    tl
              else
                  Html
    hd Html -> HtmlTable -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    </> (Html
    bar Html -> HtmlTable -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    `beside` [[String]] -> [HtmlTree] -> HtmlTable
    treeHtmls [[String]]
    morecolors [HtmlTree]
    ts)
                     HtmlTable -> Html -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    </> Html
    tl
            where
                  -- This stops a column of colors being the same
                  -- color as the immeduately outside nesting bar.
                  morecolors :: [[String]]
    morecolors = ([String] -> Bool) -> [[String]] -> [[String]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    c)(String -> Bool) -> ([String] -> String) -> [String] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .[String] -> String
    forall a. HasCallStack => [a] -> a
    head) ([String] -> [[String]]
    forall {a}. [a] -> [[a]]
    manycolors [String]
    cs)
                  bar :: Html
    bar = Html -> Html
    td (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    bgcolor String
    c,String -> HtmlAttr
    width String
    "10"] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html
    spaceHtml
                  hd :: Html
    hd = Html -> Html
    td (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    bgcolor String
    c] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html
    hopen
                  tl :: Html
    tl = Html -> Html
    td (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    bgcolor String
    c] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html
    hclose
          treeHtml' [String]
    _ HtmlTree
    _ = String -> HtmlTable
    forall a. HasCallStack => String -> a
    error String
    "The imposible happens"

    instance HTML HtmlTree where
          toHtml :: HtmlTree -> Html
    toHtml HtmlTree
    x = [String] -> HtmlTree -> Html
    treeHtml [String]
    treeColors HtmlTree
    x

    -- type "length treeColors" to see how many colors are here.
    treeColors :: [String]
    treeColors = [String
    "#88ccff",String
    "#ffffaa",String
    "#ffaaff",String
    "#ccffff"] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    treeColors

    -- ---------------------------------------------------------------------------
    -- Html Debugging Combinators

    -- This uses the above tree rendering function, and displays the
    -- Html as a tree structure, allowing debugging of what is
    -- actually getting produced.

    debugHtml :: (HTML a) => a -> Html
    debugHtml :: forall a. HTML a => a -> Html
    debugHtml a
    obj = Html -> Html
    table (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [Int -> HtmlAttr
    border Int
    0] (Html -> Html) -> HtmlTable -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                      ( Html -> Html
    th (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    bgcolor String
    "#008888"]
                         (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html -> Html
    underline
                           (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "Debugging Output"
                   Html -> Html -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    </>  Html -> Html
    td (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << ([HtmlTree] -> Html
    forall a. HTML a => a -> Html
    toHtml (Html -> [HtmlTree]
    debug' (a -> Html
    forall a. HTML a => a -> Html
    toHtml a
    obj)))
                  )
      where

          debug' :: Html -> [HtmlTree]
          debug' :: Html -> [HtmlTree]
    debug' (Html [HtmlElement]
    markups) = (HtmlElement -> HtmlTree) -> [HtmlElement] -> [HtmlTree]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> HtmlTree
    debug [HtmlElement]
    markups

          debug :: HtmlElement -> HtmlTree
          debug :: HtmlElement -> HtmlTree
    debug (HtmlString String
    str) = Html -> HtmlTree
    HtmlLeaf (Html
    spaceHtml Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++
                                                  [String] -> Html
    linesToHtml (String -> [String]
    lines String
    str))
          debug (HtmlTag {
                  markupTag :: HtmlElement -> String
    markupTag = String
    markupTag,
                  markupContent :: HtmlElement -> Html
    markupContent = Html
    markupContent,
                  markupAttrs :: HtmlElement -> [HtmlAttr]
    markupAttrs  = [HtmlAttr]
    markupAttrs
                  }) =
                  case Html
    markupContent of
                    Html [] -> Html -> [HtmlTree] -> Html -> HtmlTree
    HtmlNode Html
    hd [] Html
    noHtml
                    Html [HtmlElement]
    xs -> Html -> [HtmlTree] -> Html -> HtmlTree
    HtmlNode Html
    hd ((HtmlElement -> HtmlTree) -> [HtmlElement] -> [HtmlTree]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> HtmlTree
    debug [HtmlElement]
    xs) Html
    tl
            where
                  args :: String
    args = if [HtmlAttr] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [HtmlAttr]
    markupAttrs
                         then String
    ""
                         else String
    "  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((HtmlAttr -> String) -> [HtmlAttr] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlAttr -> String
    forall a. Show a => a -> String
    show [HtmlAttr]
    markupAttrs)
                  hd :: Html
    hd = Html -> Html
    font (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    size String
    "1"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (String
    "<" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    markupTag String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    args String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ">")
                  tl :: Html
    tl = Html -> Html
    font (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    size String
    "1"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (String
    "</" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    markupTag String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ">")

    -- ---------------------------------------------------------------------------
    -- Hotlink datatype

    data HotLink = HotLink {
          HotLink -> String
    hotLinkURL        :: URL,
          HotLink -> [Html]
    hotLinkContents   :: [Html],
          HotLink -> [HtmlAttr]
    hotLinkAttributes :: [HtmlAttr]
          } deriving Int -> HotLink -> String -> String
    [HotLink] -> String -> String
    HotLink -> String
    (Int -> HotLink -> String -> String)
    -> (HotLink -> String)
    -> ([HotLink] -> String -> String)
    -> Show HotLink
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> HotLink -> String -> String
    showsPrec :: Int -> HotLink -> String -> String
    $cshow :: HotLink -> String
    show :: HotLink -> String
    $cshowList :: [HotLink] -> String -> String
    showList :: [HotLink] -> String -> String
    Show

    instance HTML HotLink where
          toHtml :: HotLink -> Html
    toHtml HotLink
    hl = Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! (String -> HtmlAttr
    href (HotLink -> String
    hotLinkURL HotLink
    hl) HtmlAttr -> [HtmlAttr] -> [HtmlAttr]
    forall a. a -> [a] -> [a]
    : HotLink -> [HtmlAttr]
    hotLinkAttributes HotLink
    hl)
                          (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << HotLink -> [Html]
    hotLinkContents HotLink
    hl

    hotlink :: URL -> [Html] -> HotLink
    hotlink :: String -> [Html] -> HotLink
    hotlink String
    url [Html]
    h = HotLink {
          hotLinkURL :: String
    hotLinkURL = String
    url,
          hotLinkContents :: [Html]
    hotLinkContents = [Html]
    h,
          hotLinkAttributes :: [HtmlAttr]
    hotLinkAttributes = [] }

    -- ---------------------------------------------------------------------------
    -- More Combinators

    -- (Abridged from Erik Meijer's Original Html library)

    ordList   :: (HTML a) => [a] -> Html
    ordList :: forall a. HTML a => [a] -> Html
    ordList [a]
    items = Html -> Html
    olist (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (a -> Html) -> [a] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (Html -> Html
    li (Html -> Html) -> a -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<) [a]
    items

    unordList :: (HTML a) => [a] -> Html
    unordList :: forall a. HTML a => [a] -> Html
    unordList [a]
    items = Html -> Html
    ulist (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (a -> Html) -> [a] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (Html -> Html
    li (Html -> Html) -> a -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<) [a]
    items

    defList   :: (HTML a,HTML b) => [(a,b)] -> Html
    defList :: forall a b. (HTML a, HTML b) => [(a, b)] -> Html
    defList [(a, b)]
    items
     = Html -> Html
    dlist (Html -> Html) -> [[Html]] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [ [ Html -> Html
    dterm (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html -> Html
    bold (Html -> Html) -> a -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << a
    dt, Html -> Html
    ddef (Html -> Html) -> b -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << b
    dd ] | (a
    dt,b
    dd) <- [(a, b)]
    items ]

    widget :: String -> String -> [HtmlAttr] -> Html
    widget :: String -> String -> [HtmlAttr] -> Html
    widget String
    w String
    n [HtmlAttr]
    markupAttrs = Html
    input Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! ([String -> HtmlAttr
    thetype String
    w,String -> HtmlAttr
    name String
    n] [HtmlAttr] -> [HtmlAttr] -> [HtmlAttr]
    forall a. [a] -> [a] -> [a]
    ++ [HtmlAttr]
    markupAttrs)

    checkbox :: String -> String -> Html
    hidden   :: String -> String -> Html
    radio    :: String -> String -> Html
    reset    :: String -> String -> Html
    submit   :: String -> String -> Html
    password :: String           -> Html
    textfield :: String          -> Html
    afile    :: String           -> Html
    clickmap :: String           -> Html

    checkbox :: String -> String -> Html
    checkbox String
    n String
    v = String -> String -> [HtmlAttr] -> Html
    widget String
    "CHECKBOX" String
    n [String -> HtmlAttr
    value String
    v]
    hidden :: String -> String -> Html
    hidden   String
    n String
    v = String -> String -> [HtmlAttr] -> Html
    widget String
    "HIDDEN"   String
    n [String -> HtmlAttr
    value String
    v]
    radio :: String -> String -> Html
    radio    String
    n String
    v = String -> String -> [HtmlAttr] -> Html
    widget String
    "RADIO"    String
    n [String -> HtmlAttr
    value String
    v]
    reset :: String -> String -> Html
    reset    String
    n String
    v = String -> String -> [HtmlAttr] -> Html
    widget String
    "RESET"    String
    n [String -> HtmlAttr
    value String
    v]
    submit :: String -> String -> Html
    submit   String
    n String
    v = String -> String -> [HtmlAttr] -> Html
    widget String
    "SUBMIT"   String
    n [String -> HtmlAttr
    value String
    v]
    password :: String -> Html
    password String
    n   = String -> String -> [HtmlAttr] -> Html
    widget String
    "PASSWORD" String
    n []
    textfield :: String -> Html
    textfield String
    n  = String -> String -> [HtmlAttr] -> Html
    widget String
    "TEXT"     String
    n []
    afile :: String -> Html
    afile    String
    n   = String -> String -> [HtmlAttr] -> Html
    widget String
    "FILE"     String
    n []
    clickmap :: String -> Html
    clickmap String
    n   = String -> String -> [HtmlAttr] -> Html
    widget String
    "IMAGE"    String
    n []

    menu :: String -> [Html] -> Html
    menu :: String -> [Html] -> Html
    menu String
    n [Html]
    choices
       = Html -> Html
    select (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    name String
    n] (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [ Html -> Html
    option (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html -> Html
    p (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html
    choice | Html
    choice <- [Html]
    choices ]

    gui :: String -> Html -> Html
    gui :: String -> Html -> Html
    gui String
    act = Html -> Html
    form (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    action String
    act,String -> HtmlAttr
    method String
    "POST"]

    -- ---------------------------------------------------------------------------
    -- Html Rendering

    -- Uses the append trick to optimize appending.
    -- The output is quite messy, because space matters in
    -- HTML, so we must not generate needless spaces.

    renderHtml :: (HTML html) => html -> String
    renderHtml :: forall html. HTML html => html -> String
    renderHtml html
    theHtml =
          String
    renderMessage String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
             ((String -> String) -> (String -> String) -> String -> String)
    -> (String -> String) -> [String -> String] -> String -> String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) String -> String
    forall a. a -> a
    id ((HtmlElement -> String -> String)
    -> [HtmlElement] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> HtmlElement -> String -> String
    renderHtml' Int
    0)
                               (Html -> [HtmlElement]
    getHtmlElements (String -> Html -> Html
    tag String
    "HTML" (Html -> Html) -> html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << html
    theHtml))) String
    "\n"

    renderMessage :: String
    renderMessage =
          String
    "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 FINAL//EN\">\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
          String
    "<!--Rendered using the Haskell Html Library v0.2-->\n"

    -- Warning: spaces matters in HTML. You are better using renderHtml.
    -- This is intentually very inefficent to "encorage" this,
    -- but the neater version in easier when debugging.

    -- Local Utilities
    prettyHtml :: (HTML html) => html -> String
    prettyHtml :: forall html. HTML html => html -> String
    prettyHtml html
    theHtml =
            [String] -> String
    unlines
          ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
          ([[String]] -> [String]) -> [[String]] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (HtmlElement -> [String]) -> [HtmlElement] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> [String]
    prettyHtml'
          ([HtmlElement] -> [[String]]) -> [HtmlElement] -> [[String]]
    forall a b. (a -> b) -> a -> b
    $ Html -> [HtmlElement]
    getHtmlElements
          (Html -> [HtmlElement]) -> Html -> [HtmlElement]
    forall a b. (a -> b) -> a -> b
    $ html -> Html
    forall a. HTML a => a -> Html
    toHtml html
    theHtml

    renderHtml' :: Int -> HtmlElement -> ShowS
    renderHtml' :: Int -> HtmlElement -> String -> String
    renderHtml' Int
    _ (HtmlString String
    str) = String -> String -> String
    forall a. [a] -> [a] -> [a]
    (++) String
    str
    renderHtml' Int
    n (HtmlTag
                  { markupTag :: HtmlElement -> String
    markupTag = String
    name,
                    markupContent :: HtmlElement -> Html
    markupContent = Html
    html,
                    markupAttrs :: HtmlElement -> [HtmlAttr]
    markupAttrs = [HtmlAttr]
    markupAttrs })
          = if Html -> Bool
    isNoHtml Html
    html Bool -> Bool -> Bool
    && String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem String
    name [String]
    validHtmlITags
            then Bool -> String -> [HtmlAttr] -> Int -> String -> String
    renderTag Bool
    True String
    name [HtmlAttr]
    markupAttrs Int
    n
            else (Bool -> String -> [HtmlAttr] -> Int -> String -> String
    renderTag Bool
    True String
    name [HtmlAttr]
    markupAttrs Int
    n
                 (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String -> String) -> (String -> String) -> String -> String)
    -> (String -> String) -> [String -> String] -> String -> String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) String -> String
    forall a. a -> a
    id ((HtmlElement -> String -> String)
    -> [HtmlElement] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> HtmlElement -> String -> String
    renderHtml' (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    2)) (Html -> [HtmlElement]
    getHtmlElements Html
    html))
                 (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> String -> [HtmlAttr] -> Int -> String -> String
    renderTag Bool
    False String
    name [] Int
    n)

    prettyHtml' :: HtmlElement -> [String]
    prettyHtml' :: HtmlElement -> [String]
    prettyHtml' (HtmlString String
    str) = [String
    str]
    prettyHtml' (HtmlTag
                  { markupTag :: HtmlElement -> String
    markupTag = String
    name,
                    markupContent :: HtmlElement -> Html
    markupContent = Html
    html,
                    markupAttrs :: HtmlElement -> [HtmlAttr]
    markupAttrs = [HtmlAttr]
    markupAttrs })
          = if Html -> Bool
    isNoHtml Html
    html Bool -> Bool -> Bool
    && String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem String
    name [String]
    validHtmlITags
            then
             [String -> String
    rmNL (Bool -> String -> [HtmlAttr] -> Int -> String -> String
    renderTag Bool
    True String
    name [HtmlAttr]
    markupAttrs Int
    0 String
    "")]
            else
             [String -> String
    rmNL (Bool -> String -> [HtmlAttr] -> Int -> String -> String
    renderTag Bool
    True String
    name [HtmlAttr]
    markupAttrs Int
    0 String
    "")] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
              [String] -> [String]
    shift ([[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((HtmlElement -> [String]) -> [HtmlElement] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> [String]
    prettyHtml' (Html -> [HtmlElement]
    getHtmlElements Html
    html))) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
             [String -> String
    rmNL (Bool -> String -> [HtmlAttr] -> Int -> String -> String
    renderTag Bool
    False String
    name [] Int
    0 String
    "")]
      where
          shift :: [String] -> [String]
    shift = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    x -> String
    "   " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x)
    rmNL :: String -> String
    rmNL = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n')

    -- This prints the Tags The lack of spaces in intentunal, because Html is
    -- actually space dependant.

    renderTag :: Bool -> String -> [HtmlAttr] -> Int -> ShowS
    renderTag :: Bool -> String -> [HtmlAttr] -> Int -> String -> String
    renderTag Bool
    x String
    name [HtmlAttr]
    markupAttrs Int
    n String
    r
          = String
    open String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [HtmlAttr] -> String
    rest [HtmlAttr]
    markupAttrs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ">" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    r
      where
          open :: String
    open = if Bool
    x then String
    "<" else String
    "</"

          nl :: String
    nl = String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    n Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8) Char
    '\t'
                    String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    n Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    8) Char
    ' '

          rest :: [HtmlAttr] -> String
    rest []   = String
    nl
          rest [HtmlAttr]
    attr = String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((HtmlAttr -> String) -> [HtmlAttr] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlAttr -> String
    showPair [HtmlAttr]
    attr) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    nl

          showPair :: HtmlAttr -> String
          showPair :: HtmlAttr -> String
    showPair (HtmlAttr String
    tag String
    val)
                  = String
    tag String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " = \"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    val  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""