Infix and pattern matching on constructors working. Added tests. No

type annotations in Constructor patterns supported.

Test/HSX/QQSpec.hs

@@ -31,6 +31,16 @@ tests = do
             let project = Project { name = "Testproject" }
             [hsx|<h1>Project: {get #name project}</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>"
@@ -159,12 +169,12 @@ tests = do
                     ("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
 
@@ -173,4 +183,13 @@ tests = do
 
 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

ihp-hsx/IHP/HSX/HsExpToTH.hs

@@ -71,16 +71,11 @@ toName n = case n of
 toFieldExp :: a
 toFieldExp = undefined
 
--- Th.ConP Name [Type] [Pat]
--- ConPat (XConPat p) (XRec p (ConLikeP p)) (HsConPatDetails p)
--- type XConPat GhcRn = NoExtField see
--- Looks like we need the https://hackage.haskell.org/package/ghc-9.4.2/docs/GHC-Hs-Syn-Type.html hsLPatType :: LPat GhcTc -> Type
 toPat :: Pat.Pat GhcPs -> TH.Pat
 toPat (Pat.VarPat _ (unLoc -> name)) = TH.VarP (toName name)
 toPat (TuplePat _ p _) = TH.TupP (map (toPat . unLoc) p)
-toPat (ParPat xP lP) = (toPat . unLoc) lP --error "TH.ParPat not implemented"
-toPat (ConPat pat_con_ext ((unLoc -> name)) pat_args) = TH.ConP (toName name) (map toType []) (map (toPat . unLoc) (Pat.hsConPatArgs pat_args))  --error "TH.ConstructorPattern not implemented"
---toPat (ConPat pat_con_ext pat_con pat_args) = TH.ConP (toName pat_con_ext) (map (toType . unLoc) (hsPatSigType pat_args)) (map (toPat . unLoc) (Pat.hsConPatArgs pat_args))  --error "TH.ConstructorPattern not implemented"
+toPat (ParPat xP lP) = (toPat . unLoc) lP
+toPat (ConPat pat_con_ext ((unLoc -> name)) pat_args) = TH.ConP (toName name) (map toType []) (map (toPat . unLoc) (Pat.hsConPatArgs pat_args))
 toPat (ViewPat pat_con pat_args pat_con_ext) = error "TH.ViewPattern not implemented"
 toPat (SumPat _ _ _ _) = error "TH.SumPat not implemented"
 toPat (WildPat _ ) = error "TH.WildPat not implemented"