module Text.Html (
module Text.Html,
) where
import qualified Text.Html.BlockTable as BT
infixr 3 </>
infixr 4 <->
infixr 2 +++
infixr 7 <<
infixl 8 !
data HtmlElement
= HtmlString String
| HtmlTag {
HtmlElement -> String
markupTag :: String,
HtmlElement -> [HtmlAttr]
markupAttrs :: [HtmlAttr],
HtmlElement -> Html
markupContent :: Html
}
data HtmlAttr = HtmlAttr String String
newtype Html = Html { Html -> [HtmlElement]
getHtmlElements :: [HtmlElement] }
class HTML a where
toHtml :: a -> Html
toHtmlFromList :: [a] -> Html
toHtmlFromList [a]
xs = [HtmlElement] -> Html
Html (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [HtmlElement]
x | (Html [HtmlElement]
x) <- forall a b. (a -> b) -> [a] -> [b]
map forall a. HTML a => a -> Html
toHtml [a]
xs])
instance HTML Html where
toHtml :: Html -> Html
toHtml Html
a = Html
a
instance HTML Char where
toHtml :: Char -> Html
toHtml Char
a = forall a. HTML a => a -> Html
toHtml [Char
a]
toHtmlFromList :: String -> Html
toHtmlFromList [] = [HtmlElement] -> Html
Html []
toHtmlFromList String
str = [HtmlElement] -> Html
Html [String -> HtmlElement
HtmlString (String -> String
stringToHtmlString String
str)]
instance (HTML a) => HTML [a] where
toHtml :: [a] -> Html
toHtml [a]
xs = forall a. HTML a => [a] -> Html
toHtmlFromList [a]
xs
class ADDATTRS a where
(!) :: a -> [HtmlAttr] -> a
instance (ADDATTRS b) => ADDATTRS (a -> b) where
a -> b
fn ! :: (a -> b) -> [HtmlAttr] -> a -> b
! [HtmlAttr]
attr = \ a
arg -> a -> b
fn a
arg forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [HtmlAttr]
attr
instance ADDATTRS Html where
(Html [HtmlElement]
htmls) ! :: Html -> [HtmlAttr] -> Html
! [HtmlAttr]
attr = [HtmlElement] -> Html
Html (forall a b. (a -> b) -> [a] -> [b]
map HtmlElement -> HtmlElement
addAttrs [HtmlElement]
htmls)
where
addAttrs :: HtmlElement -> HtmlElement
addAttrs (html :: HtmlElement
html@(HtmlTag { markupAttrs :: HtmlElement -> [HtmlAttr]
markupAttrs = [HtmlAttr]
markupAttrs }) )
= HtmlElement
html { markupAttrs :: [HtmlAttr]
markupAttrs = [HtmlAttr]
markupAttrs forall a. [a] -> [a] -> [a]
++ [HtmlAttr]
attr }
addAttrs HtmlElement
html = HtmlElement
html
(<<) :: (HTML a) => (Html -> b) -> a -> b
Html -> b
fn << :: forall a b. HTML a => (Html -> b) -> a -> b
<< a
arg = Html -> b
fn (forall a. HTML a => a -> Html
toHtml a
arg)
concatHtml :: (HTML a) => [a] -> Html
concatHtml :: forall a. HTML a => [a] -> Html
concatHtml [a]
as = [HtmlElement] -> Html
Html (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map (Html -> [HtmlElement]
getHtmlElementsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. HTML a => a -> Html
toHtml) [a]
as))
(+++) :: (HTML a,HTML b) => a -> b -> Html
a
a +++ :: forall a b. (HTML a, HTML b) => a -> b -> Html
+++ b
b = [HtmlElement] -> Html
Html (Html -> [HtmlElement]
getHtmlElements (forall a. HTML a => a -> Html
toHtml a
a) forall a. [a] -> [a] -> [a]
++ Html -> [HtmlElement]
getHtmlElements (forall a. HTML a => a -> Html
toHtml b
b))
noHtml :: Html
noHtml :: Html
noHtml = [HtmlElement] -> Html
Html []
isNoHtml :: Html -> Bool
isNoHtml (Html [HtmlElement]
xs) = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HtmlElement]
xs
tag :: String -> Html -> Html
tag :: String -> Html -> Html
tag String
str Html
htmls = [HtmlElement] -> Html
Html [
HtmlTag {
markupTag :: String
markupTag = String
str,
markupAttrs :: [HtmlAttr]
markupAttrs = [],
markupContent :: Html
markupContent = Html
htmls }]
itag :: String -> Html
itag :: String -> Html
itag String
str = String -> Html -> Html
tag String
str Html
noHtml
emptyAttr :: String -> HtmlAttr
emptyAttr :: String -> HtmlAttr
emptyAttr String
s = String -> String -> HtmlAttr
HtmlAttr String
s String
""
intAttr :: String -> Int -> HtmlAttr
intAttr :: String -> Int -> HtmlAttr
intAttr String
s Int
i = String -> String -> HtmlAttr
HtmlAttr String
s (forall a. Show a => a -> String
show Int
i)
strAttr :: String -> String -> HtmlAttr
strAttr :: String -> String -> HtmlAttr
strAttr String
s String
t = String -> String -> HtmlAttr
HtmlAttr String
s String
t
stringToHtmlString :: String -> String
stringToHtmlString :: String -> String
stringToHtmlString = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
fixChar
where
fixChar :: Char -> String
fixChar Char
'<' = String
"<"
fixChar Char
'>' = String
">"
fixChar Char
'&' = String
"&"
fixChar Char
'"' = String
"""
fixChar Char
c = [Char
c]
instance Show Html where
showsPrec :: Int -> Html -> String -> String
showsPrec Int
_ Html
html = String -> String -> String
showString (forall html. HTML html => html -> String
prettyHtml Html
html)
showList :: [Html] -> String -> String
showList [Html]
htmls = String -> String -> String
showString (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Html]
htmls))
instance Show HtmlAttr where
showsPrec :: Int -> HtmlAttr -> String -> String
showsPrec Int
_ (HtmlAttr String
str String
val) =
String -> String -> String
showString String
str forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
showString String
"=" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Show a => a -> String -> String
shows String
val
type URL = String
primHtml :: String -> Html
primHtml :: String -> Html
primHtml String
x = [HtmlElement] -> Html
Html [String -> HtmlElement
HtmlString String
x]
stringToHtml :: String -> Html
stringToHtml :: String -> Html
stringToHtml = String -> Html
primHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stringToHtmlString
lineToHtml :: String -> Html
lineToHtml :: String -> Html
lineToHtml = String -> Html
primHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
htmlizeChar2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stringToHtmlString
where
htmlizeChar2 :: Char -> String
htmlizeChar2 Char
' ' = String
" "
htmlizeChar2 Char
c = [Char
c]
address :: Html -> Html
anchor :: Html -> Html
applet :: Html -> Html
area :: Html
basefont :: Html
big :: Html -> Html
blockquote :: Html -> Html
body :: Html -> Html
bold :: Html -> Html
br :: Html
caption :: Html -> Html
center :: Html -> Html
cite :: Html -> Html
ddef :: Html -> Html
define :: Html -> Html
dlist :: Html -> Html
dterm :: Html -> Html
emphasize :: Html -> Html
fieldset :: Html -> Html
font :: Html -> Html
form :: Html -> Html
frame :: Html -> Html
frameset :: Html -> Html
h1 :: Html -> Html
h2 :: Html -> Html
h3 :: Html -> Html
h4 :: Html -> Html
h5 :: Html -> Html
h6 :: Html -> Html
header :: Html -> Html
hr :: Html
image :: Html
input :: Html
italics :: Html -> Html
keyboard :: Html -> Html
legend :: Html -> Html
li :: Html -> Html
meta :: Html
noframes :: Html -> Html
olist :: Html -> Html
option :: Html -> Html
paragraph :: Html -> Html
param :: Html
pre :: Html -> Html
sample :: Html -> Html
select :: Html -> Html
small :: Html -> Html
strong :: Html -> Html
style :: Html -> Html
sub :: Html -> Html
sup :: Html -> Html
table :: Html -> Html
td :: Html -> Html
textarea :: Html -> Html
th :: Html -> Html
thebase :: Html
thecode :: Html -> Html
thediv :: Html -> Html
thehtml :: Html -> Html
thelink :: Html -> Html
themap :: Html -> Html
thespan :: Html -> Html
thetitle :: Html -> Html
tr :: Html -> Html
tt :: Html -> Html
ulist :: Html -> Html
underline :: Html -> Html
variable :: Html -> Html
address :: Html -> Html
address = String -> Html -> Html
tag String
"ADDRESS"
anchor :: Html -> Html
anchor = String -> Html -> Html
tag String
"A"
applet :: Html -> Html
applet = String -> Html -> Html
tag String
"APPLET"
area :: Html
area = String -> Html
itag String
"AREA"
basefont :: Html
basefont = String -> Html
itag String
"BASEFONT"
big :: Html -> Html
big = String -> Html -> Html
tag String
"BIG"
blockquote :: Html -> Html
blockquote = String -> Html -> Html
tag String
"BLOCKQUOTE"
body :: Html -> Html
body = String -> Html -> Html
tag String
"BODY"
bold :: Html -> Html
bold = String -> Html -> Html
tag String
"B"
br :: Html
br = String -> Html
itag String
"BR"
caption :: Html -> Html
caption = String -> Html -> Html
tag String
"CAPTION"
center :: Html -> Html
center = String -> Html -> Html
tag String
"CENTER"
cite :: Html -> Html
cite = String -> Html -> Html
tag String
"CITE"
ddef :: Html -> Html
ddef = String -> Html -> Html
tag String
"DD"
define :: Html -> Html
define = String -> Html -> Html
tag String
"DFN"
dlist :: Html -> Html
dlist = String -> Html -> Html
tag String
"DL"
dterm :: Html -> Html
dterm = String -> Html -> Html
tag String
"DT"
emphasize :: Html -> Html
emphasize = String -> Html -> Html
tag String
"EM"
fieldset :: Html -> Html
fieldset = String -> Html -> Html
tag String
"FIELDSET"
font :: Html -> Html
font = String -> Html -> Html
tag String
"FONT"
form :: Html -> Html
form = String -> Html -> Html
tag String
"FORM"
frame :: Html -> Html
frame = String -> Html -> Html
tag String
"FRAME"
frameset :: Html -> Html
frameset = String -> Html -> Html
tag String
"FRAMESET"
h1 :: Html -> Html
h1 = String -> Html -> Html
tag String
"H1"
h2 :: Html -> Html
h2 = String -> Html -> Html
tag String
"H2"
h3 :: Html -> Html
h3 = String -> Html -> Html
tag String
"H3"
h4 :: Html -> Html
h4 = String -> Html -> Html
tag String
"H4"
h5 :: Html -> Html
h5 = String -> Html -> Html
tag String
"H5"
h6 :: Html -> Html
h6 = String -> Html -> Html
tag String
"H6"
= String -> Html -> Html
tag String
"HEAD"
hr :: Html
hr = String -> Html
itag String
"HR"
image :: Html
image = String -> Html
itag String
"IMG"
input :: Html
input = String -> Html
itag String
"INPUT"
italics :: Html -> Html
italics = String -> Html -> Html
tag String
"I"
keyboard :: Html -> Html
keyboard = String -> Html -> Html
tag String
"KBD"
legend :: Html -> Html
legend = String -> Html -> Html
tag String
"LEGEND"
li :: Html -> Html
li = String -> Html -> Html
tag String
"LI"
meta :: Html
meta = String -> Html
itag String
"META"
noframes :: Html -> Html
noframes = String -> Html -> Html
tag String
"NOFRAMES"
olist :: Html -> Html
olist = String -> Html -> Html
tag String
"OL"
option :: Html -> Html
option = String -> Html -> Html
tag String
"OPTION"
paragraph :: Html -> Html
paragraph = String -> Html -> Html
tag String
"P"
param :: Html
param = String -> Html
itag String
"PARAM"
pre :: Html -> Html
pre = String -> Html -> Html
tag String
"PRE"
sample :: Html -> Html
sample = String -> Html -> Html
tag String
"SAMP"
select :: Html -> Html
select = String -> Html -> Html
tag String
"SELECT"
small :: Html -> Html
small = String -> Html -> Html
tag String
"SMALL"
strong :: Html -> Html
strong = String -> Html -> Html
tag String
"STRONG"
style :: Html -> Html
style = String -> Html -> Html
tag String
"STYLE"
sub :: Html -> Html
sub = String -> Html -> Html
tag String
"SUB"
sup :: Html -> Html
sup = String -> Html -> Html
tag String
"SUP"
table :: Html -> Html
table = String -> Html -> Html
tag String
"TABLE"
td :: Html -> Html
td = String -> Html -> Html
tag String
"TD"
textarea :: Html -> Html
textarea = String -> Html -> Html
tag String
"TEXTAREA"
th :: Html -> Html
th = String -> Html -> Html
tag String
"TH"
thebase :: Html
thebase = String -> Html
itag String
"BASE"
thecode :: Html -> Html
thecode = String -> Html -> Html
tag String
"CODE"
thediv :: Html -> Html
thediv = String -> Html -> Html
tag String
"DIV"
thehtml :: Html -> Html
thehtml = String -> Html -> Html
tag String
"HTML"
thelink :: Html -> Html
thelink = String -> Html -> Html
tag String
"LINK"
themap :: Html -> Html
themap = String -> Html -> Html
tag String
"MAP"
thespan :: Html -> Html
thespan = String -> Html -> Html
tag String
"SPAN"
thetitle :: Html -> Html
thetitle = String -> Html -> Html
tag String
"TITLE"
tr :: Html -> Html
tr = String -> Html -> Html
tag String
"TR"
tt :: Html -> Html
tt = String -> Html -> Html
tag String
"TT"
ulist :: Html -> Html
ulist = String -> Html -> Html
tag String
"UL"
underline :: Html -> Html
underline = String -> Html -> Html
tag String
"U"
variable :: Html -> Html
variable = String -> Html -> Html
tag String
"VAR"
action :: String -> HtmlAttr
align :: String -> HtmlAttr
alink :: String -> HtmlAttr
alt :: String -> HtmlAttr
altcode :: String -> HtmlAttr
archive :: String -> HtmlAttr
background :: String -> HtmlAttr
base :: String -> HtmlAttr
bgcolor :: String -> HtmlAttr
border :: Int -> HtmlAttr
bordercolor :: String -> HtmlAttr
cellpadding :: Int -> HtmlAttr
cellspacing :: Int -> HtmlAttr
checked :: HtmlAttr
clear :: String -> HtmlAttr
code :: String -> HtmlAttr
codebase :: String -> HtmlAttr
color :: String -> HtmlAttr
cols :: String -> HtmlAttr
colspan :: Int -> HtmlAttr
compact :: HtmlAttr
content :: String -> HtmlAttr
coords :: String -> HtmlAttr
enctype :: String -> HtmlAttr
face :: String -> HtmlAttr
frameborder :: Int -> HtmlAttr
height :: Int -> HtmlAttr
href :: String -> HtmlAttr
hspace :: Int -> HtmlAttr
httpequiv :: String -> HtmlAttr
identifier :: String -> HtmlAttr
ismap :: HtmlAttr
lang :: String -> HtmlAttr
link :: String -> HtmlAttr
marginheight :: Int -> HtmlAttr
marginwidth :: Int -> HtmlAttr
maxlength :: Int -> HtmlAttr
method :: String -> HtmlAttr
multiple :: HtmlAttr
name :: String -> HtmlAttr
nohref :: HtmlAttr
noresize :: HtmlAttr
noshade :: HtmlAttr
nowrap :: HtmlAttr
rel :: String -> HtmlAttr
rev :: String -> HtmlAttr
rows :: String -> HtmlAttr
rowspan :: Int -> HtmlAttr
rules :: String -> HtmlAttr
scrolling :: String -> HtmlAttr
selected :: HtmlAttr
shape :: String -> HtmlAttr
size :: String -> HtmlAttr
src :: String -> HtmlAttr
start :: Int -> HtmlAttr
target :: String -> HtmlAttr
text :: String -> HtmlAttr
theclass :: String -> HtmlAttr
thestyle :: String -> HtmlAttr
thetype :: String -> HtmlAttr
title :: String -> HtmlAttr
usemap :: String -> HtmlAttr
valign :: String -> HtmlAttr
value :: String -> HtmlAttr
version :: String -> HtmlAttr
vlink :: String -> HtmlAttr
vspace :: Int -> HtmlAttr
width :: String -> HtmlAttr
action :: String -> HtmlAttr
action = String -> String -> HtmlAttr
strAttr String
"ACTION"
align :: String -> HtmlAttr
align = String -> String -> HtmlAttr
strAttr String
"ALIGN"
alink :: String -> HtmlAttr
alink = String -> String -> HtmlAttr
strAttr String
"ALINK"
alt :: String -> HtmlAttr
alt = String -> String -> HtmlAttr
strAttr String
"ALT"
altcode :: String -> HtmlAttr
altcode = String -> String -> HtmlAttr
strAttr String
"ALTCODE"
archive :: String -> HtmlAttr
archive = String -> String -> HtmlAttr
strAttr String
"ARCHIVE"
background :: String -> HtmlAttr
background = String -> String -> HtmlAttr
strAttr String
"BACKGROUND"
base :: String -> HtmlAttr
base = String -> String -> HtmlAttr
strAttr String
"BASE"
bgcolor :: String -> HtmlAttr
bgcolor = String -> String -> HtmlAttr
strAttr String
"BGCOLOR"
border :: Int -> HtmlAttr
border = String -> Int -> HtmlAttr
intAttr String
"BORDER"
bordercolor :: String -> HtmlAttr
bordercolor = String -> String -> HtmlAttr
strAttr String
"BORDERCOLOR"
cellpadding :: Int -> HtmlAttr
cellpadding = String -> Int -> HtmlAttr
intAttr String
"CELLPADDING"
cellspacing :: Int -> HtmlAttr
cellspacing = String -> Int -> HtmlAttr
intAttr String
"CELLSPACING"
checked :: HtmlAttr
checked = String -> HtmlAttr
emptyAttr String
"CHECKED"
clear :: String -> HtmlAttr
clear = String -> String -> HtmlAttr
strAttr String
"CLEAR"
code :: String -> HtmlAttr
code = String -> String -> HtmlAttr
strAttr String
"CODE"
codebase :: String -> HtmlAttr
codebase = String -> String -> HtmlAttr
strAttr String
"CODEBASE"
color :: String -> HtmlAttr
color = String -> String -> HtmlAttr
strAttr String
"COLOR"
cols :: String -> HtmlAttr
cols = String -> String -> HtmlAttr
strAttr String
"COLS"
colspan :: Int -> HtmlAttr
colspan = String -> Int -> HtmlAttr
intAttr String
"COLSPAN"
compact :: HtmlAttr
compact = String -> HtmlAttr
emptyAttr String
"COMPACT"
content :: String -> HtmlAttr
content = String -> String -> HtmlAttr
strAttr String
"CONTENT"
coords :: String -> HtmlAttr
coords = String -> String -> HtmlAttr
strAttr String
"COORDS"
enctype :: String -> HtmlAttr
enctype = String -> String -> HtmlAttr
strAttr String
"ENCTYPE"
face :: String -> HtmlAttr
face = String -> String -> HtmlAttr
strAttr String
"FACE"
frameborder :: Int -> HtmlAttr
frameborder = String -> Int -> HtmlAttr
intAttr String
"FRAMEBORDER"
height :: Int -> HtmlAttr
height = String -> Int -> HtmlAttr
intAttr String
"HEIGHT"
href :: String -> HtmlAttr
href = String -> String -> HtmlAttr
strAttr String
"HREF"
hspace :: Int -> HtmlAttr
hspace = String -> Int -> HtmlAttr
intAttr String
"HSPACE"
httpequiv :: String -> HtmlAttr
httpequiv = String -> String -> HtmlAttr
strAttr String
"HTTP-EQUIV"
identifier :: String -> HtmlAttr
identifier = String -> String -> HtmlAttr
strAttr String
"ID"
ismap :: HtmlAttr
ismap = String -> HtmlAttr
emptyAttr String
"ISMAP"
lang :: String -> HtmlAttr
lang = String -> String -> HtmlAttr
strAttr String
"LANG"
link :: String -> HtmlAttr
link = String -> String -> HtmlAttr
strAttr String
"LINK"
marginheight :: Int -> HtmlAttr
marginheight = String -> Int -> HtmlAttr
intAttr String
"MARGINHEIGHT"
marginwidth :: Int -> HtmlAttr
marginwidth = String -> Int -> HtmlAttr
intAttr String
"MARGINWIDTH"
maxlength :: Int -> HtmlAttr
maxlength = String -> Int -> HtmlAttr
intAttr String
"MAXLENGTH"
method :: String -> HtmlAttr
method = String -> String -> HtmlAttr
strAttr String
"METHOD"
multiple :: HtmlAttr
multiple = String -> HtmlAttr
emptyAttr String
"MULTIPLE"
name :: String -> HtmlAttr
name = String -> String -> HtmlAttr
strAttr String
"NAME"
nohref :: HtmlAttr
nohref = String -> HtmlAttr
emptyAttr String
"NOHREF"
noresize :: HtmlAttr
noresize = String -> HtmlAttr
emptyAttr String
"NORESIZE"
noshade :: HtmlAttr
noshade = String -> HtmlAttr
emptyAttr String
"NOSHADE"
nowrap :: HtmlAttr
nowrap = String -> HtmlAttr
emptyAttr String
"NOWRAP"
rel :: String -> HtmlAttr
rel = String -> String -> HtmlAttr
strAttr String
"REL"
rev :: String -> HtmlAttr
rev = String -> String -> HtmlAttr
strAttr String
"REV"
rows :: String -> HtmlAttr
rows = String -> String -> HtmlAttr
strAttr String
"ROWS"
rowspan :: Int -> HtmlAttr
rowspan = String -> Int -> HtmlAttr
intAttr String
"ROWSPAN"
rules :: String -> HtmlAttr
rules = String -> String -> HtmlAttr
strAttr String
"RULES"
scrolling :: String -> HtmlAttr
scrolling = String -> String -> HtmlAttr
strAttr String
"SCROLLING"
selected :: HtmlAttr
selected = String -> HtmlAttr
emptyAttr String
"SELECTED"
shape :: String -> HtmlAttr
shape = String -> String -> HtmlAttr
strAttr String
"SHAPE"
size :: String -> HtmlAttr
size = String -> String -> HtmlAttr
strAttr String
"SIZE"
src :: String -> HtmlAttr
src = String -> String -> HtmlAttr
strAttr String
"SRC"
start :: Int -> HtmlAttr
start = String -> Int -> HtmlAttr
intAttr String
"START"
target :: String -> HtmlAttr
target = String -> String -> HtmlAttr
strAttr String
"TARGET"
text :: String -> HtmlAttr
text = String -> String -> HtmlAttr
strAttr String
"TEXT"
theclass :: String -> HtmlAttr
theclass = String -> String -> HtmlAttr
strAttr String
"CLASS"
thestyle :: String -> HtmlAttr
thestyle = String -> String -> HtmlAttr
strAttr String
"STYLE"
thetype :: String -> HtmlAttr
thetype = String -> String -> HtmlAttr
strAttr String
"TYPE"
title :: String -> HtmlAttr
title = String -> String -> HtmlAttr
strAttr String
"TITLE"
usemap :: String -> HtmlAttr
usemap = String -> String -> HtmlAttr
strAttr String
"USEMAP"
valign :: String -> HtmlAttr
valign = String -> String -> HtmlAttr
strAttr String
"VALIGN"
value :: String -> HtmlAttr
value = String -> String -> HtmlAttr
strAttr String
"VALUE"
version :: String -> HtmlAttr
version = String -> String -> HtmlAttr
strAttr String
"VERSION"
vlink :: String -> HtmlAttr
vlink = String -> String -> HtmlAttr
strAttr String
"VLINK"
vspace :: Int -> HtmlAttr
vspace = String -> Int -> HtmlAttr
intAttr String
"VSPACE"
width :: String -> HtmlAttr
width = String -> String -> HtmlAttr
strAttr String
"WIDTH"
validHtmlTags :: [String]
validHtmlTags :: [String]
validHtmlTags = [
String
"ADDRESS",
String
"A",
String
"APPLET",
String
"BIG",
String
"BLOCKQUOTE",
String
"BODY",
String
"B",
String
"CAPTION",
String
"CENTER",
String
"CITE",
String
"DD",
String
"DFN",
String
"DL",
String
"DT",
String
"EM",
String
"FIELDSET",
String
"FONT",
String
"FORM",
String
"FRAME",
String
"FRAMESET",
String
"H1",
String
"H2",
String
"H3",
String
"H4",
String
"H5",
String
"H6",
String
"HEAD",
String
"I",
String
"KBD",
String
"LEGEND",
String
"LI",
String
"NOFRAMES",
String
"OL",
String
"OPTION",
String
"P",
String
"PRE",
String
"SAMP",
String
"SELECT",
String
"SMALL",
String
"STRONG",
String
"STYLE",
String
"SUB",
String
"SUP",
String
"TABLE",
String
"TD",
String
"TEXTAREA",
String
"TH",
String
"CODE",
String
"DIV",
String
"HTML",
String
"LINK",
String
"MAP",
String
"TITLE",
String
"TR",
String
"TT",
String
"UL",
String
"U",
String
"VAR"]
validHtmlITags :: [String]
validHtmlITags :: [String]
validHtmlITags = [
String
"AREA",
String
"BASEFONT",
String
"BR",
String
"HR",
String
"IMG",
String
"INPUT",
String
"META",
String
"PARAM",
String
"BASE"]
validHtmlAttrs :: [String]
validHtmlAttrs :: [String]
validHtmlAttrs = [
String
"ACTION",
String
"ALIGN",
String
"ALINK",
String
"ALT",
String
"ALTCODE",
String
"ARCHIVE",
String
"BACKGROUND",
String
"BASE",
String
"BGCOLOR",
String
"BORDER",
String
"BORDERCOLOR",
String
"CELLPADDING",
String
"CELLSPACING",
String
"CHECKED",
String
"CLEAR",
String
"CODE",
String
"CODEBASE",
String
"COLOR",
String
"COLS",
String
"COLSPAN",
String
"COMPACT",
String
"CONTENT",
String
"COORDS",
String
"ENCTYPE",
String
"FACE",
String
"FRAMEBORDER",
String
"HEIGHT",
String
"HREF",
String
"HSPACE",
String
"HTTP-EQUIV",
String
"ID",
String
"ISMAP",
String
"LANG",
String
"LINK",
String
"MARGINHEIGHT",
String
"MARGINWIDTH",
String
"MAXLENGTH",
String
"METHOD",
String
"MULTIPLE",
String
"NAME",
String
"NOHREF",
String
"NORESIZE",
String
"NOSHADE",
String
"NOWRAP",
String
"REL",
String
"REV",
String
"ROWS",
String
"ROWSPAN",
String
"RULES",
String
"SCROLLING",
String
"SELECTED",
String
"SHAPE",
String
"SIZE",
String
"SRC",
String
"START",
String
"TARGET",
String
"TEXT",
String
"CLASS",
String
"STYLE",
String
"TYPE",
String
"TITLE",
String
"USEMAP",
String
"VALIGN",
String
"VALUE",
String
"VERSION",
String
"VLINK",
String
"VSPACE",
String
"WIDTH"]
aqua :: String
black :: String
blue :: String
fuchsia :: String
gray :: String
green :: String
lime :: String
maroon :: String
navy :: String
olive :: String
purple :: String
red :: String
silver :: String
teal :: String
yellow :: String
white :: String
aqua :: String
aqua = String
"aqua"
black :: String
black = String
"black"
blue :: String
blue = String
"blue"
fuchsia :: String
fuchsia = String
"fuchsia"
gray :: String
gray = String
"gray"
green :: String
green = String
"green"
lime :: String
lime = String
"lime"
maroon :: String
maroon = String
"maroon"
navy :: String
navy = String
"navy"
olive :: String
olive = String
"olive"
purple :: String
purple = String
"purple"
red :: String
red = String
"red"
silver :: String
silver = String
"silver"
teal :: String
teal = String
"teal"
yellow :: String
yellow = String
"yellow"
white :: String
white = String
"white"
linesToHtml :: [String] -> Html
linesToHtml :: [String] -> Html
linesToHtml [] = Html
noHtml
linesToHtml (String
x:[]) = String -> Html
lineToHtml String
x
linesToHtml (String
x:[String]
xs) = String -> Html
lineToHtml String
x forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
br forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [String] -> Html
linesToHtml [String]
xs
primHtmlChar :: String -> Html
copyright :: Html
spaceHtml :: Html
bullet :: Html
p :: Html -> Html
primHtmlChar :: String -> Html
primHtmlChar = \ String
x -> String -> Html
primHtml (String
"&" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
";")
copyright :: Html
copyright = String -> Html
primHtmlChar String
"copy"
spaceHtml :: Html
spaceHtml = String -> Html
primHtmlChar String
"nbsp"
bullet :: Html
bullet = String -> Html
primHtmlChar String
"#149"
p :: Html -> Html
p = Html -> Html
paragraph
class HTMLTABLE ht where
cell :: ht -> HtmlTable
instance HTMLTABLE HtmlTable where
cell :: HtmlTable -> HtmlTable
cell = forall a. a -> a
id
instance HTMLTABLE Html where
cell :: Html -> HtmlTable
cell Html
h =
let
cellFn :: Int -> Int -> Html
cellFn Int
x Int
y = Html
h forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! (forall {t} {a}. (Eq t, Num t) => t -> (t -> a) -> [a] -> [a]
add Int
x Int -> HtmlAttr
colspan forall a b. (a -> b) -> a -> b
$ forall {t} {a}. (Eq t, Num t) => t -> (t -> a) -> [a] -> [a]
add Int
y Int -> HtmlAttr
rowspan forall a b. (a -> b) -> a -> b
$ [])
add :: t -> (t -> a) -> [a] -> [a]
add t
1 t -> a
fn [a]
rest = [a]
rest
add t
n t -> a
fn [a]
rest = t -> a
fn t
n forall a. a -> [a] -> [a]
: [a]
rest
r :: BlockTable (Int -> Int -> Html)
r = forall a. a -> BlockTable a
BT.single Int -> Int -> Html
cellFn
in
BlockTable (Int -> Int -> Html) -> HtmlTable
mkHtmlTable BlockTable (Int -> Int -> Html)
r
newtype HtmlTable
= HtmlTable (BT.BlockTable (Int -> Int -> Html))
(</>),above,(<->),beside :: (HTMLTABLE ht1,HTMLTABLE ht2)
=> ht1 -> ht2 -> HtmlTable
aboves,besides :: (HTMLTABLE ht) => [ht] -> HtmlTable
simpleTable :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html
mkHtmlTable :: BT.BlockTable (Int -> Int -> Html) -> HtmlTable
mkHtmlTable :: BlockTable (Int -> Int -> Html) -> HtmlTable
mkHtmlTable BlockTable (Int -> Int -> Html)
r = BlockTable (Int -> Int -> Html) -> HtmlTable
HtmlTable BlockTable (Int -> Int -> Html)
r
above :: forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
above ht1
a ht2
b = (BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html))
-> HtmlTable -> HtmlTable -> HtmlTable
combine forall a. BlockTable a -> BlockTable a -> BlockTable a
BT.above (forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht1
a) (forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht2
b)
</> :: forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
(</>) = forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
above
beside :: forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
beside ht1
a ht2
b = (BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html))
-> HtmlTable -> HtmlTable -> HtmlTable
combine forall a. BlockTable a -> BlockTable a -> BlockTable a
BT.beside (forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht1
a) (forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht2
b)
<-> :: forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
(<->) = forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
beside
combine :: (BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html))
-> HtmlTable -> HtmlTable -> HtmlTable
combine BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
fn (HtmlTable BlockTable (Int -> Int -> Html)
a) (HtmlTable BlockTable (Int -> Int -> Html)
b) = BlockTable (Int -> Int -> Html) -> HtmlTable
mkHtmlTable (BlockTable (Int -> Int -> Html)
a BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
`fn` BlockTable (Int -> Int -> Html)
b)
aboves :: forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves [] = forall a. HasCallStack => String -> a
error String
"aboves []"
aboves [ht]
xs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
(</>) (forall a b. (a -> b) -> [a] -> [b]
map forall ht. HTMLTABLE ht => ht -> HtmlTable
cell [ht]
xs)
besides :: forall ht. HTMLTABLE ht => [ht] -> HtmlTable
besides [] = forall a. HasCallStack => String -> a
error String
"besides []"
besides [ht]
xs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
(<->) (forall a b. (a -> b) -> [a] -> [b]
map forall ht. HTMLTABLE ht => ht -> HtmlTable
cell [ht]
xs)
renderTable :: BT.BlockTable (Int -> Int -> Html) -> Html
renderTable :: BlockTable (Int -> Int -> Html) -> Html
renderTable BlockTable (Int -> Int -> Html)
theTable
= forall a. HTML a => [a] -> Html
concatHtml
[Html -> Html
tr forall a b. HTML a => (Html -> b) -> a -> b
<< [Int -> Int -> Html
theCell Int
x Int
y | (Int -> Int -> Html
theCell,(Int
x,Int
y)) <- [(Int -> Int -> Html, (Int, Int))]
theRow ]
| [(Int -> Int -> Html, (Int, Int))]
theRow <- forall a. BlockTable a -> [[(a, (Int, Int))]]
BT.getMatrix BlockTable (Int -> Int -> Html)
theTable]
instance HTML HtmlTable where
toHtml :: HtmlTable -> Html
toHtml (HtmlTable BlockTable (Int -> Int -> Html)
tab) = BlockTable (Int -> Int -> Html) -> Html
renderTable BlockTable (Int -> Int -> Html)
tab
instance Show HtmlTable where
showsPrec :: Int -> HtmlTable -> String -> String
showsPrec Int
_ (HtmlTable BlockTable (Int -> Int -> Html)
tab) = forall a. Show a => a -> String -> String
shows (BlockTable (Int -> Int -> Html) -> Html
renderTable BlockTable (Int -> Int -> Html)
tab)
simpleTable :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html
simpleTable [HtmlAttr]
attr [HtmlAttr]
cellAttr [[Html]]
lst
= Html -> Html
table forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [HtmlAttr]
attr
forall a b. HTML a => (Html -> b) -> a -> b
<< (forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall ht. HTMLTABLE ht => [ht] -> HtmlTable
besides forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Html -> Html
td forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [HtmlAttr]
cellAttr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HTML a => a -> Html
toHtml))
) [[Html]]
lst
data HtmlTree
= HtmlLeaf Html
| HtmlNode Html [HtmlTree] Html
treeHtml :: [String] -> HtmlTree -> Html
treeHtml :: [String] -> HtmlTree -> Html
treeHtml [String]
colors HtmlTree
h = Html -> Html
table forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [
Int -> HtmlAttr
border Int
0,
Int -> HtmlAttr
cellpadding Int
0,
Int -> HtmlAttr
cellspacing Int
2] forall a b. HTML a => (Html -> b) -> a -> b
<< [String] -> HtmlTree -> HtmlTable
treeHtml' [String]
colors HtmlTree
h
where
manycolors :: [a] -> [[a]]
manycolors = forall a b. (a -> b -> b) -> b -> [a] -> [b]
scanr (:) []
treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable
treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable
treeHtmls [[String]]
c [HtmlTree]
ts = forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [String] -> HtmlTree -> HtmlTable
treeHtml' [[String]]
c [HtmlTree]
ts)
treeHtml' :: [String] -> HtmlTree -> HtmlTable
treeHtml' :: [String] -> HtmlTree -> HtmlTable
treeHtml' (String
c:[String]
_) (HtmlLeaf Html
leaf) = forall ht. HTMLTABLE ht => ht -> HtmlTable
cell
(Html -> Html
td forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
width String
"100%"]
forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
bold
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
leaf)
treeHtml' (String
c:cs :: [String]
cs@(String
c2:[String]
_)) (HtmlNode Html
hopen [HtmlTree]
ts Html
hclose) =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HtmlTree]
ts Bool -> Bool -> Bool
&& Html -> Bool
isNoHtml Html
hclose
then
forall ht. HTMLTABLE ht => ht -> HtmlTable
cell Html
hd
else if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HtmlTree]
ts
then
Html
hd forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</> Html
bar forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
`beside` (Html -> Html
td forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
bgcolor String
c2] forall a b. HTML a => (Html -> b) -> a -> b
<< Html
spaceHtml)
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</> Html
tl
else
Html
hd forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</> (Html
bar forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
`beside` [[String]] -> [HtmlTree] -> HtmlTable
treeHtmls [[String]]
morecolors [HtmlTree]
ts)
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</> Html
tl
where
morecolors :: [[String]]
morecolors = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= String
c)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. [a] -> a
head) (forall {a}. [a] -> [[a]]
manycolors [String]
cs)
bar :: Html
bar = Html -> Html
td forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
bgcolor String
c,String -> HtmlAttr
width String
"10"] forall a b. HTML a => (Html -> b) -> a -> b
<< Html
spaceHtml
hd :: Html
hd = Html -> Html
td forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
bgcolor String
c] forall a b. HTML a => (Html -> b) -> a -> b
<< Html
hopen
tl :: Html
tl = Html -> Html
td forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
bgcolor String
c] forall a b. HTML a => (Html -> b) -> a -> b
<< Html
hclose
treeHtml' [String]
_ HtmlTree
_ = forall a. HasCallStack => String -> a
error String
"The imposible happens"
instance HTML HtmlTree where
toHtml :: HtmlTree -> Html
toHtml HtmlTree
x = [String] -> HtmlTree -> Html
treeHtml [String]
treeColors HtmlTree
x
treeColors :: [String]
treeColors = [String
"#88ccff",String
"#ffffaa",String
"#ffaaff",String
"#ccffff"] forall a. [a] -> [a] -> [a]
++ [String]
treeColors
debugHtml :: (HTML a) => a -> Html
debugHtml :: forall a. HTML a => a -> Html
debugHtml a
obj = Html -> Html
table forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [Int -> HtmlAttr
border Int
0] forall a b. HTML a => (Html -> b) -> a -> b
<<
( Html -> Html
th forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
bgcolor String
"#008888"]
forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
underline
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Debugging Output"
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</> Html -> Html
td forall a b. HTML a => (Html -> b) -> a -> b
<< (forall a. HTML a => a -> Html
toHtml (Html -> [HtmlTree]
debug' (forall a. HTML a => a -> Html
toHtml a
obj)))
)
where
debug' :: Html -> [HtmlTree]
debug' :: Html -> [HtmlTree]
debug' (Html [HtmlElement]
markups) = forall a b. (a -> b) -> [a] -> [b]
map HtmlElement -> HtmlTree
debug [HtmlElement]
markups
debug :: HtmlElement -> HtmlTree
debug :: HtmlElement -> HtmlTree
debug (HtmlString String
str) = Html -> HtmlTree
HtmlLeaf (Html
spaceHtml forall a b. (HTML a, HTML b) => a -> b -> Html
+++
[String] -> Html
linesToHtml (String -> [String]
lines String
str))
debug (HtmlTag {
markupTag :: HtmlElement -> String
markupTag = String
markupTag,
markupContent :: HtmlElement -> Html
markupContent = Html
markupContent,
markupAttrs :: HtmlElement -> [HtmlAttr]
markupAttrs = [HtmlAttr]
markupAttrs
}) =
case Html
markupContent of
Html [] -> Html -> [HtmlTree] -> Html -> HtmlTree
HtmlNode Html
hd [] Html
noHtml
Html [HtmlElement]
xs -> Html -> [HtmlTree] -> Html -> HtmlTree
HtmlNode Html
hd (forall a b. (a -> b) -> [a] -> [b]
map HtmlElement -> HtmlTree
debug [HtmlElement]
xs) Html
tl
where
args :: String
args = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HtmlAttr]
markupAttrs
then String
""
else String
" " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [HtmlAttr]
markupAttrs)
hd :: Html
hd = Html -> Html
font forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
size String
"1"] forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"<" forall a. [a] -> [a] -> [a]
++ String
markupTag forall a. [a] -> [a] -> [a]
++ String
args forall a. [a] -> [a] -> [a]
++ String
">")
tl :: Html
tl = Html -> Html
font forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
size String
"1"] forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"</" forall a. [a] -> [a] -> [a]
++ String
markupTag forall a. [a] -> [a] -> [a]
++ String
">")
data HotLink = HotLink {
HotLink -> String
hotLinkURL :: URL,
HotLink -> [Html]
hotLinkContents :: [Html],
HotLink -> [HtmlAttr]
hotLinkAttributes :: [HtmlAttr]
} deriving Int -> HotLink -> String -> String
[HotLink] -> String -> String
HotLink -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [HotLink] -> String -> String
$cshowList :: [HotLink] -> String -> String
show :: HotLink -> String
$cshow :: HotLink -> String
showsPrec :: Int -> HotLink -> String -> String
$cshowsPrec :: Int -> HotLink -> String -> String
Show
instance HTML HotLink where
toHtml :: HotLink -> Html
toHtml HotLink
hl = Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! (String -> HtmlAttr
href (HotLink -> String
hotLinkURL HotLink
hl) forall a. a -> [a] -> [a]
: HotLink -> [HtmlAttr]
hotLinkAttributes HotLink
hl)
forall a b. HTML a => (Html -> b) -> a -> b
<< HotLink -> [Html]
hotLinkContents HotLink
hl
hotlink :: URL -> [Html] -> HotLink
hotlink :: String -> [Html] -> HotLink
hotlink String
url [Html]
h = HotLink {
hotLinkURL :: String
hotLinkURL = String
url,
hotLinkContents :: [Html]
hotLinkContents = [Html]
h,
hotLinkAttributes :: [HtmlAttr]
hotLinkAttributes = [] }
ordList :: (HTML a) => [a] -> Html
ordList :: forall a. HTML a => [a] -> Html
ordList [a]
items = Html -> Html
olist forall a b. HTML a => (Html -> b) -> a -> b
<< forall a b. (a -> b) -> [a] -> [b]
map (Html -> Html
li forall a b. HTML a => (Html -> b) -> a -> b
<<) [a]
items
unordList :: (HTML a) => [a] -> Html
unordList :: forall a. HTML a => [a] -> Html
unordList [a]
items = Html -> Html
ulist forall a b. HTML a => (Html -> b) -> a -> b
<< forall a b. (a -> b) -> [a] -> [b]
map (Html -> Html
li forall a b. HTML a => (Html -> b) -> a -> b
<<) [a]
items
defList :: (HTML a,HTML b) => [(a,b)] -> Html
defList :: forall a b. (HTML a, HTML b) => [(a, b)] -> Html
defList [(a, b)]
items
= Html -> Html
dlist forall a b. HTML a => (Html -> b) -> a -> b
<< [ [ Html -> Html
dterm forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
bold forall a b. HTML a => (Html -> b) -> a -> b
<< a
dt, Html -> Html
ddef forall a b. HTML a => (Html -> b) -> a -> b
<< b
dd ] | (a
dt,b
dd) <- [(a, b)]
items ]
widget :: String -> String -> [HtmlAttr] -> Html
widget :: String -> String -> [HtmlAttr] -> Html
widget String
w String
n [HtmlAttr]
markupAttrs = Html
input forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! ([String -> HtmlAttr
thetype String
w,String -> HtmlAttr
name String
n] forall a. [a] -> [a] -> [a]
++ [HtmlAttr]
markupAttrs)
checkbox :: String -> String -> Html
hidden :: String -> String -> Html
radio :: String -> String -> Html
reset :: String -> String -> Html
submit :: String -> String -> Html
password :: String -> Html
textfield :: String -> Html
afile :: String -> Html
clickmap :: String -> Html
checkbox :: String -> String -> Html
checkbox String
n String
v = String -> String -> [HtmlAttr] -> Html
widget String
"CHECKBOX" String
n [String -> HtmlAttr
value String
v]
hidden :: String -> String -> Html
hidden String
n String
v = String -> String -> [HtmlAttr] -> Html
widget String
"HIDDEN" String
n [String -> HtmlAttr
value String
v]
radio :: String -> String -> Html
radio String
n String
v = String -> String -> [HtmlAttr] -> Html
widget String
"RADIO" String
n [String -> HtmlAttr
value String
v]
reset :: String -> String -> Html
reset String
n String
v = String -> String -> [HtmlAttr] -> Html
widget String
"RESET" String
n [String -> HtmlAttr
value String
v]
submit :: String -> String -> Html
submit String
n String
v = String -> String -> [HtmlAttr] -> Html
widget String
"SUBMIT" String
n [String -> HtmlAttr
value String
v]
password :: String -> Html
password String
n = String -> String -> [HtmlAttr] -> Html
widget String
"PASSWORD" String
n []
textfield :: String -> Html
textfield String
n = String -> String -> [HtmlAttr] -> Html
widget String
"TEXT" String
n []
afile :: String -> Html
afile String
n = String -> String -> [HtmlAttr] -> Html
widget String
"FILE" String
n []
clickmap :: String -> Html
clickmap String
n = String -> String -> [HtmlAttr] -> Html
widget String
"IMAGE" String
n []
menu :: String -> [Html] -> Html
String
n [Html]
choices
= Html -> Html
select forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
name String
n] forall a b. HTML a => (Html -> b) -> a -> b
<< [ Html -> Html
option forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< Html
choice | Html
choice <- [Html]
choices ]
gui :: String -> Html -> Html
gui :: String -> Html -> Html
gui String
act = Html -> Html
form forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
action String
act,String -> HtmlAttr
method String
"POST"]
renderHtml :: (HTML html) => html -> String
renderHtml :: forall html. HTML html => html -> String
renderHtml html
theHtml =
String
renderMessage forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (forall a b. (a -> b) -> [a] -> [b]
map (Int -> HtmlElement -> String -> String
renderHtml' Int
0)
(Html -> [HtmlElement]
getHtmlElements (String -> Html -> Html
tag String
"HTML" forall a b. HTML a => (Html -> b) -> a -> b
<< html
theHtml))) String
"\n"
renderMessage :: String
renderMessage =
String
"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 FINAL//EN\">\n" forall a. [a] -> [a] -> [a]
++
String
"<!--Rendered using the Haskell Html Library v0.2-->\n"
prettyHtml :: (HTML html) => html -> String
prettyHtml :: forall html. HTML html => html -> String
prettyHtml html
theHtml =
[String] -> String
unlines
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map HtmlElement -> [String]
prettyHtml'
forall a b. (a -> b) -> a -> b
$ Html -> [HtmlElement]
getHtmlElements
forall a b. (a -> b) -> a -> b
$ forall a. HTML a => a -> Html
toHtml html
theHtml
renderHtml' :: Int -> HtmlElement -> ShowS
renderHtml' :: Int -> HtmlElement -> String -> String
renderHtml' Int
_ (HtmlString String
str) = forall a. [a] -> [a] -> [a]
(++) String
str
renderHtml' Int
n (HtmlTag
{ markupTag :: HtmlElement -> String
markupTag = String
name,
markupContent :: HtmlElement -> Html
markupContent = Html
html,
markupAttrs :: HtmlElement -> [HtmlAttr]
markupAttrs = [HtmlAttr]
markupAttrs })
= if Html -> Bool
isNoHtml Html
html Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name [String]
validHtmlITags
then Bool -> String -> [HtmlAttr] -> Int -> String -> String
renderTag Bool
True String
name [HtmlAttr]
markupAttrs Int
n
else (Bool -> String -> [HtmlAttr] -> Int -> String -> String
renderTag Bool
True String
name [HtmlAttr]
markupAttrs Int
n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (forall a b. (a -> b) -> [a] -> [b]
map (Int -> HtmlElement -> String -> String
renderHtml' (Int
nforall a. Num a => a -> a -> a
+Int
2)) (Html -> [HtmlElement]
getHtmlElements Html
html))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> [HtmlAttr] -> Int -> String -> String
renderTag Bool
False String
name [] Int
n)
prettyHtml' :: HtmlElement -> [String]
prettyHtml' :: HtmlElement -> [String]
prettyHtml' (HtmlString String
str) = [String
str]
prettyHtml' (HtmlTag
{ markupTag :: HtmlElement -> String
markupTag = String
name,
markupContent :: HtmlElement -> Html
markupContent = Html
html,
markupAttrs :: HtmlElement -> [HtmlAttr]
markupAttrs = [HtmlAttr]
markupAttrs })
= if Html -> Bool
isNoHtml Html
html Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name [String]
validHtmlITags
then
[String -> String
rmNL (Bool -> String -> [HtmlAttr] -> Int -> String -> String
renderTag Bool
True String
name [HtmlAttr]
markupAttrs Int
0 String
"")]
else
[String -> String
rmNL (Bool -> String -> [HtmlAttr] -> Int -> String -> String
renderTag Bool
True String
name [HtmlAttr]
markupAttrs Int
0 String
"")] forall a. [a] -> [a] -> [a]
++
[String] -> [String]
shift (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map HtmlElement -> [String]
prettyHtml' (Html -> [HtmlElement]
getHtmlElements Html
html))) forall a. [a] -> [a] -> [a]
++
[String -> String
rmNL (Bool -> String -> [HtmlAttr] -> Int -> String -> String
renderTag Bool
False String
name [] Int
0 String
"")]
where
shift :: [String] -> [String]
shift = forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> String
" " forall a. [a] -> [a] -> [a]
++ String
x)
rmNL :: String -> String
rmNL = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
renderTag :: Bool -> String -> [HtmlAttr] -> Int -> ShowS
renderTag :: Bool -> String -> [HtmlAttr] -> Int -> String -> String
renderTag Bool
x String
name [HtmlAttr]
markupAttrs Int
n String
r
= String
open forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ [HtmlAttr] -> String
rest [HtmlAttr]
markupAttrs forall a. [a] -> [a] -> [a]
++ String
">" forall a. [a] -> [a] -> [a]
++ String
r
where
open :: String
open = if Bool
x then String
"<" else String
"</"
nl :: String
nl = String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Integral a => a -> a -> a
`div` Int
8) Char
'\t'
forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Integral a => a -> a -> a
`mod` Int
8) Char
' '
rest :: [HtmlAttr] -> String
rest [] = String
nl
rest [HtmlAttr]
attr = String
" " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map HtmlAttr -> String
showPair [HtmlAttr]
attr) forall a. [a] -> [a] -> [a]
++ String
nl
showPair :: HtmlAttr -> String
showPair :: HtmlAttr -> String
showPair (HtmlAttr String
tag String
val)
= String
tag forall a. [a] -> [a] -> [a]
++ String
" = \"" forall a. [a] -> [a] -> [a]
++ String
val forall a. [a] -> [a] -> [a]
++ String
"\""