{-# 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"