diff --git a/ihp-hsx/IHP/HSX/HsExpToTH.hs b/ihp-hsx/IHP/HSX/HsExpToTH.hs index dc28a8714..b30f672b9 100644 --- a/ihp-hsx/IHP/HSX/HsExpToTH.hs +++ b/ihp-hsx/IHP/HSX/HsExpToTH.hs @@ -74,11 +74,12 @@ 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 pat_con pat_args) = TH.ConP (toName pat_con_ext) (map toType (pat_con)) (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 (map hsLPatType (Pat.hsConPatArgs pat_args))) (map (toPat . unLoc) (Pat.hsConPatArgs pat_args)) --error "TH.ConstructorPattern not implemented" 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"