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

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

          Con String
c [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 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

          Rec String
c [(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 String
_ [(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 [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 [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 String
txt -> String -> Html -> Html
span String
"integer" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
text (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: String
txt)
          Float String
txt   -> String -> Html -> Html
span String
"float"   (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
text (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: String
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 String
txt -> String -> Html -> Html
span String
"integer" (String -> Html
text String
txt)
      Float String
txt   -> String -> Html -> Html
span String
"float"   (String -> Html
text String
txt)
      Char String
txt    -> String -> Html -> Html
span String
"char"    (String -> Html
text String
txt)
      String String
txt  -> String -> Html -> Html
span String
"string"  (String -> Html
text String
txt)
      Date String
txt    -> String -> Html -> Html
span String
"date"    (String -> Html
text String
txt)
      Time String
txt    -> String -> Html -> Html
span String
"time"    (String -> Html
text String
txt)
      Quote String
txt   -> String -> Html -> Html
span String
"quote"   (String -> Html
text String
txt)

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

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

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


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

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

wideTuple :: [Html] -> Html
wideTuple :: [Html] -> Html
wideTuple [Html]
els = String -> [Html] -> Html
table String
"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 = String -> [Html] -> Html
table String
"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 String
con [String]
labs [Html]
els = String -> [Html] -> Html
table String
"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 String
"con" Int
2 (String -> Html
text String
con) ]
  row :: String -> Html -> Html
row String
l Html
e = [Html] -> Html
tr [ String -> Int -> Html -> Html
th String
"label" Int
1 (String -> Html
text String
l),   Html -> Html
td Html
e ]

recordList :: Name -> [Name] -> [[Html]] -> Html
recordList :: String -> [String] -> [[Html]] -> Html
recordList String
con [String]
labs [[Html]]
els = String -> [Html] -> Html
table String
"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
$ String -> Int -> Html -> Html
th String
"con" Int
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 String
"label" Int
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 Int
n [Html]
es = [Html] -> Html
tr ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ String -> Int -> Html -> Html
th String
"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 = String -> [String] -> [[Html]] -> Html
recordList String
" " (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
n String
" ") [[Html]]
els

tallList :: [Html] -> Html
tallList :: [Html] -> Html
tallList [Html]
els = String -> [Html] -> Html
table String
"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 [ String -> Int -> Html -> Html
th String
"con" Int
2 (String -> Html
text String
" ")]
  row :: Int -> Html -> Html
row Int
n Html
e = [Html] -> Html
tr [ String -> Int -> Html -> Html
th String
"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 = String -> [Html] -> Html
table String
"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 (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
$ String -> Int -> Html -> Html
th String
"con" Int
1 (String -> Html
text String
" ") 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 String
"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
$ (String -> Int -> Html -> Html
th String
"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 -> String
exportHtml :: String }

table :: String -> [Html] -> Html
table :: String -> [Html] -> Html
table String
cl [Html]
body = String -> Html
Html (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
"<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
">" 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]
++
                       String
"</table>"

tr :: [Html] -> Html
tr :: [Html] -> Html
tr [Html]
body = String -> Html
Html (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
"<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]
++ String
"</tr>"

th :: String -> Int -> Html -> Html
th :: String -> Int -> Html -> Html
th String
cl Int
n Html
body = String -> Html
Html (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
"<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]
++
                         String
" 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
">" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                      Html -> String
exportHtml Html
body String -> ShowS
forall a. [a] -> [a] -> [a]
++
                      String
"</th>"

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

td' :: String -> Html -> Html
td' :: String -> Html -> Html
td' String
cl Html
body = String -> Html
Html (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
"<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
">" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     Html -> String
exportHtml Html
body String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
"</td>"

span :: String -> Html -> Html
span :: String -> Html -> Html
span String
cl Html
body = String -> Html
Html (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
"<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
">" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                      Html -> String
exportHtml Html
body String -> ShowS
forall a. [a] -> [a] -> [a]
++
                      String
"</span>"

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

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 Char
'<' = String
"&lt;"
  esc Char
'>' = String
"&gt;"
  esc Char
'&' = String
"&amp;"
  esc Char
' ' = String
"&nbsp;"
  esc Char
c   = [Char
c]

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