diff --git a/ihp-hsx/IHP/HSX/Attribute.hs b/ihp-hsx/IHP/HSX/Attribute.hs new file mode 100644 index 000000000..c533a86eb --- /dev/null +++ b/ihp-hsx/IHP/HSX/Attribute.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE UndecidableInstances #-} +{-| +Module: IHP.HSX.Attribute +Copyright: (c) digitally induced GmbH, 2023 +-} +module IHP.HSX.Attribute +( ApplyAttribute (..) +) where + +import Prelude +import Text.Blaze.Html5 ((!)) +import qualified Text.Blaze.Html5 as Html5 +import Text.Blaze.Internal (attribute, MarkupM (Parent, Leaf), StaticString (..)) +import Data.String.Conversions +import IHP.HSX.ToHtml +import qualified Data.Text as Text +import Data.Text (Text) + +class ApplyAttribute value where + applyAttribute :: Text -> Text -> value -> (Html5.Html -> Html5.Html) + +instance ApplyAttribute Bool where + applyAttribute attr attr' True h = h ! (attribute (Html5.textTag attr) (Html5.textTag attr') (Html5.textValue value)) + where + value = if "data-" `Text.isPrefixOf` attr + then "true" -- "true" for data attributes + else attr -- normal html boolean attriubtes, like , see https://html.spec.whatwg.org/multipage/common-microsyntaxes.html#boolean-attributes + applyAttribute attr attr' false h | "data-" `Text.isPrefixOf` attr = h ! (attribute (Html5.textTag attr) (Html5.textTag attr') "false") -- data attribute set to "false" + applyAttribute attr attr' false h = h -- html boolean attribute, like will be dropped as there is no other way to specify that it's set to false + {-# INLINE applyAttribute #-} + +instance ApplyAttribute attribute => ApplyAttribute (Maybe attribute) where + applyAttribute attr attr' (Just value) h = applyAttribute attr attr' value h + applyAttribute attr attr' Nothing h = h + {-# INLINE applyAttribute #-} + +instance ApplyAttribute Html5.AttributeValue where + applyAttribute attr attr' value h = h ! (attribute (Html5.textTag attr) (Html5.textTag attr') value) + {-# INLINE applyAttribute #-} + +instance {-# OVERLAPPABLE #-} ConvertibleStrings value Html5.AttributeValue => ApplyAttribute value where + applyAttribute attr attr' value h = applyAttribute attr attr' ((cs value) :: Html5.AttributeValue) h + {-# INLINE applyAttribute #-} \ No newline at end of file diff --git a/ihp-hsx/IHP/HSX/QQ.hs b/ihp-hsx/IHP/HSX/QQ.hs index 30bdef02b..5445e12fb 100644 --- a/ihp-hsx/IHP/HSX/QQ.hs +++ b/ihp-hsx/IHP/HSX/QQ.hs @@ -24,6 +24,7 @@ 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 hsx :: QuasiQuoter hsx = QuasiQuoter { @@ -109,31 +110,5 @@ textToStaticString :: Text -> StaticString textToStaticString text = StaticString (Text.unpack text ++) (Text.encodeUtf8 text) text {-# INLINE textToStaticString #-} -class ApplyAttribute value where - applyAttribute :: Text -> Text -> value -> (Html5.Html -> Html5.Html) - -instance ApplyAttribute Bool where - applyAttribute attr attr' True h = h ! (attribute (Html5.textTag attr) (Html5.textTag attr') (Html5.textValue value)) - where - value = if "data-" `Text.isPrefixOf` attr - then "true" -- "true" for data attributes - else attr -- normal html boolean attriubtes, like , see https://html.spec.whatwg.org/multipage/common-microsyntaxes.html#boolean-attributes - applyAttribute attr attr' false h | "data-" `Text.isPrefixOf` attr = h ! (attribute (Html5.textTag attr) (Html5.textTag attr') "false") -- data attribute set to "false" - applyAttribute attr attr' false h = h -- html boolean attribute, like will be dropped as there is no other way to specify that it's set to false - {-# INLINE applyAttribute #-} - -instance ApplyAttribute attribute => ApplyAttribute (Maybe attribute) where - applyAttribute attr attr' (Just value) h = applyAttribute attr attr' value h - applyAttribute attr attr' Nothing h = h - {-# INLINE applyAttribute #-} - -instance ApplyAttribute Html5.AttributeValue where - applyAttribute attr attr' value h = h ! (attribute (Html5.textTag attr) (Html5.textTag attr') value) - {-# INLINE applyAttribute #-} - -instance {-# OVERLAPPABLE #-} ConvertibleStrings value Html5.AttributeValue => ApplyAttribute value where - applyAttribute attr attr' value h = applyAttribute attr attr' ((cs value) :: Html5.AttributeValue) h - {-# INLINE applyAttribute #-} - instance Show (MarkupM ()) where show html = BlazeString.renderHtml html diff --git a/ihp-hsx/ihp-hsx.cabal b/ihp-hsx/ihp-hsx.cabal index c5a98594d..f5e1d468b 100644 --- a/ihp-hsx/ihp-hsx.cabal +++ b/ihp-hsx/ihp-hsx.cabal @@ -86,4 +86,5 @@ library , IHP.HSX.ToHtml , IHP.HSX.ConvertibleStrings , IHP.HSX.HaskellParser - , IHP.HSX.HsExpToTH \ No newline at end of file + , IHP.HSX.HsExpToTH + , IHP.HSX.Attribute \ No newline at end of file