    {-# LANGUAGE Safe #-}
    module Text.Show.Html
      ( HtmlOpts(..), defaultHtmlOpts
      , valToHtml, valToHtmlPage, htmlPage
      , Html(..)
      ) where

    import Text.Show.Value
    import Prelude hiding (span)

    -- | Make an Html page representing the given value.
    valToHtmlPage :: HtmlOpts -> Value -> String
    valToHtmlPage :: HtmlOpts -> Value -> [Char]
    valToHtmlPage HtmlOpts
    opts = HtmlOpts -> Html -> [Char]
    htmlPage HtmlOpts
    opts (Html -> [Char]) -> (Value -> Html) -> Value -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HtmlOpts -> Value -> Html
    valToHtml HtmlOpts
    opts

    -- | Options on how to generate Html (more to come).
    data HtmlOpts = HtmlOpts
      { HtmlOpts -> [Char]
    dataDir :: FilePath   -- ^ Path for extra files.  If empty, we look in
                              -- directory `style`, relative to document.
      , HtmlOpts -> Int
    wideListWidth :: Int  -- ^ Max. number of columns in wide lists.
      } deriving Int -> HtmlOpts -> ShowS
    [HtmlOpts] -> ShowS
    HtmlOpts -> [Char]
    (Int -> HtmlOpts -> ShowS)
    -> (HtmlOpts -> [Char]) -> ([HtmlOpts] -> ShowS) -> Show HtmlOpts
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HtmlOpts -> ShowS
    showsPrec :: Int -> HtmlOpts -> ShowS
    $cshow :: HtmlOpts -> [Char]
    show :: HtmlOpts -> [Char]
    $cshowList :: [HtmlOpts] -> ShowS
    showList :: [HtmlOpts] -> ShowS
    Show

    -- | Default options.
    defaultHtmlOpts :: HtmlOpts
    defaultHtmlOpts :: HtmlOpts
    defaultHtmlOpts = HtmlOpts
      { dataDir :: [Char]
    dataDir       = [Char]
    ""
      , wideListWidth :: Int
    wideListWidth = Int
    80
      }

    -- | Convert a value into an Html fragment.
    valToHtml :: HtmlOpts -> Value -> Html
    valToHtml :: HtmlOpts -> Value -> Html
    valToHtml HtmlOpts
    opts = Value -> Html
    loop
      where
      loop :: Value -> Html
    loop Value
    val =
        case Value
    val of
          Con [Char]
    con []  -> [Char] -> Html -> Html
    span [Char]
    "con" ([Char] -> Html
    text [Char]
    con)
          Con [Char]
    con [Value]
    vs  -> [Char] -> [[Char]] -> [Html] -> Html
    tallRecord [Char]
    con ((Value -> [Char]) -> [Value] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> [Char]
    forall {p}. p -> [Char]
    conLab [Value]
    vs) ((Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop         [Value]
    vs)
          Rec [Char]
    con [([Char], Value)]
    fs  -> [Char] -> [[Char]] -> [Html] -> Html
    tallRecord [Char]
    con ((([Char], Value) -> [Char]) -> [([Char], Value)] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char], Value) -> [Char]
    forall a b. (a, b) -> a
    fst [([Char], Value)]
    fs)    ((([Char], Value) -> Html) -> [([Char], Value)] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (Value -> Html
    loop (Value -> Html)
    -> (([Char], Value) -> Value) -> ([Char], Value) -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char], Value) -> Value
    forall a b. (a, b) -> b
    snd) [([Char], Value)]
    fs)
          Tuple [Value]
    vs    -> [Html] -> Html
    wideTuple                      ((Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs)

          InfixCons Value
    v [([Char], Value)]
    ms ->
            [Char] -> [Html] -> Html
    table [Char]
    "infix tallRecord"
              [ [Html] -> Html
    tr ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Int -> Html -> Html
    th [Char]
    "label" Int
    1 ([Char] -> Html
    text [Char]
    " ") Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    :)
                   ([Html] -> [Html]) -> [Html] -> [Html]
    forall a b. (a -> b) -> a -> b
    $ (Html -> Html) -> [Html] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Html -> Html
    td ([Html] -> [Html]) -> [Html] -> [Html]
    forall a b. (a -> b) -> a -> b
    $ Value -> Html
    loop Value
    v Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : [ Html
    h | ([Char]
    op,Value
    u) <- [([Char], Value)]
    ms
                                       , Html
    h <- [ [Char] -> Html
    text [Char]
    op, Value -> Html
    loop Value
    u ]
                                       ]
              ]

          List []     -> [Char] -> Html -> Html
    span [Char]
    "list" ([Char] -> Html
    text [Char]
    "[]")
          List vs :: [Value]
    vs@(Value
    v : [Value]
    vs1) ->
            case Value
    v of

              Con [Char]
    c [Value]
    fs
                | (Value -> Bool) -> [Value] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Char] -> Value -> Bool
    isCon [Char]
    c) [Value]
    vs1  -> [Char] -> [[Char]] -> [[Html]] -> Html
    recordList [Char]
    c ((Value -> [Char]) -> [Value] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> [Char]
    forall {p}. p -> [Char]
    conLab [Value]
    fs)
                                         [ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    xs | Con [Char]
    _ [Value]
    xs <- [Value]
    vs ]
                | Bool
    otherwise          -> [Html] -> Html
    tallList ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (Value -> Html
    loop) [Value]
    vs

              Rec [Char]
    c [([Char], Value)]
    fs
                | (Value -> Bool) -> [Value] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Char] -> Value -> Bool
    isRec [Char]
    c) [Value]
    vs1   -> [Char] -> [[Char]] -> [[Html]] -> Html
    recordList [Char]
    c ((([Char], Value) -> [Char]) -> [([Char], Value)] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char], Value) -> [Char]
    forall a b. (a, b) -> a
    fst [([Char], Value)]
    fs)
                                       [ (([Char], Value) -> Html) -> [([Char], Value)] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (Value -> Html
    loop (Value -> Html)
    -> (([Char], Value) -> Value) -> ([Char], Value) -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char], Value) -> Value
    forall a b. (a, b) -> b
    snd) [([Char], Value)]
    xs | Rec [Char]
    _ [([Char], Value)]
    xs <- [Value]
    vs ]
                | Bool
    otherwise           -> [Html] -> Html
    tallList ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (Value -> Html
    loop) [Value]
    vs

              Tuple [Value]
    fs -> Int -> [[Html]] -> Html
    tupleList ([Value] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Value]
    fs)
                                [ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (Value -> Html
    loop) [Value]
    xs | Tuple [Value]
    xs <- [Value]
    vs ]

              List {}    -> [Html] -> Html
    tallList    ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs

              Neg {}     -> Int -> [Html] -> Html
    wideList (HtmlOpts -> Int
    wideListWidth HtmlOpts
    opts) ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs
              Ratio {}   -> Int -> [Html] -> Html
    wideList (HtmlOpts -> Int
    wideListWidth HtmlOpts
    opts) ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs
              Integer {} -> Int -> [Html] -> Html
    wideList (HtmlOpts -> Int
    wideListWidth HtmlOpts
    opts) ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs
              Float {}   -> Int -> [Html] -> Html
    wideList (HtmlOpts -> Int
    wideListWidth HtmlOpts
    opts) ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs
              Char {}    -> Int -> [Html] -> Html
    wideList (HtmlOpts -> Int
    wideListWidth HtmlOpts
    opts) ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs
              Date {}    -> Int -> [Html] -> Html
    wideList (HtmlOpts -> Int
    wideListWidth HtmlOpts
    opts) ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs
              Time {}    -> Int -> [Html] -> Html
    wideList (HtmlOpts -> Int
    wideListWidth HtmlOpts
    opts) ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs
              Quote {}   -> Int -> [Html] -> Html
    wideList (HtmlOpts -> Int
    wideListWidth HtmlOpts
    opts) ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs
              String {}  -> [Html] -> Html
    tallList                      ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs
              InfixCons {} -> [Html] -> Html
    tallList                    ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    vs

          Neg Value
    v       ->
            case Value
    v of
              Integer [Char]
    txt -> [Char] -> Html -> Html
    span [Char]
    "integer" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    text (Char
    '-' Char -> ShowS
    forall a. a -> [a] -> [a]
    : [Char]
    txt)
              Float [Char]
    txt   -> [Char] -> Html -> Html
    span [Char]
    "float"   (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    text (Char
    '-' Char -> ShowS
    forall a. a -> [a] -> [a]
    : [Char]
    txt)
              Value
    _           -> Html -> Html
    neg (Value -> Html
    loop Value
    v)

          Ratio Value
    v1 Value
    v2 -> Html -> Html -> Html
    ratio (Value -> Html
    loop Value
    v1) (Value -> Html
    loop Value
    v2)
          Integer [Char]
    txt -> [Char] -> Html -> Html
    span [Char]
    "integer" ([Char] -> Html
    text [Char]
    txt)
          Float [Char]
    txt   -> [Char] -> Html -> Html
    span [Char]
    "float"   ([Char] -> Html
    text [Char]
    txt)
          Char [Char]
    txt    -> [Char] -> Html -> Html
    span [Char]
    "char"    ([Char] -> Html
    text [Char]
    txt)
          String [Char]
    txt  -> [Char] -> Html -> Html
    span [Char]
    "string"  ([Char] -> Html
    text [Char]
    txt)
          Date [Char]
    txt    -> [Char] -> Html -> Html
    span [Char]
    "date"    ([Char] -> Html
    text [Char]
    txt)
          Time [Char]
    txt    -> [Char] -> Html -> Html
    span [Char]
    "time"    ([Char] -> Html
    text [Char]
    txt)
          Quote [Char]
    txt   -> [Char] -> Html -> Html
    span [Char]
    "quote"   ([Char] -> Html
    text [Char]
    txt)

      conLab :: p -> [Char]
    conLab p
    _          = [Char]
    " "

      isCon :: [Char] -> Value -> Bool
    isCon [Char]
    c (Con [Char]
    d [Value]
    _) = [Char]
    c [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    d
      isCon [Char]
    _ Value
    _         = Bool
    False

      isRec :: [Char] -> Value -> Bool
    isRec [Char]
    c (Rec [Char]
    d [([Char], Value)]
    _) = [Char]
    c [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    d
      isRec [Char]
    _ Value
    _         = Bool
    False

    neg :: Html -> Html
    neg :: Html -> Html
    neg Html
    e = [Char] -> [Html] -> Html
    table [Char]
    "negate" [ [Html] -> Html
    tr [Html -> Html
    td ([Char] -> Html
    text [Char]
    "-"), Html -> Html
    td Html
    e] ]

    ratio :: Html -> Html -> Html
    ratio :: Html -> Html -> Html
    ratio Html
    e1 Html
    e2 = [Char] -> [Html] -> Html
    table [Char]
    "ratio" [ [Html] -> Html
    tr [ [Char] -> Html -> Html
    td' [Char]
    "numerator" Html
    e1 ], [Html] -> Html
    tr [Html -> Html
    td Html
    e2] ]

    wideTuple :: [Html] -> Html
    wideTuple :: [Html] -> Html
    wideTuple [Html]
    els = [Char] -> [Html] -> Html
    table [Char]
    "wideTuple" [ [Html] -> Html
    tr ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Html -> Html) -> [Html] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Html -> Html
    td [Html]
    els ]

    tallTuple :: [Html] -> Html
    tallTuple :: [Html] -> Html
    tallTuple [Html]
    els = [Char] -> [Html] -> Html
    table [Char]
    "tallTuple" ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (Html -> Html) -> [Html] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Html] -> Html
    tr ([Html] -> Html) -> (Html -> [Html]) -> Html -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Html -> [Html]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Html -> [Html]) -> (Html -> Html) -> Html -> [Html]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Html -> Html
    td) [Html]
    els

    tallRecord :: Name -> [Name] -> [Html] -> Html
    tallRecord :: [Char] -> [[Char]] -> [Html] -> Html
    tallRecord [Char]
    con [[Char]]
    labs [Html]
    els = [Char] -> [Html] -> Html
    table [Char]
    "tallRecord" ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    topHs Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : ([Char] -> Html -> Html) -> [[Char]] -> [Html] -> [Html]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith [Char] -> Html -> Html
    row [[Char]]
    labs [Html]
    els
      where
      topHs :: Html
    topHs   = [Html] -> Html
    tr [ [Char] -> Int -> Html -> Html
    th [Char]
    "con" Int
    2 ([Char] -> Html
    text [Char]
    con) ]
      row :: [Char] -> Html -> Html
    row [Char]
    l Html
    e = [Html] -> Html
    tr [ [Char] -> Int -> Html -> Html
    th [Char]
    "label" Int
    1 ([Char] -> Html
    text [Char]
    l),   Html -> Html
    td Html
    e ]

    recordList :: Name -> [Name] -> [[Html]] -> Html
    recordList :: [Char] -> [[Char]] -> [[Html]] -> Html
    recordList [Char]
    con [[Char]]
    labs [[Html]]
    els = [Char] -> [Html] -> Html
    table [Char]
    "recordList" ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    topHs Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : (Int -> [Html] -> Html) -> [Int] -> [[Html]] -> [Html]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> [Html] -> Html
    row [Int
    0..] [[Html]]
    els
      where
      topHs :: Html
    topHs    = [Html] -> Html
    tr ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Int -> Html -> Html
    th [Char]
    "con" Int
    1 ([Char] -> Html
    text [Char]
    con) Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : ([Char] -> Html) -> [[Char]] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char] -> Int -> Html -> Html
    th [Char]
    "label" Int
    1 (Html -> Html) -> ([Char] -> Html) -> [Char] -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Html
    text) [[Char]]
    labs
      row :: Int -> [Html] -> Html
    row Int
    n [Html]
    es = [Html] -> Html
    tr ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Int -> Html -> Html
    th [Char]
    "ix" Int
    1 (Int -> Html
    int Int
    n) Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : (Html -> Html) -> [Html] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Html -> Html
    td [Html]
    es

    tupleList :: Int -> [[Html]] -> Html
    tupleList :: Int -> [[Html]] -> Html
    tupleList Int
    n [[Html]]
    els = [Char] -> [[Char]] -> [[Html]] -> Html
    recordList [Char]
    " " (Int -> [Char] -> [[Char]]
    forall a. Int -> a -> [a]
    replicate Int
    n [Char]
    " ") [[Html]]
    els

    tallList :: [Html] -> Html
    tallList :: [Html] -> Html
    tallList [Html]
    els = [Char] -> [Html] -> Html
    table [Char]
    "tallList" ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    top Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : (Int -> Html -> Html) -> [Int] -> [Html] -> [Html]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Html -> Html
    row [Int
    0..] [Html]
    els
      where
      top :: Html
    top     = [Html] -> Html
    tr [ [Char] -> Int -> Html -> Html
    th [Char]
    "con" Int
    2 ([Char] -> Html
    text [Char]
    " ")]
      row :: Int -> Html -> Html
    row Int
    n Html
    e = [Html] -> Html
    tr [ [Char] -> Int -> Html -> Html
    th [Char]
    "ix" Int
    1 (Int -> Html
    int Int
    n), Html -> Html
    td Html
    e ]

    wideList :: Int -> [Html] -> Html
    wideList :: Int -> [Html] -> Html
    wideList Int
    w [Html]
    els = [Char] -> [Html] -> Html
    table [Char]
    "wideList" ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    topHs Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : (Int -> [Html] -> Html) -> [Int] -> [[Html]] -> [Html]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> [Html] -> Html
    row [Int
    0..] ([Html] -> [[Html]]
    chop [Html]
    els)
      where
      elNum :: Int
    elNum = [Html] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Html]
    els
      pad :: Bool
    pad   = Int
    elNum Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    w

      chop :: [Html] -> [[Html]]
    chop [] = []
      chop [Html]
    xs = let ([Html]
    as,[Html]
    bs) = Int -> [Html] -> ([Html], [Html])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    w [Html]
    xs
                in Int -> [Html] -> [Html]
    forall a. Int -> [a] -> [a]
    take Int
    w ([Html]
    as [Html] -> [Html] -> [Html]
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    pad then Html -> [Html]
    forall a. a -> [a]
    repeat Html
    empty else []) [Html] -> [[Html]] -> [[Html]]
    forall a. a -> [a] -> [a]
    : [Html] -> [[Html]]
    chop [Html]
    bs

      topHs :: Html
    topHs     = [Html] -> Html
    tr ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Int -> Html -> Html
    th [Char]
    "con" Int
    1 ([Char] -> Html
    text [Char]
    " ") Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : (Int -> Html) -> [Int] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char] -> Int -> Html -> Html
    th [Char]
    "label" Int
    1 (Html -> Html) -> (Int -> Html) -> Int -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Html
    int)
                                                    [ Int
    0 .. Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    elNum Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 ]
      row :: Int -> [Html] -> Html
    row Int
    n [Html]
    es  = [Html] -> Html
    tr ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Int -> Html -> Html
    th [Char]
    "ix" Int
    1 (Int -> Html
    int (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    w))) Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : (Html -> Html) -> [Html] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Html -> Html
    td [Html]
    es

    --------------------------------------------------------------------------------
    newtype Html = Html { Html -> [Char]
    exportHtml :: String }

    table :: String -> [Html] -> Html
    table :: [Char] -> [Html] -> Html
    table [Char]
    cl [Html]
    body = [Char] -> Html
    Html ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "<table class=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> [Char]
    show [Char]
    cl [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ">" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           (Html -> [Char]) -> [Html] -> [Char]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Html -> [Char]
    exportHtml [Html]
    body [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           [Char]
    "</table>"

    tr :: [Html] -> Html
    tr :: [Html] -> Html
    tr [Html]
    body = [Char] -> Html
    Html ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "<tr>" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Html -> [Char]) -> [Html] -> [Char]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Html -> [Char]
    exportHtml [Html]
    body [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "</tr>"

    th :: String -> Int -> Html -> Html
    th :: [Char] -> Int -> Html -> Html
    th [Char]
    cl Int
    n Html
    body = [Char] -> Html
    Html ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "<th class=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> [Char]
    show [Char]
    cl [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                             [Char]
    " colspan=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> [Char]
    show (Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n) [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ">" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                          Html -> [Char]
    exportHtml Html
    body [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                          [Char]
    "</th>"

    td :: Html -> Html
    td :: Html -> Html
    td Html
    body = [Char] -> Html
    Html ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "<td>" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Html -> [Char]
    exportHtml Html
    body [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "</td>"

    td' :: String -> Html -> Html
    td' :: [Char] -> Html -> Html
    td' [Char]
    cl Html
    body = [Char] -> Html
    Html ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "<td class=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> [Char]
    show [Char]
    cl [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ">" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                         Html -> [Char]
    exportHtml Html
    body [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                         [Char]
    "</td>"

    span :: String -> Html -> Html
    span :: [Char] -> Html -> Html
    span [Char]
    cl Html
    body = [Char] -> Html
    Html ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "<span class=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> [Char]
    show [Char]
    cl [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ">" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                          Html -> [Char]
    exportHtml Html
    body [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                          [Char]
    "</span>"

    empty :: Html
    empty :: Html
    empty = [Char] -> Html
    Html  [Char]
    ""

    int :: Int -> Html
    int :: Int -> Html
    int = [Char] -> Html
    Html ([Char] -> Html) -> (Int -> [Char]) -> Int -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show

    text :: String -> Html
    text :: [Char] -> Html
    text = [Char] -> Html
    Html ([Char] -> Html) -> ShowS -> [Char] -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> [Char]) -> ShowS
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Char -> [Char]
    esc
      where
      esc :: Char -> [Char]
    esc Char
    '<' = [Char]
    "&lt;"
      esc Char
    '>' = [Char]
    "&gt;"
      esc Char
    '&' = [Char]
    "&amp;"
      esc Char
    ' ' = [Char]
    "&nbsp;"
      esc Char
    c   = [Char
    c]

    -- | Wrap an Html fragment to make an Html page.
    htmlPage :: HtmlOpts -> Html -> String
    htmlPage :: HtmlOpts -> Html -> [Char]
    htmlPage HtmlOpts
    opts Html
    body =
      [[Char]] -> [Char]
    unlines
      [ [Char]
    "<html>"
      , [Char]
    "<head>"
      , [Char]
    "<link href="  [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> [Char]
    show [Char]
    pstyle [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " rel=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> [Char]
    show [Char]
    "stylesheet" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ">"
      , [Char]
    "<script src=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> [Char]
    show [Char]
    jquery [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "></script>"
      , [Char]
    "<script src=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> [Char]
    show [Char]
    pjs    [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "></script>"
      , [Char]
    "<body>"
      , Html -> [Char]
    exportHtml  Html
    body
      , [Char]
    "</body>"
      , [Char]
    "</html>"
      ]
      where
      -- XXX: slashes on Windows?
      dir :: [Char]
    dir    = case HtmlOpts -> [Char]
    dataDir HtmlOpts
    opts of
                 [Char]
    "" -> [Char]
    ""
                 [Char]
    d  -> [Char]
    d [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/"
      jquery :: [Char]
    jquery = [Char]
    dir [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "style/jquery.js"
      pjs :: [Char]
    pjs    = [Char]
    dir [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "style/pretty-show.js"
      pstyle :: [Char]
    pstyle = [Char]
    dir [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "style/pretty-show.css"