diff --git a/IHP/ViewSupport.hs b/IHP/ViewSupport.hs
index 56ed865c1..e902e3a06 100644
--- a/IHP/ViewSupport.hs
+++ b/IHP/ViewSupport.hs
@@ -55,7 +55,7 @@ import qualified IHP.View.CSSFramework as CSSFramework ()
import IHP.View.Types
import qualified IHP.FrameworkConfig as FrameworkConfig
import IHP.Controller.Context
-
+import qualified IHP.HSX.Attribute as HSX
class View theView where
-- | Hook which is called before the render is called
@@ -262,3 +262,6 @@ liveReloadWebsocketUrl :: (?context :: ControllerContext) => Text
liveReloadWebsocketUrl = ?context.frameworkConfig.ideBaseUrl
|> Text.replace "http://" "ws://"
|> Text.replace "https://" "wss://"
+
+instance InputValue (PrimaryKey table) => HSX.ApplyAttribute (Id' table) where
+ applyAttribute attr attr' value h = HSX.applyAttribute attr attr' (inputValue value) h
\ No newline at end of file
diff --git a/Test/ViewSupportSpec.hs b/Test/ViewSupportSpec.hs
index cea38e686..8911230cd 100644
--- a/Test/ViewSupportSpec.hs
+++ b/Test/ViewSupportSpec.hs
@@ -126,4 +126,14 @@ tests = beforeAll (mockContextNoDatabase WebApplication config) do
runSession (testGet "test/TestWithParam?param=foo") application >>= assertTextExists "isActiveController TestController: True"
it "should return False on a different route" $ withContext do
application <- makeApplication
- runSession (testGet "test/TestWithParam?param=foo") application >>= assertTextExists "isActiveController AnotherTestAction: False"
\ No newline at end of file
+ runSession (testGet "test/TestWithParam?param=foo") application >>= assertTextExists "isActiveController AnotherTestAction: False"
+
+ describe "HSX" $ do
+ it "allow using Id's in HSX attributes without explicitly calling inputValue" $ withContext do
+ let
+ id :: Id' "users"
+ id = Id ("70a10b53-a776-470a-91a8-900cdda06aa2" :: UUID)
+
+ (ClassyPrelude.tshow [hsx||]) `shouldBe` ""
+
+type instance PrimaryKey "users" = UUID
\ No newline at end of file
diff --git a/flake.lock b/flake.lock
index 70270fc75..5a1756a44 100644
--- a/flake.lock
+++ b/flake.lock
@@ -488,17 +488,17 @@
},
"nixpkgs_2": {
"locked": {
- "lastModified": 1696172942,
- "narHash": "sha256-hKlB5InxJjDxLy5NJ4tQKEJ39Om81H87uoo0HHBG2UU=",
- "owner": "mpscholten",
+ "lastModified": 1696291921,
+ "narHash": "sha256-isKgVAoUxuxYEuO3Q4xhbfKcZrF/+UkJtOTv0eb/W5E=",
+ "owner": "NixOS",
"repo": "nixpkgs",
- "rev": "3cdb4f45a50eb2a6a1a65f324e8243cedef4b19c",
+ "rev": "ea0284a3da391822909be5e98a60c1e62572a7dc",
"type": "github"
},
"original": {
- "owner": "mpscholten",
- "ref": "fix-ghc-m1-issue",
+ "owner": "NixOS",
"repo": "nixpkgs",
+ "rev": "ea0284a3da391822909be5e98a60c1e62572a7dc",
"type": "github"
}
},
diff --git a/ihp-hsx/.ghci b/ihp-hsx/.ghci
new file mode 120000
index 000000000..8ad639841
--- /dev/null
+++ b/ihp-hsx/.ghci
@@ -0,0 +1 @@
+../.ghci
\ No newline at end of file
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