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