{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS -fno-warn-type-defaults #-}
module Lucid.Html5 where
import Lucid.Base
import Data.Monoid
import Data.Text (Text, unwords)
doctype_ :: Applicative m => HtmlT m ()
doctype_ = makeElementNoEnd "!DOCTYPE HTML"
doctypehtml_ :: Applicative m => HtmlT m a -> HtmlT m a
doctypehtml_ m = doctype_ *> html_ m
a_ :: Term arg result => arg -> result
a_ = term "a"
abbr_ :: Term arg result => arg -> result
abbr_ = term "abbr"
address_ :: Term arg result => arg -> result
address_ = term "address"
area_ :: Applicative m => [Attribute] -> HtmlT m ()
area_ = with (makeElementNoEnd "area")
article_ :: Term arg result => arg -> result
article_ = term "article"
aside_ :: Term arg result => arg -> result
aside_ = term "aside"
audio_ :: Term arg result => arg -> result
audio_ = term "audio"
b_ :: Term arg result => arg -> result
b_ = term "b"
base_ :: Applicative m => [Attribute] -> HtmlT m ()
base_ = with (makeElementNoEnd "base")
bdo_ :: Term arg result => arg -> result
bdo_ = term "bdo"
blockquote_ :: Term arg result => arg -> result
blockquote_ = term "blockquote"
body_ :: Term arg result => arg -> result
body_ = term "body"
br_ :: Applicative m => [Attribute] -> HtmlT m ()
br_ = with (makeElementNoEnd "br")
button_ :: Term arg result => arg -> result
button_ = term "button"
canvas_ :: Term arg result => arg -> result
canvas_ = term "canvas"
caption_ :: Term arg result => arg -> result
caption_ = term "caption"
cite_ :: Term arg result => arg -> result
cite_ = term "cite"
code_ :: Term arg result => arg -> result
code_ = term "code"
col_ :: Applicative m => [Attribute] -> HtmlT m ()
col_ = with (makeElementNoEnd "col")
colgroup_ :: Term arg result => arg -> result
colgroup_ = term "colgroup"
command_ :: Term arg result => arg -> result
command_ = term "command"
datalist_ :: Term arg result => arg -> result
datalist_ = term "datalist"
dd_ :: Term arg result => arg -> result
dd_ = term "dd"
del_ :: Term arg result => arg -> result
del_ = term "del"
details_ :: Term arg result => arg -> result
details_ = term "details"
dfn_ :: Term arg result => arg -> result
dfn_ = term "dfn"
div_ :: Term arg result => arg -> result
div_ = term "div"
dl_ :: Term arg result => arg -> result
dl_ = term "dl"
dt_ :: Term arg result => arg -> result
dt_ = term "dt"
em_ :: Term arg result => arg -> result
em_ = term "em"
embed_ :: Applicative m => [Attribute] -> HtmlT m ()
embed_ = with (makeElementNoEnd "embed")
fieldset_ :: Term arg result => arg -> result
fieldset_ = term "fieldset"
figcaption_ :: Term arg result => arg -> result
figcaption_ = term "figcaption"
figure_ :: Term arg result => arg -> result
figure_ = term "figure"
footer_ :: Term arg result => arg -> result
footer_ = term "footer"
form_ :: Term arg result => arg -> result
form_ = term "form"
h1_ :: Term arg result => arg -> result
h1_ = term "h1"
h2_ :: Term arg result => arg -> result
h2_ = term "h2"
h3_ :: Term arg result => arg -> result
h3_ = term "h3"
h4_ :: Term arg result => arg -> result
h4_ = term "h4"
h5_ :: Term arg result => arg -> result
h5_ = term "h5"
h6_ :: Term arg result => arg -> result
h6_ = term "h6"
head_ :: Term arg result => arg -> result
head_ = term "head"
header_ :: Term arg result => arg -> result
header_ = term "header"
hgroup_ :: Term arg result => arg -> result
hgroup_ = term "hgroup"
hr_ :: Applicative m => [Attribute] -> HtmlT m ()
hr_ = with (makeElementNoEnd "hr")
html_ :: Term arg result => arg -> result
html_ = term "html"
i_ :: Term arg result => arg -> result
i_ = term "i"
iframe_ :: Term arg result => arg -> result
iframe_ = term "iframe"
img_ :: Applicative m => [Attribute] -> HtmlT m ()
img_ = with (makeElementNoEnd "img")
input_ :: Applicative m => [Attribute] -> HtmlT m ()
input_ = with (makeElementNoEnd "input")
ins_ :: Term arg result => arg -> result
ins_ = term "ins"
kbd_ :: Term arg result => arg -> result
kbd_ = term "kbd"
keygen_ :: Applicative m => [Attribute] -> HtmlT m ()
keygen_ = with (makeElementNoEnd "keygen")
label_ :: Term arg result => arg -> result
label_ = term "label"
legend_ :: Term arg result => arg -> result
legend_ = term "legend"
li_ :: Term arg result => arg -> result
li_ = term "li"
link_ :: Applicative m => [Attribute] -> HtmlT m ()
link_ = with (makeElementNoEnd "link")
map_ :: Term arg result => arg -> result
map_ = term "map"
main_ :: Term arg result => arg -> result
main_ = term "main"
mark_ :: Term arg result => arg -> result
mark_ = term "mark"
menu_ :: Term arg result => arg -> result
menu_ = term "menu"
menuitem_ :: Applicative m => [Attribute] -> HtmlT m ()
menuitem_ = with (makeElementNoEnd "menuitem")
meta_ :: Applicative m => [Attribute] -> HtmlT m ()
meta_ = with (makeElementNoEnd "meta")
meter_ :: Term arg result => arg -> result
meter_ = term "meter"
nav_ :: Term arg result => arg -> result
nav_ = term "nav"
noscript_ :: Term arg result => arg -> result
noscript_ = term "noscript"
object_ :: Term arg result => arg -> result
object_ = term "object"
ol_ :: Term arg result => arg -> result
ol_ = term "ol"
optgroup_ :: Term arg result => arg -> result
optgroup_ = term "optgroup"
option_ :: Term arg result => arg -> result
option_ = term "option"
output_ :: Term arg result => arg -> result
output_ = term "output"
p_ :: Term arg result => arg -> result
p_ = term "p"
param_ :: Applicative m => [Attribute] -> HtmlT m ()
param_ = with (makeElementNoEnd "param")
svg_ :: Term arg result => arg -> result
svg_ = term "svg"
pre_ :: Term arg result => arg -> result
pre_ = term "pre"
progress_ :: Term arg result => arg -> result
progress_ = term "progress"
q_ :: Term arg result => arg -> result
q_ = term "q"
rp_ :: Term arg result => arg -> result
rp_ = term "rp"
rt_ :: Term arg result => arg -> result
rt_ = term "rt"
ruby_ :: Term arg result => arg -> result
ruby_ = term "ruby"
samp_ :: Term arg result => arg -> result
samp_ = term "samp"
script_ :: TermRaw arg result => arg -> result
script_ = termRaw "script"
section_ :: Term arg result => arg -> result
section_ = term "section"
select_ :: Term arg result => arg -> result
select_ = term "select"
small_ :: Term arg result => arg -> result
small_ = term "small"
source_ :: Applicative m => [Attribute] -> HtmlT m ()
source_ = with (makeElementNoEnd "source")
span_ :: Term arg result => arg -> result
span_ = term "span"
strong_ :: Term arg result => arg -> result
strong_ = term "strong"
style_ :: TermRaw arg result => arg -> result
style_ = termRaw "style"
sub_ :: Term arg result => arg -> result
sub_ = term "sub"
summary_ :: Term arg result => arg -> result
summary_ = term "summary"
sup_ :: Term arg result => arg -> result
sup_ = term "sup"
table_ :: Term arg result => arg -> result
table_ = term "table"
tbody_ :: Term arg result => arg -> result
tbody_ = term "tbody"
td_ :: Term arg result => arg -> result
td_ = term "td"
textarea_ :: Term arg result => arg -> result
textarea_ = term "textarea"
tfoot_ :: Term arg result => arg -> result
tfoot_ = term "tfoot"
th_ :: Term arg result => arg -> result
th_ = term "th"
template_ :: Term arg result => arg -> result
template_ = term "template"
thead_ :: Term arg result => arg -> result
thead_ = term "thead"
time_ :: Term arg result => arg -> result
time_ = term "time"
title_ :: Term arg result => arg -> result
title_ = term "title"
tr_ :: Term arg result => arg -> result
tr_ = term "tr"
track_ :: Applicative m => [Attribute] -> HtmlT m ()
track_ = with (makeElementNoEnd "track")
ul_ :: Term arg result => arg -> result
ul_ = term "ul"
var_ :: Term arg result => arg -> result
var_ = term "var"
video_ :: Term arg result => arg -> result
video_ = term "video"
wbr_ :: Applicative m => [Attribute] -> HtmlT m ()
wbr_ = with (makeElementNoEnd "wbr")
accept_ :: Text -> Attribute
accept_ = makeAttribute "accept"
acceptCharset_ :: Text -> Attribute
acceptCharset_ = makeAttribute "accept-charset"
accesskey_ :: Text -> Attribute
accesskey_ = makeAttribute "accesskey"
action_ :: Text -> Attribute
action_ = makeAttribute "action"
alt_ :: Text -> Attribute
alt_ = makeAttribute "alt"
async_ :: Text -> Attribute
async_ = makeAttribute "async"
autocomplete_ :: Text -> Attribute
autocomplete_ = makeAttribute "autocomplete"
autofocus_ :: Attribute
autofocus_ = makeAttribute "autofocus" mempty
autoplay_ :: Text -> Attribute
autoplay_ = makeAttribute "autoplay"
challenge_ :: Text -> Attribute
challenge_ = makeAttribute "challenge"
charset_ :: Text -> Attribute
charset_ = makeAttribute "charset"
checked_ :: Attribute
checked_ = makeAttribute "checked" mempty
class_ :: Text -> Attribute
class_ = makeAttribute "class"
classes_ :: [Text] -> Attribute
classes_ = makeAttribute "class" . Data.Text.unwords
cols_ :: Text -> Attribute
cols_ = makeAttribute "cols"
colspan_ :: Text -> Attribute
colspan_ = makeAttribute "colspan"
content_ :: Text -> Attribute
content_ = makeAttribute "content"
contenteditable_ :: Text -> Attribute
contenteditable_ = makeAttribute "contenteditable"
contextmenu_ :: Text -> Attribute
contextmenu_ = makeAttribute "contextmenu"
controls_ :: Text -> Attribute
controls_ = makeAttribute "controls"
coords_ :: Text -> Attribute
coords_ = makeAttribute "coords"
crossorigin_ :: Text -> Attribute
crossorigin_ = makeAttribute "crossorigin"
data_ :: Text -> Text -> Attribute
data_ name = makeAttribute ("data-" <> name)
datetime_ :: Text -> Attribute
datetime_ = makeAttribute "datetime"
defer_ :: Text -> Attribute
defer_ = makeAttribute "defer"
dir_ :: Text -> Attribute
dir_ = makeAttribute "dir"
disabled_ :: Text -> Attribute
disabled_ = makeAttribute "disabled"
download_ :: Text -> Attribute
download_ = makeAttribute "download"
draggable_ :: Text -> Attribute
draggable_ = makeAttribute "draggable"
enctype_ :: Text -> Attribute
enctype_ = makeAttribute "enctype"
for_ :: Text -> Attribute
for_ = makeAttribute "for"
formaction_ :: Text -> Attribute
formaction_ = makeAttribute "formaction"
formenctype_ :: Text -> Attribute
formenctype_ = makeAttribute "formenctype"
formmethod_ :: Text -> Attribute
formmethod_ = makeAttribute "formmethod"
formnovalidate_ :: Text -> Attribute
formnovalidate_ = makeAttribute "formnovalidate"
formtarget_ :: Text -> Attribute
formtarget_ = makeAttribute "formtarget"
headers_ :: Text -> Attribute
headers_ = makeAttribute "headers"
height_ :: Text -> Attribute
height_ = makeAttribute "height"
hidden_ :: Text -> Attribute
hidden_ = makeAttribute "hidden"
high_ :: Text -> Attribute
high_ = makeAttribute "high"
href_ :: Text -> Attribute
href_ = makeAttribute "href"
hreflang_ :: Text -> Attribute
hreflang_ = makeAttribute "hreflang"
httpEquiv_ :: Text -> Attribute
httpEquiv_ = makeAttribute "http-equiv"
icon_ :: Text -> Attribute
icon_ = makeAttribute "icon"
id_ :: Text -> Attribute
id_ = makeAttribute "id"
integrity_ :: Text -> Attribute
integrity_ = makeAttribute "integrity"
ismap_ :: Text -> Attribute
ismap_ = makeAttribute "ismap"
item_ :: Text -> Attribute
item_ = makeAttribute "item"
itemprop_ :: Text -> Attribute
itemprop_ = makeAttribute "itemprop"
keytype_ :: Text -> Attribute
keytype_ = makeAttribute "keytype"
lang_ :: Text -> Attribute
lang_ = makeAttribute "lang"
list_ :: Text -> Attribute
list_ = makeAttribute "list"
loop_ :: Text -> Attribute
loop_ = makeAttribute "loop"
low_ :: Text -> Attribute
low_ = makeAttribute "low"
manifest_ :: Text -> Attribute
manifest_ = makeAttribute "manifest"
max_ :: Text -> Attribute
max_ = makeAttribute "max"
maxlength_ :: Text -> Attribute
maxlength_ = makeAttribute "maxlength"
media_ :: Text -> Attribute
media_ = makeAttribute "media"
method_ :: Text -> Attribute
method_ = makeAttribute "method"
min_ :: Text -> Attribute
min_ = makeAttribute "min"
multiple_ :: Text -> Attribute
multiple_ = makeAttribute "multiple"
name_ :: Text -> Attribute
name_ = makeAttribute "name"
novalidate_ :: Text -> Attribute
novalidate_ = makeAttribute "novalidate"
onbeforeonload_ :: Text -> Attribute
onbeforeonload_ = makeAttribute "onbeforeonload"
onbeforeprint_ :: Text -> Attribute
onbeforeprint_ = makeAttribute "onbeforeprint"
onblur_ :: Text -> Attribute
onblur_ = makeAttribute "onblur"
oncanplay_ :: Text -> Attribute
oncanplay_ = makeAttribute "oncanplay"
oncanplaythrough_ :: Text -> Attribute
oncanplaythrough_ = makeAttribute "oncanplaythrough"
onchange_ :: Text -> Attribute
onchange_ = makeAttribute "onchange"
onclick_ :: Text -> Attribute
onclick_ = makeAttribute "onclick"
oncontextmenu_ :: Text -> Attribute
oncontextmenu_ = makeAttribute "oncontextmenu"
ondblclick_ :: Text -> Attribute
ondblclick_ = makeAttribute "ondblclick"
ondrag_ :: Text -> Attribute
ondrag_ = makeAttribute "ondrag"
ondragend_ :: Text -> Attribute
ondragend_ = makeAttribute "ondragend"
ondragenter_ :: Text -> Attribute
ondragenter_ = makeAttribute "ondragenter"
ondragleave_ :: Text -> Attribute
ondragleave_ = makeAttribute "ondragleave"
ondragover_ :: Text -> Attribute
ondragover_ = makeAttribute "ondragover"
ondragstart_ :: Text -> Attribute
ondragstart_ = makeAttribute "ondragstart"
ondrop_ :: Text -> Attribute
ondrop_ = makeAttribute "ondrop"
ondurationchange_ :: Text -> Attribute
ondurationchange_ = makeAttribute "ondurationchange"
onemptied_ :: Text -> Attribute
onemptied_ = makeAttribute "onemptied"
onended_ :: Text -> Attribute
onended_ = makeAttribute "onended"
onerror_ :: Text -> Attribute
onerror_ = makeAttribute "onerror"
onfocus_ :: Text -> Attribute
onfocus_ = makeAttribute "onfocus"
onformchange_ :: Text -> Attribute
onformchange_ = makeAttribute "onformchange"
onforminput_ :: Text -> Attribute
onforminput_ = makeAttribute "onforminput"
onhaschange_ :: Text -> Attribute
onhaschange_ = makeAttribute "onhaschange"
oninput_ :: Text -> Attribute
oninput_ = makeAttribute "oninput"
oninvalid_ :: Text -> Attribute
oninvalid_ = makeAttribute "oninvalid"
onkeydown_ :: Text -> Attribute
onkeydown_ = makeAttribute "onkeydown"
onkeyup_ :: Text -> Attribute
onkeyup_ = makeAttribute "onkeyup"
onload_ :: Text -> Attribute
onload_ = makeAttribute "onload"
onloadeddata_ :: Text -> Attribute
onloadeddata_ = makeAttribute "onloadeddata"
onloadedmetadata_ :: Text -> Attribute
onloadedmetadata_ = makeAttribute "onloadedmetadata"
onloadstart_ :: Text -> Attribute
onloadstart_ = makeAttribute "onloadstart"
onmessage_ :: Text -> Attribute
onmessage_ = makeAttribute "onmessage"
onmousedown_ :: Text -> Attribute
onmousedown_ = makeAttribute "onmousedown"
onmousemove_ :: Text -> Attribute
onmousemove_ = makeAttribute "onmousemove"
onmouseout_ :: Text -> Attribute
onmouseout_ = makeAttribute "onmouseout"
onmouseover_ :: Text -> Attribute
onmouseover_ = makeAttribute "onmouseover"
onmouseup_ :: Text -> Attribute
onmouseup_ = makeAttribute "onmouseup"
onmousewheel_ :: Text -> Attribute
onmousewheel_ = makeAttribute "onmousewheel"
ononline_ :: Text -> Attribute
ononline_ = makeAttribute "ononline"
onpagehide_ :: Text -> Attribute
onpagehide_ = makeAttribute "onpagehide"
onpageshow_ :: Text -> Attribute
onpageshow_ = makeAttribute "onpageshow"
onpause_ :: Text -> Attribute
onpause_ = makeAttribute "onpause"
onplay_ :: Text -> Attribute
onplay_ = makeAttribute "onplay"
onplaying_ :: Text -> Attribute
onplaying_ = makeAttribute "onplaying"
onprogress_ :: Text -> Attribute
onprogress_ = makeAttribute "onprogress"
onpropstate_ :: Text -> Attribute
onpropstate_ = makeAttribute "onpropstate"
onratechange_ :: Text -> Attribute
onratechange_ = makeAttribute "onratechange"
onreadystatechange_ :: Text -> Attribute
onreadystatechange_ = makeAttribute "onreadystatechange"
onredo_ :: Text -> Attribute
onredo_ = makeAttribute "onredo"
onresize_ :: Text -> Attribute
onresize_ = makeAttribute "onresize"
onscroll_ :: Text -> Attribute
onscroll_ = makeAttribute "onscroll"
onseeked_ :: Text -> Attribute
onseeked_ = makeAttribute "onseeked"
onseeking_ :: Text -> Attribute
onseeking_ = makeAttribute "onseeking"
onselect_ :: Text -> Attribute
onselect_ = makeAttribute "onselect"
onstalled_ :: Text -> Attribute
onstalled_ = makeAttribute "onstalled"
onstorage_ :: Text -> Attribute
onstorage_ = makeAttribute "onstorage"
onsubmit_ :: Text -> Attribute
onsubmit_ = makeAttribute "onsubmit"
onsuspend_ :: Text -> Attribute
onsuspend_ = makeAttribute "onsuspend"
ontimeupdate_ :: Text -> Attribute
ontimeupdate_ = makeAttribute "ontimeupdate"
onundo_ :: Text -> Attribute
onundo_ = makeAttribute "onundo"
onunload_ :: Text -> Attribute
onunload_ = makeAttribute "onunload"
onvolumechange_ :: Text -> Attribute
onvolumechange_ = makeAttribute "onvolumechange"
onwaiting_ :: Text -> Attribute
onwaiting_ = makeAttribute "onwaiting"
open_ :: Text -> Attribute
open_ = makeAttribute "open"
optimum_ :: Text -> Attribute
optimum_ = makeAttribute "optimum"
pattern_ :: Text -> Attribute
pattern_ = makeAttribute "pattern"
ping_ :: Text -> Attribute
ping_ = makeAttribute "ping"
placeholder_ :: Text -> Attribute
placeholder_ = makeAttribute "placeholder"
preload_ :: Text -> Attribute
preload_ = makeAttribute "preload"
pubdate_ :: Text -> Attribute
pubdate_ = makeAttribute "pubdate"
radiogroup_ :: Text -> Attribute
radiogroup_ = makeAttribute "radiogroup"
readonly_ :: Text -> Attribute
readonly_ = makeAttribute "readonly"
rel_ :: Text -> Attribute
rel_ = makeAttribute "rel"
required_ :: Text -> Attribute
required_ = makeAttribute "required"
reversed_ :: Text -> Attribute
reversed_ = makeAttribute "reversed"
role_ :: Text -> Attribute
role_ = makeAttribute "role"
rows_ :: Text -> Attribute
rows_ = makeAttribute "rows"
rowspan_ :: Text -> Attribute
rowspan_ = makeAttribute "rowspan"
sandbox_ :: Text -> Attribute
sandbox_ = makeAttribute "sandbox"
scope_ :: Text -> Attribute
scope_ = makeAttribute "scope"
scoped_ :: Text -> Attribute
scoped_ = makeAttribute "scoped"
seamless_ :: Text -> Attribute
seamless_ = makeAttribute "seamless"
selected_ :: Text -> Attribute
selected_ = makeAttribute "selected"
shape_ :: Text -> Attribute
shape_ = makeAttribute "shape"
size_ :: Text -> Attribute
size_ = makeAttribute "size"
sizes_ :: Text -> Attribute
sizes_ = makeAttribute "sizes"
spellcheck_ :: Text -> Attribute
spellcheck_ = makeAttribute "spellcheck"
src_ :: Text -> Attribute
src_ = makeAttribute "src"
srcdoc_ :: Text -> Attribute
srcdoc_ = makeAttribute "srcdoc"
start_ :: Text -> Attribute
start_ = makeAttribute "start"
step_ :: Text -> Attribute
step_ = makeAttribute "step"
subject_ :: Text -> Attribute
subject_ = makeAttribute "subject"
tabindex_ :: Text -> Attribute
tabindex_ = makeAttribute "tabindex"
target_ :: Text -> Attribute
target_ = makeAttribute "target"
type_ :: Text -> Attribute
type_ = makeAttribute "type"
usemap_ :: Text -> Attribute
usemap_ = makeAttribute "usemap"
value_ :: Text -> Attribute
value_ = makeAttribute "value"
width_ :: Text -> Attribute
width_ = makeAttribute "width"
wrap_ :: Text -> Attribute
wrap_ = makeAttribute "wrap"
xmlns_ :: Text -> Attribute
xmlns_ = makeAttribute "xmlns"