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


{-
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 '<' = "&lt;"
      fixChar '>' = "&gt;"
      fixChar '&' = "&amp;"
      fixChar '"' = "&quot;"
      fixChar c :: Char
c   = [Char
c]               

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

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


-- ---------------------------------------------------------------------------
-- 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 x :: 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 ' ' = "&nbsp;"
      htmlizeChar2 c :: 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 "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"
header :: Html -> Html
header              =  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"

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

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

-- (automatically generated)

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

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

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

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


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

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

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

-- 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 r :: 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 :: 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)

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

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


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


-- ---------------------------------------------------------------------------
-- 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 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
              -- 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. [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

-- type "length treeColors" to see how many colors are here.
treeColors :: [String]
treeColors = ["#88ccff","#ffffaa","#ffaaff","#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 :: 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]
++ ">")

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


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

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

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

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

-- 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 :: 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')

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