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 ([[HtmlElement]] -> [HtmlElement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [HtmlElement]
x | (Html [HtmlElement]
x) <- (a -> Html) -> [a] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map a -> Html
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 = String -> Html
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 = [a] -> Html
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 b -> [HtmlAttr] -> b
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [HtmlAttr]
attr
instance ADDATTRS Html where
(Html [HtmlElement]
htmls) ! :: Html -> [HtmlAttr] -> Html
! [HtmlAttr]
attr = [HtmlElement] -> Html
Html ((HtmlElement -> HtmlElement) -> [HtmlElement] -> [HtmlElement]
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 = markupAttrs ++ 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 (a -> Html
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 ([[HtmlElement]] -> [HtmlElement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> [HtmlElement]) -> [a] -> [[HtmlElement]]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> [HtmlElement]
getHtmlElements(Html -> [HtmlElement]) -> (a -> Html) -> a -> [HtmlElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Html
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 (a -> Html
forall a. HTML a => a -> Html
toHtml a
a) [HtmlElement] -> [HtmlElement] -> [HtmlElement]
forall a. [a] -> [a] -> [a]
++ Html -> [HtmlElement]
getHtmlElements (b -> Html
forall a. HTML a => a -> Html
toHtml b
b))
noHtml :: Html
noHtml :: Html
noHtml = [HtmlElement] -> Html
Html []
isNoHtml :: Html -> Bool
isNoHtml (Html [HtmlElement]
xs) = [HtmlElement] -> Bool
forall a. [a] -> Bool
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 (Int -> String
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 = (Char -> String) -> String -> String
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 (Html -> String
forall html. HTML html => html -> String
prettyHtml Html
html)
showList :: [Html] -> String -> String
showList [Html]
htmls = String -> String -> String
showString ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Html -> String) -> [Html] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Html -> String
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 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
showString String
"=" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
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 (String -> Html) -> (String -> String) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stringToHtmlString
lineToHtml :: String -> Html
lineToHtml :: String -> Html
lineToHtml = String -> Html
primHtml (String -> Html) -> (String -> String) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
htmlizeChar2 (String -> String) -> (String -> String) -> String -> String
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 Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
br Html -> Html -> Html
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
"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
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 = HtmlTable -> HtmlTable
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 Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! (Int -> (Int -> HtmlAttr) -> [HtmlAttr] -> [HtmlAttr]
forall {t} {a}. (Eq t, Num t) => t -> (t -> a) -> [a] -> [a]
add Int
x Int -> HtmlAttr
colspan ([HtmlAttr] -> [HtmlAttr]) -> [HtmlAttr] -> [HtmlAttr]
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> HtmlAttr) -> [HtmlAttr] -> [HtmlAttr]
forall {t} {a}. (Eq t, Num t) => t -> (t -> a) -> [a] -> [a]
add Int
y Int -> HtmlAttr
rowspan ([HtmlAttr] -> [HtmlAttr]) -> [HtmlAttr] -> [HtmlAttr]
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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest
r :: BlockTable (Int -> Int -> Html)
r = (Int -> Int -> Html) -> BlockTable (Int -> Int -> Html)
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 BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
forall a. BlockTable a -> BlockTable a -> BlockTable a
BT.above (ht1 -> HtmlTable
forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht1
a) (ht2 -> HtmlTable
forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht2
b)
</> :: forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
(</>) = 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 BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
-> BlockTable (Int -> Int -> Html)
forall a. BlockTable a -> BlockTable a -> BlockTable a
BT.beside (ht1 -> HtmlTable
forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht1
a) (ht2 -> HtmlTable
forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht2
b)
<-> :: forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
(<->) = 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 [] = String -> HtmlTable
forall a. HasCallStack => String -> a
error String
"aboves []"
aboves [ht]
xs = (HtmlTable -> HtmlTable -> HtmlTable) -> [HtmlTable] -> HtmlTable
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 HtmlTable -> HtmlTable -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
(</>) ((ht -> HtmlTable) -> [ht] -> [HtmlTable]
forall a b. (a -> b) -> [a] -> [b]
map ht -> HtmlTable
forall ht. HTMLTABLE ht => ht -> HtmlTable
cell [ht]
xs)
besides :: forall ht. HTMLTABLE ht => [ht] -> HtmlTable
besides [] = String -> HtmlTable
forall a. HasCallStack => String -> a
error String
"besides []"
besides [ht]
xs = (HtmlTable -> HtmlTable -> HtmlTable) -> [HtmlTable] -> HtmlTable
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 HtmlTable -> HtmlTable -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
(<->) ((ht -> HtmlTable) -> [ht] -> [HtmlTable]
forall a b. (a -> b) -> [a] -> [b]
map ht -> HtmlTable
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
= [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml
[Html -> Html
tr (Html -> Html) -> [Html] -> Html
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 <- BlockTable (Int -> Int -> Html)
-> [[(Int -> Int -> Html, (Int, Int))]]
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) = Html -> String -> String
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 (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [HtmlAttr]
attr
(Html -> Html) -> HtmlTable -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< ([HtmlTable] -> HtmlTable
forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves
([HtmlTable] -> HtmlTable)
-> ([[Html]] -> [HtmlTable]) -> [[Html]] -> HtmlTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Html] -> HtmlTable) -> [[Html]] -> [HtmlTable]
forall a b. (a -> b) -> [a] -> [b]
map ([Html] -> HtmlTable
forall ht. HTMLTABLE ht => [ht] -> HtmlTable
besides ([Html] -> HtmlTable) -> ([Html] -> [Html]) -> [Html] -> HtmlTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html) -> [Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [HtmlAttr]
cellAttr) (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
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 (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [
Int -> HtmlAttr
border Int
0,
Int -> HtmlAttr
cellpadding Int
0,
Int -> HtmlAttr
cellspacing Int
2] (Html -> Html) -> HtmlTable -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [String] -> HtmlTree -> HtmlTable
treeHtml' [String]
colors HtmlTree
h
where
manycolors :: [a] -> [[a]]
manycolors = (a -> [a] -> [a]) -> [a] -> [a] -> [[a]]
forall a b. (a -> b -> b) -> b -> [a] -> [b]
scanr (:) []
treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable
treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable
treeHtmls [[String]]
c [HtmlTree]
ts = [HtmlTable] -> HtmlTable
forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves (([String] -> HtmlTree -> HtmlTable)
-> [[String]] -> [HtmlTree] -> [HtmlTable]
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) = Html -> HtmlTable
forall ht. HTMLTABLE ht => ht -> HtmlTable
cell
(Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
width String
"100%"]
(Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
bold
(Html -> Html) -> Html -> Html
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 [HtmlTree] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HtmlTree]
ts Bool -> Bool -> Bool
&& Html -> Bool
isNoHtml Html
hclose
then
Html -> HtmlTable
forall ht. HTMLTABLE ht => ht -> HtmlTable
cell Html
hd
else if [HtmlTree] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HtmlTree]
ts
then
Html
hd Html -> HtmlTable -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</> Html
bar Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
`beside` (Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
bgcolor String
c2] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
spaceHtml)
HtmlTable -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</> Html
tl
else
Html
hd Html -> HtmlTable -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</> (Html
bar Html -> HtmlTable -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
`beside` [[String]] -> [HtmlTree] -> HtmlTable
treeHtmls [[String]]
morecolors [HtmlTree]
ts)
HtmlTable -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</> Html
tl
where
morecolors :: [[String]]
morecolors = ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
c)(String -> Bool) -> ([String] -> String) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> String
forall a. HasCallStack => [a] -> a
head) ([String] -> [[String]]
forall {a}. [a] -> [[a]]
manycolors [String]
cs)
bar :: Html
bar = Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
bgcolor String
c,String -> HtmlAttr
width String
"10"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
spaceHtml
hd :: Html
hd = Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
bgcolor String
c] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
hopen
tl :: Html
tl = Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
bgcolor String
c] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
hclose
treeHtml' [String]
_ HtmlTree
_ = String -> HtmlTable
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"] [String] -> [String] -> [String]
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 (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [Int -> HtmlAttr
border Int
0] (Html -> Html) -> HtmlTable -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<
( Html -> Html
th (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
bgcolor String
"#008888"]
(Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
underline
(Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Debugging Output"
Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</> Html -> Html
td (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< ([HtmlTree] -> Html
forall a. HTML a => a -> Html
toHtml (Html -> [HtmlTree]
debug' (a -> Html
forall a. HTML a => a -> Html
toHtml a
obj)))
)
where
debug' :: Html -> [HtmlTree]
debug' :: Html -> [HtmlTree]
debug' (Html [HtmlElement]
markups) = (HtmlElement -> HtmlTree) -> [HtmlElement] -> [HtmlTree]
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 Html -> Html -> Html
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 ((HtmlElement -> HtmlTree) -> [HtmlElement] -> [HtmlTree]
forall a b. (a -> b) -> [a] -> [b]
map HtmlElement -> HtmlTree
debug [HtmlElement]
xs) Html
tl
where
args :: String
args = if [HtmlAttr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HtmlAttr]
markupAttrs
then String
""
else String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((HtmlAttr -> String) -> [HtmlAttr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map HtmlAttr -> String
forall a. Show a => a -> String
show [HtmlAttr]
markupAttrs)
hd :: Html
hd = Html -> Html
font (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
size String
"1"] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
markupTag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
args String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">")
tl :: Html
tl = Html -> Html
font (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
size String
"1"] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"</" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
markupTag String -> String -> String
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
(Int -> HotLink -> String -> String)
-> (HotLink -> String)
-> ([HotLink] -> String -> String)
-> Show HotLink
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> HotLink -> String -> String
showsPrec :: Int -> HotLink -> String -> String
$cshow :: HotLink -> String
show :: HotLink -> String
$cshowList :: [HotLink] -> String -> String
showList :: [HotLink] -> String -> String
Show
instance HTML HotLink where
toHtml :: HotLink -> Html
toHtml HotLink
hl = Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! (String -> HtmlAttr
href (HotLink -> String
hotLinkURL HotLink
hl) HtmlAttr -> [HtmlAttr] -> [HtmlAttr]
forall a. a -> [a] -> [a]
: HotLink -> [HtmlAttr]
hotLinkAttributes HotLink
hl)
(Html -> Html) -> [Html] -> Html
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 (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (a -> Html) -> [a] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> Html
li (Html -> Html) -> a -> Html
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 (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (a -> Html) -> [a] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> Html
li (Html -> Html) -> a -> Html
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 (Html -> Html) -> [[Html]] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [ [ Html -> Html
dterm (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
bold (Html -> Html) -> a -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< a
dt, Html -> Html
ddef (Html -> Html) -> b -> Html
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 Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! ([String -> HtmlAttr
thetype String
w,String -> HtmlAttr
name String
n] [HtmlAttr] -> [HtmlAttr] -> [HtmlAttr]
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 (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
name String
n] (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [ Html -> Html
option (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
p (Html -> Html) -> Html -> Html
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 (Html -> Html) -> [HtmlAttr] -> Html -> Html
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++
((String -> String) -> (String -> String) -> String -> String)
-> (String -> String) -> [String -> String] -> String -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) String -> String
forall a. a -> a
id ((HtmlElement -> String -> String)
-> [HtmlElement] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> HtmlElement -> String -> String
renderHtml' Int
0)
(Html -> [HtmlElement]
getHtmlElements (String -> Html -> Html
tag String
"HTML" (Html -> Html) -> html -> 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" String -> String -> String
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
([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (HtmlElement -> [String]) -> [HtmlElement] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map HtmlElement -> [String]
prettyHtml'
([HtmlElement] -> [[String]]) -> [HtmlElement] -> [[String]]
forall a b. (a -> b) -> a -> b
$ Html -> [HtmlElement]
getHtmlElements
(Html -> [HtmlElement]) -> Html -> [HtmlElement]
forall a b. (a -> b) -> a -> b
$ html -> Html
forall a. HTML a => a -> Html
toHtml html
theHtml
renderHtml' :: Int -> HtmlElement -> ShowS
renderHtml' :: Int -> HtmlElement -> String -> String
renderHtml' Int
_ (HtmlString String
str) = String -> String -> String
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
&& String -> [String] -> Bool
forall a. Eq a => a -> [a] -> 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
(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> String) -> (String -> String) -> String -> String)
-> (String -> String) -> [String -> String] -> String -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) String -> String
forall a. a -> a
id ((HtmlElement -> String -> String)
-> [HtmlElement] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> HtmlElement -> String -> String
renderHtml' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)) (Html -> [HtmlElement]
getHtmlElements Html
html))
(String -> String) -> (String -> String) -> String -> String
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
&& String -> [String] -> Bool
forall a. Eq a => a -> [a] -> 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
"")] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String] -> [String]
shift ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((HtmlElement -> [String]) -> [HtmlElement] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map HtmlElement -> [String]
prettyHtml' (Html -> [HtmlElement]
getHtmlElements Html
html))) [String] -> [String] -> [String]
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 = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x)
rmNL :: String -> String
rmNL = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ [HtmlAttr] -> String
rest [HtmlAttr]
markupAttrs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r
where
open :: String
open = if Bool
x then String
"<" else String
"</"
nl :: String
nl = String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) Char
'\t'
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8) Char
' '
rest :: [HtmlAttr] -> String
rest [] = String
nl
rest [HtmlAttr]
attr = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((HtmlAttr -> String) -> [HtmlAttr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map HtmlAttr -> String
showPair [HtmlAttr]
attr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nl
showPair :: HtmlAttr -> String
showPair :: HtmlAttr -> String
showPair (HtmlAttr String
tag String
val)
= String
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
val String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""