From 40ab728d61408eba25bfc7519a122e9051e19bb5 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 28 Jul 2026 13:00:38 -0300
Subject: [PATCH 1/6] 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 9d0343f..0bdaca8 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 28f1a09e3573ca65bdbf7e58eb47896611d5aae9 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 28 Jul 2026 16:58:18 -0300
Subject: [PATCH 2/6] 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 ae350954670b91ace9bb454be75d712eb73f442b Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Wed, 29 Jul 2026 15:43:47 -0300
Subject: [PATCH 3/6] 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 42ea3fe11b349139501b49376fae536d8f0a1102 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Wed, 29 Jul 2026 15:46:33 -0300
Subject: [PATCH 4/6] 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 0bdaca8..88bc79f 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 0269fa1e0bfc431d94dd5ff267fa413a7c838ba1 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Wed, 29 Jul 2026 16:47:10 -0300
Subject: [PATCH 5/6] 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 2b45ccc81823aeb738035749b744f952b827731d Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Wed, 29 Jul 2026 16:59:16 -0300
Subject: [PATCH 6/6] 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
-    ]