{-# LANGUAGE TemplateHaskell, UndecidableInstances, BangPatterns, PackageImports, FlexibleInstances, OverloadedStrings #-}
module IHP.HSX.QQ (hsx, uncheckedHsx, customHsx) where
import Prelude
import Data.Text (Text)
import IHP.HSX.Parser
import qualified "template-haskell" Language.Haskell.TH as TH
import qualified "template-haskell" Language.Haskell.TH.Syntax as TH
import Language.Haskell.TH.Quote
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5 as Html5
import Text.Blaze.Html (Html)
import Text.Blaze.Internal (attribute, MarkupM (Parent, Leaf), StaticString (..))
import Data.String.Conversions
import IHP.HSX.ToHtml
import qualified Text.Megaparsec as Megaparsec
import qualified Text.Blaze.Html.Renderer.String as BlazeString
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.List (foldl')
import IHP.HSX.Attribute
import qualified Text.Blaze.Html5.Attributes as Attributes
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Set as Set
hsx :: QuasiQuoter
hsx :: QuasiQuoter
hsx = HsxSettings -> QuasiQuoter
customHsx
(HsxSettings
{ $sel:checkMarkup:HsxSettings :: Bool
checkMarkup = Bool
True
, $sel:additionalTagNames:HsxSettings :: Set Text
additionalTagNames = Set Text
forall a. Set a
Set.empty
, $sel:additionalAttributeNames:HsxSettings :: Set Text
additionalAttributeNames = Set Text
forall a. Set a
Set.empty
}
)
uncheckedHsx :: QuasiQuoter
uncheckedHsx :: QuasiQuoter
uncheckedHsx = HsxSettings -> QuasiQuoter
customHsx
(HsxSettings
{ $sel:checkMarkup:HsxSettings :: Bool
checkMarkup = Bool
False
, $sel:additionalTagNames:HsxSettings :: Set Text
additionalTagNames = Set Text
forall a. Set a
Set.empty
, $sel:additionalAttributeNames:HsxSettings :: Set Text
additionalAttributeNames = Set Text
forall a. Set a
Set.empty
}
)
customHsx :: HsxSettings -> QuasiQuoter
customHsx :: HsxSettings -> QuasiQuoter
customHsx HsxSettings
settings =
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = HsxSettings -> String -> Q Exp
quoteHsxExpression HsxSettings
settings
, quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"quotePat: not defined"
, quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"quoteDec: not defined"
, quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"quoteType: not defined"
}
quoteHsxExpression :: HsxSettings -> String -> TH.ExpQ
quoteHsxExpression :: HsxSettings -> String -> Q Exp
quoteHsxExpression HsxSettings
settings String
code = do
SourcePos
hsxPosition <- Q SourcePos
findHSXPosition
[Extension]
extensions <- Q [Extension]
TH.extsEnabled
Node
expression <- case HsxSettings
-> SourcePos
-> [Extension]
-> Text
-> Either (ParseErrorBundle Text Void) Node
parseHsx HsxSettings
settings SourcePos
hsxPosition [Extension]
extensions (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
code) of
Left ParseErrorBundle Text Void
error -> String -> Q Node
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty ParseErrorBundle Text Void
error)
Right Node
result -> Node -> Q Node
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
result
Node -> Q Exp
compileToHaskell Node
expression
where
findHSXPosition :: Q SourcePos
findHSXPosition = do
Loc
loc <- Q Loc
TH.location
let (Int
line, Int
col) = Loc -> (Int, Int)
TH.loc_start Loc
loc
SourcePos -> Q SourcePos
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourcePos -> Q SourcePos) -> SourcePos -> Q SourcePos
forall a b. (a -> b) -> a -> b
$ String -> Pos -> Pos -> SourcePos
Megaparsec.SourcePos (Loc -> String
TH.loc_filename Loc
loc) (Int -> Pos
Megaparsec.mkPos Int
line) (Int -> Pos
Megaparsec.mkPos Int
col)
compileToHaskell :: Node -> TH.ExpQ
compileToHaskell :: Node -> Q Exp
compileToHaskell (Node Text
"!DOCTYPE" [StaticAttribute Text
"html" (TextValue Text
"html")] [] Bool
True) = [| Html5.docType |]
compileToHaskell (Node Text
name [Attribute]
attributes [Node]
children Bool
isLeaf) =
let
renderedChildren :: Q Exp
renderedChildren = [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Node -> Q Exp) -> [Node] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Q Exp
compileToHaskell [Node]
children
stringAttributes :: Q Exp
stringAttributes = [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Attribute -> Q Exp) -> [Attribute] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Q Exp
toStringAttribute [Attribute]
attributes
in
if Bool
isLeaf
then
let
element :: Q Exp
element = Text -> Q Exp
nodeToBlazeLeaf Text
name
in
[| applyAttributes $Q Exp
element $Q Exp
stringAttributes |]
else
let
element :: Q Exp
element = Text -> Q Exp
nodeToBlazeElement Text
name
in [| applyAttributes ($Q Exp
element (mconcat $Q Exp
renderedChildren)) $Q Exp
stringAttributes |]
compileToHaskell (Children [Node]
children) =
let
renderedChildren :: Q Exp
renderedChildren = [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Node -> Q Exp) -> [Node] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Q Exp
compileToHaskell [Node]
children
in [| mconcat $(Q Exp
renderedChildren) |]
compileToHaskell (TextNode Text
value) = [| Html5.preEscapedText value |]
compileToHaskell (PreEscapedTextNode Text
value) = [| Html5.preEscapedText value |]
compileToHaskell (SplicedNode Exp
expression) = [| toHtml $(Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
expression) |]
compileToHaskell (CommentNode Text
value) = [| Html5.textComment value |]
compileToHaskell (Node
NoRenderCommentNode) = [| mempty |]
nodeToBlazeElement :: Text -> TH.Q TH.Exp
nodeToBlazeElement :: Text -> Q Exp
nodeToBlazeElement Text
name =
Q Exp -> Text -> HashMap Text (Q Exp) -> Q Exp
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.findWithDefault (Text -> Q Exp
nodeToBlazeElementGeneric Text
name) Text
name HashMap Text (Q Exp)
knownElements
knownElements :: HashMap.HashMap Text TH.ExpQ
knownElements :: HashMap Text (Q Exp)
knownElements =
[(Text, Q Exp)] -> HashMap Text (Q Exp)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
[ (Text
"a", [| Html5.a |])
, (Text
"abbr", [| Html5.abbr |])
, (Text
"address", [| Html5.address |])
, (Text
"article", [| Html5.article |])
, (Text
"aside", [| Html5.aside |])
, (Text
"audio", [| Html5.audio |])
, (Text
"b", [| Html5.b |])
, (Text
"blockquote", [| Html5.blockquote |])
, (Text
"body", [| Html5.body |])
, (Text
"button", [| Html5.button |])
, (Text
"canvas", [| Html5.canvas |])
, (Text
"caption", [| Html5.caption |])
, (Text
"cite", [| Html5.cite |])
, (Text
"code", [| Html5.code |])
, (Text
"colgroup", [| Html5.colgroup |])
, (Text
"datalist", [| Html5.datalist |])
, (Text
"dd", [| Html5.dd |])
, (Text
"del", [| Html5.del |])
, (Text
"details", [| Html5.details |])
, (Text
"dfn", [| Html5.dfn |])
, (Text
"div", [| Html5.div |])
, (Text
"dl", [| Html5.dl |])
, (Text
"dt", [| Html5.dt |])
, (Text
"em", [| Html5.em |])
, (Text
"fieldset", [| Html5.fieldset |])
, (Text
"figcaption", [| Html5.figcaption |])
, (Text
"figure", [| Html5.figure |])
, (Text
"footer", [| Html5.footer |])
, (Text
"form", [| Html5.form |])
, (Text
"h1", [| Html5.h1 |])
, (Text
"h2", [| Html5.h2 |])
, (Text
"h3", [| Html5.h3 |])
, (Text
"h4", [| Html5.h4 |])
, (Text
"h5", [| Html5.h5 |])
, (Text
"h6", [| Html5.h6 |])
, (Text
"head", [| Html5.head |])
, (Text
"header", [| Html5.header |])
, (Text
"hgroup", [| Html5.hgroup |])
, (Text
"html", [| Html5.html |])
, (Text
"i", [| Html5.i |])
, (Text
"iframe", [| Html5.iframe |])
, (Text
"ins", [| Html5.ins |])
, (Text
"kbd", [| Html5.kbd |])
, (Text
"label", [| Html5.label |])
, (Text
"legend", [| Html5.legend |])
, (Text
"li", [| Html5.li |])
, (Text
"main", [| Html5.main |])
, (Text
"map", [| Html5.map |])
, (Text
"mark", [| Html5.mark |])
, (Text
"menu", [| Html5.menu |])
, (Text
"menuitem", [| Html5.menuitem |])
, (Text
"meter", [| Html5.meter |])
, (Text
"nav", [| Html5.nav |])
, (Text
"noscript", [| Html5.noscript |])
, (Text
"object", [| Html5.object |])
, (Text
"ol", [| Html5.ol |])
, (Text
"optgroup", [| Html5.optgroup |])
, (Text
"option", [| Html5.option |])
, (Text
"output", [| Html5.output |])
, (Text
"p", [| Html5.p |])
, (Text
"pre", [| Html5.pre |])
, (Text
"progress", [| Html5.progress |])
, (Text
"q", [| Html5.q |])
, (Text
"rp", [| Html5.rp |])
, (Text
"rt", [| Html5.rt |])
, (Text
"ruby", [| Html5.ruby |])
, (Text
"s", [| Html5.s |])
, (Text
"samp", [| Html5.samp |])
, (Text
"script", [| Html5.script |])
, (Text
"section", [| Html5.section |])
, (Text
"select", [| Html5.select |])
, (Text
"small", [| Html5.small |])
, (Text
"span", [| Html5.span |])
, (Text
"strong", [| Html5.strong |])
, (Text
"style", [| Html5.style |])
, (Text
"sub", [| Html5.sub |])
, (Text
"summary", [| Html5.summary |])
, (Text
"sup", [| Html5.sup |])
, (Text
"table", [| Html5.table |])
, (Text
"tbody", [| Html5.tbody |])
, (Text
"td", [| Html5.td |])
, (Text
"textarea", [| Html5.textarea |])
, (Text
"tfoot", [| Html5.tfoot |])
, (Text
"th", [| Html5.th |])
, (Text
"thead", [| Html5.thead |])
, (Text
"time", [| Html5.time |])
, (Text
"title", [| Html5.title |])
, (Text
"tr", [| Html5.tr |])
, (Text
"u", [| Html5.u |])
, (Text
"ul", [| Html5.ul |])
, (Text
"var", [| Html5.var |])
, (Text
"video", [| Html5.video |])
]
nodeToBlazeLeaf :: Text -> TH.Q TH.Exp
nodeToBlazeLeaf :: Text -> Q Exp
nodeToBlazeLeaf Text
name =
Q Exp -> Text -> HashMap Text (Q Exp) -> Q Exp
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.findWithDefault (Text -> Q Exp
nodeToBlazeLeafGeneric Text
name) Text
name HashMap Text (Q Exp)
knownLeafs
knownLeafs :: HashMap.HashMap Text TH.ExpQ
knownLeafs :: HashMap Text (Q Exp)
knownLeafs =
[(Text, Q Exp)] -> HashMap Text (Q Exp)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
[ (Text
"area", [| Html5.area |])
, (Text
"base", [| Html5.base |])
, (Text
"br", [| Html5.br |])
, (Text
"col", [| Html5.col |])
, (Text
"embed", [| Html5.embed |])
, (Text
"hr", [| Html5.hr |])
, (Text
"img", [| Html5.img |])
, (Text
"input", [| Html5.input |])
, (Text
"keygen", [| Html5.keygen |])
, (Text
"link", [| Html5.link |])
, (Text
"meta", [| Html5.meta |])
, (Text
"param", [| Html5.param |])
, (Text
"source", [| Html5.source |])
, (Text
"track", [| Html5.track |])
, (Text
"wbr", [| Html5.wbr |])
]
nodeToBlazeElementGeneric :: Text -> TH.Q TH.Exp
nodeToBlazeElementGeneric :: Text -> Q Exp
nodeToBlazeElementGeneric Text
name =
let
openTag :: Text
openTag :: Text
openTag = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tag
tag :: Text
tag :: Text
tag = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
name
closeTag :: Text
closeTag :: Text
closeTag = Text
"</" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
in
[| makeParent (textToStaticString $(Text -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
TH.lift Text
name)) (textToStaticString $(Text -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
TH.lift Text
openTag)) (textToStaticString $(Text -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
TH.lift Text
closeTag)) |]
nodeToBlazeLeafGeneric :: Text -> TH.Q TH.Exp
nodeToBlazeLeafGeneric :: Text -> Q Exp
nodeToBlazeLeafGeneric Text
name =
let
openTag :: Text
openTag :: Text
openTag = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tag
closeTag :: Text
closeTag :: Text
closeTag = Text
">"
tag :: Text
tag :: Text
tag = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
name
in
[| (Leaf (textToStaticString $(Text -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
TH.lift Text
tag)) (textToStaticString $(Text -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
TH.lift Text
openTag)) (textToStaticString $(Text -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
TH.lift Text
closeTag)) ()) |]
toStringAttribute :: Attribute -> TH.ExpQ
toStringAttribute :: Attribute -> Q Exp
toStringAttribute (StaticAttribute Text
name (TextValue Text
value)) =
Text -> Text -> Q Exp
attributeFromName Text
name Text
value
toStringAttribute (StaticAttribute Text
name (ExpressionValue Exp
expression)) = let nameWithSuffix :: Text
nameWithSuffix = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=\"" in [| applyAttribute name nameWithSuffix $(Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
expression) |]
toStringAttribute (SpreadAttributes Exp
expression) = [| spreadAttributes $(Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
expression) |]
attributeFromName :: Text -> Text -> TH.ExpQ
attributeFromName :: Text -> Text -> Q Exp
attributeFromName Text
name Text
value =
let
value' :: TH.ExpQ
value' :: Q Exp
value' = if Text -> Bool
Text.null Text
value then [| mempty |] else [| Html5.preEscapedTextValue value |]
attr :: Q Exp
attr = Text -> Q Exp
attributeFromName' Text
name
in
[| (! $Q Exp
attr $Q Exp
value') |]
attributeFromName' :: Text -> TH.ExpQ
attributeFromName' :: Text -> Q Exp
attributeFromName' Text
name =
Q Exp -> Text -> HashMap Text (Q Exp) -> Q Exp
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.findWithDefault (Text -> Q Exp
attributeFromNameGeneric Text
name) Text
name HashMap Text (Q Exp)
knownAttributes
knownAttributes :: HashMap.HashMap Text TH.ExpQ
knownAttributes :: HashMap Text (Q Exp)
knownAttributes =
[(Text, Q Exp)] -> HashMap Text (Q Exp)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
[ (Text
"accept", [| Attributes.accept |])
, ( Text
"accept-charset", [| Attributes.acceptCharset |])
, ( Text
"accesskey", [| Attributes.accesskey |])
, ( Text
"action", [| Attributes.action |])
, ( Text
"alt", [| Attributes.alt |])
, ( Text
"async", [| Attributes.async |])
, ( Text
"autocomplete", [| Attributes.autocomplete |])
, ( Text
"autofocus", [| Attributes.autofocus |])
, ( Text
"autoplay", [| Attributes.autoplay |])
, ( Text
"challenge", [| Attributes.challenge |])
, ( Text
"charset", [| Attributes.charset |])
, ( Text
"checked", [| Attributes.checked |])
, ( Text
"cite", [| Attributes.cite |])
, ( Text
"class", [| Attributes.class_ |])
, ( Text
"cols", [| Attributes.cols |])
, ( Text
"colspan", [| Attributes.colspan |])
, ( Text
"content", [| Attributes.content |])
, ( Text
"contenteditable", [| Attributes.contenteditable |])
, ( Text
"contextmenu", [| Attributes.contextmenu |])
, ( Text
"controls", [| Attributes.controls |])
, ( Text
"coords", [| Attributes.coords |])
, ( Text
"data", [| Attributes.data_ |])
, ( Text
"datetime", [| Attributes.datetime |])
, ( Text
"defer", [| Attributes.defer |])
, ( Text
"dir", [| Attributes.dir |])
, ( Text
"disabled", [| Attributes.disabled |])
, ( Text
"download", [| Attributes.download |])
, ( Text
"draggable", [| Attributes.draggable |])
, ( Text
"enctype", [| Attributes.enctype |])
, ( Text
"for", [| Attributes.for |])
, ( Text
"form", [| Attributes.form |])
, ( Text
"formaction", [| Attributes.formaction |])
, ( Text
"formenctype", [| Attributes.formenctype |])
, ( Text
"formmethod", [| Attributes.formmethod |])
, ( Text
"formnovalidate", [| Attributes.formnovalidate |])
, ( Text
"formtarget", [| Attributes.formtarget |])
, ( Text
"headers", [| Attributes.headers |])
, ( Text
"height", [| Attributes.height |])
, ( Text
"hidden", [| Attributes.hidden |])
, ( Text
"high", [| Attributes.high |])
, ( Text
"href", [| Attributes.href |])
, ( Text
"hreflang", [| Attributes.hreflang |])
, ( Text
"http-equiv", [| Attributes.httpEquiv |])
, ( Text
"icon", [| Attributes.icon |])
, ( Text
"id", [| Attributes.id |])
, ( Text
"ismap", [| Attributes.ismap |])
, ( Text
"item", [| Attributes.item |])
, ( Text
"itemprop", [| Attributes.itemprop |])
, ( Text
"itemscope", [| Attributes.itemscope |])
, ( Text
"itemtype", [| Attributes.itemtype |])
, ( Text
"keytype", [| Attributes.keytype |])
, ( Text
"label", [| Attributes.label |])
, ( Text
"lang", [| Attributes.lang |])
, ( Text
"list", [| Attributes.list |])
, ( Text
"loop", [| Attributes.loop |])
, ( Text
"low", [| Attributes.low |])
, ( Text
"manifest", [| Attributes.manifest |])
, ( Text
"max", [| Attributes.max |])
, ( Text
"maxlength", [| Attributes.maxlength |])
, ( Text
"media", [| Attributes.media |])
, ( Text
"method", [| Attributes.method |])
, ( Text
"min", [| Attributes.min |])
, ( Text
"minlength", [| Attributes.minlength |])
, ( Text
"multiple", [| Attributes.multiple |])
, ( Text
"muted", [| Attributes.muted |])
, ( Text
"name", [| Attributes.name |])
, ( Text
"novalidate", [| Attributes.novalidate |])
, ( Text
"onbeforeonload", [| Attributes.onbeforeonload |])
, ( Text
"onbeforeprint", [| Attributes.onbeforeprint |])
, ( Text
"onblur", [| Attributes.onblur |])
, ( Text
"oncanplay", [| Attributes.oncanplay |])
, ( Text
"oncanplaythrough", [| Attributes.oncanplaythrough |])
, ( Text
"onchange", [| Attributes.onchange |])
, ( Text
"onclick", [| Attributes.onclick |])
, ( Text
"oncontextmenu", [| Attributes.oncontextmenu |])
, ( Text
"ondblclick", [| Attributes.ondblclick |])
, ( Text
"ondrag", [| Attributes.ondrag |])
, ( Text
"ondragend", [| Attributes.ondragend |])
, ( Text
"ondragenter", [| Attributes.ondragenter |])
, ( Text
"ondragleave", [| Attributes.ondragleave |])
, ( Text
"ondragover", [| Attributes.ondragover |])
, ( Text
"ondragstart", [| Attributes.ondragstart |])
, ( Text
"ondrop", [| Attributes.ondrop |])
, ( Text
"ondurationchange", [| Attributes.ondurationchange |])
, ( Text
"onemptied", [| Attributes.onemptied |])
, ( Text
"onended", [| Attributes.onended |])
, ( Text
"onerror", [| Attributes.onerror |])
, ( Text
"onfocus", [| Attributes.onfocus |])
, ( Text
"onformchange", [| Attributes.onformchange |])
, ( Text
"onforminput", [| Attributes.onforminput |])
, ( Text
"onhaschange", [| Attributes.onhaschange |])
, ( Text
"oninput", [| Attributes.oninput |])
, ( Text
"oninvalid", [| Attributes.oninvalid |])
, ( Text
"onkeydown", [| Attributes.onkeydown |])
, ( Text
"onkeypress", [| Attributes.onkeypress |])
, ( Text
"onkeyup", [| Attributes.onkeyup |])
, ( Text
"onload", [| Attributes.onload |])
, ( Text
"onloadeddata", [| Attributes.onloadeddata |])
, ( Text
"onloadedmetadata", [| Attributes.onloadedmetadata |])
, ( Text
"onloadstart", [| Attributes.onloadstart |])
, ( Text
"onmessage", [| Attributes.onmessage |])
, ( Text
"onmousedown", [| Attributes.onmousedown |])
, ( Text
"onmousemove", [| Attributes.onmousemove |])
, ( Text
"onmouseout", [| Attributes.onmouseout |])
, ( Text
"onmouseover", [| Attributes.onmouseover |])
, ( Text
"onmouseup", [| Attributes.onmouseup |])
, ( Text
"onmousewheel", [| Attributes.onmousewheel |])
, ( Text
"ononline", [| Attributes.ononline |])
, ( Text
"onpagehide", [| Attributes.onpagehide |])
, ( Text
"onpageshow", [| Attributes.onpageshow |])
, ( Text
"onpause", [| Attributes.onpause |])
, ( Text
"onplay", [| Attributes.onplay |])
, ( Text
"onplaying", [| Attributes.onplaying |])
, ( Text
"onprogress", [| Attributes.onprogress |])
, ( Text
"onpropstate", [| Attributes.onpropstate |])
, ( Text
"onratechange", [| Attributes.onratechange |])
, ( Text
"onreadystatechange", [| Attributes.onreadystatechange |])
, ( Text
"onredo", [| Attributes.onredo |])
, ( Text
"onresize", [| Attributes.onresize |])
, ( Text
"onscroll", [| Attributes.onscroll |])
, ( Text
"onseeked", [| Attributes.onseeked |])
, ( Text
"onseeking", [| Attributes.onseeking |])
, ( Text
"onselect", [| Attributes.onselect |])
, ( Text
"onstalled", [| Attributes.onstalled |])
, ( Text
"onstorage", [| Attributes.onstorage |])
, ( Text
"onsubmit", [| Attributes.onsubmit |])
, ( Text
"onsuspend", [| Attributes.onsuspend |])
, ( Text
"ontimeupdate", [| Attributes.ontimeupdate |])
, ( Text
"onundo", [| Attributes.onundo |])
, ( Text
"onunload", [| Attributes.onunload |])
, ( Text
"onvolumechange", [| Attributes.onvolumechange |])
, ( Text
"onwaiting", [| Attributes.onwaiting |])
, ( Text
"open", [| Attributes.open |])
, ( Text
"optimum", [| Attributes.optimum |])
, ( Text
"pattern", [| Attributes.pattern |])
, ( Text
"ping", [| Attributes.ping |])
, ( Text
"placeholder", [| Attributes.placeholder |])
, ( Text
"poster", [| Attributes.poster |])
, ( Text
"preload", [| Attributes.preload |])
, ( Text
"property", [| Attributes.property |])
, ( Text
"pubdate", [| Attributes.pubdate |])
, ( Text
"radiogroup", [| Attributes.radiogroup |])
, ( Text
"readonly", [| Attributes.readonly |])
, ( Text
"rel", [| Attributes.rel |])
, ( Text
"required", [| Attributes.required |])
, ( Text
"reversed", [| Attributes.reversed |])
, ( Text
"role", [| Attributes.role |])
, ( Text
"rows", [| Attributes.rows |])
, ( Text
"rowspan", [| Attributes.rowspan |])
, ( Text
"sandbox", [| Attributes.sandbox |])
, ( Text
"scope", [| Attributes.scope |])
, ( Text
"scoped", [| Attributes.scoped |])
, ( Text
"seamless", [| Attributes.seamless |])
, ( Text
"selected", [| Attributes.selected |])
, ( Text
"shape", [| Attributes.shape |])
, ( Text
"size", [| Attributes.size |])
, ( Text
"sizes", [| Attributes.sizes |])
, ( Text
"span", [| Attributes.span |])
, ( Text
"spellcheck", [| Attributes.spellcheck |])
, ( Text
"src", [| Attributes.src |])
, ( Text
"srcdoc", [| Attributes.srcdoc |])
, ( Text
"start", [| Attributes.start |])
, ( Text
"step", [| Attributes.step |])
, ( Text
"style", [| Attributes.style |])
, ( Text
"subject", [| Attributes.subject |])
, ( Text
"summary", [| Attributes.summary |])
, ( Text
"tabindex", [| Attributes.tabindex |])
, ( Text
"target", [| Attributes.target |])
, ( Text
"title", [| Attributes.title |])
, ( Text
"type", [| Attributes.type_ |])
, ( Text
"usemap", [| Attributes.usemap |])
, ( Text
"value", [| Attributes.value |])
, ( Text
"width", [| Attributes.width |])
, ( Text
"wrap", [| Attributes.wrap |])
, ( Text
"xmlns", [| Attributes.xmlns |])
]
attributeFromNameGeneric :: Text -> TH.ExpQ
attributeFromNameGeneric :: Text -> Q Exp
attributeFromNameGeneric Text
name =
let
nameWithSuffix :: Text
nameWithSuffix = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=\""
in
[| attribute (Html5.textTag name) (Html5.textTag nameWithSuffix) |]
spreadAttributes :: ApplyAttribute value => [(Text, value)] -> Html5.Html -> Html5.Html
spreadAttributes :: forall value.
ApplyAttribute value =>
[(Text, value)] -> Html -> Html
spreadAttributes [(Text, value)]
attributes Html
html = Html -> [Html -> Html] -> Html
applyAttributes Html
html ([Html -> Html] -> Html) -> [Html -> Html] -> Html
forall a b. (a -> b) -> a -> b
$ ((Text, value) -> Html -> Html)
-> [(Text, value)] -> [Html -> Html]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
name, value
value) -> Text -> Text -> value -> Html -> Html
forall value.
ApplyAttribute value =>
Text -> Text -> value -> Html -> Html
applyAttribute Text
name (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=\"") value
value) [(Text, value)]
attributes
{-# INLINE spreadAttributes #-}
applyAttributes :: Html5.Html -> [Html5.Html -> Html5.Html] -> Html5.Html
applyAttributes :: Html -> [Html -> Html] -> Html
applyAttributes Html
element (Html -> Html
attribute:[Html -> Html]
rest) = Html -> [Html -> Html] -> Html
applyAttributes (Html -> Html
attribute Html
element) [Html -> Html]
rest
applyAttributes Html
element [] = Html
element
{-# INLINE applyAttributes #-}
makeParent :: StaticString -> StaticString -> StaticString -> Html -> Html
makeParent :: StaticString -> StaticString -> StaticString -> Html -> Html
makeParent StaticString
tag StaticString
openTag StaticString
closeTag Html
children = StaticString -> StaticString -> StaticString -> Html -> Html
forall a.
StaticString
-> StaticString -> StaticString -> MarkupM a -> MarkupM a
Parent StaticString
tag StaticString
openTag StaticString
closeTag Html
children
{-# INLINE makeParent #-}
textToStaticString :: Text -> StaticString
textToStaticString :: Text -> StaticString
textToStaticString Text
text = (String -> String) -> ByteString -> Text -> StaticString
StaticString (Text -> String
Text.unpack Text
text String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Text -> ByteString
Text.encodeUtf8 Text
text) Text
text
{-# INLINE textToStaticString #-}
instance Show (MarkupM ()) where
show :: Html -> String
show Html
html = Html -> String
BlazeString.renderHtml Html
html