ihp-hsx 1.3.0 → 1.4.0

raw patch · 7 files changed

+981/−45 lines, 7 filesdep +hspecdep +ihp-hsxdep +unordered-containersdep ~blaze-htmldep ~blaze-markupdep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec, ihp-hsx, unordered-containers

Dependency ranges changed: blaze-html, blaze-markup, bytestring, containers, megaparsec, string-conversions, template-haskell, text

API changes (from Hackage documentation)

Files

• IHP/HSX/Parser.hs +22/−8
• IHP/HSX/QQ.hs +396/−29
• README.md +96/−0
• Test/IHP/HSX/ParserSpec.hs +172/−0
• Test/IHP/HSX/QQSpec.hs +221/−0
• Test/Main.hs +12/−0
• ihp-hsx.cabal +62/−8

@@ -15,6 +15,7 @@ , Attribute (..) , AttributeValue (..) , collapseSpace+, HsxSettings (..) ) where  import Prelude@@ -34,6 +35,12 @@ import qualified Data.Containers.ListUtils as List import qualified IHP.HSX.HaskellParser as HaskellParser +data HsxSettings = HsxSettings+    { checkMarkup :: Bool+    , additionalTagNames :: Set Text+    , additionalAttributeNames :: Set Text+    }+ data AttributeValue = TextValue !Text | ExpressionValue !Haskell.Exp deriving (Eq, Show)  data Attribute = StaticAttribute !Text !AttributeValue | SpreadAttributes !Haskell.Exp deriving (Eq, Show)@@ -57,15 +64,16 @@ -- > let position = Megaparsec.SourcePos filePath (Megaparsec.mkPos line) (Megaparsec.mkPos col) -- > let hsxText = "<strong>Hello</strong>" -- >--- > let (Right node) = parseHsx position [] hsxText-parseHsx :: SourcePos -> [TH.Extension] -> Text -> Either (ParseErrorBundle Text Void) Node-parseHsx position extensions code =+-- > let (Right node) = parseHsx settings position [] hsxText+parseHsx :: HsxSettings -> SourcePos -> [TH.Extension] -> Text -> Either (ParseErrorBundle Text Void) Node+parseHsx settings position extensions code =     let         ?extensions = extensions+        ?settings = settings     in         runParser (setPosition position *> parser) "" code -type Parser a = (?extensions :: [TH.Extension]) => Parsec Void Text a+type Parser a = (?extensions :: [TH.Extension], ?settings :: HsxSettings) => Parsec Void Text a  setPosition pstateSourcePos = updateParserState (\state -> state {         statePosState = (statePosState state) { pstateSourcePos }@@ -211,15 +219,16 @@ hsxAttributeName :: Parser Text hsxAttributeName = do         name <- rawAttribute-        unless (isValidAttributeName name) (fail $ "Invalid attribute name: " <> cs name)+        let checkingMarkup = ?settings.checkMarkup+        unless (isValidAttributeName name || not checkingMarkup) (fail $ "Invalid attribute name: " <> cs name)         pure name     where         isValidAttributeName name =             "data-" `Text.isPrefixOf` name             || "aria-" `Text.isPrefixOf` name             || "hx-" `Text.isPrefixOf` name-            || "hx-" `Text.isPrefixOf` name             || name `Set.member` attributes+            || name `Set.member` ?settings.additionalAttributeNames          rawAttribute = takeWhile1P Nothing (\c -> Char.isAlphaNum c || c == '-' || c == '_') @@ -285,13 +294,18 @@         treeToString acc (TokenNode (x:xs)) = ((treeToString (acc <> "{") x) <> (Text.concat $ fmap (treeToString "") xs)) <> "}"  + hsxElementName :: Parser Text hsxElementName = do     name <- takeWhile1P (Just "identifier") (\c -> Char.isAlphaNum c || c == '_' || c == '-' || c == '!')     let isValidParent = name `Set.member` parents     let isValidLeaf = name `Set.member` leafs-    let isValidCustomWebComponent = "-" `Text.isInfixOf` name-    unless (isValidParent || isValidLeaf || isValidCustomWebComponent) (fail $ "Invalid tag name: " <> cs name)+    let isValidCustomWebComponent = "-" `Text.isInfixOf` name +                                  && not (Text.isPrefixOf "-" name)+                                  && not (Char.isNumber (Text.head name))+    let isValidAdditionalTag = name `Set.member` ?settings.additionalTagNames+    let checkingMarkup = ?settings.checkMarkup+    unless (isValidParent || isValidLeaf || isValidCustomWebComponent || isValidAdditionalTag || not checkingMarkup) (fail $ "Invalid tag name: " <> cs name)     space     pure name 

@@ -5,7 +5,7 @@ Description: Defines the @[hsx||]@ syntax Copyright: (c) digitally induced GmbH, 2022 -}-module IHP.HSX.QQ (hsx) where+module IHP.HSX.QQ (hsx, uncheckedHsx, customHsx) where  import           Prelude import Data.Text (Text)@@ -25,20 +25,42 @@ 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 {-        quoteExp = quoteHsxExpression,-        quotePat = error "quotePat: not defined",-        quoteDec = error "quoteDec: not defined",-        quoteType = error "quoteType: not defined"-    }+hsx = customHsx +        (HsxSettings +            { checkMarkup = True+            , additionalTagNames = Set.empty+            , additionalAttributeNames = Set.empty+            }+        ) -quoteHsxExpression :: String -> TH.ExpQ-quoteHsxExpression code = do+uncheckedHsx :: QuasiQuoter+uncheckedHsx = customHsx+        (HsxSettings +            { checkMarkup = False+            , additionalTagNames = Set.empty+            , additionalAttributeNames = Set.empty+            }+        )++customHsx :: HsxSettings -> QuasiQuoter+customHsx settings = +    QuasiQuoter +        { quoteExp = quoteHsxExpression settings+        , quotePat = error "quotePat: not defined"+        , quoteDec = error "quoteDec: not defined"+        , quoteType = error "quoteType: not defined"+        }++quoteHsxExpression :: HsxSettings -> String -> TH.ExpQ+quoteHsxExpression settings code = do         hsxPosition <- findHSXPosition         extensions <- TH.extsEnabled-        expression <- case parseHsx hsxPosition extensions (cs code) of+        expression <- case parseHsx settings hsxPosition extensions (cs code) of                 Left error   -> fail (Megaparsec.errorBundlePretty error)                 Right result -> pure result         compileToHaskell expression@@ -55,23 +77,17 @@     let         renderedChildren = TH.listE $ map compileToHaskell children         stringAttributes = TH.listE $ map toStringAttribute attributes-        openTag :: Text-        openTag = "<" <> tag-        tag :: Text-        tag = cs name     in         if isLeaf             then                 let-                    closeTag :: Text-                    closeTag = ">"-                in [| (applyAttributes (Leaf (textToStaticString $(TH.lift tag)) (textToStaticString $(TH.lift openTag)) (textToStaticString $(TH.lift closeTag)) ()) $(stringAttributes)) |]+                    element = nodeToBlazeLeaf name+                in+                    [| applyAttributes $element $stringAttributes |]             else                 let-                    closeTag :: Text-                    closeTag = "</" <> tag <> ">"-                in [| (applyAttributes (makeParent (textToStaticString $(TH.lift name)) (textToStaticString $(TH.lift openTag)) (textToStaticString $(TH.lift closeTag)) $renderedChildren) $(stringAttributes)) |]-+                    element = nodeToBlazeElement name+                in [| applyAttributes ($element (mconcat $renderedChildren)) $stringAttributes |] compileToHaskell (Children children) =     let         renderedChildren = TH.listE $ map compileToHaskell children@@ -83,27 +99,378 @@ compileToHaskell (CommentNode value) = [| Html5.textComment value |] compileToHaskell (NoRenderCommentNode) = [| mempty |] +nodeToBlazeElement :: Text -> TH.Q TH.Exp+nodeToBlazeElement name =+    HashMap.findWithDefault (nodeToBlazeElementGeneric name) name knownElements +knownElements :: HashMap.HashMap Text TH.ExpQ+knownElements =+    HashMap.fromList+        [ ("a", [| Html5.a |])+        , ("abbr", [| Html5.abbr |])+        , ("address", [| Html5.address |])+        , ("article", [| Html5.article |])+        , ("aside", [| Html5.aside |])+        , ("audio", [| Html5.audio |])+        , ("b", [| Html5.b |])+        , ("blockquote", [| Html5.blockquote |])+        , ("body", [| Html5.body |])+        , ("button", [| Html5.button |])+        , ("canvas", [| Html5.canvas |])+        , ("caption", [| Html5.caption |])+        , ("cite", [| Html5.cite |])+        , ("code", [| Html5.code |])+        , ("colgroup", [| Html5.colgroup |])+        , ("datalist", [| Html5.datalist |])+        , ("dd", [| Html5.dd |])+        , ("del", [| Html5.del |])+        , ("details", [| Html5.details |])+        , ("dfn", [| Html5.dfn |])+        , ("div", [| Html5.div |])+        , ("dl", [| Html5.dl |])+        , ("dt", [| Html5.dt |])+        , ("em", [| Html5.em |])+        , ("fieldset", [| Html5.fieldset |])+        , ("figcaption", [| Html5.figcaption |])+        , ("figure", [| Html5.figure |])+        , ("footer", [| Html5.footer |])+        , ("form", [| Html5.form |])+        , ("h1", [| Html5.h1 |])+        , ("h2", [| Html5.h2 |])+        , ("h3", [| Html5.h3 |])+        , ("h4", [| Html5.h4 |])+        , ("h5", [| Html5.h5 |])+        , ("h6", [| Html5.h6 |])+        , ("head", [| Html5.head |])+        , ("header", [| Html5.header |])+        , ("hgroup", [| Html5.hgroup |])+        , ("html", [| Html5.html |])+        , ("i", [| Html5.i |])+        , ("iframe", [| Html5.iframe |])+        , ("ins", [| Html5.ins |])+        , ("kbd", [| Html5.kbd |])+        , ("label", [| Html5.label |])+        , ("legend", [| Html5.legend |])+        , ("li", [| Html5.li |])+        , ("main", [| Html5.main |])+        , ("map", [| Html5.map |])+        , ("mark", [| Html5.mark |])+        , ("menu", [| Html5.menu |])+        , ("menuitem", [| Html5.menuitem |])+        , ("meter", [| Html5.meter |])+        , ("nav", [| Html5.nav |])+        , ("noscript", [| Html5.noscript |])+        , ("object", [| Html5.object |])+        , ("ol", [| Html5.ol |])+        , ("optgroup", [| Html5.optgroup |])+        , ("option", [| Html5.option |])+        , ("output", [| Html5.output |])+        , ("p", [| Html5.p |])+        , ("pre", [| Html5.pre |])+        , ("progress", [| Html5.progress |])+        , ("q", [| Html5.q |])+        , ("rp", [| Html5.rp |])+        , ("rt", [| Html5.rt |])+        , ("ruby", [| Html5.ruby |])+        , ("s", [| Html5.s |])+        , ("samp", [| Html5.samp |])+        , ("script", [| Html5.script |])+        , ("section", [| Html5.section |])+        , ("select", [| Html5.select |])+        , ("small", [| Html5.small |])+        , ("span", [| Html5.span |])+        , ("strong", [| Html5.strong |])+        , ("style", [| Html5.style |])+        , ("sub", [| Html5.sub |])+        , ("summary", [| Html5.summary |])+        , ("sup", [| Html5.sup |])+        , ("table", [| Html5.table |])+        , ("tbody", [| Html5.tbody |])+        , ("td", [| Html5.td |])+        , ("textarea", [| Html5.textarea |])+        , ("tfoot", [| Html5.tfoot |])+        , ("th", [| Html5.th |])+        , ("thead", [| Html5.thead |])+        , ("time", [| Html5.time |])+        , ("title", [| Html5.title |])+        , ("tr", [| Html5.tr |])+        , ("u", [| Html5.u |])+        , ("ul", [| Html5.ul |])+        , ("var", [| Html5.var |])+        , ("video", [| Html5.video |])+        ]++nodeToBlazeLeaf :: Text -> TH.Q TH.Exp+nodeToBlazeLeaf name =+    HashMap.findWithDefault (nodeToBlazeLeafGeneric name) name knownLeafs++knownLeafs :: HashMap.HashMap Text TH.ExpQ+knownLeafs =+    HashMap.fromList+        [ ("area", [| Html5.area |])+        , ("base", [| Html5.base |])+        , ("br", [| Html5.br |])+        , ("col", [| Html5.col |])+        , ("embed", [| Html5.embed |])+        , ("hr", [| Html5.hr |])+        , ("img", [| Html5.img |])+        , ("input", [| Html5.input |])+        , ("keygen", [| Html5.keygen |])+        , ("link", [| Html5.link |])+        , ("meta", [| Html5.meta |])+        , ("param", [| Html5.param |])+        , ("source", [| Html5.source |])+        , ("track", [| Html5.track |])+        , ("wbr", [| Html5.wbr |])+        ]++nodeToBlazeElementGeneric :: Text -> TH.Q TH.Exp+nodeToBlazeElementGeneric name =+    let+        openTag :: Text+        openTag = "<" <> tag+        +        tag :: Text+        tag = cs name++        closeTag :: Text+        closeTag = "</" <> tag <> ">"+    in+        [| makeParent (textToStaticString $(TH.lift name)) (textToStaticString $(TH.lift openTag)) (textToStaticString $(TH.lift closeTag)) |]++nodeToBlazeLeafGeneric :: Text -> TH.Q TH.Exp+nodeToBlazeLeafGeneric name =+    let+        openTag :: Text+        openTag = "<" <> tag++        closeTag :: Text+        closeTag = ">"+        +        tag :: Text+        tag = cs name+    in+        [| (Leaf (textToStaticString $(TH.lift tag)) (textToStaticString $(TH.lift openTag)) (textToStaticString $(TH.lift closeTag)) ()) |]+ toStringAttribute :: Attribute -> TH.ExpQ-toStringAttribute (StaticAttribute name (TextValue value)) = do-    let nameWithSuffix = " " <> name <> "=\""-    if Text.null value-        then [| \h -> h ! ((attribute (Html5.textTag name) (Html5.textTag nameWithSuffix)) mempty) |]-        else [| \h -> h ! ((attribute (Html5.textTag name) (Html5.textTag nameWithSuffix)) (Html5.preEscapedTextValue value)) |]+toStringAttribute (StaticAttribute name (TextValue value)) =+    attributeFromName name value  toStringAttribute (StaticAttribute name (ExpressionValue expression)) = let nameWithSuffix = " " <> name <> "=\"" in [| applyAttribute name nameWithSuffix $(pure expression) |] toStringAttribute (SpreadAttributes expression) = [| spreadAttributes $(pure expression) |] +attributeFromName :: Text -> Text -> TH.ExpQ+attributeFromName name value =+    let+        value' :: TH.ExpQ+        value' = if Text.null value then [| mempty |] else [| Html5.preEscapedTextValue value |] ++        attr = attributeFromName' name+    in+        [| (! $attr $value') |]++attributeFromName' :: Text -> TH.ExpQ+attributeFromName' name =+    HashMap.findWithDefault (attributeFromNameGeneric name) name knownAttributes++knownAttributes :: HashMap.HashMap Text TH.ExpQ+knownAttributes =+    HashMap.fromList+        [ ("accept", [| Attributes.accept |])+        , ( "accept-charset", [| Attributes.acceptCharset |])+        , ( "accesskey", [| Attributes.accesskey |])+        , ( "action", [| Attributes.action |])+        , ( "alt", [| Attributes.alt |])+        , ( "async", [| Attributes.async |])+        , ( "autocomplete", [| Attributes.autocomplete |])+        , ( "autofocus", [| Attributes.autofocus |])+        , ( "autoplay", [| Attributes.autoplay |])+        , ( "challenge", [| Attributes.challenge |])+        , ( "charset", [| Attributes.charset |])+        , ( "checked", [| Attributes.checked |])+        , ( "cite", [| Attributes.cite |])+        , ( "class", [| Attributes.class_ |])+        , ( "cols", [| Attributes.cols |])+        , ( "colspan", [| Attributes.colspan |])+        , ( "content", [| Attributes.content |])+        , ( "contenteditable", [| Attributes.contenteditable |])+        , ( "contextmenu", [| Attributes.contextmenu |])+        , ( "controls", [| Attributes.controls |])+        , ( "coords", [| Attributes.coords |])+        , ( "data", [| Attributes.data_ |])+        , ( "datetime", [| Attributes.datetime |])+        , ( "defer", [| Attributes.defer |])+        , ( "dir", [| Attributes.dir |])+        , ( "disabled", [| Attributes.disabled |])+        , ( "download", [| Attributes.download |])+        , ( "draggable", [| Attributes.draggable |])+        , ( "enctype", [| Attributes.enctype |])+        , ( "for", [| Attributes.for |])+        , ( "form", [| Attributes.form |])+        , ( "formaction", [| Attributes.formaction |])+        , ( "formenctype", [| Attributes.formenctype |])+        , ( "formmethod", [| Attributes.formmethod |])+        , ( "formnovalidate", [| Attributes.formnovalidate |])+        , ( "formtarget", [| Attributes.formtarget |])+        , ( "headers", [| Attributes.headers |])+        , ( "height", [| Attributes.height |])+        , ( "hidden", [| Attributes.hidden |])+        , ( "high", [| Attributes.high |])+        , ( "href", [| Attributes.href |])+        , ( "hreflang", [| Attributes.hreflang |])+        , ( "http-equiv", [| Attributes.httpEquiv |])+        , ( "icon", [| Attributes.icon |])+        , ( "id", [| Attributes.id |])+        , ( "ismap", [| Attributes.ismap |])+        , ( "item", [| Attributes.item |])+        , ( "itemprop", [| Attributes.itemprop |])+        , ( "itemscope", [| Attributes.itemscope |])+        , ( "itemtype", [| Attributes.itemtype |])+        , ( "keytype", [| Attributes.keytype |])+        , ( "label", [| Attributes.label |])+        , ( "lang", [| Attributes.lang |])+        , ( "list", [| Attributes.list |])+        , ( "loop", [| Attributes.loop |])+        , ( "low", [| Attributes.low |])+        , ( "manifest", [| Attributes.manifest |])+        , ( "max", [| Attributes.max |])+        , ( "maxlength", [| Attributes.maxlength |])+        , ( "media", [| Attributes.media |])+        , ( "method", [| Attributes.method |])+        , ( "min", [| Attributes.min |])+        , ( "minlength", [| Attributes.minlength |])+        , ( "multiple", [| Attributes.multiple |])+        , ( "muted", [| Attributes.muted |])+        , ( "name", [| Attributes.name |])+        , ( "novalidate", [| Attributes.novalidate |])+        , ( "onbeforeonload", [| Attributes.onbeforeonload |])+        , ( "onbeforeprint", [| Attributes.onbeforeprint |])+        , ( "onblur", [| Attributes.onblur |])+        , ( "oncanplay", [| Attributes.oncanplay |])+        , ( "oncanplaythrough", [| Attributes.oncanplaythrough |])+        , ( "onchange", [| Attributes.onchange |])+        , ( "onclick", [| Attributes.onclick |])+        , ( "oncontextmenu", [| Attributes.oncontextmenu |])+        , ( "ondblclick", [| Attributes.ondblclick |])+        , ( "ondrag", [| Attributes.ondrag |])+        , ( "ondragend", [| Attributes.ondragend |])+        , ( "ondragenter", [| Attributes.ondragenter |])+        , ( "ondragleave", [| Attributes.ondragleave |])+        , ( "ondragover", [| Attributes.ondragover |])+        , ( "ondragstart", [| Attributes.ondragstart |])+        , ( "ondrop", [| Attributes.ondrop |])+        , ( "ondurationchange", [| Attributes.ondurationchange |])+        , ( "onemptied", [| Attributes.onemptied |])+        , ( "onended", [| Attributes.onended |])+        , ( "onerror", [| Attributes.onerror |])+        , ( "onfocus", [| Attributes.onfocus |])+        , ( "onformchange", [| Attributes.onformchange |])+        , ( "onforminput", [| Attributes.onforminput |])+        , ( "onhaschange", [| Attributes.onhaschange |])+        , ( "oninput", [| Attributes.oninput |])+        , ( "oninvalid", [| Attributes.oninvalid |])+        , ( "onkeydown", [| Attributes.onkeydown |])+        , ( "onkeypress", [| Attributes.onkeypress |])+        , ( "onkeyup", [| Attributes.onkeyup |])+        , ( "onload", [| Attributes.onload |])+        , ( "onloadeddata", [| Attributes.onloadeddata |])+        , ( "onloadedmetadata", [| Attributes.onloadedmetadata |])+        , ( "onloadstart", [| Attributes.onloadstart |])+        , ( "onmessage", [| Attributes.onmessage |])+        , ( "onmousedown", [| Attributes.onmousedown |])+        , ( "onmousemove", [| Attributes.onmousemove |])+        , ( "onmouseout", [| Attributes.onmouseout |])+        , ( "onmouseover", [| Attributes.onmouseover |])+        , ( "onmouseup", [| Attributes.onmouseup |])+        , ( "onmousewheel", [| Attributes.onmousewheel |])+        , ( "ononline", [| Attributes.ononline |])+        , ( "onpagehide", [| Attributes.onpagehide |])+        , ( "onpageshow", [| Attributes.onpageshow |])+        , ( "onpause", [| Attributes.onpause |])+        , ( "onplay", [| Attributes.onplay |])+        , ( "onplaying", [| Attributes.onplaying |])+        , ( "onprogress", [| Attributes.onprogress |])+        , ( "onpropstate", [| Attributes.onpropstate |])+        , ( "onratechange", [| Attributes.onratechange |])+        , ( "onreadystatechange", [| Attributes.onreadystatechange |])+        , ( "onredo", [| Attributes.onredo |])+        , ( "onresize", [| Attributes.onresize |])+        , ( "onscroll", [| Attributes.onscroll |])+        , ( "onseeked", [| Attributes.onseeked |])+        , ( "onseeking", [| Attributes.onseeking |])+        , ( "onselect", [| Attributes.onselect |])+        , ( "onstalled", [| Attributes.onstalled |])+        , ( "onstorage", [| Attributes.onstorage |])+        , ( "onsubmit", [| Attributes.onsubmit |])+        , ( "onsuspend", [| Attributes.onsuspend |])+        , ( "ontimeupdate", [| Attributes.ontimeupdate |])+        , ( "onundo", [| Attributes.onundo |])+        , ( "onunload", [| Attributes.onunload |])+        , ( "onvolumechange", [| Attributes.onvolumechange |])+        , ( "onwaiting", [| Attributes.onwaiting |])+        , ( "open", [| Attributes.open |])+        , ( "optimum", [| Attributes.optimum |])+        , ( "pattern", [| Attributes.pattern |])+        , ( "ping", [| Attributes.ping |])+        , ( "placeholder", [| Attributes.placeholder |])+        , ( "poster", [| Attributes.poster |])+        , ( "preload", [| Attributes.preload |])+        , ( "property", [| Attributes.property |])+        , ( "pubdate", [| Attributes.pubdate |])+        , ( "radiogroup", [| Attributes.radiogroup |])+        , ( "readonly", [| Attributes.readonly |])+        , ( "rel", [| Attributes.rel |])+        , ( "required", [| Attributes.required |])+        , ( "reversed", [| Attributes.reversed |])+        , ( "role", [| Attributes.role |])+        , ( "rows", [| Attributes.rows |])+        , ( "rowspan", [| Attributes.rowspan |])+        , ( "sandbox", [| Attributes.sandbox |])+        , ( "scope", [| Attributes.scope |])+        , ( "scoped", [| Attributes.scoped |])+        , ( "seamless", [| Attributes.seamless |])+        , ( "selected", [| Attributes.selected |])+        , ( "shape", [| Attributes.shape |])+        , ( "size", [| Attributes.size |])+        , ( "sizes", [| Attributes.sizes |])+        , ( "span", [| Attributes.span |])+        , ( "spellcheck", [| Attributes.spellcheck |])+        , ( "src", [| Attributes.src |])+        , ( "srcdoc", [| Attributes.srcdoc |])+        , ( "start", [| Attributes.start |])+        , ( "step", [| Attributes.step |])+        , ( "style", [| Attributes.style |])+        , ( "subject", [| Attributes.subject |])+        , ( "summary", [| Attributes.summary |])+        , ( "tabindex", [| Attributes.tabindex |])+        , ( "target", [| Attributes.target |])+        , ( "title", [| Attributes.title |])+        , ( "type", [| Attributes.type_ |])+        , ( "usemap", [| Attributes.usemap |])+        , ( "value", [| Attributes.value |])+        , ( "width", [| Attributes.width |])+        , ( "wrap", [| Attributes.wrap |])+        , ( "xmlns", [| Attributes.xmlns |])+        ]++attributeFromNameGeneric :: Text -> TH.ExpQ+attributeFromNameGeneric name =+    let+        nameWithSuffix = " " <> name <> "=\""+    in+        [| attribute (Html5.textTag name) (Html5.textTag nameWithSuffix) |]+ spreadAttributes :: ApplyAttribute value => [(Text, value)] -> Html5.Html -> Html5.Html spreadAttributes attributes html = applyAttributes html $ map (\(name, value) -> applyAttribute name (" " <> name <> "=\"") value) attributes {-# INLINE spreadAttributes #-}  applyAttributes :: Html5.Html -> [Html5.Html -> Html5.Html] -> Html5.Html-applyAttributes element attributes = foldl' (\element attribute -> attribute element) element attributes+applyAttributes element (attribute:rest) = applyAttributes (attribute element) rest+applyAttributes element [] = element {-# INLINE applyAttributes #-} -makeParent :: StaticString -> StaticString -> StaticString -> [Html] -> Html-makeParent tag openTag closeTag children = Parent tag openTag closeTag (mconcat children)+makeParent :: StaticString -> StaticString -> StaticString -> Html -> Html+makeParent tag openTag closeTag children = Parent tag openTag closeTag children {-# INLINE makeParent #-}  textToStaticString :: Text -> StaticString

@@ -274,6 +274,102 @@  If you use HTML entities, such as `&nbsp;` for a non-breaking space, you will notice they appear exactly like that. To output directly (i.e. unescaped) use the method `preEscapedToMarkup` from `Text.Blaze.Html5`. +### Custom HSX and Unchecked HSX++HSX provides two additional QuasiQuoters beyond the standard `[hsx|...|]` for increased flexibility: `uncheckedHsx` and `customHsx`.++#### Using `uncheckedHsx`++`uncheckedHsx` provides a quick way to bypass HSX's strict tag and attribute name checking. ++It will still check for a valid HTML structure, but it will accept any tag and attribute names.+++```haskell+[uncheckedHsx|+    <anytagname custom-attribute="value">+        Content+    </anytagname>+|]+```++While convenient for rapid development, use it with caution as you lose the benefits of compile-time guarantees for your markup.++#### Using `customHsx`++`customHsx` allows you to extend the default HSX with additional whitelisted tag names and attribute names while maintaining the same strict compile-time checking of the default `hsx`. ++This makes it easier to use custom elements that often also contain special attributes, and javascript libraries, for example `_hyperscript`, that use the `_` as an attribute name.+++To use `customHsx`, you need to create it in a separate module due to Template Haskell restrictions. Here's how to set it up:++1. First, create a new module for your custom HSX (e.g., `Application.Helper.CustomHsx`):++```haskell+module Application.Helper.CustomHsx where++import IHP.Prelude+import IHP.HSX.QQ (customHsx)+import IHP.HSX.Parser+import Language.Haskell.TH.Quote+import qualified Data.Set as Set++myHsx :: QuasiQuoter+myHsx = customHsx +    (HsxSettings +        { checkMarkup = True+        , additionalTagNames = Set.fromList ["book", "heading", "name"]+        , additionalAttributeNames = Set.fromList ["_", "custom-attribute"]+        }+    )+```++Configuration options for `HsxSettings`:+- `checkMarkup`: Boolean to enable/disable markup checking+- `additionalTagNames`: Set of additional allowed tag names+- `additionalAttributeNames`: Set of additional allowed attribute names++2. Make it available in your views by adding it to your view helpers module:++```haskell+module Application.Helper.View (+    module Application.Helper.View,+    module Application.Helper.CustomHsx -- Add this line+) where++import IHP.ViewPrelude+import Application.Helper.CustomHsx (myHsx) -- Add this line+```++3. Use it in your views:++```haskell+[myHsx|+    <book _="on click log 'Hello'">+        <heading custom-attribute="value">My Book</heading>+        <name>Author Name</name>+    </book>+|]+```++The custom HSX will validate that tags and attributes are either in the default HSX whitelist or in your additional sets. This gives you the flexibility to use custom elements and attributes.++This approach is particularly useful for:+- Web Components with custom attribute names+- UI libraries with non-standard attributes+- Domain-specific XML markup languages+- Integration with third-party frameworks that extend HTML syntax++`customHsx` whitelisting and even `uncheckedHsx` does not entirely help for libraries with very unusual symbols in their attributes, like Alpine.js, because they don't recognize html attributes starting with `@` or has `:` in the attribute name. In these cases, the spread syntax `{...attributeList}` is likely your best bet.++```haskell+-- This will not work+[uncheckedHsx|<button @click="open = true">Expand</button>|]++-- Using spread syntax will work+[hsx|<button {...[("@click", "open = true" :: Text)]}>Expand</button>|]+```  ## Common HSX Patterns 

@@ -0,0 +1,172 @@+{-|+Module: IHP.HSX.QQSpec+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.HSX.ParserSpec where++import Test.Hspec+import Prelude+import IHP.HSX.Parser+import qualified Text.Megaparsec as Megaparsec+import qualified Text.Megaparsec.Error as Megaparsec+import qualified "template-haskell" Language.Haskell.TH as TH+import qualified "template-haskell" Language.Haskell.TH.Syntax as TH+import qualified Data.Set as Set+++tests = do+    let position = Megaparsec.SourcePos "" (Megaparsec.mkPos 1) (Megaparsec.mkPos 1)+    let extensions = []+    +    describe "HSX Parser" do+        let settings = HsxSettings True Set.empty Set.empty+        it "should fail on invalid html tags" do+            let errorText = "1:13:\n  |\n1 | <myinvalidel>\n  |             ^\nInvalid tag name: myinvalidel\n"+            let (Left error) = parseHsx settings position extensions "<myinvalidel>"+            (Megaparsec.errorBundlePretty error) `shouldBe` errorText++        it "should fail on invalid attribute names" do+            let errorText = "1:23:\n  |\n1 | <div invalid-attribute=\"test\">\n  |                       ^\nInvalid attribute name: invalid-attribute\n"+            let (Left error) = parseHsx settings position extensions "<div invalid-attribute=\"test\">"+            (Megaparsec.errorBundlePretty error) `shouldBe` errorText++        it "should fail on unmatched tags" do+            let errorText = "1:7:\n  |\n1 | <div></span>\n  |       ^\nunexpected '/'\nexpecting \"</div>\", identifier, or white space\n"+            let (Left error) = parseHsx settings position extensions "<div></span>"+            (Megaparsec.errorBundlePretty error) `shouldBe` errorText++        it "should parse a closing tag with spaces" do+            let p = parseHsx settings position extensions "<div></div >"+            p `shouldBe` (Right (Children [Node "div" [] [] False]))++        it "should strip spaces around nodes" do+            let p = parseHsx settings position extensions "<div> <span> </span> </div>"+            p `shouldBe` (Right (Children [Node "div" [] [Node "span" [] [] False] False]))++        it "should strip spaces after self closing tags" do+            let p = parseHsx settings position extensions "<head>{\"meta\"}\n\n                        <link rel=\"stylesheet\" href=\"/vendor/bootstrap.min.css\"></head>"+            p `shouldBe` (Right (Children [Node "head" [] [SplicedNode (TH.LitE (TH.StringL "meta")),Node "link" [StaticAttribute "rel" (TextValue "stylesheet"),StaticAttribute "href" (TextValue "/vendor/bootstrap.min.css")] [] True] False]))++        it "should not strip spaces in a text node" do+            let p = parseHsx settings position extensions " Hello World "+            p `shouldBe` (Right (Children [TextNode "Hello World"]))++        it "should deal with variables in text nodes" do+            let p = parseHsx settings position extensions "<div>\n    Hello {\"name\"}! \n</div>"+            p `shouldBe`  (Right (Children [Node "div" [] [TextNode "Hello ",SplicedNode (TH.LitE (TH.StringL "name")),TextNode "!"] False]))++        it "should parse self closing tags with spaces around it" do+            let p = parseHsx settings position extensions " <div/> "+            p `shouldBe`  (Right (Children [Node "div" [] [] False]))++        it "should collapse spaces" do+            let p = parseHsx settings position extensions "\n    Hello\n    World\n    !    "+            p `shouldBe`  (Right (Children [TextNode "Hello World !"]))+        +        it "should parse spread values" do+            let p = parseHsx settings position extensions "<div {...variables}/>"+            -- We cannot easily construct the @VarE variables@ expression, therefore we use show here for comparison+            show p `shouldBe` "Right (Children [Node \"div\" [SpreadAttributes (VarE variables)] [] False])"++        it "should parse spread values with a space" do+            -- See https://github.com/digitallyinduced/ihp/issues/1588+            let p = parseHsx settings position extensions "<div { ...variables }/>"+            show p `shouldBe` "Right (Children [Node \"div\" [SpreadAttributes (VarE variables)] [] False])"++        it "should accept underscores in data attributes" do+            let p = parseHsx settings position extensions "<div data-client_id=\"test\"/>"+            p `shouldBe` (Right (Children [Node "div" [StaticAttribute "data-client_id" (TextValue "test")] [] False]))++        it "should accept doctype" do+            let p = parseHsx settings position extensions "<!DOCTYPE html><html lang=\"en\"><body>hello</body></html>"+            p `shouldBe` (Right (Children [Node "!DOCTYPE" [StaticAttribute "html" (TextValue "html")] [] True, Node "html" [StaticAttribute "lang" (TextValue "en")] [Node "body" [] [TextNode "hello"] False] False]))++    describe "uncheckedHsx" do+        let settings = HsxSettings False Set.empty Set.empty+        it "should not check markup" do+            let p = parseHsx settings position extensions "<invalid-tag invalid-attribute=\"invalid\"/>"+            p `shouldBe` (Right (Children [Node "invalid-tag" [StaticAttribute "invalid-attribute" (TextValue "invalid")] [] False]))+        +        it "should not check attribute names" do+            let p = parseHsx settings position extensions "<div invalid-attribute=\"invalid\"/>"+            p `shouldBe` (Right (Children [Node "div" [StaticAttribute "invalid-attribute" (TextValue "invalid")] [] False]))++        it "should fail on unmatched tags" do+            let errorText = "1:7:\n  |\n1 | <div></span>\n  |       ^\nunexpected '/'\nexpecting \"</div>\", identifier, or white space\n"+            let (Left error) = parseHsx settings position extensions "<div></span>"+            (Megaparsec.errorBundlePretty error) `shouldBe` errorText++        it "should parse a closing tag with spaces" do+            let p = parseHsx settings position extensions "<div></div >"+            p `shouldBe` (Right (Children [Node "div" [] [] False]))++        it "should strip spaces around nodes" do+            let p = parseHsx settings position extensions "<div> <span> </span> </div>"+            p `shouldBe` (Right (Children [Node "div" [] [Node "span" [] [] False] False]))++        it "should strip spaces after self closing tags" do+            let p = parseHsx settings position extensions "<head>{\"meta\"}\n\n                        <link rel=\"stylesheet\" href=\"/vendor/bootstrap.min.css\"></head>"+            p `shouldBe` (Right (Children [Node "head" [] [SplicedNode (TH.LitE (TH.StringL "meta")),Node "link" [StaticAttribute "rel" (TextValue "stylesheet"),StaticAttribute "href" (TextValue "/vendor/bootstrap.min.css")] [] True] False]))++        it "should not strip spaces in a text node" do+            let p = parseHsx settings position extensions " Hello World "+            p `shouldBe` (Right (Children [TextNode "Hello World"]))++        it "should deal with variables in text nodes" do+            let p = parseHsx settings position extensions "<div>\n    Hello {\"name\"}! \n</div>"+            p `shouldBe`  (Right (Children [Node "div" [] [TextNode "Hello ",SplicedNode (TH.LitE (TH.StringL "name")),TextNode "!"] False]))++        it "should parse self closing tags with spaces around it" do+            let p = parseHsx settings position extensions " <div/> "+            p `shouldBe`  (Right (Children [Node "div" [] [] False]))++        it "should collapse spaces" do+            let p = parseHsx settings position extensions "\n    Hello\n    World\n    !    "+            p `shouldBe`  (Right (Children [TextNode "Hello World !"]))+        +        it "should parse spread values" do+            let p = parseHsx settings position extensions "<div {...variables}/>"+            -- We cannot easily construct the @VarE variables@ expression, therefore we use show here for comparison+            show p `shouldBe` "Right (Children [Node \"div\" [SpreadAttributes (VarE variables)] [] False])"++        it "should parse spread values with a space" do+            -- See https://github.com/digitallyinduced/ihp/issues/1588+            let p = parseHsx settings position extensions "<div { ...variables }/>"+            show p `shouldBe` "Right (Children [Node \"div\" [SpreadAttributes (VarE variables)] [] False])"++        it "should accept underscores in data attributes" do+            let p = parseHsx settings position extensions "<div data-client_id=\"test\"/>"+            p `shouldBe` (Right (Children [Node "div" [StaticAttribute "data-client_id" (TextValue "test")] [] False]))++        it "should accept doctype" do+            let p = parseHsx settings position extensions "<!DOCTYPE html><html lang=\"en\"><body>hello</body></html>"+            p `shouldBe` (Right (Children [Node "!DOCTYPE" [StaticAttribute "html" (TextValue "html")] [] True, Node "html" [StaticAttribute "lang" (TextValue "en")] [Node "body" [] [TextNode "hello"] False] False]))++    describe "customHsx" do+        let customSettings = HsxSettings True +                (Set.fromList ["mycustomtag"])+                (Set.fromList ["my-custom-attr"])++        it "should allow specified custom tags" do+            let p = parseHsx customSettings position extensions "<mycustomtag>hello</mycustomtag>"+            p `shouldBe` (Right (Children [Node "mycustomtag" [] [TextNode "hello"] False]))++        it "should reject non-specified custom tags" do+            let errorText = "1:15:\n  |\n1 | <notallowedtag>hello</notallowedtag>\n  |               ^\nInvalid tag name: notallowedtag\n"+            case parseHsx customSettings position extensions "<notallowedtag>hello</notallowedtag>" of+                Left error -> (Megaparsec.errorBundlePretty error) `shouldBe` errorText+                Right _ -> fail "Expected parser to fail with invalid tag name"++        it "should allow specified custom attributes" do+            let p = parseHsx customSettings position extensions "<div my-custom-attr=\"hello\">test</div>"+            p `shouldBe` (Right (Children [Node "div" [StaticAttribute "my-custom-attr" (TextValue "hello")] [TextNode "test"] False]))++        it "should reject non-specified custom attributes" do+            let errorText = "1:22:\n  |\n1 | <div not-allowed-attr=\"test\">\n  |                      ^\nInvalid attribute name: not-allowed-attr\n"+            case parseHsx customSettings position extensions "<div not-allowed-attr=\"test\">" of+                Left error -> (Megaparsec.errorBundlePretty error) `shouldBe` errorText+                Right _ -> fail "Expected parser to fail with invalid attribute name"++        it "should allow mixing custom and standard elements" do+            let p = parseHsx customSettings position extensions "<mycustomtag class=\"hello\" my-custom-attr=\"world\">test</mycustomtag>"+            p `shouldBe` (Right (Children [Node "mycustomtag" [StaticAttribute "class" (TextValue "hello"), StaticAttribute "my-custom-attr" (TextValue "world")] [TextNode "test"] False]))

@@ -0,0 +1,221 @@+{-|+Module: IHP.HSX.QQSpec+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.HSX.QQSpec where++import Test.Hspec+import Prelude+import IHP.HSX.QQ+import qualified Text.Blaze.Renderer.Text as Blaze+import Text.Blaze (preEscapedTextValue)+import Data.Text+import IHP.HSX.CustomHsxCases++tests :: SpecWith ()+tests = do+    describe "HSX" do+        it "should work with static html" do+            [hsx|<strong>hello world</strong>|] `shouldBeHtml` "<strong>hello world</strong>"+            [hsx|<h1>hello world</h1>|] `shouldBeHtml` "<h1>hello world</h1>"+            [hsx|<blink>web scale</blink>|] `shouldBeHtml` "<blink>web scale</blink>"++        it "should work with an empty input" do+            [hsx||] `shouldBeHtml` ""++        it "should support multiple root nodes" do+            [hsx|<u>underlined</u><i>italic</i>|] `shouldBeHtml` "<u>underlined</u><i>italic</i>"++        it "should work with text variables" do+            let myString :: Text = "World!"+            [hsx|Hello {myString}|] `shouldBeHtml` "Hello World!"++        it "should work with complex haskell expressions" do+            let project = Project { name = "Testproject" }+            [hsx|<h1>Project: {project.name}</h1>|] `shouldBeHtml` "<h1>Project: Testproject</h1>"++        it "should support lambdas and pattern matching on constructors" do+            let placeData = PlaceId "Punches Cross"+            [hsx|<h1>{(\(PlaceId x) -> x)(placeData)}</h1>|] `shouldBeHtml` "<h1>Punches Cross</h1>"++        it "should support infix notation for standard constructors e.g. (:):" do+            [hsx| <h1>{show $ (:) 1  [2,3,42]}</h1> |] `shouldBeHtml` "<h1>[1,2,3,42]</h1>"++        it "should support infix notation for standard constructors e.g. (,):" do+            [hsx|<h1>{((,) 1 2)}</h1>|] `shouldBeHtml` "<h1>(1,2)</h1>"++        it "should support self closing tags" do+            [hsx|<input>|] `shouldBeHtml` "<input>"+            [hsx|<br><br/>|] `shouldBeHtml` "<br><br>"++        it "should support boolean attributes" do+            [hsx|<input disabled>|] `shouldBeHtml` "<input disabled=\"disabled\">"+            [hsx|<input disabled={True}>|] `shouldBeHtml` "<input disabled=\"disabled\">"+            [hsx|<input disabled={False}>|] `shouldBeHtml` "<input>"++        it "should correctly output True and False values in data attributes" do+            [hsx|<form data-disabled-javascript-submission></form>|] `shouldBeHtml` "<form data-disabled-javascript-submission=\"true\"></form>"+            [hsx|<form data-disabled-javascript-submission={True}></form>|] `shouldBeHtml` "<form data-disabled-javascript-submission=\"true\"></form>"+            [hsx|<form data-disabled-javascript-submission={False}></form>|] `shouldBeHtml` "<form data-disabled-javascript-submission=\"false\"></form>"++        it "should work with inline JS" do+            [hsx|<script>var a = { hello: true }; alert('hello world');</script>|] `shouldBeHtml` "<script>var a = { hello: true }; alert('hello world');</script>"+            [hsx|<script>{haskellCodeNotWorkingHere}</script>|] `shouldBeHtml` "<script>{haskellCodeNotWorkingHere}</script>"++        it "should work with inline CSS" do+            [hsx|<style>.blue { background: blue; }</style>|] `shouldBeHtml` "<style>.blue { background: blue; }</style>"+            [hsx|<style>{haskellCodeNotWorkingHere}</style>|] `shouldBeHtml` "<style>{haskellCodeNotWorkingHere}</style>"++        it "should strip whitespace around script tags" do+            [hsx|+                <script>+                    var apiKey = document.currentScript.dataset.apiKey;+                </script>+            |] `shouldBeHtml` "<script>var apiKey = document.currentScript.dataset.apiKey;</script>"++        it "should strip whitespace around text nodes" do+            [hsx| <strong> Hello World </strong> |] `shouldBeHtml` "<strong>Hello World</strong>"+            [hsx|<i> a</i>|] `shouldBeHtml` "<i>a</i>"+            [hsx|<i> a b</i>|] `shouldBeHtml` "<i>a b</i>"+            [hsx|<i> a b c </i>|] `shouldBeHtml` "<i>a b c</i>"++        it "should collapse spaces" do+            [hsx|+                Hello+                World+                !+            |] `shouldBeHtml` "Hello World !"++        it "should not strip whitespace around variables near to text nodes" do+            let name :: Text = "Tester"+            [hsx| <strong> Hello {name} ! </strong> |] `shouldBeHtml` "<strong>Hello Tester !</strong>"+            [hsx| <strong> Hello {name}{name} ! </strong> |] `shouldBeHtml` "<strong>Hello TesterTester !</strong>"+            [hsx| <strong> Hello {name} {name} ! </strong> |] `shouldBeHtml` "<strong>Hello Tester Tester !</strong>"+            [hsx|{name}|] `shouldBeHtml` "Tester"++            let question :: Text = "Q"+            let answer :: Text = "A"+            [hsx|<td>{question} → {answer}</td>|] `shouldBeHtml` "<td>Q → A</td>"++        it "should work with html comments" do+            [hsx|<div><!--my comment--></div>|] `shouldBeHtml` "<div><!-- my comment --></div>"++        it "should work with no render comments" do+            [hsx|<div>{- my comment -}</div>|] `shouldBeHtml` "<div></div>"++        it "should escape variables to avoid XSS" do+            let variableContent :: Text = "<script>alert(1);</script>"+            [hsx|{variableContent}|] `shouldBeHtml` "&lt;script&gt;alert(1);&lt;/script&gt;"++        it "should parse custom web component tags" do+            [hsx|<confetti-effect></confetti-effect>|] `shouldBeHtml` "<confetti-effect></confetti-effect>"+            [hsx|<confetti-effect/>|] `shouldBeHtml` "<confetti-effect></confetti-effect>" -- Currently we cannot deal with self closing tags as expected+            [hsx|<div is="confetti-effect"></div>|] `shouldBeHtml` "<div is=\"confetti-effect\"></div>"++        it "should parse a small hsx document" do+            let metaTags = [hsx|+                <meta charset="utf-8">+            |]+            let stylesheets = [hsx|+                <link rel="stylesheet" href="/vendor/bootstrap.min.css"/>+                <link rel="stylesheet" href="/vendor/flatpickr.min.css"/>+                <link rel="stylesheet" href="/app.css"/>+            |]+            let scripts = [hsx|+                <script src="/prod.js"></script>+            |]+            [hsx|+                <html>+                    <head>+                        {metaTags}++                        {stylesheets}+                        {scripts}++                        <title>IHP Forum</title>+                    </head>+                </html>+            |] `shouldBeHtml` "<html><head><meta charset=\"utf-8\"> <link rel=\"stylesheet\" href=\"/vendor/bootstrap.min.css\"><link rel=\"stylesheet\" href=\"/vendor/flatpickr.min.css\"><link rel=\"stylesheet\" href=\"/app.css\"> <script src=\"/prod.js\"></script><title>IHP Forum</title></head></html>"++        it "should parse an example hsx document" do+            let metaTags = [hsx|+                <meta charset="utf-8">+            |]+            metaTags `shouldBeHtml` "<meta charset=\"utf-8\">"+            let stylesheets = [hsx|+                <link rel="stylesheet" href="/vendor/bootstrap.min.css"/>+                <link rel="stylesheet" href="/vendor/flatpickr.min.css"/>+                <link rel="stylesheet" href="/app.css"/>+            |]+            let scripts = [hsx|+                <script src="/prod.js"></script>+            |]+            [hsx|+                <html>+                    <head>+                        {metaTags}++                        {stylesheets}+                        {scripts}++                        <title>IHP Forum</title>+                    </head>+                    <body>+                        <div class="container mt-4">+                            <nav class="navbar navbar-expand-lg navbar-light mb-4">+                                <a class="navbar-brand" href="/">λ IHP Forum</a>+                            </nav>+                        </div>+                    </body>+                </html>+            |] `shouldBeHtml` "<html><head><meta charset=\"utf-8\"> <link rel=\"stylesheet\" href=\"/vendor/bootstrap.min.css\"><link rel=\"stylesheet\" href=\"/vendor/flatpickr.min.css\"><link rel=\"stylesheet\" href=\"/app.css\"> <script src=\"/prod.js\"></script><title>IHP Forum</title></head><body><div class=\"container mt-4\"><nav class=\"navbar navbar-expand-lg navbar-light mb-4\"><a class=\"navbar-brand\" href=\"/\">\955 IHP Forum</a></nav></div></body></html>"++        it "should handle spread attributes with a variable" do+            let customAttributes :: [(Text, Text)] = [+                    ("hello", "world")+                    ]+            [hsx|<div {...customAttributes}></div>|] `shouldBeHtml` "<div hello=\"world\"></div>"++        it "should handle spread attributes with a list" do+            -- See https://github.com/digitallyinduced/ihp/issues/1226++            [hsx|<div {...[ ("data-hoge" :: Text, "Hello World!" :: Text) ]}></div>|] `shouldBeHtml` "<div data-hoge=\"Hello World!\"></div>"++        it "should support pre escaped class names" do+            -- See https://github.com/digitallyinduced/ihp/issues/1527++            let className = preEscapedTextValue "a&"+            [hsx|<div class={className}></div>|] `shouldBeHtml` "<div class=\"a&\"></div>"++        it "should support support doctype" do+            -- See https://github.com/digitallyinduced/ihp/issues/1717++            [hsx|<!DOCTYPE html><html lang="en"><body>hello</body></html>|] `shouldBeHtml` "<!DOCTYPE HTML>\n<html lang=\"en\"><body>hello</body></html>"++    describe "customHsx" do+        it "should allow specified custom tags" do+            [myTagsOnlyHsx|<mycustomtag>hello</mycustomtag>|] `shouldBeHtml` "<mycustomtag>hello</mycustomtag>"+            [myTagsOnlyHsx|<anothercustomtag>world</anothercustomtag>|] `shouldBeHtml` "<anothercustomtag>world</anothercustomtag>"++        it "should allow specified custom attributes" do+            [myAttrsOnlyHsx|<div my-custom-attr="hello">test</div>|] `shouldBeHtml` "<div my-custom-attr=\"hello\">test</div>"+            [myAttrsOnlyHsx|<div anothercustomattr="world">test</div>|] `shouldBeHtml` "<div anothercustomattr=\"world\">test</div>"++        it "should allow combining custom tags and attributes" do+            [myCustomHsx|<mycustomtag my-custom-attr="hello">test</mycustomtag>|] `shouldBeHtml` "<mycustomtag my-custom-attr=\"hello\">test</mycustomtag>"++        it "should work with regular HTML tags and attributes too" do+           [myCustomHsx|<div class="hello" my-custom-attr="test">world</div>|] `shouldBeHtml` "<div class=\"hello\" my-custom-attr=\"test\">world</div>"++data Project = Project { name :: Text }++data PlaceId  = PlaceId Text+data LocationId  = LocationId Int PlaceId+newtype NewPlaceId = NewPlaceId Text++newPlaceData = NewPlaceId "New Punches Cross"+locationId = LocationId 17 (PlaceId "Punches Cross")++++shouldBeHtml hsx expectedHtml = (Blaze.renderMarkup hsx) `shouldBe` expectedHtml

@@ -0,0 +1,12 @@+module Main where++import Prelude++import Test.Hspec+import qualified IHP.HSX.QQSpec+import qualified IHP.HSX.ParserSpec++main :: IO ()+main = hspec do+    IHP.HSX.QQSpec.tests+    IHP.HSX.ParserSpec.tests

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                ihp-hsx-version:             1.3.0+version:             1.4.0 synopsis:            JSX-like but for Haskell description:         JSX-like templating syntax for Haskell license:             MIT@@ -20,15 +20,16 @@     default-language: Haskell2010     build-depends:           base >= 4.17.0 && < 4.20-        , blaze-html >= 0.9.1 && < 0.10-        , bytestring >= 0.11.3 && < 0.13+        , blaze-html+        , bytestring         , template-haskell >= 2.19.0 && < 2.22-        , text >= 2.0.1 && < 2.2-        , containers >= 0.6.6 && < 0.7-        , blaze-markup >= 0.8.2 && < 0.9+        , text+        , containers+        , blaze-markup         , ghc >= 9.4.4 && < 9.9-        , megaparsec >= 9.2.2 && < 9.7-        , string-conversions >= 0.4.0 && < 0.5+        , megaparsec+        , string-conversions+        , unordered-containers     default-extensions:         OverloadedStrings         , NoImplicitPrelude@@ -88,3 +89,56 @@         , IHP.HSX.HaskellParser         , IHP.HSX.HsExpToTH         , IHP.HSX.Attribute++test-suite ihp-hsx-tests+    type:                exitcode-stdio-1.0+    hs-source-dirs:      Test+    main-is:             Main.hs+    other-modules:+        IHP.HSX.ParserSpec+        IHP.HSX.QQSpec+    default-language:    Haskell2010+    build-depends:+          base >= 4.17.0 && < 4.20+        , ihp-hsx+        , hspec+        , text+        , bytestring+        , containers+        , blaze-markup+        , megaparsec+        , template-haskell+    default-extensions:+        OverloadedStrings+        , NoImplicitPrelude+        , ImplicitParams+        , Rank2Types+        , NamedFieldPuns+        , TypeSynonymInstances+        , FlexibleInstances+        , DisambiguateRecordFields+        , DuplicateRecordFields+        , OverloadedLabels+        , FlexibleContexts+        , DataKinds+        , QuasiQuotes+        , TypeFamilies+        , PackageImports+        , ScopedTypeVariables+        , RecordWildCards+        , TypeApplications+        , DataKinds+        , InstanceSigs+        , DeriveGeneric+        , MultiParamTypeClasses+        , TypeOperators+        , DeriveDataTypeable+        , DefaultSignatures+        , BangPatterns+        , FunctionalDependencies+        , PartialTypeSignatures+        , BlockArguments+        , LambdaCase+        , StandaloneDeriving+        , TemplateHaskell+        , OverloadedRecordDot