-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Html
-- Copyright   :  (c) Andy Gill and OGI, 1999-2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  Andy Gill <andy@galconn.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- An Html combinator library
--
-----------------------------------------------------------------------------

module Text.Html (
      module Text.Html,
      ) where

import qualified Text.Html.BlockTable as BT

infixr 3 </>  -- combining table cells 
infixr 4 <->  -- combining table cells
infixr 2 +++  -- combining Html
infixr 7 <<   -- nesting Html
infixl 8 !    -- adding optional arguments


-- A important property of Html is that all strings inside the
-- structure are already in Html friendly format.
-- For example, use of &gt;,etc.

data HtmlElement
{-
 -    ..just..plain..normal..text... but using &copy; and &amb;, etc.
 -}
      = HtmlString String
{-
 -    <thetag {..attrs..}> ..content.. </thetag>
 -}
      | HtmlTag {                   -- tag with internal markup
              HtmlElement -> String
markupTag      :: String,
              HtmlElement -> [HtmlAttr]
markupAttrs    :: [HtmlAttr],
              HtmlElement -> Html
markupContent  :: Html
              }

{- These are the index-value pairs.
 - The empty string is a synonym for tags with no arguments.
 - (not strictly HTML, but anyway).
 -}


data HtmlAttr = HtmlAttr String String


newtype Html = Html { Html -> [HtmlElement]
getHtmlElements :: [HtmlElement] }

-- Read MARKUP as the class of things that can be validly rendered
-- inside MARKUP tag brackets. So this can be one or more Html's,
-- or a String, for example.

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


{-
foldHtml :: (String -> [HtmlAttr] -> [a] -> a) 
      -> (String -> a)
      -> Html
      -> a
foldHtml f g (HtmlTag str attr fmls) 
      = f str attr (map (foldHtml f g) fmls) 
foldHtml f g (HtmlString  str)           
      = g str

-}
-- Processing Strings into Html friendly things.
-- This converts a String to a Html String.
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
"&lt;"
      fixChar Char
'>' = String
"&gt;"
      fixChar Char
'&' = String
"&amp;"
      fixChar Char
'"' = String
"&quot;"
      fixChar Char
c   = [Char
c]               

-- ---------------------------------------------------------------------------
-- Classes

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


-- ---------------------------------------------------------------------------
-- Data types

type URL = String

-- ---------------------------------------------------------------------------
-- Basic primitives

-- This is not processed for special chars. 
-- use stringToHtml or lineToHtml instead, for user strings, 
-- because they  understand special chars, like '<'.

primHtml      :: String                                -> Html
primHtml :: String -> Html
primHtml String
x    = [HtmlElement] -> Html
Html [String -> HtmlElement
HtmlString String
x]

-- ---------------------------------------------------------------------------
-- Basic Combinators

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 

-- This converts a string, but keeps spaces as non-line-breakable

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
"&nbsp;"
      htmlizeChar2 Char
c   = [Char
c]

-- ---------------------------------------------------------------------------
-- Html Constructors

-- (automatically generated)

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"
header :: Html -> Html
header              =  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"

-- ---------------------------------------------------------------------------
-- Html Attributes

-- (automatically generated)

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"

-- ---------------------------------------------------------------------------
-- Html Constructors

-- (automatically generated)

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"]

-- ---------------------------------------------------------------------------
-- Html colors

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"

-- ---------------------------------------------------------------------------
-- Basic Combinators

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


-- ---------------------------------------------------------------------------
-- Html abbriviations

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

-- ---------------------------------------------------------------------------
-- Html tables

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

-- We internally represent the Cell inside a Table with an
-- object of the type
-- \pre{
-- 	   Int -> Int -> Html
-- } 	
-- When we render it later, we find out how many columns
-- or rows this cell will span over, and can
-- include the correct colspan/rowspan command.

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

-- We give both infix and nonfix, take your pick.
-- Notice that there is no concept of a row/column
-- of zero items.

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)

-- Both aboves and besides presume a non-empty list.
-- here is no concept of a empty row or column in these
-- table combinators.

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 takes the HtmlTable, and renders it back into
-- and Html object.

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)


-- If you can't be bothered with the above, then you
-- can build simple tables with simpleTable.
-- Just provide the attributes for the whole table,
-- attributes for the cells (same for every cell),
-- and a list of lists of cell contents,
-- and this function will build the table for you.
-- It does presume that all the lists are non-empty,
-- and there is at least one list.
--  
-- Different length lists means that the last cell
-- gets padded. If you want more power, then
-- use the system above, or build tables explicitly.

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


-- ---------------------------------------------------------------------------
-- Tree Displaying Combinators
 
-- The basic idea is you render your structure in the form
-- of this tree, and then use treeHtml to turn it into a Html
-- object with the structure explicit.

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
              -- This stops a column of colors being the same
              -- color as the immeduately outside nesting bar.
              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

-- type "length treeColors" to see how many colors are here.
treeColors :: [String]
treeColors = [String
"#88ccff",String
"#ffffaa",String
"#ffaaff",String
"#ccffff"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
treeColors


-- ---------------------------------------------------------------------------
-- Html Debugging Combinators
 
-- This uses the above tree rendering function, and displays the
-- Html as a tree structure, allowing debugging of what is
-- actually getting produced.

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
">")

-- ---------------------------------------------------------------------------
-- Hotlink datatype

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 = [] }


-- ---------------------------------------------------------------------------
-- More Combinators

-- (Abridged from Erik Meijer's Original Html library)

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
menu :: String -> [Html] -> Html
menu 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"]

-- ---------------------------------------------------------------------------
-- Html Rendering
 
-- Uses the append trick to optimize appending.
-- The output is quite messy, because space matters in
-- HTML, so we must not generate needless spaces.

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"

-- Warning: spaces matters in HTML. You are better using renderHtml.
-- This is intentually very inefficent to "encorage" this,
-- but the neater version in easier when debugging.

-- Local Utilities
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')

-- This prints the Tags The lack of spaces in intentunal, because Html is
-- actually space dependant.

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
"\""