From 83e6aeb31983dfd594355522faead2e08c480e2d Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 28 Jul 2026 13:00:38 -0300
Subject: [PATCH 01/18] Claude written ghc-lib-parser usage

---
 hpgsql/hpgsql.cabal                  |   4 +-
 hpgsql/src/Hpgsql/GhcParseExp.hs     | 151 +++++++++++++++++++++++++++
 hpgsql/src/Hpgsql/GhcParserOpts.hs   |  45 ++++++++
 hpgsql/src/Hpgsql/ParsingInternal.hs |   8 +-
 hpgsql/src/Hpgsql/QueryInternal.hs   |   2 +-
 5 files changed, 204 insertions(+), 6 deletions(-)
 create mode 100644 hpgsql/src/Hpgsql/GhcParseExp.hs
 create mode 100644 hpgsql/src/Hpgsql/GhcParserOpts.hs

diff --git a/hpgsql/hpgsql.cabal b/hpgsql/hpgsql.cabal
index 87d0379..cd12eef 100644
--- a/hpgsql/hpgsql.cabal
+++ b/hpgsql/hpgsql.cabal
@@ -43,6 +43,8 @@ library
       Hpgsql.Types
   other-modules:
       Hpgsql.Base
+      Hpgsql.GhcParseExp
+      Hpgsql.GhcParserOpts
       Hpgsql.Internal
       Hpgsql.Locking
       Hpgsql.Msgs
@@ -104,7 +106,7 @@ library
     crypton >= 1.0.0 && < 1.1,
     memory >= 0.18.0 && < 0.19,
     hashable >= 1.5 && < 1.6,
-    haskell-src-meta >= 0.8 && < 0.9,
+    ghc-lib-parser,
     network >= 3.2 && < 3.3,
     network-uri >= 2.6 && < 2.7,
     safe-exceptions >= 0.1 && < 0.2,
diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
new file mode 100644
index 0000000..6666c69
--- /dev/null
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -0,0 +1,151 @@
+module Hpgsql.GhcParseExp (parseExp, canParseExp) where
+
+import Data.Char (isUpper)
+import GHC.Data.FastString (mkFastString, unpackFS)
+import GHC.Data.StringBuffer (stringToStringBuffer)
+import GHC.Driver.Config.Parser (initParserOpts)
+import GHC.Hs
+import GHC.Parser (parseExpression)
+import GHC.Parser.Lexer (P (..), ParseResult (..), initParserState)
+import GHC.Parser.PostProcess (ECP (..), runPV)
+import GHC.Types.Basic (Boxity (..))
+import GHC.Types.Name.Occurrence (occNameString)
+import GHC.Types.Name.Reader (RdrName (..))
+import GHC.Types.SourceText (IntegralLit (..), rationalFromFractionalLit)
+import GHC.Types.SrcLoc (GenLocated (..), mkRealSrcLoc)
+import Hpgsql.GhcParserOpts (parserDynFlags)
+import qualified Language.Haskell.TH as TH
+
+-- | Parse a Haskell expression string into a Template Haskell Exp.
+-- Drop-in replacement for Language.Haskell.Meta.Parse.parseExp.
+parseExp :: String -> Either String TH.Exp
+parseExp str = do
+  hsExpr <- ghcParse str
+  convertExpr hsExpr
+
+-- | Check if a string can be parsed as a Haskell expression.
+-- This only checks parsing validity; it does not convert to TH.
+canParseExp :: String -> Bool
+canParseExp str = case ghcParse str of
+  Right _ -> True
+  Left _ -> False
+
+ghcParse :: String -> Either String (HsExpr GhcPs)
+ghcParse str =
+  let buf = stringToStringBuffer str
+      loc = mkRealSrcLoc (mkFastString "<hpgsql>") 1 1
+      opts = initParserOpts parserDynFlags
+      parseExprP = parseExpression >>= \ecp -> runPV (unECP ecp)
+   in case unP parseExprP (initParserState opts buf loc) of
+        POk _ (L _ expr) -> Right expr
+        PFailed _ -> Left "Failed to parse Haskell expression"
+
+-- GHC HsExpr to TH Exp conversion
+
+convertExpr :: HsExpr GhcPs -> Either String TH.Exp
+convertExpr (HsVar _ (L _ rdr)) = Right (rdrToExp rdr)
+convertExpr (HsApp _ (L _ f) (L _ x)) = TH.AppE <$> convertExpr f <*> convertExpr x
+convertExpr (OpApp _ (L _ l) (L _ op) (L _ r)) = do
+  l' <- convertExpr l
+  op' <- convertExpr op
+  r' <- convertExpr r
+  Right (TH.UInfixE l' op' r')
+convertExpr (NegApp _ (L _ e) _) = do
+  e' <- convertExpr e
+  Right (TH.AppE (TH.VarE (TH.mkName "negate")) e')
+convertExpr (HsPar _ (L _ e)) =
+  TH.ParensE <$> convertExpr e
+convertExpr (ExplicitList _ es) = TH.ListE <$> traverse (\(L _ e) -> convertExpr e) es
+convertExpr (ExplicitTuple _ args boxity) = do
+  args' <- traverse convertTupArg args
+  Right
+    ( case boxity of
+        Boxed -> TH.TupE args'
+        Unboxed -> TH.UnboxedTupE args'
+    )
+convertExpr (SectionL _ (L _ e) (L _ op)) = do
+  e' <- convertExpr e
+  op' <- convertExpr op
+  Right (TH.InfixE (Just e') op' Nothing)
+convertExpr (SectionR _ (L _ op) (L _ e)) = do
+  op' <- convertExpr op
+  e' <- convertExpr e
+  Right (TH.InfixE Nothing op' (Just e'))
+convertExpr (HsIf _ (L _ c) (L _ t) (L _ f)) = do
+  c' <- convertExpr c
+  t' <- convertExpr t
+  f' <- convertExpr f
+  Right (TH.CondE c' t' f')
+convertExpr (HsLit _ lit) = TH.LitE <$> convertHsLit lit
+convertExpr (HsOverLit _ ol) = convertOverLit ol
+convertExpr (ExprWithTySig _ (L _ e) sigWcTy) = do
+  e' <- convertExpr e
+  ty' <- convertSigWcType sigWcTy
+  Right (TH.SigE e' ty')
+convertExpr _ = Left "Unsupported Haskell expression form in SQL quasi-quoter"
+
+-- Helper functions
+
+rdrToExp :: RdrName -> TH.Exp
+rdrToExp rdr =
+  let name = rdrToName rdr
+   in if isConName name then TH.ConE name else TH.VarE name
+
+rdrToName :: RdrName -> TH.Name
+rdrToName (Unqual occ) = TH.mkName (occNameString occ)
+rdrToName (Qual modN occ) = TH.mkName (moduleNameString modN ++ "." ++ occNameString occ)
+rdrToName _ = TH.mkName "<unknown-name>"
+
+isConName :: TH.Name -> Bool
+isConName n = case TH.nameBase n of
+  (c : _) -> isUpper c || c == ':'
+  _ -> False
+
+convertTupArg :: HsTupArg GhcPs -> Either String (Maybe TH.Exp)
+convertTupArg (Present _ (L _ e)) = Just <$> convertExpr e
+convertTupArg (Missing _) = Right Nothing
+
+convertHsLit :: HsLit GhcPs -> Either String TH.Lit
+convertHsLit (HsChar _ c) = Right (TH.CharL c)
+convertHsLit (HsString _ fs) = Right (TH.StringL (unpackFS fs))
+convertHsLit (HsInt _ il) = Right (TH.IntegerL (il_value il))
+convertHsLit (HsIntPrim _ i) = Right (TH.IntPrimL i)
+convertHsLit (HsWordPrim _ w) = Right (TH.WordPrimL w)
+convertHsLit (HsFloatPrim _ fl) = Right (TH.FloatPrimL (rationalFromFractionalLit fl))
+convertHsLit (HsDoublePrim _ fl) = Right (TH.DoublePrimL (rationalFromFractionalLit fl))
+convertHsLit _ = Left "Unsupported literal type in SQL quasi-quoter"
+
+convertOverLit :: HsOverLit GhcPs -> Either String TH.Exp
+convertOverLit ol = case ol_val ol of
+  HsIntegral il -> Right (TH.LitE (TH.IntegerL (il_value il)))
+  HsFractional fl -> Right (TH.LitE (TH.RationalL (rationalFromFractionalLit fl)))
+  HsIsString _ fs -> Right (TH.LitE (TH.StringL (unpackFS fs)))
+
+-- Type conversion (GHC HsType to TH Type)
+
+convertSigWcType :: LHsSigWcType GhcPs -> Either String TH.Type
+convertSigWcType (HsWC _ (L _ (HsSig _ _ (L _ ty)))) = convertType ty
+
+convertType :: HsType GhcPs -> Either String TH.Type
+convertType (HsTyVar _ promo (L _ rdr)) =
+  let name = rdrToName rdr
+   in Right $ case promo of
+        IsPromoted -> TH.PromotedT name
+        NotPromoted
+          | isConName name -> TH.ConT name
+          | otherwise -> TH.VarT name
+convertType (HsAppTy _ (L _ t1) (L _ t2)) =
+  TH.AppT <$> convertType t1 <*> convertType t2
+convertType (HsListTy _ (L _ t)) =
+  TH.AppT TH.ListT <$> convertType t
+convertType (HsTupleTy _ _ ts) = do
+  ts' <- traverse (\(L _ t) -> convertType t) ts
+  let n = length ts'
+  Right (foldl TH.AppT (TH.TupleT n) ts')
+convertType (HsFunTy _ _ (L _ t1) (L _ t2)) =
+  TH.AppT . TH.AppT TH.ArrowT <$> convertType t1 <*> convertType t2
+convertType (HsParTy _ (L _ t)) =
+  convertType t
+convertType (HsQualTy _ _ (L _ t)) =
+  convertType t
+convertType _ = Left "Unsupported type in SQL quasi-quoter type signature"
diff --git a/hpgsql/src/Hpgsql/GhcParserOpts.hs b/hpgsql/src/Hpgsql/GhcParserOpts.hs
new file mode 100644
index 0000000..f37898a
--- /dev/null
+++ b/hpgsql/src/Hpgsql/GhcParserOpts.hs
@@ -0,0 +1,45 @@
+{-# OPTIONS_GHC -Wno-missing-fields #-}
+
+module Hpgsql.GhcParserOpts (parserDynFlags) where
+
+import GHC.Driver.Session (DynFlags, defaultDynFlags, xopt_set)
+import GHC.LanguageExtensions.Type
+import GHC.Platform (genericPlatform)
+import GHC.Settings
+import GHC.Settings.Config (cProjectVersion)
+import GHC.Utils.Fingerprint (fingerprint0)
+
+-- | Fake GHC 'Settings' with only the fields the parser needs.
+-- All other fields are left undefined; this is why we suppress
+-- the missing-fields warning for this module only.
+fakeSettings :: Settings
+fakeSettings =
+  Settings
+    { sGhcNameVersion = GhcNameVersion "ghc" cProjectVersion,
+      sFileSettings = FileSettings {},
+      sTargetPlatform = genericPlatform,
+      sPlatformMisc = PlatformMisc {},
+      sToolSettings = ToolSettings {toolSettings_opt_P_fingerprint = fingerprint0}
+    }
+
+parserDynFlags :: DynFlags
+parserDynFlags =
+  foldl
+    xopt_set
+    (defaultDynFlags fakeSettings)
+    [ OverloadedStrings,
+      OverloadedRecordDot,
+      TupleSections,
+      LambdaCase,
+      MultiWayIf,
+      PostfixOperators,
+      QuasiQuotes,
+      UnicodeSyntax,
+      MagicHash,
+      ForeignFunctionInterface,
+      TemplateHaskell,
+      RankNTypes,
+      MultiParamTypeClasses,
+      RecursiveDo,
+      TypeApplications
+    ]
diff --git a/hpgsql/src/Hpgsql/ParsingInternal.hs b/hpgsql/src/Hpgsql/ParsingInternal.hs
index 232ec60..f38866d 100644
--- a/hpgsql/src/Hpgsql/ParsingInternal.hs
+++ b/hpgsql/src/Hpgsql/ParsingInternal.hs
@@ -36,7 +36,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 import Data.Text (Text)
 import qualified Data.Text as Text
-import Language.Haskell.Meta.Parse (parseExp)
+import Hpgsql.GhcParseExp (canParseExp)
 import Prelude hiding (takeWhile)
 
 data BlockOrNotBlock = StaticSql !Text | DollarNumberedArg !Int | QuestionMarkArg | QuasiQuoterExpression !QQExprKind !Text | SemiColon | CommentsOrWhitespace !Text
@@ -165,9 +165,9 @@ quasiQuoterExpressionParser = do
       chunk <- takeWhile (/= '}')
       void $ char '}'
       let candidate = acc <> chunk
-      case parseExp (Text.unpack candidate) of
-        Right _ -> pure candidate
-        Left _ -> findExpressionEnd (candidate <> "}")
+      if canParseExp (Text.unpack candidate)
+        then pure candidate
+        else findExpressionEnd (candidate <> "}")
 
 dollarNumberedQueryArgParser :: Parser BlockOrNotBlock
 dollarNumberedQueryArgParser = do
diff --git a/hpgsql/src/Hpgsql/QueryInternal.hs b/hpgsql/src/Hpgsql/QueryInternal.hs
index b721c79..016d04f 100644
--- a/hpgsql/src/Hpgsql/QueryInternal.hs
+++ b/hpgsql/src/Hpgsql/QueryInternal.hs
@@ -22,7 +22,7 @@ import Hpgsql.Encoding (FieldEncoder (..), RowEncoder (..), ToPgField (..), ToPg
 import Hpgsql.InternalTypes (Query (..), SingleQuery (..), SingleQueryFragment (..), breakQueryIntoStatements, renumberParamsFrom)
 import Hpgsql.ParsingInternal (BlockOrNotBlock (..), ParsingOpts (..), QQExprKind (..), blockText, flattenBlocks, parseSql)
 import Hpgsql.TypeInfo (EncodingContext, Oid)
-import Language.Haskell.Meta.Parse (parseExp)
+import Hpgsql.GhcParseExp (parseExp)
 import Language.Haskell.TH
 import Language.Haskell.TH.Quote
 

From d83d3084b3849018aa8fed406c88cf30a5dc35e0 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 28 Jul 2026 16:58:18 -0300
Subject: [PATCH 02/18] First round of hardening and self-review

---
 hpgsql-tests/SqlQuasiquoterSpec.hs | 11 +++++++----
 hpgsql/src/Hpgsql/GhcParseExp.hs   | 21 +++++++++++++++------
 2 files changed, 22 insertions(+), 10 deletions(-)

diff --git a/hpgsql-tests/SqlQuasiquoterSpec.hs b/hpgsql-tests/SqlQuasiquoterSpec.hs
index 13ba3f8..cf78ef8 100644
--- a/hpgsql-tests/SqlQuasiquoterSpec.hs
+++ b/hpgsql-tests/SqlQuasiquoterSpec.hs
@@ -144,6 +144,10 @@ genMkQuery =
         pure (mkQuery "SELECT $1, $2, $3, $4, $5;" params, toComparableParams params)
     ]
 
+data SomeRecord = SomeRecord {field1 :: Int, field2 :: Int}
+
+newtype SomeGenericRecord a = SomeGenericRecord {field1 :: a}
+
 -- | Queries built with the sql quasiquoter and #{} interpolation.
 genInterpolatedQuery :: Gen (Query, [(Maybe Oid, BinaryField)])
 genInterpolatedQuery =
@@ -153,14 +157,13 @@ genInterpolatedQuery =
         x <- genInt
         pure ([sql|SELECT #{x};|], toComparableParams (Only x)),
       do
-        x <- genInt
-        y <- genInt
-        pure ([sql|SELECT #{x}, #{y};|], toComparableParams (x, y)),
+        x <- SomeRecord <$> genInt <*> genInt
+        pure ([sql|SELECT #{x.field1}, #{-(x.field2)};|], toComparableParams (x.field1, -(x.field2))),
       do
         x <- genInt
         y <- genInt
         z <- genInt
-        pure ([sql|SELECT #{x} FROM t WHERE #{y} BETWEEN 0 AND #{z};|], toComparableParams (x, y, z))
+        pure ([sql|SELECT #{x} FROM t WHERE #{y} BETWEEN 0 AND #{(SomeGenericRecord { field1 = z }).field1};|], toComparableParams (x, y, z))
     ]
 
 -- | Queries built with ^{} embedded queries, including reused placeholders.
diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 6666c69..0b1e347 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -1,6 +1,7 @@
 module Hpgsql.GhcParseExp (parseExp, canParseExp) where
 
 import Data.Char (isUpper)
+import Data.Either (isRight)
 import GHC.Data.FastString (mkFastString, unpackFS)
 import GHC.Data.StringBuffer (stringToStringBuffer)
 import GHC.Driver.Config.Parser (initParserOpts)
@@ -14,6 +15,7 @@ import GHC.Types.Name.Reader (RdrName (..))
 import GHC.Types.SourceText (IntegralLit (..), rationalFromFractionalLit)
 import GHC.Types.SrcLoc (GenLocated (..), mkRealSrcLoc)
 import Hpgsql.GhcParserOpts (parserDynFlags)
+import Language.Haskell.Syntax.Basic (FieldLabelString (..))
 import qualified Language.Haskell.TH as TH
 
 -- | Parse a Haskell expression string into a Template Haskell Exp.
@@ -26,9 +28,7 @@ parseExp str = do
 -- | Check if a string can be parsed as a Haskell expression.
 -- This only checks parsing validity; it does not convert to TH.
 canParseExp :: String -> Bool
-canParseExp str = case ghcParse str of
-  Right _ -> True
-  Left _ -> False
+canParseExp = isRight . ghcParse
 
 ghcParse :: String -> Either String (HsExpr GhcPs)
 ghcParse str =
@@ -52,7 +52,7 @@ convertExpr (OpApp _ (L _ l) (L _ op) (L _ r)) = do
   Right (TH.UInfixE l' op' r')
 convertExpr (NegApp _ (L _ e) _) = do
   e' <- convertExpr e
-  Right (TH.AppE (TH.VarE (TH.mkName "negate")) e')
+  Right (TH.AppE (TH.VarE 'negate) e')
 convertExpr (HsPar _ (L _ e)) =
   TH.ParensE <$> convertExpr e
 convertExpr (ExplicitList _ es) = TH.ListE <$> traverse (\(L _ e) -> convertExpr e) es
@@ -82,7 +82,12 @@ convertExpr (ExprWithTySig _ (L _ e) sigWcTy) = do
   e' <- convertExpr e
   ty' <- convertSigWcType sigWcTy
   Right (TH.SigE e' ty')
-convertExpr _ = Left "Unsupported Haskell expression form in SQL quasi-quoter"
+convertExpr (HsGetField _ (L _ e) (L _ (DotFieldOcc _ (L _ fld)))) = do
+  e' <- convertExpr e
+  Right (TH.GetFieldE e' (fieldLabelToString fld))
+convertExpr (HsProjection _ flds) =
+  Right (TH.ProjectionE (fmap (\(DotFieldOcc _ (L _ fld)) -> fieldLabelToString fld) flds))
+convertExpr _ = Left "Unsupported Haskell expression form in hpgsql's SQL quasi-quoter"
 
 -- Helper functions
 
@@ -98,9 +103,13 @@ rdrToName _ = TH.mkName "<unknown-name>"
 
 isConName :: TH.Name -> Bool
 isConName n = case TH.nameBase n of
+  -- TODO: No module name check?
   (c : _) -> isUpper c || c == ':'
   _ -> False
 
+fieldLabelToString :: FieldLabelString -> String
+fieldLabelToString (FieldLabelString fs) = unpackFS fs
+
 convertTupArg :: HsTupArg GhcPs -> Either String (Maybe TH.Exp)
 convertTupArg (Present _ (L _ e)) = Just <$> convertExpr e
 convertTupArg (Missing _) = Right Nothing
@@ -111,7 +120,7 @@ convertHsLit (HsString _ fs) = Right (TH.StringL (unpackFS fs))
 convertHsLit (HsInt _ il) = Right (TH.IntegerL (il_value il))
 convertHsLit (HsIntPrim _ i) = Right (TH.IntPrimL i)
 convertHsLit (HsWordPrim _ w) = Right (TH.WordPrimL w)
-convertHsLit (HsFloatPrim _ fl) = Right (TH.FloatPrimL (rationalFromFractionalLit fl))
+convertHsLit (HsFloatPrim _ fl) = Right (TH.FloatPrimL (rationalFromFractionalLit fl)) -- TODO Why rational?
 convertHsLit (HsDoublePrim _ fl) = Right (TH.DoublePrimL (rationalFromFractionalLit fl))
 convertHsLit _ = Left "Unsupported literal type in SQL quasi-quoter"
 

From 76d8afe1d7b4157dbfa348cf1f1c81391be4504a Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Wed, 29 Jul 2026 15:43:47 -0300
Subject: [PATCH 03/18] Another question and an `if` expression

---
 hpgsql-tests/SqlQuasiquoterSpec.hs | 6 +++---
 hpgsql/src/Hpgsql/GhcParseExp.hs   | 2 ++
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/hpgsql-tests/SqlQuasiquoterSpec.hs b/hpgsql-tests/SqlQuasiquoterSpec.hs
index cf78ef8..f7da82b 100644
--- a/hpgsql-tests/SqlQuasiquoterSpec.hs
+++ b/hpgsql-tests/SqlQuasiquoterSpec.hs
@@ -146,7 +146,7 @@ genMkQuery =
 
 data SomeRecord = SomeRecord {field1 :: Int, field2 :: Int}
 
-newtype SomeGenericRecord a = SomeGenericRecord {field1 :: a}
+-- newtype SomeGenericRecord a = SomeGenericRecord {field1 :: a}
 
 -- | Queries built with the sql quasiquoter and #{} interpolation.
 genInterpolatedQuery :: Gen (Query, [(Maybe Oid, BinaryField)])
@@ -155,7 +155,7 @@ genInterpolatedQuery =
     [ pure ([sql|SELECT 1, '#{x}', '^{y}';|], []),
       do
         x <- genInt
-        pure ([sql|SELECT #{x};|], toComparableParams (Only x)),
+        pure ([sql|SELECT #{if True then x else 0};|], toComparableParams (Only x)),
       do
         x <- SomeRecord <$> genInt <*> genInt
         pure ([sql|SELECT #{x.field1}, #{-(x.field2)};|], toComparableParams (x.field1, -(x.field2))),
@@ -163,7 +163,7 @@ genInterpolatedQuery =
         x <- genInt
         y <- genInt
         z <- genInt
-        pure ([sql|SELECT #{x} FROM t WHERE #{y} BETWEEN 0 AND #{(SomeGenericRecord { field1 = z }).field1};|], toComparableParams (x, y, z))
+        pure ([sql|SELECT #{x} FROM t WHERE #{y} BETWEEN 0 AND #{z};|], toComparableParams (x, y, z))
     ]
 
 -- | Queries built with ^{} embedded queries, including reused placeholders.
diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 0b1e347..6bf244d 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -18,6 +18,8 @@ import Hpgsql.GhcParserOpts (parserDynFlags)
 import Language.Haskell.Syntax.Basic (FieldLabelString (..))
 import qualified Language.Haskell.TH as TH
 
+-- TODO: How about source locations/lines? Do we need them?
+
 -- | Parse a Haskell expression string into a Template Haskell Exp.
 -- Drop-in replacement for Language.Haskell.Meta.Parse.parseExp.
 parseExp :: String -> Either String TH.Exp

From 17675d950f0d8e0fa854eec52be237279e2b069d Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Wed, 29 Jul 2026 15:46:33 -0300
Subject: [PATCH 04/18] Tighten version bounds

---
 hpgsql/hpgsql.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/hpgsql/hpgsql.cabal b/hpgsql/hpgsql.cabal
index cd12eef..18db3c8 100644
--- a/hpgsql/hpgsql.cabal
+++ b/hpgsql/hpgsql.cabal
@@ -106,7 +106,7 @@ library
     crypton >= 1.0.0 && < 1.1,
     memory >= 0.18.0 && < 0.19,
     hashable >= 1.5 && < 1.6,
-    ghc-lib-parser,
+    ghc-lib-parser >= 9.6 && < 9.14,
     network >= 3.2 && < 3.3,
     network-uri >= 2.6 && < 2.7,
     safe-exceptions >= 0.1 && < 0.2,

From 50a95999a1518778e5f0c7476b52f7ad357ad1b1 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Wed, 29 Jul 2026 16:47:10 -0300
Subject: [PATCH 05/18] Support GHC 9.8

---
 .hlint.yaml                        |  1 +
 hpgsql/src/Hpgsql/GhcParseExp.hs   | 16 ++++++++++++++--
 hpgsql/src/Hpgsql/QueryInternal.hs |  6 ++++--
 3 files changed, 19 insertions(+), 4 deletions(-)

diff --git a/.hlint.yaml b/.hlint.yaml
index 76dc978..8328b00 100644
--- a/.hlint.yaml
+++ b/.hlint.yaml
@@ -4,6 +4,7 @@
 
 - arguments:
   - "--cpp-define=MIN_VERSION_base(a,b,c)=1"
+  - "--cpp-define=MIN_VERSION_ghc_lib_parser(9,10,0)=1"
   - "-XQuasiQuotes"
   - "-XTemplateHaskell"
   - "-XOverloadedRecordDot"
diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 6bf244d..8fd09ca 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PackageImports #-}
+
 module Hpgsql.GhcParseExp (parseExp, canParseExp) where
 
 import Data.Char (isUpper)
@@ -16,7 +19,7 @@ import GHC.Types.SourceText (IntegralLit (..), rationalFromFractionalLit)
 import GHC.Types.SrcLoc (GenLocated (..), mkRealSrcLoc)
 import Hpgsql.GhcParserOpts (parserDynFlags)
 import Language.Haskell.Syntax.Basic (FieldLabelString (..))
-import qualified Language.Haskell.TH as TH
+import qualified "template-haskell" Language.Haskell.TH as TH
 
 -- TODO: How about source locations/lines? Do we need them?
 
@@ -54,8 +57,13 @@ convertExpr (OpApp _ (L _ l) (L _ op) (L _ r)) = do
   Right (TH.UInfixE l' op' r')
 convertExpr (NegApp _ (L _ e) _) = do
   e' <- convertExpr e
-  Right (TH.AppE (TH.VarE 'negate) e')
+  Right $ TH.AppE (TH.VarE 'negate) e'
+
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
 convertExpr (HsPar _ (L _ e)) =
+#elif MIN_VERSION_ghc_lib_parser(9,8,0)
+convertExpr (HsPar _ _ (L _ e) _) =
+#endif
   TH.ParensE <$> convertExpr e
 convertExpr (ExplicitList _ es) = TH.ListE <$> traverse (\(L _ e) -> convertExpr e) es
 convertExpr (ExplicitTuple _ args boxity) = do
@@ -88,7 +96,11 @@ convertExpr (HsGetField _ (L _ e) (L _ (DotFieldOcc _ (L _ fld)))) = do
   e' <- convertExpr e
   Right (TH.GetFieldE e' (fieldLabelToString fld))
 convertExpr (HsProjection _ flds) =
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
   Right (TH.ProjectionE (fmap (\(DotFieldOcc _ (L _ fld)) -> fieldLabelToString fld) flds))
+#elif MIN_VERSION_ghc_lib_parser(9,8,0)
+  Right (TH.ProjectionE (fmap (\(L _ (DotFieldOcc _ (L _ fld))) -> fieldLabelToString fld) flds))
+#endif
 convertExpr _ = Left "Unsupported Haskell expression form in hpgsql's SQL quasi-quoter"
 
 -- Helper functions
diff --git a/hpgsql/src/Hpgsql/QueryInternal.hs b/hpgsql/src/Hpgsql/QueryInternal.hs
index 016d04f..b811692 100644
--- a/hpgsql/src/Hpgsql/QueryInternal.hs
+++ b/hpgsql/src/Hpgsql/QueryInternal.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PackageImports #-}
+
 module Hpgsql.QueryInternal
   ( Query (..),
     SingleQuery (..),
@@ -19,12 +21,12 @@ import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Hpgsql.Builder (BinaryField)
 import Hpgsql.Encoding (FieldEncoder (..), RowEncoder (..), ToPgField (..), ToPgRow (..))
+import Hpgsql.GhcParseExp (parseExp)
 import Hpgsql.InternalTypes (Query (..), SingleQuery (..), SingleQueryFragment (..), breakQueryIntoStatements, renumberParamsFrom)
 import Hpgsql.ParsingInternal (BlockOrNotBlock (..), ParsingOpts (..), QQExprKind (..), blockText, flattenBlocks, parseSql)
 import Hpgsql.TypeInfo (EncodingContext, Oid)
-import Hpgsql.GhcParseExp (parseExp)
-import Language.Haskell.TH
 import Language.Haskell.TH.Quote
+import "template-haskell" Language.Haskell.TH
 
 -- | A useful representation for our quasiquoter parsing.
 data SqlFragment

From 348810fd9e61c249018edb6e4d8bc25ae927aac7 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Wed, 29 Jul 2026 16:59:16 -0300
Subject: [PATCH 06/18] Keep only partial record in module with disabled
 warning, appease hlint

---
 hpgsql/src/Hpgsql/GhcParseExp.hs   | 36 +++++++++++++++++++++++++-----
 hpgsql/src/Hpgsql/GhcParserOpts.hs | 26 +--------------------
 2 files changed, 31 insertions(+), 31 deletions(-)

diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 8fd09ca..607413a 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -8,7 +8,9 @@ import Data.Either (isRight)
 import GHC.Data.FastString (mkFastString, unpackFS)
 import GHC.Data.StringBuffer (stringToStringBuffer)
 import GHC.Driver.Config.Parser (initParserOpts)
-import GHC.Hs
+import GHC.Driver.Session (DynFlags, defaultDynFlags, xopt_set)
+import GHC.Hs hiding (UnicodeSyntax)
+import GHC.LanguageExtensions (Extension (..))
 import GHC.Parser (parseExpression)
 import GHC.Parser.Lexer (P (..), ParseResult (..), initParserState)
 import GHC.Parser.PostProcess (ECP (..), runPV)
@@ -17,7 +19,7 @@ import GHC.Types.Name.Occurrence (occNameString)
 import GHC.Types.Name.Reader (RdrName (..))
 import GHC.Types.SourceText (IntegralLit (..), rationalFromFractionalLit)
 import GHC.Types.SrcLoc (GenLocated (..), mkRealSrcLoc)
-import Hpgsql.GhcParserOpts (parserDynFlags)
+import Hpgsql.GhcParserOpts (fakeSettings)
 import Language.Haskell.Syntax.Basic (FieldLabelString (..))
 import qualified "template-haskell" Language.Haskell.TH as TH
 
@@ -44,6 +46,28 @@ ghcParse str =
    in case unP parseExprP (initParserState opts buf loc) of
         POk _ (L _ expr) -> Right expr
         PFailed _ -> Left "Failed to parse Haskell expression"
+  where
+    parserDynFlags :: DynFlags
+    parserDynFlags =
+      foldl
+        xopt_set
+        (defaultDynFlags fakeSettings)
+        [ OverloadedStrings,
+          OverloadedRecordDot,
+          TupleSections,
+          LambdaCase,
+          MultiWayIf,
+          PostfixOperators,
+          QuasiQuotes,
+          UnicodeSyntax,
+          MagicHash,
+          ForeignFunctionInterface,
+          TemplateHaskell,
+          RankNTypes,
+          MultiParamTypeClasses,
+          RecursiveDo,
+          TypeApplications
+        ]
 
 -- GHC HsExpr to TH Exp conversion
 
@@ -60,11 +84,10 @@ convertExpr (NegApp _ (L _ e) _) = do
   Right $ TH.AppE (TH.VarE 'negate) e'
 
 #if MIN_VERSION_ghc_lib_parser(9,10,0)
-convertExpr (HsPar _ (L _ e)) =
+convertExpr (HsPar _ (L _ e)) = TH.ParensE <$> convertExpr e
 #elif MIN_VERSION_ghc_lib_parser(9,8,0)
-convertExpr (HsPar _ _ (L _ e) _) =
+convertExpr (HsPar _ _ (L _ e) _) = TH.ParensE <$> convertExpr e
 #endif
-  TH.ParensE <$> convertExpr e
 convertExpr (ExplicitList _ es) = TH.ListE <$> traverse (\(L _ e) -> convertExpr e) es
 convertExpr (ExplicitTuple _ args boxity) = do
   args' <- traverse convertTupArg args
@@ -95,10 +118,11 @@ convertExpr (ExprWithTySig _ (L _ e) sigWcTy) = do
 convertExpr (HsGetField _ (L _ e) (L _ (DotFieldOcc _ (L _ fld)))) = do
   e' <- convertExpr e
   Right (TH.GetFieldE e' (fieldLabelToString fld))
-convertExpr (HsProjection _ flds) =
 #if MIN_VERSION_ghc_lib_parser(9,10,0)
+convertExpr (HsProjection _ flds) =
   Right (TH.ProjectionE (fmap (\(DotFieldOcc _ (L _ fld)) -> fieldLabelToString fld) flds))
 #elif MIN_VERSION_ghc_lib_parser(9,8,0)
+convertExpr (HsProjection _ flds) =
   Right (TH.ProjectionE (fmap (\(L _ (DotFieldOcc _ (L _ fld))) -> fieldLabelToString fld) flds))
 #endif
 convertExpr _ = Left "Unsupported Haskell expression form in hpgsql's SQL quasi-quoter"
diff --git a/hpgsql/src/Hpgsql/GhcParserOpts.hs b/hpgsql/src/Hpgsql/GhcParserOpts.hs
index f37898a..90590e7 100644
--- a/hpgsql/src/Hpgsql/GhcParserOpts.hs
+++ b/hpgsql/src/Hpgsql/GhcParserOpts.hs
@@ -1,9 +1,7 @@
 {-# OPTIONS_GHC -Wno-missing-fields #-}
 
-module Hpgsql.GhcParserOpts (parserDynFlags) where
+module Hpgsql.GhcParserOpts (fakeSettings) where
 
-import GHC.Driver.Session (DynFlags, defaultDynFlags, xopt_set)
-import GHC.LanguageExtensions.Type
 import GHC.Platform (genericPlatform)
 import GHC.Settings
 import GHC.Settings.Config (cProjectVersion)
@@ -21,25 +19,3 @@ fakeSettings =
       sPlatformMisc = PlatformMisc {},
       sToolSettings = ToolSettings {toolSettings_opt_P_fingerprint = fingerprint0}
     }
-
-parserDynFlags :: DynFlags
-parserDynFlags =
-  foldl
-    xopt_set
-    (defaultDynFlags fakeSettings)
-    [ OverloadedStrings,
-      OverloadedRecordDot,
-      TupleSections,
-      LambdaCase,
-      MultiWayIf,
-      PostfixOperators,
-      QuasiQuotes,
-      UnicodeSyntax,
-      MagicHash,
-      ForeignFunctionInterface,
-      TemplateHaskell,
-      RankNTypes,
-      MultiParamTypeClasses,
-      RecursiveDo,
-      TypeApplications
-    ]

From ed16056828541e99935b0890daf9dc4766d13106 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Fri, 31 Jul 2026 17:21:52 -0300
Subject: [PATCH 07/18] Use caller's enabled extensions when parsing

---
 .hlint.yaml                                   |   4 +-
 hpgsql-tests/ParsingSpec.hs                   |   8 +-
 hpgsql/hpgsql.cabal                           |   1 +
 hpgsql/src/Hpgsql/GhcParseExp.hs              |  40 ++--
 .../Hpgsql/LanguageHaskell/FromThExtension.hs | 171 ++++++++++++++++++
 hpgsql/src/Hpgsql/ParsingInternal.hs          |  15 +-
 hpgsql/src/Hpgsql/QueryInternal.hs            |  25 ++-
 7 files changed, 217 insertions(+), 47 deletions(-)
 create mode 100644 hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs

diff --git a/.hlint.yaml b/.hlint.yaml
index 8328b00..cf9b903 100644
--- a/.hlint.yaml
+++ b/.hlint.yaml
@@ -4,7 +4,9 @@
 
 - arguments:
   - "--cpp-define=MIN_VERSION_base(a,b,c)=1"
-  - "--cpp-define=MIN_VERSION_ghc_lib_parser(9,10,0)=1"
+  - "--cpp-define=MIN_VERSION_template_haskell(2,21,0)=1"
+  - "--cpp-define=MIN_VERSION_template_haskell(2,22,0)=1"
+  - "--cpp-define=MIN_VERSION_template_haskell(2,23,0)=0"
   - "-XQuasiQuotes"
   - "-XTemplateHaskell"
   - "-XOverloadedRecordDot"
diff --git a/hpgsql-tests/ParsingSpec.hs b/hpgsql-tests/ParsingSpec.hs
index 05f46d3..2f72d6d 100644
--- a/hpgsql-tests/ParsingSpec.hs
+++ b/hpgsql-tests/ParsingSpec.hs
@@ -299,25 +299,25 @@ spec = do
 
     it "parseSql AcceptQuasiQuoterExpressions preserves quasiquoter expressions with parentheses" $ do
       let input = "SELECT ^{escapeIdentifier (fromQuery name)}, #{someFunc (arg1) arg2}"
-          result = parseSql AcceptQuasiQuoterExpressions input
+          result = parseSql (AcceptQuasiQuoterExpressions []) input
           qqExprs = [(k, t) | QuasiQuoterExpression k t <- result]
       qqExprs `shouldBe` [(QQEmbeddedQuery, "escapeIdentifier (fromQuery name)"), (QQInterpolation, "someFunc (arg1) arg2")]
 
     it "parseSql AcceptQuasiQuoterExpressions handles nested parentheses in expressions" $ do
       let input = "SELECT #{f (g (x))}"
-          result = parseSql AcceptQuasiQuoterExpressions input
+          result = parseSql (AcceptQuasiQuoterExpressions []) input
           qqExprs = [(k, t) | QuasiQuoterExpression k t <- result]
       qqExprs `shouldBe` [(QQInterpolation, "f (g (x))")]
 
     it "parseSql AcceptQuasiQuoterExpressions inside parenthesised SQL expressions" $ do
       let input = "SELECT (#{someFunc (arg)})"
-          result = parseSql AcceptQuasiQuoterExpressions input
+          result = parseSql (AcceptQuasiQuoterExpressions []) input
           qqExprs = [(k, t) | QuasiQuoterExpression k t <- result]
       qqExprs `shouldBe` [(QQInterpolation, "someFunc (arg)")]
 
     it "parseSql AcceptQuasiQuoterExpressions handles } inside Haskell strings" $ do
       let input = "SELECT #{\"abc}\" ++ x}"
-          result = parseSql AcceptQuasiQuoterExpressions input
+          result = parseSql (AcceptQuasiQuoterExpressions []) input
           qqExprs = [(k, t) | QuasiQuoterExpression k t <- result]
       qqExprs `shouldBe` [(QQInterpolation, "\"abc}\" ++ x")]
 
diff --git a/hpgsql/hpgsql.cabal b/hpgsql/hpgsql.cabal
index 18db3c8..3e7a56e 100644
--- a/hpgsql/hpgsql.cabal
+++ b/hpgsql/hpgsql.cabal
@@ -46,6 +46,7 @@ library
       Hpgsql.GhcParseExp
       Hpgsql.GhcParserOpts
       Hpgsql.Internal
+      Hpgsql.LanguageHaskell.FromThExtension
       Hpgsql.Locking
       Hpgsql.Msgs
       Hpgsql.Networking
diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 607413a..aaa9992 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -5,12 +5,13 @@ module Hpgsql.GhcParseExp (parseExp, canParseExp) where
 
 import Data.Char (isUpper)
 import Data.Either (isRight)
+import qualified Data.List as List
+import Data.Maybe (mapMaybe)
 import GHC.Data.FastString (mkFastString, unpackFS)
 import GHC.Data.StringBuffer (stringToStringBuffer)
 import GHC.Driver.Config.Parser (initParserOpts)
 import GHC.Driver.Session (DynFlags, defaultDynFlags, xopt_set)
 import GHC.Hs hiding (UnicodeSyntax)
-import GHC.LanguageExtensions (Extension (..))
 import GHC.Parser (parseExpression)
 import GHC.Parser.Lexer (P (..), ParseResult (..), initParserState)
 import GHC.Parser.PostProcess (ECP (..), runPV)
@@ -20,25 +21,24 @@ import GHC.Types.Name.Reader (RdrName (..))
 import GHC.Types.SourceText (IntegralLit (..), rationalFromFractionalLit)
 import GHC.Types.SrcLoc (GenLocated (..), mkRealSrcLoc)
 import Hpgsql.GhcParserOpts (fakeSettings)
+import Hpgsql.LanguageHaskell.FromThExtension (fromThToGhcLibExtension)
 import Language.Haskell.Syntax.Basic (FieldLabelString (..))
 import qualified "template-haskell" Language.Haskell.TH as TH
 
 -- TODO: How about source locations/lines? Do we need them?
 
 -- | Parse a Haskell expression string into a Template Haskell Exp.
--- Drop-in replacement for Language.Haskell.Meta.Parse.parseExp.
-parseExp :: String -> Either String TH.Exp
-parseExp str = do
-  hsExpr <- ghcParse str
+parseExp :: [TH.Extension] -> String -> Either String TH.Exp
+parseExp callerExtensions str = do
+  hsExpr <- ghcParse callerExtensions str
   convertExpr hsExpr
 
 -- | Check if a string can be parsed as a Haskell expression.
--- This only checks parsing validity; it does not convert to TH.
-canParseExp :: String -> Bool
-canParseExp = isRight . ghcParse
+canParseExp :: [TH.Extension] -> String -> Bool
+canParseExp callerExtensions = isRight . ghcParse callerExtensions
 
-ghcParse :: String -> Either String (HsExpr GhcPs)
-ghcParse str =
+ghcParse :: [TH.Extension] -> String -> Either String (HsExpr GhcPs)
+ghcParse callerExtensions str =
   let buf = stringToStringBuffer str
       loc = mkRealSrcLoc (mkFastString "<hpgsql>") 1 1
       opts = initParserOpts parserDynFlags
@@ -49,26 +49,12 @@ ghcParse str =
   where
     parserDynFlags :: DynFlags
     parserDynFlags =
-      foldl
+      List.foldl'
         xopt_set
         (defaultDynFlags fakeSettings)
-        [ OverloadedStrings,
-          OverloadedRecordDot,
-          TupleSections,
-          LambdaCase,
-          MultiWayIf,
-          PostfixOperators,
-          QuasiQuotes,
-          UnicodeSyntax,
-          MagicHash,
-          ForeignFunctionInterface,
-          TemplateHaskell,
-          RankNTypes,
-          MultiParamTypeClasses,
-          RecursiveDo,
-          TypeApplications
-        ]
+        (mapMaybe fromThToGhcLibExtension callerExtensions)
 
+--
 -- GHC HsExpr to TH Exp conversion
 
 convertExpr :: HsExpr GhcPs -> Either String TH.Exp
diff --git a/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs b/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs
new file mode 100644
index 0000000..981c1d8
--- /dev/null
+++ b/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs
@@ -0,0 +1,171 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PackageImports #-}
+{-# OPTIONS_GHC -Wno-overlapping-patterns #-}
+{- FOURMOLU_DISABLE -}
+module Hpgsql.LanguageHaskell.FromThExtension where
+
+import qualified "template-haskell" Language.Haskell.TH as TH
+import GHC.LanguageExtensions.Type (Extension (..))
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+fromThToGhcLibExtension :: TH.Extension -> Maybe Extension
+fromThToGhcLibExtension = \case
+  TH.AllowAmbiguousTypes -> Just AllowAmbiguousTypes
+  TH.AlternativeLayoutRule -> Just AlternativeLayoutRule
+  TH.AlternativeLayoutRuleTransitional -> Just AlternativeLayoutRuleTransitional
+  TH.ApplicativeDo -> Just ApplicativeDo
+  TH.Arrows -> Just Arrows
+  TH.AutoDeriveTypeable -> Just AutoDeriveTypeable
+  TH.BangPatterns -> Just BangPatterns
+  TH.BinaryLiterals -> Just BinaryLiterals
+  TH.BlockArguments -> Just BlockArguments
+  TH.CApiFFI -> Just CApiFFI
+  TH.CUSKs -> Just CUSKs
+  TH.ConstrainedClassMethods -> Just ConstrainedClassMethods
+  TH.ConstraintKinds -> Just ConstraintKinds
+  TH.Cpp -> Just Cpp
+  TH.DataKinds -> Just DataKinds
+  TH.DatatypeContexts -> Just DatatypeContexts
+  TH.DeepSubsumption -> Just DeepSubsumption
+  TH.DefaultSignatures -> Just DefaultSignatures
+  TH.DeriveAnyClass -> Just DeriveAnyClass
+  TH.DeriveDataTypeable -> Just DeriveDataTypeable
+  TH.DeriveFoldable -> Just DeriveFoldable
+  TH.DeriveFunctor -> Just DeriveFunctor
+  TH.DeriveGeneric -> Just DeriveGeneric
+  TH.DeriveLift -> Just DeriveLift
+  TH.DeriveTraversable -> Just DeriveTraversable
+  TH.DerivingStrategies -> Just DerivingStrategies
+  TH.DerivingVia -> Just DerivingVia
+  TH.DisambiguateRecordFields -> Just DisambiguateRecordFields
+  TH.DoAndIfThenElse -> Just DoAndIfThenElse
+  TH.DuplicateRecordFields -> Just DuplicateRecordFields
+  TH.EmptyCase -> Just EmptyCase
+  TH.EmptyDataDecls -> Just EmptyDataDecls
+  TH.EmptyDataDeriving -> Just EmptyDataDeriving
+  TH.ExistentialQuantification -> Just ExistentialQuantification
+  TH.ExplicitForAll -> Just ExplicitForAll
+  TH.ExplicitNamespaces -> Just ExplicitNamespaces
+  TH.ExtendedDefaultRules -> Just ExtendedDefaultRules
+  TH.FieldSelectors -> Just FieldSelectors
+  TH.FlexibleContexts -> Just FlexibleContexts
+  TH.FlexibleInstances -> Just FlexibleInstances
+  TH.ForeignFunctionInterface -> Just ForeignFunctionInterface
+  TH.FunctionalDependencies -> Just FunctionalDependencies
+  TH.GADTSyntax -> Just GADTSyntax
+  TH.GADTs -> Just GADTs
+  TH.GHCForeignImportPrim -> Just GHCForeignImportPrim
+  TH.GeneralizedNewtypeDeriving -> Just GeneralizedNewtypeDeriving
+  TH.HexFloatLiterals -> Just HexFloatLiterals
+  TH.ImplicitParams -> Just ImplicitParams
+  TH.ImplicitPrelude -> Just ImplicitPrelude
+  TH.ImportQualifiedPost -> Just ImportQualifiedPost
+  TH.ImpredicativeTypes -> Just ImpredicativeTypes
+  TH.IncoherentInstances -> Just IncoherentInstances
+  TH.InstanceSigs -> Just InstanceSigs
+  TH.InterruptibleFFI -> Just InterruptibleFFI
+  TH.JavaScriptFFI -> Just JavaScriptFFI
+  TH.KindSignatures -> Just KindSignatures
+  TH.LambdaCase -> Just LambdaCase
+  TH.LexicalNegation -> Just LexicalNegation
+  TH.LiberalTypeSynonyms -> Just LiberalTypeSynonyms
+  TH.LinearTypes -> Just LinearTypes
+  TH.MagicHash -> Just MagicHash
+  TH.MonadComprehensions -> Just MonadComprehensions
+  TH.MonoLocalBinds -> Just MonoLocalBinds
+  TH.MonomorphismRestriction -> Just MonomorphismRestriction
+  TH.MultiParamTypeClasses -> Just MultiParamTypeClasses
+  TH.MultiWayIf -> Just MultiWayIf
+  TH.NPlusKPatterns -> Just NPlusKPatterns
+  TH.NamedFieldPuns -> Just NamedFieldPuns
+  TH.NamedWildCards -> Just NamedWildCards
+  TH.NegativeLiterals -> Just NegativeLiterals
+  TH.NondecreasingIndentation -> Just NondecreasingIndentation
+  TH.NullaryTypeClasses -> Just NullaryTypeClasses
+  TH.NumDecimals -> Just NumDecimals
+  TH.NumericUnderscores -> Just NumericUnderscores
+  TH.OverlappingInstances -> Just OverlappingInstances
+  TH.OverloadedLabels -> Just OverloadedLabels
+  TH.OverloadedLists -> Just OverloadedLists
+  TH.OverloadedRecordDot -> Just OverloadedRecordDot
+  TH.OverloadedRecordUpdate -> Just OverloadedRecordUpdate
+  TH.OverloadedStrings -> Just OverloadedStrings
+  TH.PackageImports -> Just PackageImports
+  TH.ParallelArrays -> Just ParallelArrays
+  TH.ParallelListComp -> Just ParallelListComp
+  TH.PartialTypeSignatures -> Just PartialTypeSignatures
+  TH.PatternGuards -> Just PatternGuards
+  TH.PatternSynonyms -> Just PatternSynonyms
+  TH.PolyKinds -> Just PolyKinds
+  TH.PostfixOperators -> Just PostfixOperators
+  TH.QualifiedDo -> Just QualifiedDo
+  TH.QuantifiedConstraints -> Just QuantifiedConstraints
+  TH.QuasiQuotes -> Just QuasiQuotes
+  TH.RankNTypes -> Just RankNTypes
+  TH.RebindableSyntax -> Just RebindableSyntax
+  TH.RecordWildCards -> Just RecordWildCards
+  TH.RecursiveDo -> Just RecursiveDo
+  TH.RelaxedLayout -> Just RelaxedLayout
+  TH.RelaxedPolyRec -> Just RelaxedPolyRec
+  TH.RoleAnnotations -> Just RoleAnnotations
+  TH.ScopedTypeVariables -> Just ScopedTypeVariables
+  TH.StandaloneDeriving -> Just StandaloneDeriving
+  TH.StandaloneKindSignatures -> Just StandaloneKindSignatures
+  TH.StarIsType -> Just StarIsType
+  TH.StaticPointers -> Just StaticPointers
+  TH.Strict -> Just Strict
+  TH.StrictData -> Just StrictData
+  TH.TemplateHaskell -> Just TemplateHaskell
+  TH.TemplateHaskellQuotes -> Just TemplateHaskellQuotes
+  TH.TraditionalRecordSyntax -> Just TraditionalRecordSyntax
+  TH.TransformListComp -> Just TransformListComp
+  TH.TupleSections -> Just TupleSections
+  TH.TypeApplications -> Just TypeApplications
+  TH.TypeData -> Just TypeData
+  TH.TypeFamilies -> Just TypeFamilies
+  TH.TypeFamilyDependencies -> Just TypeFamilyDependencies
+  TH.TypeInType -> Just TypeInType
+  TH.TypeOperators -> Just TypeOperators
+  TH.TypeSynonymInstances -> Just TypeSynonymInstances
+  TH.UnboxedSums -> Just UnboxedSums
+  TH.UnboxedTuples -> Just UnboxedTuples
+  TH.UndecidableInstances -> Just UndecidableInstances
+  TH.UndecidableSuperClasses -> Just UndecidableSuperClasses
+  TH.UnicodeSyntax -> Just UnicodeSyntax
+  TH.UnliftedDatatypes -> Just UnliftedDatatypes
+  TH.UnliftedFFITypes -> Just UnliftedFFITypes
+  TH.UnliftedNewtypes -> Just UnliftedNewtypes
+  TH.ViewPatterns -> Just ViewPatterns
+#if MIN_VERSION_template_haskell(2,21,0)
+  TH.ExtendedLiterals -> Just ExtendedLiterals
+  TH.TypeAbstractions -> Just TypeAbstractions
+#endif
+#if MIN_VERSION_template_haskell(2,22,0)
+  TH.ListTuplePuns -> Just ListTuplePuns
+  TH.RequiredTypeArguments -> Just RequiredTypeArguments
+#endif
+#if MIN_VERSION_template_haskell(2,23,0)
+  TH.MultilineStrings -> Just MultilineStrings
+  TH.NamedDefaults -> Just NamedDefaults
+  TH.OrPatterns -> Just OrPatterns
+#endif
+  -- Why a catch-all here after going through all the work of listing
+  -- extensions above? Because of two conflicting goals:
+  -- 1 - Not allocate and parse strings, plus run a Map search during compilation (see algo below)
+  -- 2 - Support users compiling hpgsql with newer GHC versions
+  --
+  -- Goal 1 is arguably excessive over-refinement, and goal 2 is arguably
+  -- pointless since it seems like (from my extremely limited experience)
+  -- template-haskell and ghc-lib-parser will change with new releases
+  -- anyway, but not being the annoying library that fails to compile or run
+  -- with some user trying out a new GHC (after bumping version bounds themselves)
+  -- feels important.
+  -- So we achieve a little bit of both goals like this. This is also the reason
+  -- why we have -Wno-overlapping-patterns in this file.
+  someNewThExtension -> Map.lookup (show someNewThExtension) allGhcLibParserExtensions
+
+allGhcLibParserExtensions :: Map String Extension
+allGhcLibParserExtensions = Map.fromList $ map (\ex -> (show ex, ex)) [minBound..maxBound]
+
+
diff --git a/hpgsql/src/Hpgsql/ParsingInternal.hs b/hpgsql/src/Hpgsql/ParsingInternal.hs
index f38866d..6e47f5d 100644
--- a/hpgsql/src/Hpgsql/ParsingInternal.hs
+++ b/hpgsql/src/Hpgsql/ParsingInternal.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PackageImports #-}
+
 -- |
 --
 -- This module contains parsers that are helpful to separate SQL statements from each other by finding query boundaries: semi-colons, but not when inside a string or a parenthesised expression, for example.
@@ -37,6 +39,7 @@ import qualified Data.List.NonEmpty as NE
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Hpgsql.GhcParseExp (canParseExp)
+import "template-haskell" Language.Haskell.TH (Extension)
 import Prelude hiding (takeWhile)
 
 data BlockOrNotBlock = StaticSql !Text | DollarNumberedArg !Int | QuestionMarkArg | QuasiQuoterExpression !QQExprKind !Text | SemiColon | CommentsOrWhitespace !Text
@@ -45,7 +48,7 @@ data BlockOrNotBlock = StaticSql !Text | DollarNumberedArg !Int | QuestionMarkAr
 data QQExprKind = QQInterpolation | QQEmbeddedQuery
   deriving stock (Eq, Show)
 
-data ParsingOpts = AcceptQuestionMarksAsQueryArgs | AcceptOnlyDollarNumberedArgs | AcceptQuasiQuoterExpressions
+data ParsingOpts = AcceptQuestionMarksAsQueryArgs | AcceptOnlyDollarNumberedArgs | AcceptQuasiQuoterExpressions [Extension]
   deriving stock (Show)
 
 -- | Parses one or more SQL statements (separated by semi-colons).
@@ -106,7 +109,7 @@ blockParser popts =
   -- This seems fragile, but our tests will error out if changes make this unsupported.
   (: [])
     <$> ( case popts of
-            AcceptQuasiQuoterExpressions -> quasiQuoterExpressionParser
+            AcceptQuasiQuoterExpressions callerExtensions -> quasiQuoterExpressionParser callerExtensions
             _ -> fail "No quasiquoter expressions"
         )
     <|> (: []) <$> parseStdConformingString
@@ -148,12 +151,12 @@ isPossibleBlockStartingChar popts c =
     || c
       == '?'
     || ( case popts of
-           AcceptQuasiQuoterExpressions -> c == '#' || c == '^'
+           AcceptQuasiQuoterExpressions _ -> c == '#' || c == '^'
            _ -> False
        )
 
-quasiQuoterExpressionParser :: Parser BlockOrNotBlock
-quasiQuoterExpressionParser = do
+quasiQuoterExpressionParser :: [Extension] -> Parser BlockOrNotBlock
+quasiQuoterExpressionParser callerExtensions = do
   prefix <- string "#{" <|> string "^{"
   let kind = if prefix == "#{" then QQInterpolation else QQEmbeddedQuery
   expr <- findExpressionEnd ""
@@ -165,7 +168,7 @@ quasiQuoterExpressionParser = do
       chunk <- takeWhile (/= '}')
       void $ char '}'
       let candidate = acc <> chunk
-      if canParseExp (Text.unpack candidate)
+      if canParseExp callerExtensions (Text.unpack candidate)
         then pure candidate
         else findExpressionEnd (candidate <> "}")
 
diff --git a/hpgsql/src/Hpgsql/QueryInternal.hs b/hpgsql/src/Hpgsql/QueryInternal.hs
index b811692..a4a6477 100644
--- a/hpgsql/src/Hpgsql/QueryInternal.hs
+++ b/hpgsql/src/Hpgsql/QueryInternal.hs
@@ -26,7 +26,7 @@ import Hpgsql.InternalTypes (Query (..), SingleQuery (..), SingleQueryFragment (
 import Hpgsql.ParsingInternal (BlockOrNotBlock (..), ParsingOpts (..), QQExprKind (..), blockText, flattenBlocks, parseSql)
 import Hpgsql.TypeInfo (EncodingContext, Oid)
 import Language.Haskell.TH.Quote
-import "template-haskell" Language.Haskell.TH
+import "template-haskell" Language.Haskell.TH (Exp (..), Q, extsEnabled, integerL, litE, stringL)
 
 -- | A useful representation for our quasiquoter parsing.
 data SqlFragment
@@ -130,7 +130,9 @@ mkQueryInternal queryTemplate allParams =
 sql :: QuasiQuoter
 sql =
   QuasiQuoter
-    { quoteExp = liftQuery False . parseSql AcceptQuasiQuoterExpressions . Text.pack,
+    { quoteExp = \qqSqlString -> do
+        exts <- extsEnabled
+        liftQuery False $ parseSql (AcceptQuasiQuoterExpressions exts) $ Text.pack qqSqlString,
       quotePat = error "Hpgsql's sql quasiquoter does not implement quotePat",
       quoteType = error "Hpgsql's sql quasiquoter does not implement quoteType",
       quoteDec = error "Hpgsql's sql quasiquoter does not implement quoteDec"
@@ -141,7 +143,9 @@ sql =
 sqlPrep :: QuasiQuoter
 sqlPrep =
   QuasiQuoter
-    { quoteExp = liftQuery True . parseSql AcceptQuasiQuoterExpressions . Text.pack,
+    { quoteExp = \qqSqlString -> do
+        exts <- extsEnabled
+        liftQuery True $ parseSql (AcceptQuasiQuoterExpressions exts) $ Text.pack qqSqlString,
       quotePat = error "Hpgsql's sql quasiquoter does not implement quotePat",
       quoteType = error "Hpgsql's sql quasiquoter does not implement quoteType",
       quoteDec = error "Hpgsql's sql quasiquoter does not implement quoteDec"
@@ -176,16 +180,18 @@ liftQueryDynamic isPrepared allFragments = do
 fragmentToPartExp :: SqlFragment -> Q Exp
 fragmentToPartExp (NonInterpolatedSqlFragment t) =
   [|StaticSqlPart $(litE (stringL (Text.unpack t)))|]
-fragmentToPartExp (InterpolatedHaskellExpr haskellExpr) =
-  case parseExp (Text.unpack haskellExpr) of
+fragmentToPartExp (InterpolatedHaskellExpr haskellExpr) = do
+  exts <- extsEnabled
+  case parseExp exts (Text.unpack haskellExpr) of
     Left err -> error $ "Could not parse Haskell expression '" ++ Text.unpack haskellExpr ++ "': " ++ err
     Right expr -> [|ParamPart (encodeParam $(pure expr))|]
 fragmentToPartExp SemiColonFragment =
   [|SemiColonPart|]
 fragmentToPartExp (WhitespaceOrCommentsFragment t) =
   [|WhitespaceOrCommenstPart $(litE (stringL (Text.unpack t)))|]
-fragmentToPartExp (EmbeddedQueryExpr haskellExpr) =
-  case parseExp (Text.unpack haskellExpr) of
+fragmentToPartExp (EmbeddedQueryExpr haskellExpr) = do
+  exts <- extsEnabled
+  case parseExp exts (Text.unpack haskellExpr) of
     Left err -> error $ "Could not parse Haskell expression '" ++ Text.unpack haskellExpr ++ "': " ++ err
     Right expr -> [|EmbeddedQueryPart $(pure expr)|]
 
@@ -251,8 +257,9 @@ parseBlockQuasiQuoter (QuasiQuoterExpression QQEmbeddedQuery expr) = [EmbeddedQu
 
 -- | Generate a parameter expression for a captured variable
 generateParamExp :: Text -> Q Exp
-generateParamExp (Text.unpack -> haskellExpr) =
-  case parseExp haskellExpr of
+generateParamExp (Text.unpack -> haskellExpr) = do
+  exts <- extsEnabled
+  case parseExp exts haskellExpr of
     Left err -> error $ "Could not parse Haskell expression '" ++ haskellExpr ++ "': " ++ err
     Right expr ->
       [|encodeParam $(pure expr)|]

From ac17368fbed29fc3095a5767efc75324e87404ba Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sat, 1 Aug 2026 09:45:34 -0300
Subject: [PATCH 08/18] Support at least one form of TypeApplications in
 quasiquoters

---
 hpgsql-tests/SqlQuasiquoterSpec.hs | 8 +++++++-
 hpgsql/src/Hpgsql/GhcParseExp.hs   | 2 ++
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/hpgsql-tests/SqlQuasiquoterSpec.hs b/hpgsql-tests/SqlQuasiquoterSpec.hs
index f7da82b..ce73eb5 100644
--- a/hpgsql-tests/SqlQuasiquoterSpec.hs
+++ b/hpgsql-tests/SqlQuasiquoterSpec.hs
@@ -6,6 +6,7 @@ import qualified Data.ByteString.Lazy as LBS
 import Data.Char (isDigit)
 import qualified Data.List as List
 import qualified Data.List.NonEmpty as NE
+import Data.Proxy (Proxy (..))
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
@@ -148,14 +149,19 @@ data SomeRecord = SomeRecord {field1 :: Int, field2 :: Int}
 
 -- newtype SomeGenericRecord a = SomeGenericRecord {field1 :: a}
 
+-- | This exists to test TypeApplications inside quasiquoters.
+polyFunc42 :: Proxy a -> Int
+polyFunc42 _ = 42
+
 -- | Queries built with the sql quasiquoter and #{} interpolation.
+-- These test a variety of GHC extensions inside quasiquoters.
 genInterpolatedQuery :: Gen (Query, [(Maybe Oid, BinaryField)])
 genInterpolatedQuery =
   Gen.choice
     [ pure ([sql|SELECT 1, '#{x}', '^{y}';|], []),
       do
         x <- genInt
-        pure ([sql|SELECT #{if True then x else 0};|], toComparableParams (Only x)),
+        pure ([sql|SELECT #{if True then x else 0}, #{polyFunc42 (Proxy @String)};|], toComparableParams (x, polyFunc42 (Proxy @String))),
       do
         x <- SomeRecord <$> genInt <*> genInt
         pure ([sql|SELECT #{x.field1}, #{-(x.field2)};|], toComparableParams (x.field1, -(x.field2))),
diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index aaa9992..1d8fee7 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -111,6 +111,8 @@ convertExpr (HsProjection _ flds) =
 convertExpr (HsProjection _ flds) =
   Right (TH.ProjectionE (fmap (\(L _ (DotFieldOcc _ (L _ fld))) -> fieldLabelToString fld) flds))
 #endif
+convertExpr (HsAppType _ (L _ e) (HsWC _ (L _ ty))) = TH.AppTypeE <$> convertExpr e <*> convertType ty
+-- convertExpr (HsAppType _ _ _) = Left "TypeApplications are still unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
 convertExpr _ = Left "Unsupported Haskell expression form in hpgsql's SQL quasi-quoter"
 
 -- Helper functions

From 97c4516de216a13bc4259c50d1093790eca2b663 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sat, 1 Aug 2026 10:07:30 -0300
Subject: [PATCH 09/18] Support TypeApplications

---
 hpgsql/src/Hpgsql/GhcParseExp.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 1d8fee7..7e23761 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -111,7 +111,11 @@ convertExpr (HsProjection _ flds) =
 convertExpr (HsProjection _ flds) =
   Right (TH.ProjectionE (fmap (\(L _ (DotFieldOcc _ (L _ fld))) -> fieldLabelToString fld) flds))
 #endif
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
 convertExpr (HsAppType _ (L _ e) (HsWC _ (L _ ty))) = TH.AppTypeE <$> convertExpr e <*> convertType ty
+#else
+convertExpr (HsAppType _ (L _ e) _ (HsWC _ (L _ ty))) = TH.AppTypeE <$> convertExpr e <*> convertType ty
+#endif
 -- convertExpr (HsAppType _ _ _) = Left "TypeApplications are still unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
 convertExpr _ = Left "Unsupported Haskell expression form in hpgsql's SQL quasi-quoter"
 

From 8b7a34202dc56e5d18df03fa192097291b555baa Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sat, 1 Aug 2026 16:33:07 -0300
Subject: [PATCH 10/18] Support record constructors in quasiquotes

---
 hpgsql-tests/SqlQuasiquoterSpec.hs | 28 +++++++++++++++++++++++-----
 hpgsql/src/Hpgsql/GhcParseExp.hs   | 14 ++++++++++++++
 2 files changed, 37 insertions(+), 5 deletions(-)

diff --git a/hpgsql-tests/SqlQuasiquoterSpec.hs b/hpgsql-tests/SqlQuasiquoterSpec.hs
index ce73eb5..c0efc2f 100644
--- a/hpgsql-tests/SqlQuasiquoterSpec.hs
+++ b/hpgsql-tests/SqlQuasiquoterSpec.hs
@@ -4,17 +4,20 @@ import Control.Monad (forM_)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as LBS
 import Data.Char (isDigit)
+import Data.Functor.Contravariant (contramap)
+import Data.Int (Int32)
 import qualified Data.List as List
 import qualified Data.List.NonEmpty as NE
 import Data.Proxy (Proxy (..))
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import GHC.Generics (Generic)
 import Hedgehog (Gen, PropertyT, annotateShow, forAll, (===))
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 import Hpgsql.Builder (BinaryField (..))
-import Hpgsql.Encoding (RowEncoder (..), ToPgRow (..))
+import Hpgsql.Encoding (FromPgField, LowerCasedPgEnum (..), RowEncoder (..), ToPgField (..), ToPgRow (..), compositeTypeEncoder, typeFieldEncoder, typeOidWithName)
 import Hpgsql.InternalTypes (Query (..), SingleQuery (..))
 import Hpgsql.ParsingInternal (ParsingOpts (..), parseSql)
 import Hpgsql.Query (breakQueryIntoStatements, mkQuery, sql)
@@ -147,14 +150,26 @@ genMkQuery =
 
 data SomeRecord = SomeRecord {field1 :: Int, field2 :: Int}
 
--- newtype SomeGenericRecord a = SomeGenericRecord {field1 :: a}
+data SomeGenericEnum = EVal1 | EVal2 | EVal3
+  deriving stock (Bounded, Enum, Eq, Generic, Show)
+  deriving (ToPgField) via (LowerCasedPgEnum SomeGenericEnum)
+
+data IntAndBool = IntAndBool {ibInt :: Int, ibBool :: Bool}
+  deriving stock (Eq, Show)
+
+instance ToPgField IntAndBool where
+  fieldEncoder =
+    typeFieldEncoder (typeOidWithName "int_and_bool") $
+      compositeTypeEncoder $
+        contramap (\(IntAndBool i b) -> (fromIntegral i :: Int32, b)) rowEncoder
 
 -- | This exists to test TypeApplications inside quasiquoters.
 polyFunc42 :: Proxy a -> Int
 polyFunc42 _ = 42
 
 -- | Queries built with the sql quasiquoter and #{} interpolation.
--- These test a variety of GHC extensions inside quasiquoters.
+-- These test a variety of GHC extensions and language syntax/features
+-- inside quasiquoters.
 genInterpolatedQuery :: Gen (Query, [(Maybe Oid, BinaryField)])
 genInterpolatedQuery =
   Gen.choice
@@ -164,12 +179,15 @@ genInterpolatedQuery =
         pure ([sql|SELECT #{if True then x else 0}, #{polyFunc42 (Proxy @String)};|], toComparableParams (x, polyFunc42 (Proxy @String))),
       do
         x <- SomeRecord <$> genInt <*> genInt
-        pure ([sql|SELECT #{x.field1}, #{-(x.field2)};|], toComparableParams (x.field1, -(x.field2))),
+        y <- genInt
+        z <- Gen.bool
+        pure ([sql|SELECT #{x.field1}, #{-(x.field2)}, #{IntAndBool { ibInt = y, {- Some comment -} ibBool = z }};|], toComparableParams (x.field1, -(x.field2), IntAndBool y z)),
       do
         x <- genInt
         y <- genInt
         z <- genInt
-        pure ([sql|SELECT #{x} FROM t WHERE #{y} BETWEEN 0 AND #{z};|], toComparableParams (x, y, z))
+        e :: SomeGenericEnum <- Gen.enum minBound maxBound
+        pure ([sql|SELECT #{x}, #{e} FROM t WHERE #{y} BETWEEN 0 AND #{z};|], toComparableParams (x, e, y, z))
     ]
 
 -- | Queries built with ^{} embedded queries, including reused placeholders.
diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 7e23761..7151332 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -116,6 +116,15 @@ convertExpr (HsAppType _ (L _ e) (HsWC _ (L _ ty))) = TH.AppTypeE <$> convertExp
 #else
 convertExpr (HsAppType _ (L _ e) _ (HsWC _ (L _ ty))) = TH.AppTypeE <$> convertExpr e <*> convertType ty
 #endif
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
+convertExpr (RecordCon _ (L _ conName) (HsRecFields _ flds _)) = do
+  flds' <- traverse convertRecField flds
+  Right $ TH.RecConE (rdrToName conName) flds'
+#elif MIN_VERSION_ghc_lib_parser(9,8,0)
+convertExpr (RecordCon _ (L _ conName) (HsRecFields flds _)) = do
+  flds' <- traverse convertRecField flds
+  Right $ TH.RecConE (rdrToName conName) flds'
+#endif
 -- convertExpr (HsAppType _ _ _) = Left "TypeApplications are still unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
 convertExpr _ = Left "Unsupported Haskell expression form in hpgsql's SQL quasi-quoter"
 
@@ -140,6 +149,11 @@ isConName n = case TH.nameBase n of
 fieldLabelToString :: FieldLabelString -> String
 fieldLabelToString (FieldLabelString fs) = unpackFS fs
 
+convertRecField :: LHsRecField GhcPs (LHsExpr GhcPs) -> Either String (TH.Name, TH.Exp)
+convertRecField (L _ (HsFieldBind _ (L _ (FieldOcc _ (L _ rdr))) (L _ expr) _)) = do
+  expr' <- convertExpr expr
+  Right (rdrToName rdr, expr')
+
 convertTupArg :: HsTupArg GhcPs -> Either String (Maybe TH.Exp)
 convertTupArg (Present _ (L _ e)) = Just <$> convertExpr e
 convertTupArg (Missing _) = Right Nothing

From aa7e86f44d320691e80ff745ed654cb42e6c2a7b Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sat, 1 Aug 2026 17:11:49 -0300
Subject: [PATCH 11/18] Support `case` expressions

---
 hpgsql-tests/SqlQuasiquoterSpec.hs |  18 ++++-
 hpgsql/src/Hpgsql/GhcParseExp.hs   | 107 ++++++++++++++++++++++++++++-
 2 files changed, 122 insertions(+), 3 deletions(-)

diff --git a/hpgsql-tests/SqlQuasiquoterSpec.hs b/hpgsql-tests/SqlQuasiquoterSpec.hs
index c0efc2f..40dc412 100644
--- a/hpgsql-tests/SqlQuasiquoterSpec.hs
+++ b/hpgsql-tests/SqlQuasiquoterSpec.hs
@@ -187,7 +187,23 @@ genInterpolatedQuery =
         y <- genInt
         z <- genInt
         e :: SomeGenericEnum <- Gen.enum minBound maxBound
-        pure ([sql|SELECT #{x}, #{e} FROM t WHERE #{y} BETWEEN 0 AND #{z};|], toComparableParams (x, e, y, z))
+        pure ([sql|SELECT #{x}, #{e} FROM t WHERE #{y} BETWEEN 0 AND #{z};|], toComparableParams (x, e, y, z)),
+      do
+        x <- genInt
+        b <- Gen.bool
+        pure
+          ( [sql|SELECT #{fst <$> Just (b, False)}, #{case compare x 0 of
+                                                      EQ -> "abc"::Text
+                                                      GT -> "cde"
+                                                      LT -> "xyz"};|],
+            toComparableParams
+              ( b,
+                case compare x 0 of
+                  EQ -> "abc" :: Text
+                  GT -> "cde"
+                  LT -> "xyz"
+              )
+          )
     ]
 
 -- | Queries built with ^{} embedded queries, including reused placeholders.
diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 7151332..42c78ae 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -125,8 +125,111 @@ convertExpr (RecordCon _ (L _ conName) (HsRecFields flds _)) = do
   flds' <- traverse convertRecField flds
   Right $ TH.RecConE (rdrToName conName) flds'
 #endif
--- convertExpr (HsAppType _ _ _) = Left "TypeApplications are still unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr _ = Left "Unsupported Haskell expression form in hpgsql's SQL quasi-quoter"
+convertExpr (HsCase _ (L _ caseExpr) mg) = TH.CaseE <$> convertExpr caseExpr <*> convertMatchGroup mg
+convertExpr (HsQual {}) = Left "HsQual is unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsFunArr {}) = Left "Function types are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsForAll {}) = Left "Forall-types are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsUnboundVar {}) = Left "Unbound variables/holes are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+-- convertExpr (HsRecSel {}) = Left "Record field selectors are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsOverLabel {}) = Left "Overloaded labels are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsIPVar {}) = Left "Implicit parameters are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsLam {}) = Left "Lambda expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (ExplicitSum {}) = Left "Unboxed sums are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsMultiIf {}) = Left "Multi-way if expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsLet {}) = Left "Let expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsDo {}) = Left "Do notation is unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (RecordUpd {}) = Left "Record updates are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (ArithSeq {}) = Left "Arithmetic sequences are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsTypedBracket {}) = Left "Typed Template Haskell brackets are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsUntypedBracket {}) = Left "Untyped Template Haskell brackets are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsTypedSplice {}) = Left "Typed Template Haskell splices are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsUntypedSplice {}) = Left "Untyped Template Haskell splices are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsProc {}) = Left "Arrow proc notation is unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsStatic {}) = Left "Static pointers are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsPragE {}) = Left "Pragma expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertExpr (HsEmbTy {}) = Left "Embedded type expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+
+-- convertExpr (XExpr _) = Left "Unsupported expression form in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+
+convertMatchGroup :: MatchGroup GhcPs (LHsExpr GhcPs) -> Either String [TH.Match]
+convertMatchGroup (MG _ (L _ matches)) = traverse convertMatch matches
+
+convertMatch :: LMatch GhcPs (LHsExpr GhcPs) -> Either String TH.Match
+convertMatch (L _ (Match _ _ (L _ pats) grhss)) = do
+  pats' <- traverse (\(L _ p) -> convertPat p) pats
+  (body, decs) <- convertGRHSs grhss
+  case pats' of
+    [pat] -> Right (TH.Match pat body decs)
+    _ -> Left "Multi-pattern matches are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+
+convertGRHSs :: GRHSs GhcPs (LHsExpr GhcPs) -> Either String (TH.Body, [TH.Dec])
+convertGRHSs (GRHSs _ grhss localBinds) = do
+  decs <- convertLocalBinds localBinds
+  body <- case grhss of
+    [L _ (GRHS _ [] (L _ e))] -> TH.NormalB <$> convertExpr e
+    _ -> Left "Guarded case alternatives are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+  Right (body, decs)
+
+convertLocalBinds :: HsLocalBinds GhcPs -> Either String [TH.Dec]
+convertLocalBinds (EmptyLocalBinds _) = Right []
+convertLocalBinds _ = Left "Where clauses in case expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+
+-- Pattern conversion (GHC Pat to TH Pat)
+
+convertPat :: Pat GhcPs -> Either String TH.Pat
+convertPat (WildPat _) = Right TH.WildP
+convertPat (VarPat _ (L _ rdr)) = Right (TH.VarP (rdrToName rdr))
+convertPat (LitPat _ lit) = TH.LitP <$> convertHsLit lit
+convertPat (NPat _ (L _ ol) _ _) = do
+  e <- convertOverLit ol
+  case e of
+    TH.LitE lit -> Right (TH.LitP lit)
+    _ -> Left "Unsupported overloaded literal pattern in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
+convertPat (ConPat _ (L _ con) details) = convertConPatDetails con details
+#elif MIN_VERSION_ghc_lib_parser(9,8,0)
+convertPat (ConPat _ (L _ con) details) = convertConPatDetails con details
+#endif
+convertPat (TuplePat _ pats boxity) = do
+  pats' <- traverse (\(L _ p) -> convertPat p) pats
+  Right $ case boxity of
+    Boxed -> TH.TupP pats'
+    Unboxed -> TH.UnboxedTupP pats'
+convertPat (ListPat _ pats) = TH.ListP <$> traverse (\(L _ p) -> convertPat p) pats
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
+convertPat (ParPat _ (L _ p)) = TH.ParensP <$> convertPat p
+convertPat (AsPat _ (L _ rdr) (L _ p)) = TH.AsP (rdrToName rdr) <$> convertPat p
+#elif MIN_VERSION_ghc_lib_parser(9,8,0)
+convertPat (ParPat _ _ (L _ p) _) = TH.ParensP <$> convertPat p
+convertPat (AsPat _ (L _ rdr) _ (L _ p)) = TH.AsP (rdrToName rdr) <$> convertPat p
+#endif
+convertPat (BangPat _ (L _ p)) = TH.BangP <$> convertPat p
+convertPat _ = Left "Unsupported pattern form in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+
+convertConPatDetails :: RdrName -> HsConPatDetails GhcPs -> Either String TH.Pat
+convertConPatDetails con (PrefixCon tyArgs args) = do
+  args' <- traverse (\(L _ p) -> convertPat p) args
+  if null tyArgs
+    then Right (TH.ConP (rdrToName con) [] args')
+    else Left "Type applications in constructor patterns are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertConPatDetails con (InfixCon (L _ l) (L _ r)) = do
+  l' <- convertPat l
+  r' <- convertPat r
+  Right (TH.InfixP l' (rdrToName con) r')
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
+convertConPatDetails con (RecCon (HsRecFields _ flds _)) = do
+  flds' <- traverse convertPatRecField flds
+  Right (TH.RecP (rdrToName con) flds')
+#elif MIN_VERSION_ghc_lib_parser(9,8,0)
+convertConPatDetails con (RecCon (HsRecFields flds _)) = do
+  flds' <- traverse convertPatRecField flds
+  Right (TH.RecP (rdrToName con) flds')
+#endif
+
+convertPatRecField :: LHsRecField GhcPs (LPat GhcPs) -> Either String TH.FieldPat
+convertPatRecField (L _ (HsFieldBind _ (L _ (FieldOcc _ (L _ rdr))) (L _ pat) _)) = do
+  pat' <- convertPat pat
+  Right (rdrToName rdr, pat')
 
 -- Helper functions
 

From 2ac5848136463813972676171926befa083f2113 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sat, 1 Aug 2026 17:26:14 -0300
Subject: [PATCH 12/18] No more importing everything from GHC.Hs

---
 hpgsql/src/Hpgsql/GhcParseExp.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 42c78ae..206f408 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -11,7 +11,7 @@ import GHC.Data.FastString (mkFastString, unpackFS)
 import GHC.Data.StringBuffer (stringToStringBuffer)
 import GHC.Driver.Config.Parser (initParserOpts)
 import GHC.Driver.Session (DynFlags, defaultDynFlags, xopt_set)
-import GHC.Hs hiding (UnicodeSyntax)
+import GHC.Hs (GhcPs)
 import GHC.Parser (parseExpression)
 import GHC.Parser.Lexer (P (..), ParseResult (..), initParserState)
 import GHC.Parser.PostProcess (ECP (..), runPV)
@@ -22,7 +22,10 @@ import GHC.Types.SourceText (IntegralLit (..), rationalFromFractionalLit)
 import GHC.Types.SrcLoc (GenLocated (..), mkRealSrcLoc)
 import Hpgsql.GhcParserOpts (fakeSettings)
 import Hpgsql.LanguageHaskell.FromThExtension (fromThToGhcLibExtension)
+import Language.Haskell.Syntax (FieldOcc (..), GRHS (..), GRHSs (..), HsConDetails (..), HsConPatDetails, HsFieldBind (..), HsLit (..), HsLocalBinds, HsLocalBindsLR (..), HsOverLit (..), HsRecFields (..), HsSigType (..), HsTupArg (..), HsType (..), HsWildCardBndrs (..), LHsExpr, LHsRecField, LHsSigWcType, LMatch, LPat, Match (..), MatchGroup (..), OverLitVal (..), Pat (..), PromotionFlag (..))
 import Language.Haskell.Syntax.Basic (FieldLabelString (..))
+import Language.Haskell.Syntax.Expr (DotFieldOcc (..), HsExpr (..))
+import Language.Haskell.Syntax.Module.Name (moduleNameString)
 import qualified "template-haskell" Language.Haskell.TH as TH
 
 -- TODO: How about source locations/lines? Do we need them?

From ea6c01572ea1d46c092a6d66277b3ba9a52f38ca Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sat, 1 Aug 2026 17:39:30 -0300
Subject: [PATCH 13/18] Tidy up error messages

---
 hpgsql/src/Hpgsql/GhcParseExp.hs | 58 +++++++++++++++++++-------------
 1 file changed, 35 insertions(+), 23 deletions(-)

diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 206f408..587c56c 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE PackageImports #-}
+{- FOURMOLU_DISABLE -}
 
 module Hpgsql.GhcParseExp (parseExp, canParseExp) where
 
@@ -129,36 +130,47 @@ convertExpr (RecordCon _ (L _ conName) (HsRecFields flds _)) = do
   Right $ TH.RecConE (rdrToName conName) flds'
 #endif
 convertExpr (HsCase _ (L _ caseExpr) mg) = TH.CaseE <$> convertExpr caseExpr <*> convertMatchGroup mg
-convertExpr (HsQual {}) = Left "HsQual is unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsFunArr {}) = Left "Function types are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsForAll {}) = Left "Forall-types are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsUnboundVar {}) = Left "Unbound variables/holes are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
--- convertExpr (HsRecSel {}) = Left "Record field selectors are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsOverLabel {}) = Left "Overloaded labels are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsIPVar {}) = Left "Implicit parameters are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsLam {}) = Left "Lambda expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (ExplicitSum {}) = Left "Unboxed sums are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsMultiIf {}) = Left "Multi-way if expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsLet {}) = Left "Let expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsDo {}) = Left "Do notation is unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (RecordUpd {}) = Left "Record updates are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (ArithSeq {}) = Left "Arithmetic sequences are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsTypedBracket {}) = Left "Typed Template Haskell brackets are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsUntypedBracket {}) = Left "Untyped Template Haskell brackets are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsTypedSplice {}) = Left "Typed Template Haskell splices are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsUntypedSplice {}) = Left "Untyped Template Haskell splices are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsProc {}) = Left "Arrow proc notation is unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsStatic {}) = Left "Static pointers are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsPragE {}) = Left "Pragma expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
-convertExpr (HsEmbTy {}) = Left "Embedded type expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
 
--- convertExpr (XExpr _) = Left "Unsupported expression form in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+-- Now come our list of unsupported language features
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
+convertExpr (HsEmbTy {}) = unsupportedLanguageFeatureMsg "Embedded type expressions are"
+convertExpr (HsForAll {}) = unsupportedLanguageFeatureMsg "Forall-types are"
+convertExpr (HsFunArr {}) = unsupportedLanguageFeatureMsg "Function types are"
+convertExpr (HsQual {}) = unsupportedLanguageFeatureMsg "HsQual is"
+#else
+convertExpr (HsLamCase {}) = unsupportedLanguageFeatureMsg "Lambda expressions are"
+convertExpr (HsRecSel {}) = unsupportedLanguageFeatureMsg "Record field selectors are"
+#endif
+convertExpr (HsUnboundVar {}) = unsupportedLanguageFeatureMsg "Unbound variables/holes are"
+convertExpr (HsOverLabel {}) = unsupportedLanguageFeatureMsg "Overloaded labels are"
+convertExpr (HsIPVar {}) = unsupportedLanguageFeatureMsg "Implicit parameters are"
+convertExpr (HsLam {}) = unsupportedLanguageFeatureMsg "Lambda expressions are"
+convertExpr (ExplicitSum {}) = unsupportedLanguageFeatureMsg "Unboxed sums are"
+convertExpr (HsMultiIf {}) = unsupportedLanguageFeatureMsg "Multi-way if expressions are"
+convertExpr (HsLet {}) = unsupportedLanguageFeatureMsg "Let expressions are"
+convertExpr (HsDo {}) = unsupportedLanguageFeatureMsg "Do notation is"
+convertExpr (RecordUpd {}) = unsupportedLanguageFeatureMsg "Record updates are"
+convertExpr (ArithSeq {}) = unsupportedLanguageFeatureMsg "Arithmetic sequences are"
+convertExpr (HsTypedBracket {}) = unsupportedLanguageFeatureMsg "Typed Template Haskell brackets are"
+convertExpr (HsUntypedBracket {}) = unsupportedLanguageFeatureMsg "Untyped Template Haskell brackets are"
+convertExpr (HsTypedSplice {}) = unsupportedLanguageFeatureMsg "Typed Template Haskell splices are"
+convertExpr (HsUntypedSplice {}) = unsupportedLanguageFeatureMsg "Untyped Template Haskell splices are"
+convertExpr (HsProc {}) = unsupportedLanguageFeatureMsg "Arrow proc notation is"
+convertExpr (HsStatic {}) = unsupportedLanguageFeatureMsg "Static pointers are"
+convertExpr (HsPragE {}) = unsupportedLanguageFeatureMsg "Pragma expressions are"
+
+unsupportedLanguageFeatureMsg :: String -> Either String a
+unsupportedLanguageFeatureMsg feat = Left $ feat ++ " unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
 
 convertMatchGroup :: MatchGroup GhcPs (LHsExpr GhcPs) -> Either String [TH.Match]
 convertMatchGroup (MG _ (L _ matches)) = traverse convertMatch matches
 
 convertMatch :: LMatch GhcPs (LHsExpr GhcPs) -> Either String TH.Match
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
 convertMatch (L _ (Match _ _ (L _ pats) grhss)) = do
+#else
+convertMatch (L _ (Match _ _ pats grhss)) = do
+#endif
   pats' <- traverse (\(L _ p) -> convertPat p) pats
   (body, decs) <- convertGRHSs grhss
   case pats' of

From 8d147184aac260827fa93f6c9ad4f4a23f06aa77 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sun, 2 Aug 2026 09:08:01 -0300
Subject: [PATCH 14/18] Document assumption on `Show` instances

---
 hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs b/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs
index 981c1d8..c3fcf8a 100644
--- a/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs
+++ b/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs
@@ -165,6 +165,8 @@ fromThToGhcLibExtension = \case
   -- why we have -Wno-overlapping-patterns in this file.
   someNewThExtension -> Map.lookup (show someNewThExtension) allGhcLibParserExtensions
 
+-- | This Map is only useful by assuming the `Show` representations of language extensions in both
+-- ghc-lib-parser and template-haskell match. That feels like a reasonable assumption.
 allGhcLibParserExtensions :: Map String Extension
 allGhcLibParserExtensions = Map.fromList $ map (\ex -> (show ex, ex)) [minBound..maxBound]
 

From ef4a04312252abc06fb618fc533ba1acdfa88743 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sun, 2 Aug 2026 09:13:44 -0300
Subject: [PATCH 15/18] Notes on fourmolu and CPP macros

---
 hpgsql/src/Hpgsql/GhcParseExp.hs                     |  2 +-
 hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs | 12 ++++++------
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 587c56c..2c57dd4 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE PackageImports #-}
-{- FOURMOLU_DISABLE -}
+{- FOURMOLU_DISABLE -} -- CPP macros make fourmolu fail
 
 module Hpgsql.GhcParseExp (parseExp, canParseExp) where
 
diff --git a/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs b/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs
index c3fcf8a..ab658c2 100644
--- a/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs
+++ b/hpgsql/src/Hpgsql/LanguageHaskell/FromThExtension.hs
@@ -1,13 +1,13 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE PackageImports #-}
 {-# OPTIONS_GHC -Wno-overlapping-patterns #-}
-{- FOURMOLU_DISABLE -}
+
 module Hpgsql.LanguageHaskell.FromThExtension where
 
-import qualified "template-haskell" Language.Haskell.TH as TH
-import GHC.LanguageExtensions.Type (Extension (..))
 import Data.Map (Map)
 import qualified Data.Map as Map
+import GHC.LanguageExtensions.Type (Extension (..))
+import qualified "template-haskell" Language.Haskell.TH as TH
 
 fromThToGhcLibExtension :: TH.Extension -> Maybe Extension
 fromThToGhcLibExtension = \case
@@ -163,11 +163,11 @@ fromThToGhcLibExtension = \case
   -- feels important.
   -- So we achieve a little bit of both goals like this. This is also the reason
   -- why we have -Wno-overlapping-patterns in this file.
+{- FOURMOLU_DISABLE -}
   someNewThExtension -> Map.lookup (show someNewThExtension) allGhcLibParserExtensions
+{- FOURMOLU_ENABLE -}
 
 -- | This Map is only useful by assuming the `Show` representations of language extensions in both
 -- ghc-lib-parser and template-haskell match. That feels like a reasonable assumption.
 allGhcLibParserExtensions :: Map String Extension
-allGhcLibParserExtensions = Map.fromList $ map (\ex -> (show ex, ex)) [minBound..maxBound]
-
-
+allGhcLibParserExtensions = Map.fromList $ map (\ex -> (show ex, ex)) [minBound .. maxBound]

From bd0472d269c9bf89e580ddacc183a5e322e4b854 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sun, 2 Aug 2026 09:23:39 -0300
Subject: [PATCH 16/18] "____ expressions" in error message

---
 hpgsql/src/Hpgsql/GhcParseExp.hs | 48 ++++++++++++++++----------------
 1 file changed, 24 insertions(+), 24 deletions(-)

diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index 2c57dd4..f192b66 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -133,34 +133,34 @@ convertExpr (HsCase _ (L _ caseExpr) mg) = TH.CaseE <$> convertExpr caseExpr <*>
 
 -- Now come our list of unsupported language features
 #if MIN_VERSION_ghc_lib_parser(9,10,0)
-convertExpr (HsEmbTy {}) = unsupportedLanguageFeatureMsg "Embedded type expressions are"
-convertExpr (HsForAll {}) = unsupportedLanguageFeatureMsg "Forall-types are"
-convertExpr (HsFunArr {}) = unsupportedLanguageFeatureMsg "Function types are"
-convertExpr (HsQual {}) = unsupportedLanguageFeatureMsg "HsQual is"
+convertExpr (HsEmbTy {}) = unsupportedLanguageFeatureMsg "Embedded type"
+convertExpr (HsForAll {}) = unsupportedLanguageFeatureMsg "Forall-types"
+convertExpr (HsFunArr {}) = unsupportedLanguageFeatureMsg "Function types"
+convertExpr (HsQual {}) = unsupportedLanguageFeatureMsg "HsQual"
 #else
-convertExpr (HsLamCase {}) = unsupportedLanguageFeatureMsg "Lambda expressions are"
-convertExpr (HsRecSel {}) = unsupportedLanguageFeatureMsg "Record field selectors are"
+convertExpr (HsLamCase {}) = unsupportedLanguageFeatureMsg "LambdaCase"
+convertExpr (HsRecSel {}) = unsupportedLanguageFeatureMsg "Record field selectors"
 #endif
-convertExpr (HsUnboundVar {}) = unsupportedLanguageFeatureMsg "Unbound variables/holes are"
-convertExpr (HsOverLabel {}) = unsupportedLanguageFeatureMsg "Overloaded labels are"
-convertExpr (HsIPVar {}) = unsupportedLanguageFeatureMsg "Implicit parameters are"
-convertExpr (HsLam {}) = unsupportedLanguageFeatureMsg "Lambda expressions are"
-convertExpr (ExplicitSum {}) = unsupportedLanguageFeatureMsg "Unboxed sums are"
-convertExpr (HsMultiIf {}) = unsupportedLanguageFeatureMsg "Multi-way if expressions are"
-convertExpr (HsLet {}) = unsupportedLanguageFeatureMsg "Let expressions are"
-convertExpr (HsDo {}) = unsupportedLanguageFeatureMsg "Do notation is"
-convertExpr (RecordUpd {}) = unsupportedLanguageFeatureMsg "Record updates are"
-convertExpr (ArithSeq {}) = unsupportedLanguageFeatureMsg "Arithmetic sequences are"
-convertExpr (HsTypedBracket {}) = unsupportedLanguageFeatureMsg "Typed Template Haskell brackets are"
-convertExpr (HsUntypedBracket {}) = unsupportedLanguageFeatureMsg "Untyped Template Haskell brackets are"
-convertExpr (HsTypedSplice {}) = unsupportedLanguageFeatureMsg "Typed Template Haskell splices are"
-convertExpr (HsUntypedSplice {}) = unsupportedLanguageFeatureMsg "Untyped Template Haskell splices are"
-convertExpr (HsProc {}) = unsupportedLanguageFeatureMsg "Arrow proc notation is"
-convertExpr (HsStatic {}) = unsupportedLanguageFeatureMsg "Static pointers are"
-convertExpr (HsPragE {}) = unsupportedLanguageFeatureMsg "Pragma expressions are"
+convertExpr (HsUnboundVar {}) = unsupportedLanguageFeatureMsg "Unbound variables/holes"
+convertExpr (HsOverLabel {}) = unsupportedLanguageFeatureMsg "Overloaded labels"
+convertExpr (HsIPVar {}) = unsupportedLanguageFeatureMsg "Implicit parameters"
+convertExpr (HsLam {}) = unsupportedLanguageFeatureMsg "Lambda"
+convertExpr (ExplicitSum {}) = unsupportedLanguageFeatureMsg "Unboxed sums"
+convertExpr (HsMultiIf {}) = unsupportedLanguageFeatureMsg "Multi-way if"
+convertExpr (HsLet {}) = unsupportedLanguageFeatureMsg "Let"
+convertExpr (HsDo {}) = unsupportedLanguageFeatureMsg "Do notation"
+convertExpr (RecordUpd {}) = unsupportedLanguageFeatureMsg "Record updates"
+convertExpr (ArithSeq {}) = unsupportedLanguageFeatureMsg "Arithmetic sequences"
+convertExpr (HsTypedBracket {}) = unsupportedLanguageFeatureMsg "Typed Template Haskell brackets"
+convertExpr (HsUntypedBracket {}) = unsupportedLanguageFeatureMsg "Untyped Template Haskell brackets"
+convertExpr (HsTypedSplice {}) = unsupportedLanguageFeatureMsg "Typed Template Haskell splices"
+convertExpr (HsUntypedSplice {}) = unsupportedLanguageFeatureMsg "Untyped Template Haskell splices"
+convertExpr (HsProc {}) = unsupportedLanguageFeatureMsg "Arrow proc notation"
+convertExpr (HsStatic {}) = unsupportedLanguageFeatureMsg "Static pointers"
+convertExpr (HsPragE {}) = unsupportedLanguageFeatureMsg "Pragma"
 
 unsupportedLanguageFeatureMsg :: String -> Either String a
-unsupportedLanguageFeatureMsg feat = Left $ feat ++ " unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+unsupportedLanguageFeatureMsg feat = Left $ feat ++ " expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
 
 convertMatchGroup :: MatchGroup GhcPs (LHsExpr GhcPs) -> Either String [TH.Match]
 convertMatchGroup (MG _ (L _ matches)) = traverse convertMatch matches

From f20437acff633caf90dc79ad1c6c724e47705aed Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sun, 2 Aug 2026 09:44:05 -0300
Subject: [PATCH 17/18] Less wildcard pattern matching

---
 hpgsql-tests/SqlQuasiquoterSpec.hs | 19 +++++---
 hpgsql/src/Hpgsql/GhcParseExp.hs   | 73 +++++++++++++++++++++++-------
 2 files changed, 69 insertions(+), 23 deletions(-)

diff --git a/hpgsql-tests/SqlQuasiquoterSpec.hs b/hpgsql-tests/SqlQuasiquoterSpec.hs
index 40dc412..78040bf 100644
--- a/hpgsql-tests/SqlQuasiquoterSpec.hs
+++ b/hpgsql-tests/SqlQuasiquoterSpec.hs
@@ -12,6 +12,7 @@ import Data.Proxy (Proxy (..))
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import qualified Data.Vector as Vector
 import GHC.Generics (Generic)
 import Hedgehog (Gen, PropertyT, annotateShow, forAll, (===))
 import qualified Hedgehog.Gen as Gen
@@ -167,6 +168,9 @@ instance ToPgField IntAndBool where
 polyFunc42 :: Proxy a -> Int
 polyFunc42 _ = 42
 
+infixFunc :: Char -> String -> String
+infixFunc c s = c : s
+
 -- | Queries built with the sql quasiquoter and #{} interpolation.
 -- These test a variety of GHC extensions and language syntax/features
 -- inside quasiquoters.
@@ -176,30 +180,33 @@ genInterpolatedQuery =
     [ pure ([sql|SELECT 1, '#{x}', '^{y}';|], []),
       do
         x <- genInt
-        pure ([sql|SELECT #{if True then x else 0}, #{polyFunc42 (Proxy @String)};|], toComparableParams (x, polyFunc42 (Proxy @String))),
+        y <- genInt
+        c <- genChar
+        pure ([sql|SELECT #{c `infixFunc` "abc"} #{if True then x else 0}, #{polyFunc42 (Proxy @String)}, #{Vector.fromList $ 37 : [45, y]};|], toComparableParams (c `infixFunc` "abc", x, polyFunc42 (Proxy @String), Vector.fromList [37, 45, y])),
       do
         x <- SomeRecord <$> genInt <*> genInt
         y <- genInt
         z <- Gen.bool
-        pure ([sql|SELECT #{x.field1}, #{-(x.field2)}, #{IntAndBool { ibInt = y, {- Some comment -} ibBool = z }};|], toComparableParams (x.field1, -(x.field2), IntAndBool y z)),
+        pure ([sql|SELECT #{x.field1}, #{-(x.field2)}, #{IntAndBool { ibInt = y, {- Some comment -} ibBool = z }}, #{'a'};|], toComparableParams (x.field1, -(x.field2), IntAndBool y z, 'a')),
       do
         x <- genInt
         y <- genInt
         z <- genInt
         e :: SomeGenericEnum <- Gen.enum minBound maxBound
-        pure ([sql|SELECT #{x}, #{e} FROM t WHERE #{y} BETWEEN 0 AND #{z};|], toComparableParams (x, e, y, z)),
+        pure ([sql|SELECT #{x}, #{e} FROM t WHERE #{y} BETWEEN 0 AND #{fromIntegral z + 1.421::Float};|], toComparableParams (x, e, y, fromIntegral z + 1.421 :: Float)),
       do
         x <- genInt
         b <- Gen.bool
         pure
           ( [sql|SELECT #{fst <$> Just (b, False)}, #{case compare x 0 of
-                                                      EQ -> "abc"::Text
+                                                      !EQ -> "abc"::Text
                                                       GT -> "cde"
-                                                      LT -> "xyz"};|],
+                                                      LT -> "xyz"
+                                                      _ -> error "Impossible"};|],
             toComparableParams
               ( b,
                 case compare x 0 of
-                  EQ -> "abc" :: Text
+                  !EQ -> "abc" :: Text
                   GT -> "cde"
                   LT -> "xyz"
               )
diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index f192b66..d2fb93e 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -17,6 +17,7 @@ import GHC.Parser (parseExpression)
 import GHC.Parser.Lexer (P (..), ParseResult (..), initParserState)
 import GHC.Parser.PostProcess (ECP (..), runPV)
 import GHC.Types.Basic (Boxity (..))
+import GHC.Types.Name (nameOccName)
 import GHC.Types.Name.Occurrence (occNameString)
 import GHC.Types.Name.Reader (RdrName (..))
 import GHC.Types.SourceText (IntegralLit (..), rationalFromFractionalLit)
@@ -100,7 +101,7 @@ convertExpr (HsIf _ (L _ c) (L _ t) (L _ f)) = do
   f' <- convertExpr f
   Right (TH.CondE c' t' f')
 convertExpr (HsLit _ lit) = TH.LitE <$> convertHsLit lit
-convertExpr (HsOverLit _ ol) = convertOverLit ol
+convertExpr (HsOverLit _ ol) = TH.LitE <$> convertOverLit ol
 convertExpr (ExprWithTySig _ (L _ e) sigWcTy) = do
   e' <- convertExpr e
   ty' <- convertSigWcType sigWcTy
@@ -175,19 +176,20 @@ convertMatch (L _ (Match _ _ pats grhss)) = do
   (body, decs) <- convertGRHSs grhss
   case pats' of
     [pat] -> Right (TH.Match pat body decs)
-    _ -> Left "Multi-pattern matches are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+    _ -> unsupportedLanguageFeatureMsg "Multi-pattern matches"
 
 convertGRHSs :: GRHSs GhcPs (LHsExpr GhcPs) -> Either String (TH.Body, [TH.Dec])
 convertGRHSs (GRHSs _ grhss localBinds) = do
   decs <- convertLocalBinds localBinds
   body <- case grhss of
     [L _ (GRHS _ [] (L _ e))] -> TH.NormalB <$> convertExpr e
-    _ -> Left "Guarded case alternatives are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+    _ -> unsupportedLanguageFeatureMsg "Guarded case alternative"
   Right (body, decs)
 
 convertLocalBinds :: HsLocalBinds GhcPs -> Either String [TH.Dec]
 convertLocalBinds (EmptyLocalBinds _) = Right []
-convertLocalBinds _ = Left "Where clauses in case expressions are unsupported in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertLocalBinds (HsValBinds {}) = unsupportedLanguageFeatureMsg "HsValBinds"
+convertLocalBinds (HsIPBinds {}) = unsupportedLanguageFeatureMsg "HsIPBinds"
 
 -- Pattern conversion (GHC Pat to TH Pat)
 
@@ -195,11 +197,7 @@ convertPat :: Pat GhcPs -> Either String TH.Pat
 convertPat (WildPat _) = Right TH.WildP
 convertPat (VarPat _ (L _ rdr)) = Right (TH.VarP (rdrToName rdr))
 convertPat (LitPat _ lit) = TH.LitP <$> convertHsLit lit
-convertPat (NPat _ (L _ ol) _ _) = do
-  e <- convertOverLit ol
-  case e of
-    TH.LitE lit -> Right (TH.LitP lit)
-    _ -> Left "Unsupported overloaded literal pattern in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+convertPat (NPat _ (L _ ol) _ _) = TH.LitP <$> convertOverLit ol
 #if MIN_VERSION_ghc_lib_parser(9,10,0)
 convertPat (ConPat _ (L _ con) details) = convertConPatDetails con details
 #elif MIN_VERSION_ghc_lib_parser(9,8,0)
@@ -219,7 +217,18 @@ convertPat (ParPat _ _ (L _ p) _) = TH.ParensP <$> convertPat p
 convertPat (AsPat _ (L _ rdr) _ (L _ p)) = TH.AsP (rdrToName rdr) <$> convertPat p
 #endif
 convertPat (BangPat _ (L _ p)) = TH.BangP <$> convertPat p
-convertPat _ = Left "Unsupported pattern form in hpgsql's SQL quasi-quoter. Please file a bug report at https://github.com/mzabani/hpgsql/issues if you want this."
+-- Unsupported pattern matching expressions
+convertPat (LazyPat{}) = unsupportedLanguageFeatureMsg "LazyPat in pattern matching"
+convertPat (ViewPat{}) = unsupportedLanguageFeatureMsg "ViewPat in pattern matching"
+convertPat (SumPat{}) = unsupportedLanguageFeatureMsg "SumPat in pattern matching"
+convertPat (SplicePat{}) = unsupportedLanguageFeatureMsg "SplicePat in pattern matching"
+convertPat (SigPat{}) = unsupportedLanguageFeatureMsg "SigPat in pattern matching"
+convertPat (NPlusKPat{}) = unsupportedLanguageFeatureMsg "NPlusKPat in pattern matching"
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
+convertPat (EmbTyPat{}) = unsupportedLanguageFeatureMsg "EmbTyPat in pattern matching"
+convertPat (InvisPat{}) = unsupportedLanguageFeatureMsg "InvisPat in pattern matching"
+convertPat (OrPat{}) = unsupportedLanguageFeatureMsg "OrPat in pattern matching"
+#endif
 
 convertConPatDetails :: RdrName -> HsConPatDetails GhcPs -> Either String TH.Pat
 convertConPatDetails con (PrefixCon tyArgs args) = do
@@ -256,7 +265,8 @@ rdrToExp rdr =
 rdrToName :: RdrName -> TH.Name
 rdrToName (Unqual occ) = TH.mkName (occNameString occ)
 rdrToName (Qual modN occ) = TH.mkName (moduleNameString modN ++ "." ++ occNameString occ)
-rdrToName _ = TH.mkName "<unknown-name>"
+rdrToName (Orig _ occ) = TH.mkName (occNameString occ)
+rdrToName (Exact name) = TH.mkName (occNameString (nameOccName name))
 
 isConName :: TH.Name -> Bool
 isConName n = case TH.nameBase n of
@@ -284,13 +294,27 @@ convertHsLit (HsIntPrim _ i) = Right (TH.IntPrimL i)
 convertHsLit (HsWordPrim _ w) = Right (TH.WordPrimL w)
 convertHsLit (HsFloatPrim _ fl) = Right (TH.FloatPrimL (rationalFromFractionalLit fl)) -- TODO Why rational?
 convertHsLit (HsDoublePrim _ fl) = Right (TH.DoublePrimL (rationalFromFractionalLit fl))
-convertHsLit _ = Left "Unsupported literal type in SQL quasi-quoter"
+#if MIN_VERSION_ghc_lib_parser(9,10,0)
+convertHsLit (HsMultilineString _ fs) = Right (TH.StringL (unpackFS fs))
+#endif
+convertHsLit (HsCharPrim {}) = unsupportedLanguageFeatureMsg "HsCharPrim literal"
+convertHsLit (HsStringPrim {}) = unsupportedLanguageFeatureMsg "HsStringPrim literal"
+convertHsLit (HsInt8Prim {}) = unsupportedLanguageFeatureMsg "HsInt8Prim literal"
+convertHsLit (HsInt16Prim {}) = unsupportedLanguageFeatureMsg "HsInt16Prim literal"
+convertHsLit (HsInt32Prim {}) = unsupportedLanguageFeatureMsg "HsInt32Prim literal"
+convertHsLit (HsInt64Prim {}) = unsupportedLanguageFeatureMsg "HsInt64Prim literal"
+convertHsLit (HsWord8Prim {}) = unsupportedLanguageFeatureMsg "HsWord8Prim literal"
+convertHsLit (HsWord16Prim {}) = unsupportedLanguageFeatureMsg "HsWord16Prim literal"
+convertHsLit (HsWord32Prim {}) = unsupportedLanguageFeatureMsg "HsWord32Prim literal"
+convertHsLit (HsWord64Prim {}) = unsupportedLanguageFeatureMsg "HsWord64Prim literal"
+convertHsLit (HsInteger {}) = unsupportedLanguageFeatureMsg "HsInteger literal"
+convertHsLit (HsRat {}) = unsupportedLanguageFeatureMsg "HsRat literal"
 
-convertOverLit :: HsOverLit GhcPs -> Either String TH.Exp
+convertOverLit :: HsOverLit GhcPs -> Either String TH.Lit
 convertOverLit ol = case ol_val ol of
-  HsIntegral il -> Right (TH.LitE (TH.IntegerL (il_value il)))
-  HsFractional fl -> Right (TH.LitE (TH.RationalL (rationalFromFractionalLit fl)))
-  HsIsString _ fs -> Right (TH.LitE (TH.StringL (unpackFS fs)))
+  HsIntegral il -> Right (TH.IntegerL (il_value il))
+  HsFractional fl -> Right (TH.RationalL (rationalFromFractionalLit fl))
+  HsIsString _ fs -> Right (TH.StringL (unpackFS fs))
 
 -- Type conversion (GHC HsType to TH Type)
 
@@ -319,4 +343,19 @@ convertType (HsParTy _ (L _ t)) =
   convertType t
 convertType (HsQualTy _ _ (L _ t)) =
   convertType t
-convertType _ = Left "Unsupported type in SQL quasi-quoter type signature"
+convertType (HsForAllTy{}) = unsupportedLanguageFeatureMsg "HsForAllTy in a type"
+convertType (HsAppKindTy{}) = unsupportedLanguageFeatureMsg "HsAppKindTy in a type"
+convertType (HsOpTy{}) = unsupportedLanguageFeatureMsg "HsOpTy in a type"
+convertType (HsSumTy{}) = unsupportedLanguageFeatureMsg "HsSumTy in a type"
+convertType (HsIParamTy{}) = unsupportedLanguageFeatureMsg "HsIParamTy in a type"
+convertType (HsStarTy{}) = unsupportedLanguageFeatureMsg "HsStarTy in a type"
+convertType (HsKindSig{}) = unsupportedLanguageFeatureMsg "HsKindSig in a type"
+convertType (HsSpliceTy{}) = unsupportedLanguageFeatureMsg "HsSpliceTy in a type"
+convertType (HsDocTy{}) = unsupportedLanguageFeatureMsg "HsDocTy in a type"
+convertType (HsBangTy{}) = unsupportedLanguageFeatureMsg "HsBangTy in a type"
+convertType (HsRecTy{}) = unsupportedLanguageFeatureMsg "HsRecTy in a type"
+convertType (HsExplicitListTy{}) = unsupportedLanguageFeatureMsg "HsExplicitListTy in a type"
+convertType (HsExplicitTupleTy{}) = unsupportedLanguageFeatureMsg "HsExplicitTupleTy in a type"
+convertType (HsTyLit{}) = unsupportedLanguageFeatureMsg "HsTyLit in a type"
+convertType (HsWildCardTy{}) = unsupportedLanguageFeatureMsg "HsWildCardTy in a type"
+convertType (XHsType{}) = unsupportedLanguageFeatureMsg "XHsType in a type"

From e605c923a608d261a1b3f57e9b906e9d36a5c3e6 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sun, 2 Aug 2026 10:14:06 -0300
Subject: [PATCH 18/18] Remove TODO on constructor name

This is just Haskell syntax for data constructors checking the first
character. I understand it now.
---
 hpgsql/src/Hpgsql/GhcParseExp.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/hpgsql/src/Hpgsql/GhcParseExp.hs b/hpgsql/src/Hpgsql/GhcParseExp.hs
index d2fb93e..7b61155 100644
--- a/hpgsql/src/Hpgsql/GhcParseExp.hs
+++ b/hpgsql/src/Hpgsql/GhcParseExp.hs
@@ -260,7 +260,7 @@ convertPatRecField (L _ (HsFieldBind _ (L _ (FieldOcc _ (L _ rdr))) (L _ pat) _)
 rdrToExp :: RdrName -> TH.Exp
 rdrToExp rdr =
   let name = rdrToName rdr
-   in if isConName name then TH.ConE name else TH.VarE name
+   in if isConstructorName name then TH.ConE name else TH.VarE name
 
 rdrToName :: RdrName -> TH.Name
 rdrToName (Unqual occ) = TH.mkName (occNameString occ)
@@ -268,9 +268,8 @@ rdrToName (Qual modN occ) = TH.mkName (moduleNameString modN ++ "." ++ occNameSt
 rdrToName (Orig _ occ) = TH.mkName (occNameString occ)
 rdrToName (Exact name) = TH.mkName (occNameString (nameOccName name))
 
-isConName :: TH.Name -> Bool
-isConName n = case TH.nameBase n of
-  -- TODO: No module name check?
+isConstructorName :: TH.Name -> Bool
+isConstructorName n = case TH.nameBase n of
   (c : _) -> isUpper c || c == ':'
   _ -> False
 
@@ -327,7 +326,7 @@ convertType (HsTyVar _ promo (L _ rdr)) =
    in Right $ case promo of
         IsPromoted -> TH.PromotedT name
         NotPromoted
-          | isConName name -> TH.ConT name
+          | isConstructorName name -> TH.ConT name
           | otherwise -> TH.VarT name
 convertType (HsAppTy _ (L _ t1) (L _ t2)) =
   TH.AppT <$> convertType t1 <*> convertType t2