{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Module    : Html
-- Copyright   : (c) Joshua Obritsch, 2021
-- License     : MIT
-- Maintainer  : joshua@obritsch.com
-- Stability   : Experimental
--
-- The "Html" module provides a set of types, classes and functions for generating HTML elements.
--
-- These elements along with their attributes and event handlers, found in the "Html.Attributes" and "Html.Events" modules respectively, can
-- be used to dynamically compose HTML documents natively in Haskell, without relying on templating engines or other techniques that can be
-- error-prone and difficult to maintain.
--
-- Additionally, the functions provided in the "Html.Intl" module can be used to facilitate internationalization.
module Html
    ( -- * Types
      -- ** Html
      Html(..)
      -- ** Attribute
    , Attribute(..)

      -- * Classes
      -- ** Buildable
    , Buildable(..)
      -- ** Translatable
    , Translatable(..)

      -- * Declarations
      -- ** \<!DOCTYPE\>
    , doctype

      -- * Elements
      -- ** \<a\>
    , a
      -- ** \<abbr\>
    , abbr
      -- ** \<address\>
    , address
      -- ** \<area\>
    , area
      -- ** \<article\>
    , article
      -- ** \<aside\>
    , aside
      -- ** \<audio\>
    , audio
      -- ** \<b\>
    , b
      -- ** \<base\>
    , base
      -- ** \<bdi\>
    , bdi
      -- ** \<bdo\>
    , bdo
      -- ** \<blockquote\>
    , blockquote
      -- ** \<body\>
    , body
      -- ** \<br\>
    , br
      -- ** \<button\>
    , button
      -- ** \<canvas\>
    , canvas
      -- ** \<caption\>
    , caption
      -- ** \<cite\>
    , cite
      -- ** \<code\>
    , code
      -- ** \<col\>
    , col
      -- ** \<colgroup\>
    , colgroup
      -- ** \<data\>
    , data_
      -- ** \<datalist\>
    , datalist
      -- ** \<dd\>
    , dd
      -- ** \<del\>
    , del
      -- ** \<details\>
    , details
      -- ** \<dfn\>
    , dfn
      -- ** \<dialog\>
    , dialog
      -- ** \<div\>
    , div
      -- ** \<dl\>
    , dl
      -- ** \<dt\>
    , dt
      -- ** \<em\>
    , em
      -- ** \<embed\>
    , embed
      -- ** \<fieldset\>
    , fieldset
      -- ** \<figcaption\>
    , figcaption
      -- ** \<figure\>
    , figure
      -- ** \<footer\>
    , footer
      -- ** \<form\>
    , form
      -- ** \<h1\>
    , h1
      -- ** \<h2\>
    , h2
      -- ** \<h3\>
    , h3
      -- ** \<h4\>
    , h4
      -- ** \<h5\>
    , h5
      -- ** \<h6\>
    , h6
      -- ** \<head\>
    , head
      -- ** \<header\>
    , header
      -- ** \<hgroup\>
    , hgroup
      -- ** \<hr\>
    , hr
      -- ** \<html\>
    , html
      -- ** \<i\>
    , i
      -- ** \<iframe\>
    , iframe
      -- ** \<img\>
    , img
      -- ** \<input\>
    , input
      -- ** \<ins\>
    , ins
      -- ** \<kbd\>
    , kbd
      -- ** \<label\>
    , label
      -- ** \<legend\>
    , legend
      -- ** \<li\>
    , li
      -- ** \<link\>
    , link
      -- ** \<main\>
    , main
      -- ** \<map\>
    , map
      -- ** \<mark\>
    , mark
      -- ** \<menu\>
    , menu
      -- ** \<meta\>
    , meta
      -- ** \<meter\>
    , meter
      -- ** \<nav\>
    , nav
      -- ** \<noscript\>
    , noscript
      -- ** \<object\>
    , object
      -- ** \<ol\>
    , ol
      -- ** \<optgroup\>
    , optgroup
      -- ** \<option\>
    , option
      -- ** \<output\>
    , output
      -- ** \<p\>
    , p
      -- ** \<picture\>
    , picture
      -- ** \<pre\>
    , pre
      -- ** \<progress\>
    , progress
      -- ** \<q\>
    , q
      -- ** \<rp\>
    , rp
      -- ** \<rt\>
    , rt
      -- ** \<ruby\>
    , ruby
      -- ** \<s\>
    , s
      -- ** \<samp\>
    , samp
      -- ** \<script\>
    , script
      -- ** \<section\>
    , section
      -- ** \<select\>
    , select
      -- ** \<slot\>
    , slot
      -- ** \<small\>
    , small
      -- ** \<source\>
    , source
      -- ** \<span\>
    , span
      -- ** \<strong\>
    , strong
      -- ** \<style\>
    , style
      -- ** \<sub\>
    , sub
      -- ** \<summary\>
    , summary
      -- ** \<sup\>
    , sup
      -- ** \<table\>
    , table
      -- ** \<tbody\>
    , tbody
      -- ** \<td\>
    , td
      -- ** \<template\>
    , template
      -- ** \<textarea\>
    , textarea
      -- ** \<tfoot\>
    , tfoot
      -- ** \<th\>
    , th
      -- ** \<thead\>
    , thead
      -- ** \<time\>
    , time
      -- ** \<title\>
    , title
      -- ** \<tr\>
    , tr
      -- ** \<track\>
    , track
      -- ** \<u\>
    , u
      -- ** \<ul\>
    , ul
      -- ** \<var\>
    , var
      -- ** \<video\>
    , video
      -- ** \<wbr\>
    , wbr
    ) where


import Data.Bool (Bool(..))
import Data.Foldable (foldr)
import Data.Function ((.))
import Data.Monoid ((<>), mempty)
import Data.String (IsString(..))
import Data.Text.Lazy (unpack)
import Data.Text.Lazy.Builder (Builder, singleton, toLazyText)
import Text.Show (Show(..))


-- TYPES


-- | Represents an HTML element.
--
-- /Note: The type variable /lng/ stands for /language/ and is used to facilitate internationalization./
data Html lng where

    -- | Constructs an HTML parent node.
    ParentNode :: Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng

    -- | Constructs an HTML leaf node.
    LeafNode :: Builder -> [Attribute] -> Html lng

    -- | Constructs an HTML root node.
    RootNode :: Builder -> [Html lng] -> Html lng

    -- | Constructs a monolingual HTML text node.
    TextNode :: Builder -> Html lng

    -- | Constructs a multilingual HTML text node.
    IntlNode :: Translatable lng => lng -> Html lng


instance IsString (Html lng) where
    fromString :: String -> Html lng
fromString = forall lng. Builder -> Html lng
TextNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString


instance Show (Html lng) where
    show :: Html lng -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Buildable a => a -> Builder
build


instance Buildable (Html lng) where
    build :: Html lng -> Builder
build Html lng
html = case Html lng
html of
        ParentNode Builder
startTag Builder
endTag []         []       -> Builder
startTag forall a. Semigroup a => a -> a -> a
<>                     Char -> Builder
singleton Char
'>' forall a. Semigroup a => a -> a -> a
<>                   Builder
endTag
        ParentNode Builder
startTag Builder
endTag [Attribute]
attributes []       -> Builder
startTag forall a. Semigroup a => a -> a -> a
<> forall a. Buildable a => a -> Builder
build [Attribute]
attributes forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'>' forall a. Semigroup a => a -> a -> a
<>                   Builder
endTag
        ParentNode Builder
startTag Builder
endTag []         [Html lng]
children -> Builder
startTag forall a. Semigroup a => a -> a -> a
<>                     Char -> Builder
singleton Char
'>' forall a. Semigroup a => a -> a -> a
<> forall a. Buildable a => a -> Builder
build [Html lng]
children forall a. Semigroup a => a -> a -> a
<> Builder
endTag
        ParentNode Builder
startTag Builder
endTag [Attribute]
attributes [Html lng]
children -> Builder
startTag forall a. Semigroup a => a -> a -> a
<> forall a. Buildable a => a -> Builder
build [Attribute]
attributes forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'>' forall a. Semigroup a => a -> a -> a
<> forall a. Buildable a => a -> Builder
build [Html lng]
children forall a. Semigroup a => a -> a -> a
<> Builder
endTag
        LeafNode   Builder
startTag        []                  -> Builder
startTag forall a. Semigroup a => a -> a -> a
<>                     Char -> Builder
singleton Char
'>'
        LeafNode   Builder
startTag        [Attribute]
attributes          -> Builder
startTag forall a. Semigroup a => a -> a -> a
<> forall a. Buildable a => a -> Builder
build [Attribute]
attributes forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'>'
        RootNode   Builder
startTag                   []       -> Builder
startTag
        RootNode   Builder
startTag                   [Html lng]
children -> Builder
startTag forall a. Semigroup a => a -> a -> a
<>                                      forall a. Buildable a => a -> Builder
build [Html lng]
children
        TextNode   Builder
text                                -> Builder
text
        IntlNode   lng
intl                                -> Builder
text
          where text :: Builder
text = forall a. Translatable a => a -> Builder
defaultLanguage lng
intl


instance {-# OVERLAPPING #-} Show [Html lng] where
    show :: [Html lng] -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Buildable a => a -> Builder
build


instance Buildable [Html lng] where
    build :: [Html lng] -> Builder
build = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Buildable a => a -> Builder
build) forall a. Monoid a => a
mempty


-- | Represents an HTML attribute.
data Attribute

    -- | Constructs a boolean HTML attribute.
    = BoolAttribute Builder Bool

    -- | Constructs a textual HTML attribute.
    | TextAttribute Builder Builder


instance Show Attribute where
    show :: Attribute -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Buildable a => a -> Builder
build


instance Buildable Attribute where
    build :: Attribute -> Builder
build Attribute
attribute = case Attribute
attribute of
        BoolAttribute Builder
_   Bool
False -> forall a. Monoid a => a
mempty
        BoolAttribute Builder
key Bool
True  -> Builder
key
        TextAttribute Builder
_   Builder
""    -> forall a. Monoid a => a
mempty
        TextAttribute Builder
key Builder
value -> Builder
key forall a. Semigroup a => a -> a -> a
<> Builder
value forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'"'


instance {-# OVERLAPPING #-} Show [Attribute] where
    show :: [Attribute] -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Buildable a => a -> Builder
build


instance Buildable [Attribute] where
    build :: [Attribute] -> Builder
build = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Buildable a => a -> Builder
build) forall a. Monoid a => a
mempty


-- CLASSES


-- | Enables conversion to 'Data.Text.Lazy.Builder.Builder'.
class Buildable a where

    -- | Converts to 'Data.Text.Lazy.Builder.Builder'.
    build :: a -> Builder


-- | Enables the use of multilingual text nodes with 'Html.Html'.
class Translatable a where

    -- | Sets the default language to use for internationalization with 'Html.Html'.
    defaultLanguage :: a -> Builder


-- DECLARATIONS


-- | Generates an HTML @\<!DOCTYPE\>@ declaration with the given contents.
doctype :: [Html lng] -> Html lng
doctype :: forall lng. [Html lng] -> Html lng
doctype = forall lng. Builder -> [Html lng] -> Html lng
RootNode Builder
"<!DOCTYPE html>\n"
{-# INLINE doctype #-}


-- ELEMENTS


-- | Generates an HTML @\<a\>@ element with the given attributes and contents.
a :: [Attribute] -> [Html lng] -> Html lng
a :: forall lng. [Attribute] -> [Html lng] -> Html lng
a = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<a" Builder
"</a>"
{-# INLINE a #-}


-- | Generates an HTML @\<abbr\>@ element with the given attributes and contents.
abbr :: [Attribute] -> [Html lng] -> Html lng
abbr :: forall lng. [Attribute] -> [Html lng] -> Html lng
abbr = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<abbr" Builder
"</abbr>"
{-# INLINE abbr #-}


-- | Generates an HTML @\<address\>@ element with the given attributes and contents.
address :: [Attribute] -> [Html lng] -> Html lng
address :: forall lng. [Attribute] -> [Html lng] -> Html lng
address = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<address" Builder
"</address>"
{-# INLINE address #-}


-- | Generates an HTML @\<area\>@ element with the given attributes.
area :: [Attribute] -> Html lng
area :: forall lng. [Attribute] -> Html lng
area = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<area"
{-# INLINE area #-}


-- | Generates an HTML @\<article\>@ element with the given attributes and contents.
article :: [Attribute] -> [Html lng] -> Html lng
article :: forall lng. [Attribute] -> [Html lng] -> Html lng
article = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<article" Builder
"</article>"
{-# INLINE article #-}


-- | Generates an HTML @\<aside\>@ element with the given attributes and contents.
aside :: [Attribute] -> [Html lng] -> Html lng
aside :: forall lng. [Attribute] -> [Html lng] -> Html lng
aside = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<aside" Builder
"</aside>"
{-# INLINE aside #-}


-- | Generates an HTML @\<audio\>@ element with the given attributes and contents.
audio :: [Attribute] -> [Html lng] -> Html lng
audio :: forall lng. [Attribute] -> [Html lng] -> Html lng
audio = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<audio" Builder
"</audio>"
{-# INLINE audio #-}


-- | Generates an HTML @\<b\>@ element with the given attributes and contents.
b :: [Attribute] -> [Html lng] -> Html lng
b :: forall lng. [Attribute] -> [Html lng] -> Html lng
b = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<b" Builder
"</b>"
{-# INLINE b #-}


-- | Generates an HTML @\<base\>@ element with the given attributes.
base :: [Attribute] -> Html lng
base :: forall lng. [Attribute] -> Html lng
base = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<base"
{-# INLINE base #-}


-- | Generates an HTML @\<bdi\>@ element with the given attributes and contents.
bdi :: [Attribute] -> [Html lng] -> Html lng
bdi :: forall lng. [Attribute] -> [Html lng] -> Html lng
bdi = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<bdi" Builder
"</bdi>"
{-# INLINE bdi #-}


-- | Generates an HTML @\<bdo\>@ element with the given attributes and contents.
bdo :: [Attribute] -> [Html lng] -> Html lng
bdo :: forall lng. [Attribute] -> [Html lng] -> Html lng
bdo = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<bdo" Builder
"</bdo>"
{-# INLINE bdo #-}


-- | Generates an HTML @\<blockquote\>@ element with the given attributes and contents.
blockquote :: [Attribute] -> [Html lng] -> Html lng
blockquote :: forall lng. [Attribute] -> [Html lng] -> Html lng
blockquote = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<blockquote" Builder
"</blockquote>"
{-# INLINE blockquote #-}


-- | Generates an HTML @\<body\>@ element with the given attributes and contents.
body :: [Attribute] -> [Html lng] -> Html lng
body :: forall lng. [Attribute] -> [Html lng] -> Html lng
body = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<body" Builder
"</body>"
{-# INLINE body #-}


-- | Generates an HTML @\<br\>@ element with the given attributes.
br :: [Attribute] -> Html lng
br :: forall lng. [Attribute] -> Html lng
br = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<br"
{-# INLINE br #-}


-- | Generates an HTML @\<button\>@ element with the given attributes and contents.
button :: [Attribute] -> [Html lng] -> Html lng
button :: forall lng. [Attribute] -> [Html lng] -> Html lng
button = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<button" Builder
"</button>"
{-# INLINE button #-}


-- | Generates an HTML @\<canvas\>@ element with the given attributes and contents.
canvas :: [Attribute] -> [Html lng] -> Html lng
canvas :: forall lng. [Attribute] -> [Html lng] -> Html lng
canvas = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<canvas" Builder
"</canvas>"
{-# INLINE canvas #-}


-- | Generates an HTML @\<caption\>@ element with the given attributes and contents.
caption :: [Attribute] -> [Html lng] -> Html lng
caption :: forall lng. [Attribute] -> [Html lng] -> Html lng
caption = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<caption" Builder
"</caption>"
{-# INLINE caption #-}


-- | Generates an HTML @\<cite\>@ element with the given attributes and contents.
cite :: [Attribute] -> [Html lng] -> Html lng
cite :: forall lng. [Attribute] -> [Html lng] -> Html lng
cite = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<cite" Builder
"</cite>"
{-# INLINE cite #-}


-- | Generates an HTML @\<code\>@ element with the given attributes and contents.
code :: [Attribute] -> [Html lng] -> Html lng
code :: forall lng. [Attribute] -> [Html lng] -> Html lng
code = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<code" Builder
"</code>"
{-# INLINE code #-}


-- | Generates an HTML @\<col\>@ element with the given attributes.
col :: [Attribute] -> Html lng
col :: forall lng. [Attribute] -> Html lng
col = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<col"
{-# INLINE col #-}


-- | Generates an HTML @\<colgroup\>@ element with the given attributes and contents.
colgroup :: [Attribute] -> [Html lng] -> Html lng
colgroup :: forall lng. [Attribute] -> [Html lng] -> Html lng
colgroup = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<colgroup" Builder
"</colgroup>"
{-# INLINE colgroup #-}


-- | Generates an HTML @\<data\>@ element with the given attributes and contents.
data_ :: [Attribute] -> [Html lng] -> Html lng
data_ :: forall lng. [Attribute] -> [Html lng] -> Html lng
data_ = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<data" Builder
"</data>"
{-# INLINE data_ #-}


-- | Generates an HTML @\<datalist\>@ element with the given attributes and contents.
datalist :: [Attribute] -> [Html lng] -> Html lng
datalist :: forall lng. [Attribute] -> [Html lng] -> Html lng
datalist = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<datalist" Builder
"</datalist>"
{-# INLINE datalist #-}


-- | Generates an HTML @\<dd\>@ element with the given attributes and contents.
dd :: [Attribute] -> [Html lng] -> Html lng
dd :: forall lng. [Attribute] -> [Html lng] -> Html lng
dd = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<dd" Builder
"</dd>"
{-# INLINE dd #-}


-- | Generates an HTML @\<del\>@ element with the given attributes and contents.
del :: [Attribute] -> [Html lng] -> Html lng
del :: forall lng. [Attribute] -> [Html lng] -> Html lng
del = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<del" Builder
"</del>"
{-# INLINE del #-}


-- | Generates an HTML @\<details\>@ element with the given attributes and contents.
details :: [Attribute] -> [Html lng] -> Html lng
details :: forall lng. [Attribute] -> [Html lng] -> Html lng
details = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<details" Builder
"</details>"
{-# INLINE details #-}


-- | Generates an HTML @\<dfn\>@ element with the given attributes and contents.
dfn :: [Attribute] -> [Html lng] -> Html lng
dfn :: forall lng. [Attribute] -> [Html lng] -> Html lng
dfn = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<dfn" Builder
"</dfn>"
{-# INLINE dfn #-}


-- | Generates an HTML @\<dialog\>@ element with the given attributes and contents.
dialog :: [Attribute] -> [Html lng] -> Html lng
dialog :: forall lng. [Attribute] -> [Html lng] -> Html lng
dialog = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<dialog" Builder
"</dialog>"
{-# INLINE dialog #-}


-- | Generates an HTML @\<div\>@ element with the given attributes and contents.
div :: [Attribute] -> [Html lng] -> Html lng
div :: forall lng. [Attribute] -> [Html lng] -> Html lng
div = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<div" Builder
"</div>"
{-# INLINE div #-}


-- | Generates an HTML @\<dl\>@ element with the given attributes and contents.
dl :: [Attribute] -> [Html lng] -> Html lng
dl :: forall lng. [Attribute] -> [Html lng] -> Html lng
dl = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<dl" Builder
"</dl>"
{-# INLINE dl #-}


-- | Generates an HTML @\<dt\>@ element with the given attributes and contents.
dt :: [Attribute] -> [Html lng] -> Html lng
dt :: forall lng. [Attribute] -> [Html lng] -> Html lng
dt = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<dt" Builder
"</dt>"
{-# INLINE dt #-}


-- | Generates an HTML @\<em\>@ element with the given attributes and contents.
em :: [Attribute] -> [Html lng] -> Html lng
em :: forall lng. [Attribute] -> [Html lng] -> Html lng
em = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<em" Builder
"</em>"
{-# INLINE em #-}


-- | Generates an HTML @\<embed\>@ element with the given attributes.
embed :: [Attribute] -> Html lng
embed :: forall lng. [Attribute] -> Html lng
embed = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<embed"
{-# INLINE embed #-}


-- | Generates an HTML @\<fieldset\>@ element with the given attributes and contents.
fieldset :: [Attribute] -> [Html lng] -> Html lng
fieldset :: forall lng. [Attribute] -> [Html lng] -> Html lng
fieldset = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<fieldset" Builder
"</fieldset>"
{-# INLINE fieldset #-}


-- | Generates an HTML @\<figcaption\>@ element with the given attributes and contents.
figcaption :: [Attribute] -> [Html lng] -> Html lng
figcaption :: forall lng. [Attribute] -> [Html lng] -> Html lng
figcaption = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<figcaption" Builder
"</figcaption>"
{-# INLINE figcaption #-}


-- | Generates an HTML @\<figure\>@ element with the given attributes and contents.
figure :: [Attribute] -> [Html lng] -> Html lng
figure :: forall lng. [Attribute] -> [Html lng] -> Html lng
figure = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<figure" Builder
"</figure>"
{-# INLINE figure #-}


-- | Generates an HTML @\<footer\>@ element with the given attributes and contents.
footer :: [Attribute] -> [Html lng] -> Html lng
footer :: forall lng. [Attribute] -> [Html lng] -> Html lng
footer = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<footer" Builder
"</footer>"
{-# INLINE footer #-}


-- | Generates an HTML @\<form\>@ element with the given attributes and contents.
form :: [Attribute] -> [Html lng] -> Html lng
form :: forall lng. [Attribute] -> [Html lng] -> Html lng
form = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<form" Builder
"</form>"
{-# INLINE form #-}


-- | Generates an HTML @\<h1\>@ element with the given attributes and contents.
h1 :: [Attribute] -> [Html lng] -> Html lng
h1 :: forall lng. [Attribute] -> [Html lng] -> Html lng
h1 = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<h1" Builder
"</h1>"
{-# INLINE h1 #-}


-- | Generates an HTML @\<h2\>@ element with the given attributes and contents.
h2 :: [Attribute] -> [Html lng] -> Html lng
h2 :: forall lng. [Attribute] -> [Html lng] -> Html lng
h2 = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<h2" Builder
"</h2>"
{-# INLINE h2 #-}


-- | Generates an HTML @\<h3\>@ element with the given attributes and contents.
h3 :: [Attribute] -> [Html lng] -> Html lng
h3 :: forall lng. [Attribute] -> [Html lng] -> Html lng
h3 = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<h3" Builder
"</h3>"
{-# INLINE h3 #-}


-- | Generates an HTML @\<h4\>@ element with the given attributes and contents.
h4 :: [Attribute] -> [Html lng] -> Html lng
h4 :: forall lng. [Attribute] -> [Html lng] -> Html lng
h4 = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<h4" Builder
"</h4>"
{-# INLINE h4 #-}


-- | Generates an HTML @\<h5\>@ element with the given attributes and contents.
h5 :: [Attribute] -> [Html lng] -> Html lng
h5 :: forall lng. [Attribute] -> [Html lng] -> Html lng
h5 = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<h5" Builder
"</h5>"
{-# INLINE h5 #-}


-- | Generates an HTML @\<h6\>@ element with the given attributes and contents.
h6 :: [Attribute] -> [Html lng] -> Html lng
h6 :: forall lng. [Attribute] -> [Html lng] -> Html lng
h6 = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<h6" Builder
"</h6>"
{-# INLINE h6 #-}


-- | Generates an HTML @\<head\>@ element with the given attributes and contents.
head :: [Attribute] -> [Html lng] -> Html lng
head :: forall lng. [Attribute] -> [Html lng] -> Html lng
head = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<head" Builder
"</head>"
{-# INLINE head #-}


-- | Generates an HTML @\<header\>@ element with the given attributes and contents.
header :: [Attribute] -> [Html lng] -> Html lng
header :: forall lng. [Attribute] -> [Html lng] -> Html lng
header = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<header" Builder
"</header>"
{-# INLINE header #-}


-- | Generates an HTML @\<hgroup\>@ element with the given attributes and contents.
hgroup :: [Attribute] -> [Html lng] -> Html lng
hgroup :: forall lng. [Attribute] -> [Html lng] -> Html lng
hgroup = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<hgroup" Builder
"</hgroup>"
{-# INLINE hgroup #-}


-- | Generates an HTML @\<hr\>@ element with the given attributes.
hr :: [Attribute] -> Html lng
hr :: forall lng. [Attribute] -> Html lng
hr = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<hr"
{-# INLINE hr #-}


-- | Generates an HTML @\<html\>@ element with the given attributes and contents.
html :: [Attribute] -> [Html lng] -> Html lng
html :: forall lng. [Attribute] -> [Html lng] -> Html lng
html = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<html" Builder
"</html>"
{-# INLINE html #-}


-- | Generates an HTML @\<i\>@ element with the given attributes and contents.
i :: [Attribute] -> [Html lng] -> Html lng
i :: forall lng. [Attribute] -> [Html lng] -> Html lng
i = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<i" Builder
"</i>"
{-# INLINE i #-}


-- | Generates an HTML @\<iframe\>@ element with the given attributes and contents.
iframe :: [Attribute] -> [Html lng] -> Html lng
iframe :: forall lng. [Attribute] -> [Html lng] -> Html lng
iframe = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<iframe" Builder
"</iframe>"
{-# INLINE iframe #-}


-- | Generates an HTML @\<img\>@ element with the given attributes.
img :: [Attribute] -> Html lng
img :: forall lng. [Attribute] -> Html lng
img = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<img"
{-# INLINE img #-}


-- | Generates an HTML @\<input\>@ element with the given attributes.
input :: [Attribute] -> Html lng
input :: forall lng. [Attribute] -> Html lng
input = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<input"
{-# INLINE input #-}


-- | Generates an HTML @\<ins\>@ element with the given attributes and contents.
ins :: [Attribute] -> [Html lng] -> Html lng
ins :: forall lng. [Attribute] -> [Html lng] -> Html lng
ins = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<ins" Builder
"</ins>"
{-# INLINE ins #-}


-- | Generates an HTML @\<kbd\>@ element with the given attributes and contents.
kbd :: [Attribute] -> [Html lng] -> Html lng
kbd :: forall lng. [Attribute] -> [Html lng] -> Html lng
kbd = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<kbd" Builder
"</kbd>"
{-# INLINE kbd #-}


-- | Generates an HTML @\<label\>@ element with the given attributes and contents.
label :: [Attribute] -> [Html lng] -> Html lng
label :: forall lng. [Attribute] -> [Html lng] -> Html lng
label = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<label" Builder
"</label>"
{-# INLINE label #-}


-- | Generates an HTML @\<legend\>@ element with the given attributes and contents.
legend :: [Attribute] -> [Html lng] -> Html lng
legend :: forall lng. [Attribute] -> [Html lng] -> Html lng
legend = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<legend" Builder
"</legend>"
{-# INLINE legend #-}


-- | Generates an HTML @\<li\>@ element with the given attributes and contents.
li :: [Attribute] -> [Html lng] -> Html lng
li :: forall lng. [Attribute] -> [Html lng] -> Html lng
li = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<li" Builder
"</li>"
{-# INLINE li #-}


-- | Generates an HTML @\<link\>@ element with the given attributes.
link :: [Attribute] -> Html lng
link :: forall lng. [Attribute] -> Html lng
link = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<link"
{-# INLINE link #-}


-- | Generates an HTML @\<main\>@ element with the given attributes and contents.
main :: [Attribute] -> [Html lng] -> Html lng
main :: forall lng. [Attribute] -> [Html lng] -> Html lng
main = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<main" Builder
"</main>"
{-# INLINE main #-}


-- | Generates an HTML @\<map\>@ element with the given attributes and contents.
map :: [Attribute] -> [Html lng] -> Html lng
map :: forall lng. [Attribute] -> [Html lng] -> Html lng
map = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<map" Builder
"</map>"
{-# INLINE map #-}


-- | Generates an HTML @\<mark\>@ element with the given attributes and contents.
mark :: [Attribute] -> [Html lng] -> Html lng
mark :: forall lng. [Attribute] -> [Html lng] -> Html lng
mark = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<mark" Builder
"</mark>"
{-# INLINE mark #-}


-- | Generates an HTML @\<menu\>@ element with the given attributes and contents.
menu :: [Attribute] -> [Html lng] -> Html lng
menu :: forall lng. [Attribute] -> [Html lng] -> Html lng
menu = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<menu" Builder
"</menu>"
{-# INLINE menu #-}


-- | Generates an HTML @\<meta\>@ element with the given attributes.
meta :: [Attribute] -> Html lng
meta :: forall lng. [Attribute] -> Html lng
meta = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<meta"
{-# INLINE meta #-}


-- | Generates an HTML @\<meter\>@ element with the given attributes and contents.
meter :: [Attribute] -> [Html lng] -> Html lng
meter :: forall lng. [Attribute] -> [Html lng] -> Html lng
meter = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<meter" Builder
"</meter>"
{-# INLINE meter #-}


-- | Generates an HTML @\<nav\>@ element with the given attributes and contents.
nav :: [Attribute] -> [Html lng] -> Html lng
nav :: forall lng. [Attribute] -> [Html lng] -> Html lng
nav = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<nav" Builder
"</nav>"
{-# INLINE nav #-}


-- | Generates an HTML @\<noscript\>@ element with the given attributes and contents.
noscript :: [Attribute] -> [Html lng] -> Html lng
noscript :: forall lng. [Attribute] -> [Html lng] -> Html lng
noscript = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<noscript" Builder
"</noscript>"
{-# INLINE noscript #-}


-- | Generates an HTML @\<object\>@ element with the given attributes and contents.
object :: [Attribute] -> [Html lng] -> Html lng
object :: forall lng. [Attribute] -> [Html lng] -> Html lng
object = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<object" Builder
"</object>"
{-# INLINE object #-}


-- | Generates an HTML @\<ol\>@ element with the given attributes and contents.
ol :: [Attribute] -> [Html lng] -> Html lng
ol :: forall lng. [Attribute] -> [Html lng] -> Html lng
ol = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<ol" Builder
"</ol>"
{-# INLINE ol #-}


-- | Generates an HTML @\<optgroup\>@ element with the given attributes and contents.
optgroup :: [Attribute] -> [Html lng] -> Html lng
optgroup :: forall lng. [Attribute] -> [Html lng] -> Html lng
optgroup = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<optgroup" Builder
"</optgroup>"
{-# INLINE optgroup #-}


-- | Generates an HTML @\<option\>@ element with the given attributes and contents.
option :: [Attribute] -> [Html lng] -> Html lng
option :: forall lng. [Attribute] -> [Html lng] -> Html lng
option = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<option" Builder
"</option>"
{-# INLINE option #-}


-- | Generates an HTML @\<output\>@ element with the given attributes and contents.
output :: [Attribute] -> [Html lng] -> Html lng
output :: forall lng. [Attribute] -> [Html lng] -> Html lng
output = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<output" Builder
"</output>"
{-# INLINE output #-}


-- | Generates an HTML @\<p\>@ element with the given attributes and contents.
p :: [Attribute] -> [Html lng] -> Html lng
p :: forall lng. [Attribute] -> [Html lng] -> Html lng
p = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<p" Builder
"</p>"
{-# INLINE p #-}


-- | Generates an HTML @\<picture\>@ element with the given attributes and contents.
picture :: [Attribute] -> [Html lng] -> Html lng
picture :: forall lng. [Attribute] -> [Html lng] -> Html lng
picture = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<picture" Builder
"</picture>"
{-# INLINE picture #-}


-- | Generates an HTML @\<pre\>@ element with the given attributes and contents.
pre :: [Attribute] -> [Html lng] -> Html lng
pre :: forall lng. [Attribute] -> [Html lng] -> Html lng
pre = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<pre" Builder
"</pre>"
{-# INLINE pre #-}


-- | Generates an HTML @\<progress\>@ element with the given attributes and contents.
progress :: [Attribute] -> [Html lng] -> Html lng
progress :: forall lng. [Attribute] -> [Html lng] -> Html lng
progress = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<progress" Builder
"</progress>"
{-# INLINE progress #-}


-- | Generates an HTML @\<q\>@ element with the given attributes and contents.
q :: [Attribute] -> [Html lng] -> Html lng
q :: forall lng. [Attribute] -> [Html lng] -> Html lng
q = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<q" Builder
"</q>"
{-# INLINE q #-}


-- | Generates an HTML @\<rp\>@ element with the given attributes and contents.
rp :: [Attribute] -> [Html lng] -> Html lng
rp :: forall lng. [Attribute] -> [Html lng] -> Html lng
rp = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<rp" Builder
"</rp>"
{-# INLINE rp #-}


-- | Generates an HTML @\<rt\>@ element with the given attributes and contents.
rt :: [Attribute] -> [Html lng] -> Html lng
rt :: forall lng. [Attribute] -> [Html lng] -> Html lng
rt = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<rt" Builder
"</rt>"
{-# INLINE rt #-}


-- | Generates an HTML @\<ruby\>@ element with the given attributes and contents.
ruby :: [Attribute] -> [Html lng] -> Html lng
ruby :: forall lng. [Attribute] -> [Html lng] -> Html lng
ruby = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<ruby" Builder
"</ruby>"
{-# INLINE ruby #-}


-- | Generates an HTML @\<s\>@ element with the given attributes and contents.
s :: [Attribute] -> [Html lng] -> Html lng
s :: forall lng. [Attribute] -> [Html lng] -> Html lng
s = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<s" Builder
"</s>"
{-# INLINE s #-}


-- | Generates an HTML @\<samp\>@ element with the given attributes and contents.
samp :: [Attribute] -> [Html lng] -> Html lng
samp :: forall lng. [Attribute] -> [Html lng] -> Html lng
samp = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<samp" Builder
"</samp>"
{-# INLINE samp #-}


-- | Generates an HTML @\<script\>@ element with the given attributes and contents.
script :: [Attribute] -> [Html lng] -> Html lng
script :: forall lng. [Attribute] -> [Html lng] -> Html lng
script = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<script" Builder
"</script>"
{-# INLINE script #-}


-- | Generates an HTML @\<section\>@ element with the given attributes and contents.
section :: [Attribute] -> [Html lng] -> Html lng
section :: forall lng. [Attribute] -> [Html lng] -> Html lng
section = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<section" Builder
"</section>"
{-# INLINE section #-}


-- | Generates an HTML @\<select\>@ element with the given attributes and contents.
select :: [Attribute] -> [Html lng] -> Html lng
select :: forall lng. [Attribute] -> [Html lng] -> Html lng
select = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<select" Builder
"</select>"
{-# INLINE select #-}


-- | Generates an HTML @\<slot\>@ element with the given attributes and contents.
slot :: [Attribute] -> [Html lng] -> Html lng
slot :: forall lng. [Attribute] -> [Html lng] -> Html lng
slot = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<slot" Builder
"</slot>"
{-# INLINE slot #-}


-- | Generates an HTML @\<small\>@ element with the given attributes and contents.
small :: [Attribute] -> [Html lng] -> Html lng
small :: forall lng. [Attribute] -> [Html lng] -> Html lng
small = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<small" Builder
"</small>"
{-# INLINE small #-}


-- | Generates an HTML @\<source\>@ element with the given attributes.
source :: [Attribute] -> Html lng
source :: forall lng. [Attribute] -> Html lng
source = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<source"
{-# INLINE source #-}


-- | Generates an HTML @\<span\>@ element with the given attributes and contents.
span :: [Attribute] -> [Html lng] -> Html lng
span :: forall lng. [Attribute] -> [Html lng] -> Html lng
span = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<span" Builder
"</span>"
{-# INLINE span #-}


-- | Generates an HTML @\<strong\>@ element with the given attributes and contents.
strong :: [Attribute] -> [Html lng] -> Html lng
strong :: forall lng. [Attribute] -> [Html lng] -> Html lng
strong = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<strong" Builder
"</strong>"
{-# INLINE strong #-}


-- | Generates an HTML @\<style\>@ element with the given attributes and contents.
style :: [Attribute] -> [Html lng] -> Html lng
style :: forall lng. [Attribute] -> [Html lng] -> Html lng
style = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<style" Builder
"</style>"
{-# INLINE style #-}


-- | Generates an HTML @\<sub\>@ element with the given attributes and contents.
sub :: [Attribute] -> [Html lng] -> Html lng
sub :: forall lng. [Attribute] -> [Html lng] -> Html lng
sub = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<sub" Builder
"</sub>"
{-# INLINE sub #-}


-- | Generates an HTML @\<summary\>@ element with the given attributes and contents.
summary :: [Attribute] -> [Html lng] -> Html lng
summary :: forall lng. [Attribute] -> [Html lng] -> Html lng
summary = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<summary" Builder
"</summary>"
{-# INLINE summary #-}


-- | Generates an HTML @\<sup\>@ element with the given attributes and contents.
sup :: [Attribute] -> [Html lng] -> Html lng
sup :: forall lng. [Attribute] -> [Html lng] -> Html lng
sup = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<sup" Builder
"</sup>"
{-# INLINE sup #-}


-- | Generates an HTML @\<table\>@ element with the given attributes and contents.
table :: [Attribute] -> [Html lng] -> Html lng
table :: forall lng. [Attribute] -> [Html lng] -> Html lng
table = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<table" Builder
"</table>"
{-# INLINE table #-}


-- | Generates an HTML @\<tbody\>@ element with the given attributes and contents.
tbody :: [Attribute] -> [Html lng] -> Html lng
tbody :: forall lng. [Attribute] -> [Html lng] -> Html lng
tbody = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<tbody" Builder
"</tbody>"
{-# INLINE tbody #-}


-- | Generates an HTML @\<td\>@ element with the given attributes and contents.
td :: [Attribute] -> [Html lng] -> Html lng
td :: forall lng. [Attribute] -> [Html lng] -> Html lng
td = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<td" Builder
"</td>"
{-# INLINE td #-}


-- | Generates an HTML @\<template\>@ element with the given attributes and contents.
template :: [Attribute] -> [Html lng] -> Html lng
template :: forall lng. [Attribute] -> [Html lng] -> Html lng
template = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<template" Builder
"</template>"
{-# INLINE template #-}


-- | Generates an HTML @\<textarea\>@ element with the given attributes and contents.
textarea :: [Attribute] -> [Html lng] -> Html lng
textarea :: forall lng. [Attribute] -> [Html lng] -> Html lng
textarea = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<textarea" Builder
"</textarea>"
{-# INLINE textarea #-}


-- | Generates an HTML @\<tfoot\>@ element with the given attributes and contents.
tfoot :: [Attribute] -> [Html lng] -> Html lng
tfoot :: forall lng. [Attribute] -> [Html lng] -> Html lng
tfoot = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<tfoot" Builder
"</tfoot>"
{-# INLINE tfoot #-}


-- | Generates an HTML @\<th\>@ element with the given attributes and contents.
th :: [Attribute] -> [Html lng] -> Html lng
th :: forall lng. [Attribute] -> [Html lng] -> Html lng
th = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<th" Builder
"</th>"
{-# INLINE th #-}


-- | Generates an HTML @\<thead\>@ element with the given attributes and contents.
thead :: [Attribute] -> [Html lng] -> Html lng
thead :: forall lng. [Attribute] -> [Html lng] -> Html lng
thead = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<thead" Builder
"</thead>"
{-# INLINE thead #-}


-- | Generates an HTML @\<time\>@ element with the given attributes and contents.
time :: [Attribute] -> [Html lng] -> Html lng
time :: forall lng. [Attribute] -> [Html lng] -> Html lng
time = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<time" Builder
"</time>"
{-# INLINE time #-}


-- | Generates an HTML @\<title\>@ element with the given attributes and contents.
title :: [Attribute] -> [Html lng] -> Html lng
title :: forall lng. [Attribute] -> [Html lng] -> Html lng
title = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<title" Builder
"</title>"
{-# INLINE title #-}


-- | Generates an HTML @\<tr\>@ element with the given attributes and contents.
tr :: [Attribute] -> [Html lng] -> Html lng
tr :: forall lng. [Attribute] -> [Html lng] -> Html lng
tr = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<tr" Builder
"</tr>"
{-# INLINE tr #-}


-- | Generates an HTML @\<track\>@ element with the given attributes.
track :: [Attribute] -> Html lng
track :: forall lng. [Attribute] -> Html lng
track = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<track"
{-# INLINE track #-}


-- | Generates an HTML @\<u\>@ element with the given attributes and contents.
u :: [Attribute] -> [Html lng] -> Html lng
u :: forall lng. [Attribute] -> [Html lng] -> Html lng
u = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<u" Builder
"</u>"
{-# INLINE u #-}


-- | Generates an HTML @\<ul\>@ element with the given attributes and contents.
ul :: [Attribute] -> [Html lng] -> Html lng
ul :: forall lng. [Attribute] -> [Html lng] -> Html lng
ul = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<ul" Builder
"</ul>"
{-# INLINE ul #-}


-- | Generates an HTML @\<var\>@ element with the given attributes and contents.
var :: [Attribute] -> [Html lng] -> Html lng
var :: forall lng. [Attribute] -> [Html lng] -> Html lng
var = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<var" Builder
"</var>"
{-# INLINE var #-}


-- | Generates an HTML @\<video\>@ element with the given attributes and contents.
video :: [Attribute] -> [Html lng] -> Html lng
video :: forall lng. [Attribute] -> [Html lng] -> Html lng
video = forall lng.
Builder -> Builder -> [Attribute] -> [Html lng] -> Html lng
ParentNode Builder
"<video" Builder
"</video>"
{-# INLINE video #-}


-- | Generates an HTML @\<wbr\>@ element with the given attributes.
wbr :: [Attribute] -> Html lng
wbr :: forall lng. [Attribute] -> Html lng
wbr = forall lng. Builder -> [Attribute] -> Html lng
LeafNode Builder
"<wbr"
{-# INLINE wbr #-}