{-# LANGUAGE Safe #-}
module Text.Show.Html
( HtmlOpts(..), defaultHtmlOpts
, valToHtml, valToHtmlPage, htmlPage
, Html(..)
) where
import Text.Show.Value
import Prelude hiding (span)
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
data HtmlOpts = HtmlOpts
{ HtmlOpts -> String
dataDir :: FilePath
, HtmlOpts -> Int
wideListWidth :: Int
} 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
defaultHtmlOpts :: HtmlOpts
defaultHtmlOpts :: HtmlOpts
defaultHtmlOpts = HtmlOpts :: String -> Int -> HtmlOpts
HtmlOpts
{ dataDir :: String
dataDir = ""
, wideListWidth :: Int
wideListWidth = 80
}
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 '<' = "<"
esc '>' = ">"
esc '&' = "&"
esc ' ' = " "
esc c :: Char
c = [Char
c]
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
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"