    {-# 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 -> String
    valToHtmlPage opts :: HtmlOpts
    opts = HtmlOpts -> Html -> String
    htmlPage HtmlOpts
    opts (Html -> String) -> (Value -> Html) -> Value -> String
    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 -> String
    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 -> String
    (Int -> HtmlOpts -> ShowS)
    -> (HtmlOpts -> String) -> ([HtmlOpts] -> ShowS) -> Show HtmlOpts
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [HtmlOpts] -> ShowS
    $cshowList :: [HtmlOpts] -> ShowS
    show :: HtmlOpts -> String
    $cshow :: HtmlOpts -> String
    showsPrec :: Int -> HtmlOpts -> ShowS
    $cshowsPrec :: Int -> HtmlOpts -> ShowS
    Show

    -- | Default options.
    defaultHtmlOpts :: HtmlOpts
    defaultHtmlOpts :: HtmlOpts
    defaultHtmlOpts = HtmlOpts :: String -> Int -> HtmlOpts
    HtmlOpts
      { dataDir :: String
    dataDir       = ""
      , wideListWidth :: Int
    wideListWidth = 80
      }

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

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

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

              Con c :: String
    c fs :: [Value]
    fs
                | (Value -> Bool) -> [Value] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (String -> Value -> Bool
    isCon String
    c) [Value]
    vs1  -> String -> [String] -> [[Html]] -> Html
    recordList String
    c ((Value -> String) -> [Value] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> String
    forall p. p -> String
    conLab [Value]
    fs)
                                         [ (Value -> Html) -> [Value] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Html
    loop [Value]
    xs | Con _ xs :: [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 c :: String
    c fs :: [(String, Value)]
    fs
                | (Value -> Bool) -> [Value] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (String -> Value -> Bool
    isRec String
    c) [Value]
    vs1   -> String -> [String] -> [[Html]] -> Html
    recordList String
    c (((String, Value) -> String) -> [(String, Value)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Value) -> String
    forall a b. (a, b) -> a
    fst [(String, Value)]
    fs)
                                       [ ((String, Value) -> Html) -> [(String, Value)] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (Value -> Html
    loop (Value -> Html)
    -> ((String, Value) -> Value) -> (String, Value) -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, Value) -> Value
    forall a b. (a, b) -> b
    snd) [(String, Value)]
    xs | Rec _ xs :: [(String, 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 fs :: [Value]
    fs -> Int -> [[Html]] -> Html
    tupleList ([Value] -> 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 xs :: [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 v :: Value
    v       ->
            case Value
    v of
              Integer txt :: String
    txt -> String -> Html -> Html
    span "integer" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ String -> Html
    text ('-' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    txt)
              Float txt :: String
    txt   -> String -> Html -> Html
    span "float"   (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ String -> Html
    text ('-' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    txt)
              _           -> Html -> Html
    neg (Value -> Html
    loop Value
    v)

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

      conLab :: p -> String
    conLab _          = " "

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

      isRec :: String -> Value -> Bool
    isRec c :: String
    c (Rec d :: String
    d _) = String
    c String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    d
      isRec _ _         = Bool
    False

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

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

    wideTuple :: [Html] -> Html
    wideTuple :: [Html] -> Html
    wideTuple els :: [Html]
    els = String -> [Html] -> Html
    table "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 els :: [Html]
    els = String -> [Html] -> Html
    table "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 (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 :: String -> [String] -> [Html] -> Html
    tallRecord con :: String
    con labs :: [String]
    labs els :: [Html]
    els = String -> [Html] -> Html
    table "tallRecord" ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    topHs Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : (String -> Html -> Html) -> [String] -> [Html] -> [Html]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith String -> Html -> Html
    row [String]
    labs [Html]
    els
      where
      topHs :: Html
    topHs   = [Html] -> Html
    tr [ String -> Int -> Html -> Html
    th "con" 2 (String -> Html
    text String
    con) ]
      row :: String -> Html -> Html
    row l :: String
    l e :: Html
    e = [Html] -> Html
    tr [ String -> Int -> Html -> Html
    th "label" 1 (String -> Html
    text String
    l),   Html -> Html
    td Html
    e ]

    recordList :: Name -> [Name] -> [[Html]] -> Html
    recordList :: String -> [String] -> [[Html]] -> Html
    recordList con :: String
    con labs :: [String]
    labs els :: [[Html]]
    els = String -> [Html] -> Html
    table "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 [0..] [[Html]]
    els
      where
      topHs :: Html
    topHs    = [Html] -> Html
    tr ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ String -> Int -> Html -> Html
    th "con" 1 (String -> Html
    text String
    con) Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : (String -> Html) -> [String] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Int -> Html -> Html
    th "label" 1 (Html -> Html) -> (String -> Html) -> String -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Html
    text) [String]
    labs
      row :: Int -> [Html] -> Html
    row n :: Int
    n es :: [Html]
    es = [Html] -> Html
    tr ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ String -> Int -> Html -> Html
    th "ix" 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 n :: Int
    n els :: [[Html]]
    els = String -> [String] -> [[Html]] -> Html
    recordList " " (Int -> String -> [String]
    forall a. Int -> a -> [a]
    replicate Int
    n " ") [[Html]]
    els

    tallList :: [Html] -> Html
    tallList :: [Html] -> Html
    tallList els :: [Html]
    els = String -> [Html] -> Html
    table "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 [0..] [Html]
    els
      where
      top :: Html
    top     = [Html] -> Html
    tr [ String -> Int -> Html -> Html
    th "con" 2 (String -> Html
    text " ")]
      row :: Int -> Html -> Html
    row n :: Int
    n e :: Html
    e = [Html] -> Html
    tr [ String -> Int -> Html -> Html
    th "ix" 1 (Int -> Html
    int Int
    n), Html -> Html
    td Html
    e ]

    wideList :: Int -> [Html] -> Html
    wideList :: Int -> [Html] -> Html
    wideList w :: Int
    w els :: [Html]
    els = String -> [Html] -> Html
    table "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 [0..] ([Html] -> [[Html]]
    chop [Html]
    els)
      where
      elNum :: Int
    elNum = [Html] -> 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 xs :: [Html]
    xs = let (as :: [Html]
    as,bs :: [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
    $ String -> Int -> Html -> Html
    th "con" 1 (String -> Html
    text " ") Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    : (Int -> Html) -> [Int] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Int -> Html -> Html
    th "label" 1 (Html -> Html) -> (Int -> Html) -> Int -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Html
    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
    - 1 ]
      row :: Int -> [Html] -> Html
    row n :: Int
    n es :: [Html]
    es  = [Html] -> Html
    tr ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ (String -> Int -> Html -> Html
    th "ix" 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 -> String
    exportHtml :: String }

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

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

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

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

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

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

    empty :: Html
    empty :: Html
    empty = String -> Html
    Html  ""

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

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

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