squeal-postgresql-qq (empty) → 0.1.0.0

raw patch · 11 files changed

+4059/−0 lines, 11 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, generics-sop, hspec, postgresql-syntax, squeal-postgresql, squeal-postgresql-qq, template-haskell, text, time, uuid

Files

• LICENSE +19/−0
• README.md +90/−0
• squeal-postgresql-qq.cabal +63/−0
• src/Squeal/QuasiQuotes.hs +215/−0
• src/Squeal/QuasiQuotes/Common.hs +986/−0
• src/Squeal/QuasiQuotes/Delete.hs +98/−0
• src/Squeal/QuasiQuotes/Insert.hs +209/−0
• src/Squeal/QuasiQuotes/Query.hs +568/−0
• src/Squeal/QuasiQuotes/RowType.hs +150/−0
• src/Squeal/QuasiQuotes/Update.hs +131/−0
• test/test.hs +1530/−0

@@ -0,0 +1,19 @@+Copyright 2022 Rick Owens++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the "Software"),+to deal in the Software without restriction, including without limitation+the rights to use, copy, modify, merge, publish, distribute, sublicense,+and/or sell copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,90 @@+# squeal-postgresql-qq++This library provides a Template Haskell quasiquoter+parsing SQL as the quoted language and producing corresponding+[`squeal-postgresql`](https://hackage.haskell.org/package/squeal-postgresql)+expressing. The goal is to provide an easier way to use the+[`squeal-postgresql`](https://hackage.haskell.org/package/squeal-postgresql)+library, by eliminating (or at least reducing) the need for the user to+learn the squeal "DSL" and allowing her to write regular SQL instead.++## Stability++I would give this package a 5 out of 10 for stability where 0 is+completely unstable and experimental and 10 is maybe like the `aeson`+package.++I think I've got a very large and usable segment of SQL supported but+of course there are unsupported features that are kind of important such+as common table expressions.++I don't foresee backwards incompatable changes being a problem because,+after all, the "interface" is mostly the SQL language, which is+stable. Most work will be about supporting new corners of SQL.++In terms of maintenance, I intend to be responsive to any bugs and to keep+up to date with the latest dependencies and GHC versions. In other words,+this is a maintained package, even if I experience a lull in adding new+supported SQL features.++## Production usage++I would feel relatively comfortable using this in production. The+risk regarding stability/maintenance is pretty low.++If you have queries that are supported, great! They'll continue to be+supported. If you have a query that is not supported, you can always+fall back to crafting squeal expressions manually. (File an issue! I'll+prioritize real-world usage.)++If you have a supported SQL statement that you find you have to+modify in a way that makes it unsupported, you can always tell GHC to+`-ddump-splices` and use the quasi-quoter generated squeal as a starting+point for your modifications.++## How to use this library.++See the haddocks.++## Most important features not currently implemented++* Prepared statement parameters+    * See the haddock documentation for how to get haskell values into+      your sql statements.+* `WITH` clauses (Common Table Expressions)+* `ON CONFLICT` clause++## Other features is not currently implemented++(Generated by an LLM. Maybe not complete.)++* `TABLESAMPLE` clause+* `ONLY` keyword for table inheritance+* `WINDOW` clause and window functions (`OVER`)+* `INTO` clause (`SELECT ... INTO ...`)+* `LIKE` with `ESCAPE`+* `IN` with a subquery+* `OPERATOR()` syntax+* Parameter indirection (e.g., `$1[i]`)+* Indirection on parenthesized expressions (e.g., `(expr)[i]`)+* Aggregate `FILTER` clause+* `WITHIN GROUP` clause+* `DISTINCT` in function arguments+* `ORDER BY` in function arguments+* Function name indirection (e.g., `schema.func`)+* `SETOF` type modifier+* `BIT` and `BIT VARYING` types+* `INTERVAL` with qualifiers+* Types with precision/scale (`TIMESTAMP`, `TIME`, `FLOAT`, `NUMERIC`, etc.)+* Qualified type names (e.g., `schema.my_type`)+* `CURRENT_TIMESTAMP` with precision+* Multidimensional arrays with explicit bounds+* `ORDER BY USING`+* `FOR READ ONLY` locking clause+* Advanced `GROUP BY` features (`GROUPING SETS`, `CUBE`, `ROLLUP`)+* Multi-row `VALUES` clause+* `OVERRIDING` clause for identity columns+* Column indirection in `INSERT` target lists+* `WHERE CURRENT OF` for cursors+* Complex relation expressions in `UPDATE` or `DELETE` targets+* Column indirection in `UPDATE SET` clauses

@@ -0,0 +1,63 @@+cabal-version:       3.0+name:                squeal-postgresql-qq+version:             0.1.0.0+synopsis:            QuasiQuoter transforming raw sql into Squeal expressions.+-- description:         +homepage:            https://github.com/owensmurray/squeal-postgresql-qq+license:             MIT+license-file:        LICENSE+author:              Rick Owens+maintainer:          rick@owensmurray.com+copyright:           2022 Rick Owens+-- category:            +build-type:          Simple+extra-source-files:+  README.md+  LICENSE++common dependencies+  build-depends:+    , aeson             >= 2.1.2.1  && < 2.3+    , base              >= 4.18.3.0 && < 4.22+    , bytestring        >= 0.11.3.0 && < 0.13+    , generics-sop      >= 0.5.1.3  && < 0.6+    , postgresql-syntax >= 0.4      && < 0.5+    , squeal-postgresql >= 0.9.1.3  && < 0.10+    , template-haskell  >= 2.20.0.0 && < 2.24+    , text              >= 1.2.5.0  && < 2.2+    , time              >= 1.9.3    && < 1.15+    , uuid              >= 1.3.15   && < 1.4++common warnings+  ghc-options:+    -Wmissing-deriving-strategies+    -Wmissing-export-lists+    -Wmissing-import-lists+    -Wredundant-constraints+    -Wall++library+  import: dependencies, warnings+  exposed-modules:     +    Squeal.QuasiQuotes+  other-modules:+    Squeal.QuasiQuotes.Common+    Squeal.QuasiQuotes.Delete+    Squeal.QuasiQuotes.Insert+    Squeal.QuasiQuotes.Query+    Squeal.QuasiQuotes.RowType+    Squeal.QuasiQuotes.Update+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite test+  import: dependencies, warnings+  main-is: test.hs+  other-modules:+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  default-language: Haskell2010+  build-depends:+    squeal-postgresql-qq+    , hspec >= 2.11.7 && < 2.12+

@@ -0,0 +1,215 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskellQuotes #-}++{- |+  Description: quasiquoter understanding SQL and producing [squeal-postgresql](https://hackage.haskell.org/package/squeal-postgresql) expressions.+-}+module Squeal.QuasiQuotes (+  -- * The quasi-quoter+  ssql,+  Field (..),++  -- * Discussion about monomorphized 'Statements'++  --+  -- $discussion+) where++import Language.Haskell.TH.Quote+  ( QuasiQuoter(QuasiQuoter, quoteDec, quoteExp, quotePat, quoteType)+  )+import Language.Haskell.TH.Syntax (Exp(AppE, VarE), Q, runIO)+import Prelude+  ( Applicative(pure), Either(Left, Right), MonadFail(fail), Semigroup((<>))+  , Show(show), ($), (.), String, error, print+  )+import Squeal.QuasiQuotes.Delete (toSquealDelete)+import Squeal.QuasiQuotes.Insert (toSquealInsert)+import Squeal.QuasiQuotes.Query (toSquealQuery)+import Squeal.QuasiQuotes.RowType+  ( Field(Field, unField), monoManipulation, monoQuery+  )+import Squeal.QuasiQuotes.Update (toSquealUpdate)+import qualified Data.Text as Text+import qualified PostgresqlSyntax.Ast as PGT_AST+import qualified PostgresqlSyntax.Parsing as PGT_Parse+++{- |+  Splice in a squeal expression with the following type:++  > Statement db () <Canonical-Haskell-Row-Type>++  @\<Canonical-Haskell-Row-Type\>@ is going to be some concrete tuple of the+  form:++  > (Field name1 type1,+  > (Field name2 type2,+  > (Field name3 type3,+  > <continue nesting>,+  > ()))...)++  where the "name\<N\>" are phantom types of kind `Symbol`, which provide+  the name of the corresponding column, and types "type\<N\>" are whatever+  appropriate haskell type represents the postgres column type.++  See the [discussion](#discussion) section for why we monomorphize the+  squeal 'Statement' in this way.++  = Haskell values++  The way you get Haskell values into your sql statements is with special bulit-in sql functions:++  * @inline(\<ident\>)@: Corresponds to 'Squeal.PostgreSQL.Expression.Inline.inline' (value being inlined must not be null)+  * @inline_param(\<ident\>)@: Corresponds to 'Squeal.PostgreSQL.Expression.Inline.inlineParam' (value can be null)++  where @\<ident\>@ is a haskell identifier in scope, whose type has an+  'Squeal.PostgreSQL.Inline' instance.++  = Example++  For the examples, let's assume you have a database like this:++  > type UsersConstraints = '[ "pk_users" ::: 'PrimaryKey '["id"] ]+  > type UsersColumns =+  >   '[          "id" :::   'Def :=> 'NotNull 'PGtext+  >    ,        "name" ::: 'NoDef :=> 'NotNull 'PGtext+  >    , "employee_id" ::: 'NoDef :=> 'NotNull 'PGuuid+  >    ,         "bio" ::: 'NoDef :=> 'Null    'PGtext+  >    ]+  > type EmailsConstraints =+  >   '[ "pk_emails"  ::: 'PrimaryKey '["id"]+  >    , "fk_user_id" ::: 'ForeignKey '["user_id"] "public" "users" '["id"]+  >    ]+  > type EmailsColumns =+  >   '[      "id" :::   'Def :=> 'NotNull 'PGint4+  >    , "user_id" ::: 'NoDef :=> 'NotNull 'PGtext+  >    ,   "email" ::: 'NoDef :=> 'Null 'PGtext+  >    ]+  > type Schema =+  >   '[  "users" ::: 'Table (UsersConstraints :=> UsersColumns)+  >    , "emails" ::: 'Table (EmailsConstraints :=> EmailsColumns)+  >    ]+++  == Insert Example++  > mkStatement :: Int32 -> Text -> Maybe Text -> Statement DB () ()+  > mkStatement emailId uid email =+  >   [ssql|+  >     insert into+  >       emails (id, user_id, email)+  >       values (inline("emailId"), inline(uid), inline_param(email))+  >   |]++  Notice the quotes around @"emailId"@. This is because postgres SQL+  parsing mandates the unquoted idents be converted to lower case+  (as a way of being "case insensitive"), which would result in the+  quasiquoter injecting the lower case @emailid@ variable, which is not+  in scope. The solution is to double quote the SQL ident so that its+  casing is preserved.++  == Select Example++  > mkStatement+  >   :: Text+  >   -> Statement+  >        DB+  >        ()+  >        ( Field "id" Text+  >        , ( Field "name" Text+  >          , ( Field "email" (Maybe Text)+  >            , ()+  >            )+  >          )+  >        )+  > mkStatement targetEmail =+  >   [ssql|+  >     select users.id, users.name, emails.email+  >     from users+  >     left outer join emails+  >     on emails.user_id = users.id+  >     where emails.email = inline("targetEmail")+  >   |]++  These examples are more or less taken from the+  test suite. I strongly recommend reading [the test+  code](https://github.com/owensmurray/squeal-postgresql-qq/blob/master/test/test.hs)+  to see what is currently supported.+-}+ssql :: QuasiQuoter+ssql =+  QuasiQuoter+    { quoteExp =+        toSqueal . PGT_Parse.run PGT_Parse.preparableStmt . Text.strip . Text.pack+    , quotePat = error "pattern quotes not supported"+    , quoteType = error "type quotes not supported"+    , quoteDec = error "declaration quotes not supported"+    }+++toSqueal :: Either String PGT_AST.PreparableStmt -> Q Exp+toSqueal = \case+  Left err -> fail err+  Right statement -> do+    runIO (print statement)+    toSquealStatement statement+++toSquealStatement :: PGT_AST.PreparableStmt -> Q Exp+toSquealStatement = \case+  PGT_AST.SelectPreparableStmt theQuery -> do+    queryExp <- toSquealQuery theQuery+    pure $ VarE 'monoQuery `AppE` queryExp+  PGT_AST.InsertPreparableStmt stmt -> do+    manipExp <- toSquealInsert stmt+    pure $ VarE 'monoManipulation `AppE` manipExp+  PGT_AST.UpdatePreparableStmt stmt -> do+    manipExp <- toSquealUpdate stmt+    pure $ VarE 'monoManipulation `AppE` manipExp+  PGT_AST.DeletePreparableStmt stmt -> do+    manipExp <- toSquealDelete stmt+    pure $ VarE 'monoManipulation `AppE` manipExp+  unsupported ->+    error $ "Unsupported statement: " <> show unsupported+++{- $discussion++  #discussion#++  The reason we monomorphize the SQL statement using the nested tuple+  structure (see 'ssql') is that Squeal by default allows for generic+  based polymorphic input row types and output row types. This is+  problematic for a number of reasons. It severely hinders type inference,+  and it produces very bad error messages when the types are misaligned.++  If you were to manually craft Squeal expressions, you would have the+  opportunity to add helpful type annotations for convenient and critical+  sub-expressions of the overall top-level Squeal expression. But because+  this quasi-quoter generates the Squeal expression for you, you have+  no opportunity to do something similar. The only place you can place+  a type annotation is at the entire top level expression generated by+  the quasi-quoter.++  Therefore, the trade-offs between going with the polymorphic approach+  and a monomorphic approach don't have the same costs/benefits when+  using the quasi-quoter as they do when manually crafting Squeal.++  To solve this problem (or rather to choose a different set of+  trade-offs), the quasi-quoter forces all input and output rows to be+  monomorphized into a "canonical" Haskell type which has this nested+  tuple of fields structure. Under the hood we do this via an injective+  type family, so that type inference can go both ways.++  If you have a quasi-quoted query in hand, you can use a type hole to+  ask GHC what its inferred concrete type is.  Conversely, if you know+  what the expected row type is, but your quasi-quoted SQL statement is+  failing to align with your expected types, you can put your expected+  row type in a type signature and get a much better error message about+  how and why the SQL statement is failing to type check.+-}++

@@ -0,0 +1,986 @@+{-# LANGUAGE GHC2021 #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE ViewPatterns #-}++-- | Commonplace renderers shared by other modules.+module Squeal.QuasiQuotes.Common (+  renderPGTTableRef,+  renderPGTAExpr,+  getIdentText,+  renderPGTTargeting,+  renderPGTTargetList,+) where++import Control.Applicative (Alternative((<|>)))+import Control.Monad (when)+import Data.Foldable (Foldable(elem, foldl', null))+import Data.Maybe (isJust)+import Data.String (IsString(fromString))+import Language.Haskell.TH.Syntax+  ( Exp(AppE, AppTypeE, ConE, InfixE, LabelE, ListE, LitE, TupE, VarE)+  , Lit(IntegerL, StringL), TyLit(NumTyLit), Type(LitT), Name, Q, mkName+  )+import Prelude+  ( Applicative(pure), Bool(False, True), Either(Left, Right), Eq((==))+  , Functor(fmap), Maybe(Just, Nothing), MonadFail(fail)+  , Num((*), (+), (-), fromInteger), Ord((<)), Semigroup((<>)), Show(show)+  , Traversable(mapM), ($), (&&), (.), (<$>), (||), Int, Integer, any, either+  , error, fromIntegral, id+  )+import qualified Data.ByteString.Char8 as BS8+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as Text+import qualified PostgresqlSyntax.Ast as PGT_AST+import qualified Squeal.PostgreSQL as S+++getIdentText :: PGT_AST.Ident -> Text.Text+getIdentText = \case+  PGT_AST.QuotedIdent t -> t+  PGT_AST.UnquotedIdent t -> t+++renderPGTTableRef :: NE.NonEmpty PGT_AST.TableRef -> Q Exp+renderPGTTableRef tableRefs = do+  renderedTableRefs <- mapM renderSingleTableRef (NE.toList tableRefs)+  case renderedTableRefs of+    [] -> fail "Empty FROM clause" -- Should not happen with NonEmpty+    (firstTbl : restTbls) ->+      -- For FROM t1, t2, t3 Squeal uses: (table #t1) & also (table #t2) & also (table #t3)+      -- S.also takes new item first, then accumulated.+      -- So foldl' (\acc item -> VarE 'S.also `AppE` item `AppE` acc) firstTbl restTbls+      -- However, Squeal's FromClause Additional instance is `also right left`, meaning `also new current`.+      -- So `foldl (\current new -> VarE 'S.also `AppE` new `AppE` current) firstTbl restTbls` is correct.+      pure $ foldl' (\acc tbl -> VarE 'S.also `AppE` tbl `AppE` acc) firstTbl restTbls+++renderSingleTableRef :: PGT_AST.TableRef -> Q Exp+renderSingleTableRef = \case+  PGT_AST.RelationExprTableRef relationExpr maybeAliasClause sampleClause -> do+    when (isJust sampleClause) $ fail "TABLESAMPLE clause is not supported yet."+    renderPGTRelationExprTableRef relationExpr maybeAliasClause+  PGT_AST.JoinTableRef joinedTable maybeAliasClause ->+    -- If `maybeAliasClause` is Just, it means `(JOIN_TABLE) AS alias`.+    -- Squeal's direct join combinators don't alias the *result* of the join.+    -- This would require wrapping the join in a subquery.+    -- For now, we'll fail if an alias is applied to a complex join structure directly.+    -- Simple table references with aliases are handled by RelationExprTableRef.+    case maybeAliasClause of+      Just _ ->+        fail+          "Aliasing a JOIN clause directly is not supported. Consider a subquery: (SELECT * FROM ...) AS alias"+      Nothing -> renderPGTJoinedTable joinedTable+  -- PGT_AST.InParensTableRefTableRef was an incorrect pattern, removing it.+  -- Parenthesized joins are handled by PGT_AST.InParensJoinedTable within renderPGTJoinedTable.+  unsupported ->+    fail $ "Unsupported TableRef type in renderSingleTableRef: " <> show unsupported+++renderPGTJoinedTable :: PGT_AST.JoinedTable -> Q Exp+renderPGTJoinedTable = \case+  PGT_AST.InParensJoinedTable joinedTable -> renderPGTJoinedTable joinedTable+  PGT_AST.MethJoinedTable joinMeth leftRef rightRef -> do+    leftTableExp <- renderSingleTableRef leftRef+    rightTableExp <- renderSingleTableRef rightRef+    case joinMeth of+      PGT_AST.QualJoinMeth maybeJoinType joinQual ->+        case joinQual of+          PGT_AST.OnJoinQual onConditionAExpr -> do+            onConditionExp <- renderPGTAExpr onConditionAExpr+            squealJoinFn <-+              case maybeJoinType of+                Just (PGT_AST.LeftJoinType _) -> pure $ VarE 'S.leftOuterJoin+                Just (PGT_AST.RightJoinType _) -> pure $ VarE 'S.rightOuterJoin+                Just (PGT_AST.FullJoinType _) -> pure $ VarE 'S.fullOuterJoin+                Just PGT_AST.InnerJoinType -> pure $ VarE 'S.innerJoin+                Nothing -> pure $ VarE 'S.innerJoin -- SQL JOIN (no type) is INNER JOIN+                -- Change: Use S.& for join: leftTableExp & squealJoinFn rightTableExp onConditionExp+            pure $+              InfixE+                (Just leftTableExp)+                (VarE '(S.&))+                (Just (squealJoinFn `AppE` rightTableExp `AppE` onConditionExp))+          PGT_AST.UsingJoinQual _identsNE ->+            fail "USING join qualification not yet supported"+      PGT_AST.CrossJoinMeth ->+        -- Change: Use S.& for crossJoin: leftTableExp & S.crossJoin rightTableExp+        pure $+          InfixE+            (Just leftTableExp)+            (VarE '(S.&))+            (Just (VarE 'S.crossJoin `AppE` rightTableExp))+      PGT_AST.NaturalJoinMeth _naturalJoinType ->+        -- Squeal does not have direct high-level support for NATURAL JOIN.+        -- These would typically be rewritten as INNER JOINs with USING clauses+        -- or explicit ON conditions based on common column names.+        -- This is complex to implement correctly in the QQ and might be error-prone.+        fail "NATURAL JOIN is not supported by Squeal-QQ."+++renderPGTRelationExprTableRef+  :: PGT_AST.RelationExpr -> Maybe PGT_AST.AliasClause -> Q Exp+renderPGTRelationExprTableRef relationExpr maybeAliasClause = do+  tableExpr <-+    case relationExpr of+      PGT_AST.SimpleRelationExpr qualifiedName isAsterisk -> do+        when isAsterisk $ fail "Relation with '*' (e.g. 'table *') is not supported."+        renderPGTQualifiedName qualifiedName+      PGT_AST.OnlyRelationExpr _qualifiedName _areParensPresent -> do+        -- Squeal doesn't have a direct equivalent for ONLY, so we treat it as a normal table for now.+        -- This might need adjustment if ONLY semantics are critical.+        fail "ONLY keyword is not supported."++  aliasStr <-+    case maybeAliasClause of+      Just (PGT_AST.AliasClause _ aliasIdent _) -> pure $ Text.unpack (getIdentText aliasIdent)+      Nothing -> case relationExpr of -- Infer default alias if none provided+        PGT_AST.SimpleRelationExpr (PGT_AST.SimpleQualifiedName ident) _ -> pure $ Text.unpack (getIdentText ident)+        PGT_AST.SimpleRelationExpr+          ( PGT_AST.IndirectedQualifiedName+              _+              (NE.last -> PGT_AST.AttrNameIndirectionEl ident)+            )+          _ -> pure $ Text.unpack (getIdentText ident)+        _ ->+          fail $+            "Cannot determine default alias for relation expression: " <> show relationExpr++  pure $ VarE 'S.table `AppE` (VarE 'S.as `AppE` tableExpr `AppE` LabelE aliasStr)+++renderPGTQualifiedName :: PGT_AST.QualifiedName -> Q Exp+renderPGTQualifiedName = \case+  PGT_AST.SimpleQualifiedName ident -> pure $ LabelE (Text.unpack (getIdentText ident))+  PGT_AST.IndirectedQualifiedName+    schemaIdent+    (PGT_AST.AttrNameIndirectionEl colIdent NE.:| []) ->+      -- Assuming schema.table.col+      pure $+        VarE '(S.!)+          `AppE` LabelE (Text.unpack (getIdentText schemaIdent))+          `AppE` LabelE (Text.unpack (getIdentText colIdent))+  unsupported ->+    fail $ "Unsupported qualified name for table reference: " <> show unsupported+++-- | Defines associativity of an operator.+data Associativity = LeftAssoc | RightAssoc | NonAssoc+  deriving stock (Eq, Show)+++-- | Holds details for a binary operator relevant to precedence restructuring.+data OperatorDetails = OperatorDetails+  { odConstructor :: PGT_AST.AExpr -> PGT_AST.AExpr -> PGT_AST.AExpr+  , odPrecedence :: Int+  , odAssociativity :: Associativity+  }+++{- | Extracts components if the expression is a recognized binary operator.+Higher precedence number means binds tighter.+Based on PostgreSQL operator precedence.+-}+getOperatorDetails+  :: PGT_AST.AExpr -> Maybe (PGT_AST.AExpr, OperatorDetails, PGT_AST.AExpr)+getOperatorDetails = \case+  PGT_AST.SymbolicBinOpAExpr l symOp r ->+    let+      details _op constr prec assoc = Just (l, OperatorDetails constr prec assoc, r)+      mathDetails mathOp prec assoc =+        details+          (PGT_AST.MathSymbolicExprBinOp mathOp)+          ( \l' r' -> PGT_AST.SymbolicBinOpAExpr l' (PGT_AST.MathSymbolicExprBinOp mathOp) r'+          )+          prec+          assoc+    in+      case symOp of+        PGT_AST.MathSymbolicExprBinOp PGT_AST.ArrowUpMathOp -> mathDetails PGT_AST.ArrowUpMathOp 8 LeftAssoc+        -- \^ (exponentiation)+        PGT_AST.MathSymbolicExprBinOp op+          | op `elem` [PGT_AST.AsteriskMathOp, PGT_AST.SlashMathOp, PGT_AST.PercentMathOp] ->+              mathDetails op 7 LeftAssoc+        -- \* / %+        PGT_AST.MathSymbolicExprBinOp op+          | op `elem` [PGT_AST.PlusMathOp, PGT_AST.MinusMathOp] ->+              mathDetails op 6 LeftAssoc -- binary + -+        PGT_AST.MathSymbolicExprBinOp op -- Comparisons+          | op+              `elem` [ PGT_AST.ArrowLeftMathOp+                     , PGT_AST.ArrowRightMathOp+                     , PGT_AST.EqualsMathOp+                     , PGT_AST.LessEqualsMathOp+                     , PGT_AST.GreaterEqualsMathOp+                     , PGT_AST.ArrowLeftArrowRightMathOp+                     , PGT_AST.ExclamationEqualsMathOp+                     ] ->+              mathDetails op 3 LeftAssoc -- < > = <= >= <> !=+        PGT_AST.QualSymbolicExprBinOp qualOp ->+          -- User-defined operators, bitwise, etc.+          details+            (PGT_AST.QualSymbolicExprBinOp qualOp)+            ( \l' r' -> PGT_AST.SymbolicBinOpAExpr l' (PGT_AST.QualSymbolicExprBinOp qualOp) r'+            )+            5+            LeftAssoc+        _ -> Nothing -- Should be exhaustive for PGT_AST.MathSymbolicExprBinOp if it's a binary op+  PGT_AST.AndAExpr l r -> Just (l, OperatorDetails PGT_AST.AndAExpr 2 LeftAssoc, r) -- AND (precedence 2 in PG docs example)+  PGT_AST.OrAExpr l r -> Just (l, OperatorDetails PGT_AST.OrAExpr 1 LeftAssoc, r) -- OR (precedence 1 in PG docs example)+  PGT_AST.VerbalExprBinOpAExpr l notOp verbalOp r mEscape ->+    -- LIKE, ILIKE, SIMILAR TO+    Just+      ( l+      , OperatorDetails+          (\l' r' -> PGT_AST.VerbalExprBinOpAExpr l' notOp verbalOp r' mEscape)+          3+          LeftAssoc+      , r -- Same as comparisons+      )+  PGT_AST.ReversableOpAExpr l notOp (PGT_AST.DistinctFromAExprReversableOp r) ->+    -- IS DISTINCT FROM+    Just+      ( l+      , OperatorDetails+          ( \l' r' ->+              PGT_AST.ReversableOpAExpr l' notOp (PGT_AST.DistinctFromAExprReversableOp r')+          )+          3+          LeftAssoc+      , r -- Same as =+      )+  _ -> Nothing+++-- | Rearranges the AExpr syntax tree to account for operator precedence.+fixOperatorPrecedence :: PGT_AST.AExpr -> PGT_AST.AExpr+fixOperatorPrecedence = go+  where+    go expr =+      case getOperatorDetails expr of+        Just (l1, op1Details, r1) ->+          let+            l1Fixed = go l1+            r1Fixed = go r1+            currentOpConstructor = odConstructor op1Details+            currentPrecedence = odPrecedence op1Details+            currentAssociativity = odAssociativity op1Details+          in+            case getOperatorDetails r1Fixed of+              Just (l2, op2Details, r2) ->+                let+                  -- We have effectively: l1Fixed `op1` (l2 `op2` r2)+                  -- l2 is the left child of the (potentially restructured) r1Fixed+                  -- r2 is the right child of the (potentially restructured) r1Fixed+                  innerOpConstructor = odConstructor op2Details+                  innerPrecedence = odPrecedence op2Details+                in+                  -- innerAssociativity = odAssociativity op2Details -- Not used in this branch's logic directly++                  if currentPrecedence < innerPrecedence+                    || (currentPrecedence == innerPrecedence && currentAssociativity == RightAssoc)+                    then+                      -- op2 binds tighter, or op1 is right-associative with same precedence.+                      -- Structure l1Fixed `op1` (l2 `op2` r2) is correct.+                      currentOpConstructor l1Fixed r1Fixed+                    else+                      -- op1 binds tighter, or op1 is left-associative with same precedence.+                      -- We need to rotate to form: (l1Fixed `op1` l2) `op2` r2+                      let+                        newLeftChild = currentOpConstructor l1Fixed l2+                      in+                        go (innerOpConstructor newLeftChild r2) -- Recursively fix the new structure+              Nothing ->+                -- Right child r1Fixed is not a binary operator we're rebalancing.+                -- The structure l1Fixed `op1` r1Fixed is locally correct.+                currentOpConstructor l1Fixed r1Fixed+        Nothing ->+          -- Current expression `expr` is not a binary operator handled by getOperatorDetails,+          -- or it's an atom. Recursively fix its children.+          case expr of+            PGT_AST.CExprAExpr c -> PGT_AST.CExprAExpr c -- CExprs are atoms or structured (FuncCExpr, CaseCExpr etc.)+            PGT_AST.TypecastAExpr e t -> PGT_AST.TypecastAExpr (go e) t+            PGT_AST.CollateAExpr e c -> PGT_AST.CollateAExpr (go e) c+            PGT_AST.AtTimeZoneAExpr e1 e2 -> PGT_AST.AtTimeZoneAExpr (go e1) (go e2)+            PGT_AST.PlusAExpr e -> PGT_AST.PlusAExpr (go e) -- Unary plus+            -- MinusAExpr is handled by fixOperatorPrecedence if it's part of a binary op,+            -- otherwise it's a unary negate.+            PGT_AST.MinusAExpr e -> PGT_AST.MinusAExpr (go e)+            PGT_AST.PrefixQualOpAExpr op e -> PGT_AST.PrefixQualOpAExpr op (go e)+            PGT_AST.SuffixQualOpAExpr e op -> PGT_AST.SuffixQualOpAExpr (go e) op+            PGT_AST.NotAExpr e -> PGT_AST.NotAExpr (go e)+            PGT_AST.ReversableOpAExpr e notFlag revOp ->+              let+                eFixed = go e+              in+                case revOp of+                  PGT_AST.DistinctFromAExprReversableOp{} -> expr -- Should have been caught by getOperatorDetails+                  PGT_AST.BetweenAExprReversableOp symm bExpr aExpr ->+                    PGT_AST.ReversableOpAExpr+                      eFixed+                      notFlag+                      (PGT_AST.BetweenAExprReversableOp symm (goBExpr bExpr) (go aExpr))+                  PGT_AST.InAExprReversableOp inExpr ->+                    PGT_AST.ReversableOpAExpr+                      eFixed+                      notFlag+                      (PGT_AST.InAExprReversableOp (goInExpr inExpr))+                  _ -> PGT_AST.ReversableOpAExpr eFixed notFlag revOp -- For IS NULL, IS TRUE etc.+            PGT_AST.IsnullAExpr e -> PGT_AST.IsnullAExpr (go e)+            PGT_AST.NotnullAExpr e -> PGT_AST.NotnullAExpr (go e)+            PGT_AST.OverlapsAExpr row1 row2 -> PGT_AST.OverlapsAExpr (goRow row1) (goRow row2)+            PGT_AST.SubqueryAExpr e op st sub ->+              PGT_AST.SubqueryAExpr+                (go e)+                op+                st+                (either (Left . goSelectWithParens) (Right . go) sub)+            PGT_AST.UniqueAExpr s -> PGT_AST.UniqueAExpr (goSelectWithParens s)+            PGT_AST.DefaultAExpr -> PGT_AST.DefaultAExpr+            _ -> expr -- Leaf node or unhandled construct+    goBExpr :: PGT_AST.BExpr -> PGT_AST.BExpr+    goBExpr = \case+      PGT_AST.CExprBExpr c -> PGT_AST.CExprBExpr c+      PGT_AST.TypecastBExpr be t -> PGT_AST.TypecastBExpr (goBExpr be) t+      PGT_AST.PlusBExpr be -> PGT_AST.PlusBExpr (goBExpr be)+      PGT_AST.MinusBExpr be -> PGT_AST.MinusBExpr (goBExpr be)+      -- BExpr's own binary ops are typically higher precedence than AExpr's,+      -- but for completeness, one could define getOperatorDetails for BExpr too.+      -- For now, just recurse.+      PGT_AST.SymbolicBinOpBExpr l op r -> PGT_AST.SymbolicBinOpBExpr (goBExpr l) op (goBExpr r)+      PGT_AST.QualOpBExpr op be -> PGT_AST.QualOpBExpr op (goBExpr be)+      PGT_AST.IsOpBExpr be notFlag isOp ->+        let+          beFixed = goBExpr be+        in+          case isOp of+            PGT_AST.DistinctFromBExprIsOp b ->+              PGT_AST.IsOpBExpr beFixed notFlag (PGT_AST.DistinctFromBExprIsOp (goBExpr b))+            _ -> PGT_AST.IsOpBExpr beFixed notFlag isOp++    goRow :: PGT_AST.Row -> PGT_AST.Row+    goRow = \case+      PGT_AST.ExplicitRowRow mExprs -> PGT_AST.ExplicitRowRow (fmap (NE.map go) mExprs)+      PGT_AST.ImplicitRowRow (PGT_AST.ImplicitRow exprs aexpr) -> PGT_AST.ImplicitRowRow (PGT_AST.ImplicitRow (NE.map go exprs) (go aexpr))++    goSelectWithParens :: PGT_AST.SelectWithParens -> PGT_AST.SelectWithParens+    goSelectWithParens = id -- Placeholder: A full traversal would be needed.+    goInExpr :: PGT_AST.InExpr -> PGT_AST.InExpr+    goInExpr = \case+      PGT_AST.SelectInExpr s -> PGT_AST.SelectInExpr (goSelectWithParens s)+      PGT_AST.ExprListInExpr exprs -> PGT_AST.ExprListInExpr (NE.map go exprs)+++renderPGTAExpr :: PGT_AST.AExpr -> Q Exp+renderPGTAExpr astExpr = case fixOperatorPrecedence astExpr of+  PGT_AST.CExprAExpr cExpr -> renderPGTCExpr cExpr+  PGT_AST.TypecastAExpr aExpr typename -> do+    tnExp <- renderPGTTypename typename+    aExp <- renderPGTAExpr aExpr+    pure $ VarE 'S.cast `AppE` tnExp `AppE` aExp+  PGT_AST.SymbolicBinOpAExpr left op right -> do+    lExp <- renderPGTAExpr left+    rExp <- renderPGTAExpr right+    squealOpExp <-+      case op of+        PGT_AST.MathSymbolicExprBinOp mathOp -> pure $ renderPGTMathOp mathOp+        PGT_AST.QualSymbolicExprBinOp qualOp -> pure $ renderPGTQualOp qualOp+    pure (squealOpExp `AppE` lExp `AppE` rExp)+  PGT_AST.PrefixQualOpAExpr op expr -> do+    let+      opExp' = renderPGTQualOp op+    eExp' <- renderPGTAExpr expr+    pure (opExp' `AppE` eExp')+  PGT_AST.AndAExpr left right -> do+    lExp' <- renderPGTAExpr left+    rExp' <- renderPGTAExpr right+    pure (VarE '(S..&&) `AppE` lExp' `AppE` rExp')+  PGT_AST.OrAExpr left right -> do+    lExp' <- renderPGTAExpr left+    rExp' <- renderPGTAExpr right+    pure (VarE '(S..||) `AppE` lExp' `AppE` rExp')+  PGT_AST.NotAExpr expr -> do+    eExp' <- renderPGTAExpr expr+    pure (VarE 'S.not_ `AppE` eExp')+  PGT_AST.VerbalExprBinOpAExpr left not op right mEscape -> do+    when (isJust mEscape) $ fail "LIKE with ESCAPE is not supported yet."+    lExp' <- renderPGTAExpr left+    rExp' <- renderPGTAExpr right+    baseOpExp <-+      case op of+        PGT_AST.LikeVerbalExprBinOp -> pure $ VarE 'S.like+        PGT_AST.IlikeVerbalExprBinOp -> pure $ VarE 'S.ilike+        _ -> fail $ "Unsupported verbal binary operator: " <> show op+    let+      finalOpExp = if not then VarE 'S.not_ `AppE` baseOpExp else baseOpExp+    pure (finalOpExp `AppE` lExp' `AppE` rExp')+  PGT_AST.ReversableOpAExpr expr not reversableOp -> do+    renderedExpr' <- renderPGTAExpr expr+    case reversableOp of+      PGT_AST.NullAExprReversableOp ->+        pure $ (if not then VarE 'S.isNotNull else VarE 'S.isNull) `AppE` renderedExpr'+      PGT_AST.BetweenAExprReversableOp _asymmetric bExpr andAExpr -> do+        bExp' <- renderPGTBExpr bExpr+        aExp' <- renderPGTAExpr andAExpr+        let+          opVar' = if not then VarE 'S.notBetween else VarE 'S.between+        pure $ opVar' `AppE` renderedExpr' `AppE` TupE [Just bExp', Just aExp']+      PGT_AST.InAExprReversableOp inExpr ->+        let+          opVar' = if not then VarE 'S.notIn else VarE 'S.in_+        in+          case inExpr of+            PGT_AST.ExprListInExpr exprList -> do+              listExp' <- ListE <$> mapM renderPGTAExpr (NE.toList exprList)+              pure $ opVar' `AppE` renderedExpr' `AppE` listExp'+            _ -> fail "Unsupported IN subquery expression"+      _ -> fail $ "Unsupported reversable operator: " <> show reversableOp+  PGT_AST.DefaultAExpr -> pure $ ConE 'S.Default+  PGT_AST.MinusAExpr expr -> do+    -- Unary minus+    eExp' <- renderPGTAExpr expr+    let+      zeroExp = AppE (VarE 'fromInteger) (LitE (IntegerL 0))+    pure (InfixE (Just zeroExp) (VarE '(-)) (Just eExp'))+  unsupported -> fail $ "Unsupported AExpr: " <> show unsupported+++renderPGTBExpr :: PGT_AST.BExpr -> Q Exp+renderPGTBExpr = \case+  PGT_AST.CExprBExpr cExpr -> renderPGTCExpr cExpr+  PGT_AST.TypecastBExpr bExpr typename -> do+    tnExp <- renderPGTTypename typename+    bExp <- renderPGTBExpr bExpr+    pure $ VarE 'S.cast `AppE` tnExp `AppE` bExp+  PGT_AST.SymbolicBinOpBExpr left op right -> do+    lExp <- renderPGTBExpr left+    rExp <- renderPGTBExpr right+    squealOpExp <-+      case op of+        PGT_AST.MathSymbolicExprBinOp mathOp -> pure $ renderPGTMathOp mathOp+        PGT_AST.QualSymbolicExprBinOp qualOp -> pure $ renderPGTQualOp qualOp+    pure (squealOpExp `AppE` lExp `AppE` rExp)+  unsupported -> fail $ "Unsupported BExpr: " <> show unsupported+++renderPGTCExpr :: PGT_AST.CExpr -> Q Exp+renderPGTCExpr = \case+  PGT_AST.AexprConstCExpr aexprConst -> pure $ renderPGTAexprConst aexprConst+  PGT_AST.ColumnrefCExpr columnref -> pure $ renderPGTColumnref columnref+  PGT_AST.ParamCExpr n maybeIndirection -> do+    when (isJust maybeIndirection) $+      fail "Parameters with indirection (e.g. $1[i]) are not supported."+    pure $ VarE 'S.param `AppTypeE` LitT (NumTyLit (fromIntegral n))+  PGT_AST.InParensCExpr expr maybeIndirection -> do+    when (isJust maybeIndirection) $+      fail "Parenthesized expressions with indirection are not supported."+    renderPGTAExpr expr -- Squeal's operator precedence should handle this+  PGT_AST.FuncCExpr funcExpr -> renderPGTFuncExpr funcExpr+  unsupported -> fail $ "Unsupported CExpr: " <> show unsupported+++renderPGTFuncExpr :: PGT_AST.FuncExpr -> Q Exp+renderPGTFuncExpr = \case+  PGT_AST.ApplicationFuncExpr funcApp maybeWithinGroup maybeFilter maybeOver -> do+    when (isJust maybeWithinGroup) $ fail "WITHIN GROUP clause is not supported."+    when (isJust maybeFilter) $ fail "FILTER clause is not supported."+    when (isJust maybeOver) $ fail "OVER clause is not supported."+    renderPGTFuncApplication funcApp+  PGT_AST.SubexprFuncExpr funcCommonSubexpr -> renderPGTFuncExprCommonSubexpr funcCommonSubexpr+++renderPGTFuncApplication :: PGT_AST.FuncApplication -> Q Exp+renderPGTFuncApplication (PGT_AST.FuncApplication funcName maybeParams) =+  case funcName of+    PGT_AST.IndirectedFuncName{} ->+      fail "Functions with indirection (e.g. schema.func) are not supported."+    PGT_AST.TypeFuncName fident ->+      let+        fnNameStr = Text.unpack (getIdentText fident)+      in+        case Text.toLower (Text.pack fnNameStr) of+          "inline" ->+            case maybeParams of+              Just (PGT_AST.NormalFuncApplicationParams _ args _) ->+                case NE.toList args of+                  [ PGT_AST.ExprFuncArgExpr+                      (PGT_AST.CExprAExpr (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref ident Nothing)))+                    ] -> do+                      let+                        varName :: Name+                        varName = mkName . Text.unpack . getIdentText $ ident+                      pure $ VarE 'S.inline `AppE` VarE varName+                  _ -> fail "inline() function expects a single variable argument"+              _ -> fail "inline() function expects a single variable argument"+          "inline_param" ->+            case maybeParams of+              Just (PGT_AST.NormalFuncApplicationParams _ args _) ->+                case NE.toList args of+                  [ PGT_AST.ExprFuncArgExpr+                      (PGT_AST.CExprAExpr (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref ident Nothing)))+                    ] -> do+                      let+                        varName :: Name+                        varName = mkName . Text.unpack . getIdentText $ ident+                      pure $ VarE 'S.inlineParam `AppE` VarE varName+                  _ -> fail "inline_param() function expects a single variable argument"+              _ -> fail "inline_param() function expects a single variable argument"+          otherFnName ->+            let+              squealFn :: Q Exp+              squealFn =+                case otherFnName of+                  "coalesce" -> pure $ VarE 'S.coalesce+                  "lower" -> pure $ VarE 'S.lower+                  "char_length" -> pure $ VarE 'S.charLength+                  "character_length" -> pure $ VarE 'S.charLength+                  "upper" -> pure $ VarE 'S.upper+                  "count" -> pure $ VarE 'S.count -- Special handling for count(*) might be needed+                  "now" -> pure $ VarE 'S.now+                  _ -> fail $ "Unsupported function: " <> fnNameStr+            in+              case maybeParams of+                Nothing -> squealFn -- No-argument function+                Just params -> case params of+                  PGT_AST.NormalFuncApplicationParams maybeAllOrDistinct args maybeSortClause -> do+                    when (isJust maybeAllOrDistinct) $+                      fail "DISTINCT in function calls is not supported."+                    when (isJust maybeSortClause) $+                      fail "ORDER BY in function calls is not supported."+                    fn <- squealFn+                    argExps <- mapM renderPGTFuncArgExpr (NE.toList args)+                    pure $ foldl' AppE fn argExps+                  PGT_AST.StarFuncApplicationParams ->+                    -- Specific for count(*)+                    if fnNameStr == "count"+                      then pure $ VarE 'S.countStar+                      else fail "Star argument only supported for COUNT"+                  _ -> fail $ "Unsupported function parameters structure: " <> show params+++renderPGTFuncArgExpr :: PGT_AST.FuncArgExpr -> Q Exp+renderPGTFuncArgExpr = \case+  PGT_AST.ExprFuncArgExpr aExpr -> renderPGTAExpr aExpr+  _ -> fail "Named or colon-syntax function arguments not supported"+++renderPGTFuncExprCommonSubexpr :: PGT_AST.FuncExprCommonSubexpr -> Q Exp+renderPGTFuncExprCommonSubexpr = \case+  PGT_AST.CurrentTimestampFuncExprCommonSubexpr (Just _) ->+    fail "CURRENT_TIMESTAMP with precision is not supported."+  PGT_AST.CurrentTimestampFuncExprCommonSubexpr Nothing -> pure $ VarE 'S.now -- Or S.currentTimestamp+  PGT_AST.CurrentDateFuncExprCommonSubexpr -> pure $ VarE 'S.currentDate+  PGT_AST.CoalesceFuncExprCommonSubexpr exprListNE -> do+    renderedInitExprs <- mapM renderPGTAExpr (NE.init exprListNE)+    renderedLastExpr <- renderPGTAExpr (NE.last exprListNE)+    pure $ VarE 'S.coalesce `AppE` ListE renderedInitExprs `AppE` renderedLastExpr+  e -> fail $ "Unsupported common function subexpression: " <> show e+++renderPGTColumnref :: PGT_AST.Columnref -> Exp+renderPGTColumnref (PGT_AST.Columnref colId maybeIndirection) =+    case maybeIndirection of+      Nothing -> LabelE (Text.unpack (getIdentText colId))+      Just indirection ->+        let+          base = LabelE (Text.unpack (getIdentText colId))+        in+          foldl' applyIndirection base (NE.toList indirection)+  where+    applyIndirection acc = \case+      PGT_AST.AttrNameIndirectionEl attrName ->+        VarE '(S.!) `AppE` acc `AppE` LabelE (Text.unpack (getIdentText attrName))+      _ -> error "Unsupported column reference indirection"+++renderPGTAexprConst :: PGT_AST.AexprConst -> Exp+renderPGTAexprConst = \case+  PGT_AST.IAexprConst n ->+    ConE 'S.UnsafeExpression+      `AppE` ( VarE 'BS8.pack+                 `AppE` LitE (StringL (show n))+             )+  PGT_AST.FAexprConst f ->+    ConE 'S.UnsafeExpression+      `AppE` ( VarE 'BS8.pack+                 `AppE` LitE (StringL (show f))+             )+  PGT_AST.SAexprConst s ->+    VarE 'fromString `AppE` LitE (StringL (Text.unpack s))+  PGT_AST.BoolAexprConst True -> VarE 'S.true+  PGT_AST.BoolAexprConst False -> VarE 'S.false+  PGT_AST.NullAexprConst -> VarE 'S.null_+  unsupported -> error $ "Unsupported AexprConst: " <> show unsupported+++renderPGTMathOp :: PGT_AST.MathOp -> Exp+renderPGTMathOp = \case+  PGT_AST.PlusMathOp -> VarE '(+)+  PGT_AST.MinusMathOp -> VarE '(-)+  PGT_AST.AsteriskMathOp -> VarE '(*)+  PGT_AST.EqualsMathOp -> VarE '(S..==)+  PGT_AST.ArrowLeftArrowRightMathOp -> VarE '(S../=) -- <>+  PGT_AST.ExclamationEqualsMathOp -> VarE '(S../=) -- !=+  PGT_AST.ArrowRightMathOp -> VarE '(S..>)+  PGT_AST.GreaterEqualsMathOp -> VarE '(S..>=)+  PGT_AST.ArrowLeftMathOp -> VarE '(S..<)+  PGT_AST.LessEqualsMathOp -> VarE '(S..<=)+  _ -> error "Unsupported math operator"+++renderPGTQualOp :: PGT_AST.QualOp -> Exp+renderPGTQualOp = \case+  PGT_AST.OpQualOp opText ->+    case Text.toLower opText of+      "+" -> VarE '(+)+      "-" -> VarE '(-)+      "*" -> VarE '(*)+      "=" -> VarE '(S..==)+      "<>" -> VarE '(S../=)+      "!=" -> VarE '(S../=)+      ">" -> VarE '(S..>)+      ">=" -> VarE '(S..>=)+      "<" -> VarE '(S..<)+      "<=" -> VarE '(S..<=)+      "and" -> VarE '(S..&&)+      "or" -> VarE '(S..||)+      "not" -> VarE 'S.not_+      "like" -> VarE 'S.like+      "ilike" -> VarE 'S.ilike+      _ -> error $ "Unsupported QualOp operator text: " <> Text.unpack opText+  PGT_AST.OperatorQualOp _anyOperator ->+    error "OPERATOR(any_operator) syntax not supported"+++renderPGTTypename :: PGT_AST.Typename -> Q Exp+renderPGTTypename (PGT_AST.Typename setof simpleTypename nullable arrayInfo) = do+  when setof $ fail "SETOF type modifier is not supported."+  when nullable $ fail "Nullable type modifier '?' is not supported."+  baseTypeExp <- renderPGTSimpleTypename simpleTypename+  case arrayInfo of+    Nothing -> pure baseTypeExp+    Just (dims, nullableArray) -> do+      when nullableArray $ fail "Nullable array modifier '?' is not supported."+      renderPGTArrayDimensions baseTypeExp dims+++renderPGTArrayDimensions :: Exp -> PGT_AST.TypenameArrayDimensions -> Q Exp+renderPGTArrayDimensions baseTypeExp = \case+  PGT_AST.BoundsTypenameArrayDimensions bounds ->+    -- Squeal's fixarray takes a type-level list of Nats for dimensions.+    -- This is hard to represent directly from parsed integer bounds.+    -- For now, we'll only support 1D arrays if bounds are provided.+    case NE.toList bounds of+      [Just dim] ->+        pure $+          VarE 'S.fixarray+            `AppTypeE` LitT (NumTyLit (fromIntegral dim))+            `AppE` baseTypeExp+      [_] -> pure $ VarE 'S.vararray `AppE` baseTypeExp -- e.g. int[]+      _ ->+        fail "Multidimensional arrays with explicit bounds not yet supported"+  PGT_AST.ExplicitTypenameArrayDimensions Nothing -> pure $ VarE 'S.vararray `AppE` baseTypeExp -- e.g. sometype ARRAY+  PGT_AST.ExplicitTypenameArrayDimensions (Just dim) ->+    pure $+      VarE 'S.fixarray+        `AppTypeE` LitT (NumTyLit (fromIntegral dim))+        `AppE` baseTypeExp -- e.g. sometype ARRAY[N]+++renderPGTSimpleTypename :: PGT_AST.SimpleTypename -> Q Exp+renderPGTSimpleTypename = \case+  PGT_AST.GenericTypeSimpleTypename+    (PGT_AST.GenericType typeFnName attrs maybeModifiers) -> do+      when (isJust attrs) $+        fail "Qualified type names (e.g. schema.my_type) are not supported."+      let+        nameLower = Text.toLower (getIdentText typeFnName)+        extractLength :: Maybe PGT_AST.TypeModifiers -> Q Integer+        extractLength = \case+          Just+            ((PGT_AST.CExprAExpr (PGT_AST.AexprConstCExpr (PGT_AST.IAexprConst n))) NE.:| []) -> pure (fromIntegral n)+          Just other ->+            fail $+              "Unsupported type modifier for " <> Text.unpack nameLower <> ": " <> show other+          Nothing ->+            fail $+              "Type "+                <> Text.unpack nameLower+                <> " requires a length argument (e.g., "+                <> Text.unpack nameLower+                <> "(N))."++        extractLengthOrDefault :: Integer -> Maybe PGT_AST.TypeModifiers -> Q Integer+        extractLengthOrDefault def = \case+          Just+            ((PGT_AST.CExprAExpr (PGT_AST.AexprConstCExpr (PGT_AST.IAexprConst n))) NE.:| []) -> pure (fromIntegral n)+          Just other ->+            fail $+              "Unsupported type modifier for " <> Text.unpack nameLower <> ": " <> show other+          Nothing -> pure def+      case nameLower of+        "char" -> do+          len <- extractLengthOrDefault 1 maybeModifiers+          pure $ VarE 'S.char `AppTypeE` LitT (NumTyLit len)+        "character" -> do+          len <- extractLengthOrDefault 1 maybeModifiers+          pure $ VarE 'S.character `AppTypeE` LitT (NumTyLit len)+        "varchar" -> case maybeModifiers of+          Nothing -> pure $ VarE 'S.text -- varchar without length is text+          Just _ -> do+            len <- extractLength maybeModifiers+            pure $ VarE 'S.varchar `AppTypeE` LitT (NumTyLit len)+        "character varying" -> case maybeModifiers of+          Nothing -> pure $ VarE 'S.text -- character varying without length is text+          Just _ -> do+            len <- extractLength maybeModifiers+            pure $ VarE 'S.characterVarying `AppTypeE` LitT (NumTyLit len)+        "bool" -> pure $ VarE 'S.bool+        "int2" -> pure $ VarE 'S.int2+        "smallint" -> pure $ VarE 'S.smallint+        "int4" -> pure $ VarE 'S.int4+        "int" -> pure $ VarE 'S.int+        "integer" -> pure $ VarE 'S.integer+        "int8" -> pure $ VarE 'S.int8+        "bigint" -> pure $ VarE 'S.bigint+        "numeric" -> pure $ VarE 'S.numeric -- Ignoring precision/scale for now+        "float4" -> pure $ VarE 'S.float4 -- Ignoring precision for now+        "real" -> pure $ VarE 'S.real+        "float8" -> pure $ VarE 'S.float8+        "double precision" -> pure $ VarE 'S.doublePrecision+        "money" -> pure $ VarE 'S.money+        "text" -> pure $ VarE 'S.text+        "bytea" -> pure $ VarE 'S.bytea+        "timestamp" -> pure $ VarE 'S.timestamp+        "timestamptz" -> pure $ VarE 'S.timestamptz+        "timestamp with time zone" -> pure $ VarE 'S.timestampWithTimeZone+        "date" -> pure $ VarE 'S.date+        "time" -> pure $ VarE 'S.time+        "timetz" -> pure $ VarE 'S.timetz+        "time with time zone" -> pure $ VarE 'S.timeWithTimeZone+        "interval" -> pure $ VarE 'S.interval+        "uuid" -> pure $ VarE 'S.uuid+        "inet" -> pure $ VarE 'S.inet+        "json" -> pure $ VarE 'S.json+        "jsonb" -> pure $ VarE 'S.jsonb+        "tsvector" -> pure $ VarE 'S.tsvector+        "tsquery" -> pure $ VarE 'S.tsquery+        "oid" -> pure $ VarE 'S.oid+        "int4range" -> pure $ VarE 'S.int4range+        "int8range" -> pure $ VarE 'S.int8range+        "numrange" -> pure $ VarE 'S.numrange+        "tsrange" -> pure $ VarE 'S.tsrange+        "tstzrange" -> pure $ VarE 'S.tstzrange+        "daterange" -> pure $ VarE 'S.daterange+        "record" -> pure $ VarE 'S.record+        other -> fail $ "Unsupported generic type name: " <> Text.unpack other+  PGT_AST.NumericSimpleTypename numeric -> renderPGTNumeric numeric+  PGT_AST.BitSimpleTypename (PGT_AST.Bit _varying _maybeLength) ->+    -- PostgreSQL's BIT type without length is BIT(1). BIT VARYING without length is unlimited.+    -- Squeal's `char` and `varchar` are for text, not bit strings.+    -- Squeal does not have a direct equivalent for PG bit string types yet.+    -- Potentially map to bytea or text, or add new Squeal types. For now, error.+    fail+      "BIT and BIT VARYING types are not directly supported by Squeal's `char`/`varchar` like types. Consider using bytea or text, or a custom Squeal type."+  PGT_AST.CharacterSimpleTypename charTypeAst ->+    case charTypeAst of+      PGT_AST.CharacterCharacter False -> pure $ VarE 'S.character `AppTypeE` LitT (NumTyLit 1) -- SQL CHARACTER -> Squeal character(1)+      PGT_AST.CharacterCharacter True -> pure $ VarE 'S.text -- SQL CHARACTER VARYING -> Squeal text+      PGT_AST.CharCharacter False -> pure $ VarE 'S.char `AppTypeE` LitT (NumTyLit 1) -- SQL CHAR -> Squeal char(1)+      PGT_AST.CharCharacter True -> pure $ VarE 'S.text -- SQL CHAR VARYING -> Squeal text+      PGT_AST.VarcharCharacter -> pure $ VarE 'S.text -- SQL VARCHAR (no length) -> Squeal text+      -- National character types are often aliases for standard character types in PostgreSQL+      PGT_AST.NationalCharacterCharacter False -> pure $ VarE 'S.character `AppTypeE` LitT (NumTyLit 1) -- NCHAR -> character(1)+      PGT_AST.NationalCharacterCharacter True -> pure $ VarE 'S.text -- NCHAR VARYING -> text+      PGT_AST.NationalCharCharacter False -> pure $ VarE 'S.char `AppTypeE` LitT (NumTyLit 1) -- NATIONAL CHAR -> char(1)+      PGT_AST.NationalCharCharacter True -> pure $ VarE 'S.text -- NATIONAL CHAR VARYING -> text+      PGT_AST.NcharCharacter False -> pure $ VarE 'S.char `AppTypeE` LitT (NumTyLit 1) -- NCHAR (synonym for NATIONAL CHAR) -> char(1)+      PGT_AST.NcharCharacter True -> pure $ VarE 'S.text -- NCHAR VARYING -> text+  PGT_AST.ConstDatetimeSimpleTypename dt -> case dt of+    PGT_AST.TimestampConstDatetime precision maybeTimezone -> do+      when (isJust precision) $ fail "TIMESTAMP with precision is not supported."+      pure $ case maybeTimezone of+        Just False -> VarE 'S.timestampWithTimeZone -- WITH TIME ZONE+        _ -> VarE 'S.timestamp -- WITHOUT TIME ZONE or unspecified+    PGT_AST.TimeConstDatetime precision maybeTimezone -> do+      when (isJust precision) $ fail "TIME with precision is not supported."+      pure $ case maybeTimezone of+        Just False -> VarE 'S.timeWithTimeZone -- WITH TIME ZONE+        _ -> VarE 'S.time -- WITHOUT TIME ZONE or unspecified+  PGT_AST.ConstIntervalSimpleTypename (Left (Just _)) ->+    fail "INTERVAL with qualifiers is not supported."+  PGT_AST.ConstIntervalSimpleTypename (Left Nothing) ->+    pure $ VarE 'S.interval+  PGT_AST.ConstIntervalSimpleTypename (Right _) ->+    fail "INTERVAL with integer literal is not supported in this context."+++renderPGTNumeric :: PGT_AST.Numeric -> Q Exp+renderPGTNumeric = \case+  PGT_AST.IntNumeric -> pure $ VarE 'S.int+  PGT_AST.IntegerNumeric -> pure $ VarE 'S.integer+  PGT_AST.SmallintNumeric -> pure $ VarE 'S.smallint+  PGT_AST.BigintNumeric -> pure $ VarE 'S.bigint+  PGT_AST.RealNumeric -> pure $ VarE 'S.real+  PGT_AST.FloatNumeric (Just _) -> fail "FLOAT with precision is not supported."+  PGT_AST.FloatNumeric Nothing -> pure $ VarE 'S.float4+  PGT_AST.DoublePrecisionNumeric -> pure $ VarE 'S.doublePrecision+  PGT_AST.DecimalNumeric (Just _) -> fail "DECIMAL with precision/scale is not supported."+  PGT_AST.DecimalNumeric Nothing -> pure $ VarE 'S.numeric+  PGT_AST.DecNumeric (Just _) -> fail "DEC with precision/scale is not supported."+  PGT_AST.DecNumeric Nothing -> pure $ VarE 'S.numeric+  PGT_AST.NumericNumeric (Just _) -> fail "NUMERIC with precision/scale is not supported."+  PGT_AST.NumericNumeric Nothing -> pure $ VarE 'S.numeric+  PGT_AST.BooleanNumeric -> pure $ VarE 'S.bool+++{- |+  Translates the `Targeting` clause of a SQL SELECT statement from the+  `postgresql-syntax` AST (`PGT_AST.Targeting`) into a Squeal representation.+  The `Targeting` clause defines the list of expressions or columns to be+  returned by the query (e.g., `*`, `col1`, `col2 AS alias`, `DISTINCT col3`).++  The function returns a Template Haskell `Q` computation that, when run,+  produces a pair:+  1. `Exp`: A Template Haskell expression representing the Squeal selection list.+     This could be `S.Star` for `SELECT *`, or a constructed Squeal expression+     for a list of target elements (e.g., `expression1 :* expression2 :* S.Nil`).+  2. `Maybe [PGT_AST.AExpr]`: This field is used to pass along the expressions+     from a `DISTINCT ON (expr1, expr2, ...)` clause. If the query uses+     `DISTINCT ON`, this will be `Just` containing the list of `PGT_AST.AExpr`+     nodes representing `expr1, expr2, ...`. For all other types of targeting+     (e.g., `SELECT DISTINCT col`, `SELECT col1, col2`, `SELECT *`), this+     will be `Nothing`.++  The function handles different kinds of targeting:+  - `PGT_AST.NormalTargeting`: Standard `SELECT col1, col2, ...`+  - `PGT_AST.AllTargeting`: `SELECT ALL ...` (often equivalent to normal select or `SELECT *`)+  - `PGT_AST.DistinctTargeting`: `SELECT DISTINCT ...` or `SELECT DISTINCT ON (...) ...`++  Returns (SquealSelectionListExp, Maybe DistinctOnAstExpressions)+-}+renderPGTTargeting+  :: PGT_AST.Targeting+  -> Q (Exp, Maybe [PGT_AST.AExpr])+renderPGTTargeting = \case+  PGT_AST.NormalTargeting targetList -> do+    selListExp <- renderPGTTargetList targetList+    pure (selListExp, Nothing)+  PGT_AST.AllTargeting maybeTargetList -> do+    selListExp <-+      case maybeTargetList of+        Nothing -> pure $ ConE 'S.Star -- SELECT ALL (which is like SELECT *)+        Just tl -> renderPGTTargetList tl+    pure (selListExp, Nothing)+  PGT_AST.DistinctTargeting maybeOnExprs targetList -> do+    selListExp <- renderPGTTargetList targetList+    pure (selListExp, fmap NE.toList maybeOnExprs)+++renderPGTTargetEl :: PGT_AST.TargetEl -> Maybe PGT_AST.Ident -> Int -> Q Exp+renderPGTTargetEl targetEl mOuterAlias idx =+  let+    (exprAST, mInternalAlias) = case targetEl of+      PGT_AST.AliasedExprTargetEl e an -> (e, Just an)+      PGT_AST.ImplicitlyAliasedExprTargetEl e an -> (e, Just an)+      PGT_AST.ExprTargetEl e -> (e, Nothing)+      PGT_AST.AsteriskTargetEl ->+        ( PGT_AST.CExprAExpr+            ( PGT_AST.AexprConstCExpr+                PGT_AST.NullAexprConst+            )+        , Nothing -- Placeholder for Star, should be S.Star+        )+    finalAliasName = mOuterAlias <|> mInternalAlias+  in+    case targetEl of+      PGT_AST.AsteriskTargetEl -> pure $ ConE 'S.Star+      _ -> do+        renderedScalarExp <- renderPGTAExpr exprAST+        case exprAST of+          PGT_AST.CExprAExpr (PGT_AST.ColumnrefCExpr _)+            | Nothing <- finalAliasName ->+                pure renderedScalarExp+          _ -> do+            let+              aliasLabelStr =+                case finalAliasName of+                  Just ident -> Text.unpack $ getIdentText ident+                  Nothing -> "_col" <> show idx+            pure $+              VarE 'S.as+                `AppE` renderedScalarExp+                `AppE` LabelE aliasLabelStr+++renderPGTTargetList :: PGT_AST.TargetList -> Q Exp+renderPGTTargetList (item NE.:| items) =+    if null items && isAsterisk item+      then+        pure $ ConE 'S.Star+      else+        if null items && isDotStar item+          then+            renderPGTTargetElDotStar item+          else+            go (item : items) 1+  where+    isAsterisk :: PGT_AST.TargetEl -> Bool+    isAsterisk PGT_AST.AsteriskTargetEl = True+    isAsterisk _ = False++    isDotStar :: PGT_AST.TargetEl -> Bool+    isDotStar+      ( PGT_AST.ExprTargetEl+          ( PGT_AST.CExprAExpr+              (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref _ (Just indirection)))+            )+        ) =+        any isAllIndirectionEl (NE.toList indirection)+    isDotStar _ = False++    isAllIndirectionEl :: PGT_AST.IndirectionEl -> Bool+    isAllIndirectionEl PGT_AST.AllIndirectionEl = True+    isAllIndirectionEl _ = False++    renderPGTTargetElDotStar :: PGT_AST.TargetEl -> Q Exp+    renderPGTTargetElDotStar+      ( PGT_AST.ExprTargetEl+          ( PGT_AST.CExprAExpr+              ( PGT_AST.ColumnrefCExpr+                  ( PGT_AST.Columnref+                      qualName+                      indirectionOpt+                    )+                )+            )+        ) =+        case indirectionOpt of+          Just indirection+            | any isAllIndirectionEl (NE.toList indirection) ->+                pure $+                  ConE 'S.DotStar+                    `AppE` (LabelE (Text.unpack (getIdentText qualName)))+          _ ->+            fail $+              "renderPGTTargetElDotStar called with non-DotStar "+                <> "TargetEl structure"+    renderPGTTargetElDotStar _ =+      fail "renderPGTTargetElDotStar called with unexpected TargetEl"++    go :: [PGT_AST.TargetEl] -> Int -> Q Exp+    go [] _ =+      {- Should not happen with NonEmpty input to renderPGTTargetList -}+      fail "Empty selection list items in go."+    go [el] currentIdx = renderPGTTargetEl el Nothing currentIdx+    go (el : more) currentIdx = do+      renderedEl <- renderPGTTargetEl el Nothing currentIdx+      if null more+        then pure renderedEl+        else do+          restRendered <- go more (currentIdx + 1)+          pure $ ConE 'S.Also `AppE` restRendered `AppE` renderedEl++

@@ -0,0 +1,98 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE ViewPatterns #-}++-- | Description: Translate delete statements.+module Squeal.QuasiQuotes.Delete (+  toSquealDelete,+) where++import Control.Monad (when)+import Data.Maybe (isJust)+import Language.Haskell.TH.Syntax (Exp(AppE, ConE, LabelE, VarE), Q)+import Prelude+  ( Applicative(pure), Maybe(Just, Nothing), MonadFail(fail), ($), (<$>)+  )+import Squeal.QuasiQuotes.Common+  ( getIdentText, renderPGTAExpr, renderPGTTableRef, renderPGTTargetList+  )+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as Text+import qualified PostgresqlSyntax.Ast as PGT_AST+import qualified Squeal.PostgreSQL as S+++toSquealDelete :: PGT_AST.DeleteStmt -> Q Exp+toSquealDelete+  ( PGT_AST.DeleteStmt+      maybeWithClause+      relationExprOptAlias+      maybeUsingClause+      maybeWhereClause+      maybeReturningClause+    ) = do+    when (isJust maybeWithClause) $+      fail "WITH clauses are not supported in DELETE statements yet."+    -- whereOrCurrentClause with cursor is not supported yet++    targetTableExp <- renderPGTRelationExprOptAlias' relationExprOptAlias++    usingClauseExp <-+      case maybeUsingClause of+        Nothing -> pure $ ConE 'S.NoUsing+        Just usingClause -> AppE (ConE 'S.Using) <$> renderPGTTableRef usingClause++    whereConditionExp <-+      case maybeWhereClause of+        Nothing ->+          fail+            "DELETE statements must have a WHERE clause for safety. Use WHERE TRUE to delete all rows."+        Just (PGT_AST.ExprWhereOrCurrentClause whereAExpr) -> renderPGTAExpr whereAExpr+        Just (PGT_AST.CursorWhereOrCurrentClause _) -> fail "WHERE CURRENT OF is not supported."++    returningClauseExp <-+      case maybeReturningClause of+        Nothing -> pure $ ConE 'S.Returning_ `AppE` ConE 'S.Nil+        Just returningClause -> AppE (ConE 'S.Returning) <$> renderPGTTargetList returningClause++    pure+      ( VarE 'S.deleteFrom+          `AppE` targetTableExp+          `AppE` usingClauseExp+          `AppE` whereConditionExp+          `AppE` returningClauseExp+      )+++renderPGTRelationExprOptAlias' :: PGT_AST.RelationExprOptAlias -> Q Exp+renderPGTRelationExprOptAlias' (PGT_AST.RelationExprOptAlias relationExpr maybeAlias) = do+  (tableName, schemaName) <-+    case relationExpr of+      PGT_AST.SimpleRelationExpr (PGT_AST.SimpleQualifiedName ident) _ ->+        pure (getIdentText ident, Nothing)+      PGT_AST.SimpleRelationExpr+        ( PGT_AST.IndirectedQualifiedName+            schemaIdent+            (PGT_AST.AttrNameIndirectionEl tableIdent NE.:| [])+          )+        _ ->+          pure (getIdentText tableIdent, Just (getIdentText schemaIdent))+      _ -> fail "Unsupported relation expression in DELETE statement."++  let+    aliasName = case maybeAlias of+      Just (_, colId) -> getIdentText colId+      Nothing -> tableName++  let+    qualifiedAlias = case schemaName of+      Nothing -> LabelE (Text.unpack tableName)+      Just schema ->+        VarE '(S.!)+          `AppE` LabelE (Text.unpack schema)+          `AppE` LabelE (Text.unpack tableName)++  pure $ VarE 'S.as `AppE` qualifiedAlias `AppE` LabelE (Text.unpack aliasName)++

@@ -0,0 +1,209 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE ViewPatterns #-}++-- | Description: Translate insert statements.+module Squeal.QuasiQuotes.Insert (+  toSquealInsert,+) where++import Control.Monad (MonadFail(fail), mapM, when, zipWithM)+import Data.Maybe (isJust)+import Language.Haskell.TH.Syntax (Exp(AppE, ConE, LabelE, ListE, VarE), Q)+import Prelude+  ( Applicative(pure), Either(Left), Eq((/=)), Foldable(foldr, length)+  , Maybe(Just, Nothing), Semigroup((<>)), Show(show), ($), (.), error+  , otherwise+  )+import Squeal.QuasiQuotes.Common (getIdentText, renderPGTAExpr)+import Squeal.QuasiQuotes.Query (toSquealQuery)+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as Text+import qualified PostgresqlSyntax.Ast as PGT_AST+import qualified Squeal.PostgreSQL as S+++toSquealInsert :: PGT_AST.InsertStmt -> Q Exp+toSquealInsert+  ( PGT_AST.InsertStmt+      maybeWithClause+      insertTarget+      insertRest+      maybeOnConflict+      maybeReturningClause+    ) = do+    when (isJust maybeWithClause) $+      fail "WITH clauses are not supported in INSERT statements yet."+    when (isJust maybeOnConflict) $+      fail "ON CONFLICT clauses are not supported yet."++    insertBody <-+      case insertRest of+        PGT_AST.SelectInsertRest maybeInsertColumnList maybeOverrideKind selectStmt -> do+          when (isJust maybeOverrideKind) $+            fail "OVERRIDING clause is not supported yet."+          queryClauseExp <-+            case selectStmt of+              -- Case 1: INSERT ... VALUES ...+              Left+                (PGT_AST.SelectNoParens _ (Left (PGT_AST.ValuesSimpleSelect valuesClause)) _ _ _) ->+                  case maybeInsertColumnList of+                    Just colItems ->+                      renderPGTValueRows (NE.toList colItems) valuesClause+                    Nothing ->+                      fail+                        "INSERT INTO ... VALUES must specify column names for the Squeal-QQ translation."+              -- Case 2: INSERT ... SELECT ... (a general SELECT statement)+              _ ->+                -- selectStmt is not a ValuesSimpleSelect (i.e., it's a general query)+                case maybeInsertColumnList of+                  Just _ ->+                    fail+                      "INSERT INTO table (columns) SELECT ... is not yet supported by Squeal-QQ. Please use INSERT INTO table SELECT ... and ensure your SELECT statement provides all columns for the table, matching the table's column order and types."+                  Nothing -> do+                    squealQueryExp <- toSquealQuery selectStmt -- from Squeal.QuasiQuotes.Query+                    pure (ConE 'S.Subquery `AppE` squealQueryExp)+          let+            table = renderPGTInsertTarget insertTarget+          case maybeReturningClause of+            Nothing ->+              pure $ VarE 'S.insertInto_ `AppE` table `AppE` queryClauseExp+            Just (NE.toList -> [PGT_AST.AsteriskTargetEl]) -> do+              let+                returning = ConE 'S.Returning `AppE` ConE 'S.Star+              pure $+                VarE 'S.insertInto+                  `AppE` table+                  `AppE` queryClauseExp+                  `AppE` ConE 'S.OnConflictDoRaise+                  `AppE` returning+            Just targetList -> do+              returningProj <- renderTargetList (NE.toList targetList)+              let+                returning = ConE 'S.Returning `AppE` (ConE 'S.List `AppE` returningProj)+              pure $+                VarE 'S.insertInto+                  `AppE` table+                  `AppE` queryClauseExp+                  `AppE` ConE 'S.OnConflictDoRaise+                  `AppE` returning+        PGT_AST.DefaultValuesInsertRest ->+          fail "INSERT INTO ... DEFAULT VALUES is not yet supported by Squeal-QQ."++    pure insertBody+++renderTargetList :: [PGT_AST.TargetEl] -> Q Exp+renderTargetList targetEls = do+  exps <- mapM renderTargetEl targetEls+  pure $+    foldr+      (\h t -> ConE '(S.:*) `AppE` h `AppE` t)+      (ConE 'S.Nil)+      exps+++renderTargetEl :: PGT_AST.TargetEl -> Q Exp+renderTargetEl = \case+  PGT_AST.ExprTargetEl expr -> do+    exprExp <- renderPGTAExpr expr+    case expr of+      PGT_AST.CExprAExpr (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref ident Nothing)) ->+        let+          colName = getIdentText ident+        in+          pure $ VarE 'S.as `AppE` exprExp `AppE` LabelE (Text.unpack colName)+      _ ->+        fail+          "Returning expression without an alias is not supported for this expression type. Please add an alias."+  PGT_AST.AliasedExprTargetEl expr alias -> do+    exprExp <- renderPGTAExpr expr+    pure $+      VarE 'S.as `AppE` exprExp `AppE` LabelE (Text.unpack (getIdentText alias))+  PGT_AST.AsteriskTargetEl -> fail "should be handled by toSquealInsert"+  PGT_AST.ImplicitlyAliasedExprTargetEl{} ->+    fail "Implicitly aliased expressions in RETURNING are not supported"+++getUnqualifiedNameFromAst :: PGT_AST.QualifiedName -> Text.Text+getUnqualifiedNameFromAst (PGT_AST.SimpleQualifiedName ident) = getIdentText ident+getUnqualifiedNameFromAst (PGT_AST.IndirectedQualifiedName _ (PGT_AST.AttrNameIndirectionEl ident NE.:| [])) = getIdentText ident+getUnqualifiedNameFromAst unsupported =+  error $+    "Unsupported qualified name structure for extracting unqualified name: "+      <> show unsupported+++renderPGTInsertTarget :: PGT_AST.InsertTarget -> Exp+renderPGTInsertTarget (PGT_AST.InsertTarget qualifiedName maybeAsAlias) =+  let+    tableIdentifierExp = renderPGTQualifiedName qualifiedName+    targetAliasText = case maybeAsAlias of+      Nothing -> getUnqualifiedNameFromAst qualifiedName+      Just asAliasColId -> getIdentText asAliasColId+    targetAliasExp = LabelE (Text.unpack targetAliasText)+  in+    VarE 'S.as `AppE` tableIdentifierExp `AppE` targetAliasExp+++renderPGTQualifiedName :: PGT_AST.QualifiedName -> Exp+renderPGTQualifiedName = \case+  PGT_AST.SimpleQualifiedName ident -> LabelE (Text.unpack (getIdentText ident)) -- Defaults to public schema+  PGT_AST.IndirectedQualifiedName+    schemaIdent+    (PGT_AST.AttrNameIndirectionEl colIdent NE.:| []) ->+      -- Assuming simple schema.table form+      VarE '(S.!)+        `AppE` LabelE (Text.unpack (getIdentText schemaIdent))+        `AppE` LabelE (Text.unpack (getIdentText colIdent))+  unsupported -> error $ "Unsupported qualified name structure: " <> show unsupported+++renderPGTValueRows+  :: [PGT_AST.InsertColumnItem] -> PGT_AST.ValuesClause -> Q Exp+renderPGTValueRows colItems (valuesClauseRows) =+  -- valuesClauseRows is NonEmpty (NonEmpty AExpr)+  case NE.toList valuesClauseRows of+    [] -> fail "Insert statement has no value rows."+    row : moreRows -> do+      firstRowExp <- renderPGTValueRow colItems (NE.toList row)+      moreRowsExp <- mapM (renderPGTValueRow colItems . NE.toList) moreRows+      pure $+        ConE 'S.Values+          `AppE` firstRowExp+          `AppE` ListE moreRowsExp+++renderPGTValueRow :: [PGT_AST.InsertColumnItem] -> [PGT_AST.AExpr] -> Q Exp+renderPGTValueRow colItems exprs+    | length colItems /= length exprs =+        fail "Mismatched number of column names and values in INSERT statement."+    | otherwise = do+        processedItems <- zipWithM processItem colItems exprs+        pure $ foldr nvpToCons (ConE 'S.Nil) processedItems+  where+    nvpToCons :: Exp -> Exp -> Exp+    nvpToCons item acc = ConE '(S.:*) `AppE` item `AppE` acc++    processItem :: PGT_AST.InsertColumnItem -> PGT_AST.AExpr -> Q Exp+    processItem (PGT_AST.InsertColumnItem colId maybeIndirection) expr = do+      when (isJust maybeIndirection) $+        fail "INSERT with indirection (e.g., array access) is not supported."+      let+        colNameStr = Text.unpack (getIdentText colId)+      case expr of+        PGT_AST.DefaultAExpr ->+          -- Check for DEFAULT keyword+          pure $+            VarE 'S.as+              `AppE` ConE 'S.Default+              `AppE` LabelE colNameStr+        _ -> do+          renderedExpr <- renderPGTAExpr expr+          pure $+            VarE 'S.as+              `AppE` (ConE 'S.Set `AppE` renderedExpr)+              `AppE` LabelE colNameStr++

@@ -0,0 +1,568 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE ViewPatterns #-}++-- | Description: Translate query expressions.+module Squeal.QuasiQuotes.Query (+  toSquealQuery,+) where++import Control.Monad (unless, when)+import Data.Foldable (Foldable(foldl', foldr, null))+import Data.Maybe (fromMaybe, isJust, isNothing)+import Language.Haskell.TH.Syntax+  ( Exp(AppE, ConE, InfixE, LabelE, ListE, LitE, VarE), Lit(IntegerL), Q, mkName+  )+import Prelude+  ( Applicative(pure), Bool(False, True), Either(Left, Right)+  , Maybe(Just, Nothing), MonadFail(fail), Num((+)), Ord((>=)), Semigroup((<>))+  , Show(show), Traversable(mapM), ($), (&&), (<$>), Int, fromIntegral, zip+  )+import Squeal.QuasiQuotes.Common+  ( getIdentText, renderPGTAExpr, renderPGTTableRef, renderPGTTargeting+  )+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as Text+import qualified PostgresqlSyntax.Ast as PGT_AST+import qualified Squeal.PostgreSQL as S+++toSquealQuery :: PGT_AST.SelectStmt -> Q Exp+toSquealQuery selectStmt = case selectStmt of+  Left selectNoParens -> toSquealSelectNoParens selectNoParens+  Right selectWithParens -> toSquealSelectWithParens selectWithParens+++toSquealSelectWithParens :: PGT_AST.SelectWithParens -> Q Exp+toSquealSelectWithParens = \case+  PGT_AST.NoParensSelectWithParens snp -> toSquealSelectNoParens snp+  PGT_AST.WithParensSelectWithParens swp ->+    {- The AST structure itself should handle precedence.  Just recurse.  -}+    toSquealSelectWithParens swp+++toSquealSelectNoParens :: PGT_AST.SelectNoParens -> Q Exp+toSquealSelectNoParens+  ( PGT_AST.SelectNoParens+      maybeWithClause+      selectClause+      maybeSortClause+      maybeSelectLimit+      maybeForLockingClause+    ) = do+    when (isJust maybeWithClause) $ fail "WITH clauses are not supported yet."+    case selectClause of+      Left simpleSelect ->+        toSquealSimpleSelect+          simpleSelect+          maybeSortClause+          maybeSelectLimit+          maybeForLockingClause+      Right selectWithParens' -> toSquealSelectWithParens selectWithParens'+++toSquealSimpleSelect+  :: PGT_AST.SimpleSelect+  -> Maybe PGT_AST.SortClause+  -> Maybe PGT_AST.SelectLimit+  -> Maybe PGT_AST.ForLockingClause+  -> Q Exp+toSquealSimpleSelect simpleSelect maybeSortClause maybeSelectLimit maybeForLockingClause =+  case simpleSelect of+    PGT_AST.ValuesSimpleSelect valuesClause -> do+      unless+        ( isNothing maybeSortClause+            && isNothing maybeSelectLimit+            && isNothing maybeForLockingClause+        )+        $ fail+        $ "ORDER BY / OFFSET / LIMIT / FOR UPDATE etc. not supported with VALUES clause "+          <> "in this translation yet."+      renderedValues <- renderValuesClauseToNP valuesClause+      pure $ VarE 'S.values_ `AppE` renderedValues+    PGT_AST.NormalSimpleSelect+      maybeTargeting+      maybeIntoClause+      maybeFromClause+      maybeWhereClause+      maybeGroupClause+      maybeHavingClause+      maybeWindowClause ->+        do+          targeting <-+            case maybeTargeting of+              Nothing ->+                fail "SELECT without a selection list is not supported."+              Just targeting -> pure targeting+          case+              ( maybeFromClause+              , maybeGroupClause+              , maybeHavingClause+              , maybeIntoClause+              , maybeSelectLimit+              , maybeWhereClause+              , maybeWindowClause+              )+            of+              ( Nothing+                , Nothing+                , Nothing+                , Nothing+                , Nothing+                , Nothing+                , Nothing+                ) ->+                  do+                    -- Case: SELECT <targeting_list> (no FROM, no other clauses)+                    -- Translate to S.values_+                    renderedTargetingForValues <-+                      renderPGTTargetingForValues targeting+                    pure $+                      VarE 'S.values_ `AppE` renderedTargetingForValues+              (Nothing, _, _, _, _, _, _) ->+                {-+                  Case: SELECT <targeting_list> (no FROM, but other+                  clauses are present)+                -}+                fail $+                  "SELECT with targeting but no FROM clause cannot have "+                    <> "other clauses like INTO, WHERE, GROUP BY, HAVING, "+                    <> "WINDOW, or LIMIT/OFFSET."+              (Just fromClause, _, _, _, _, _, _) -> do+                -- Case: SELECT ... FROM ... (original logic)++                when (isJust maybeIntoClause) $+                  fail "INTO clause is not yet supported in this translation."+                when (isJust maybeWindowClause) $+                  fail $+                    "WINDOW clause is not yet supported in this translation "+                      <> "for NormalSimpleSelect with FROM."++                renderedFromClauseExp <- renderPGTTableRef fromClause+                let+                  baseTableExpr = VarE 'S.from `AppE` renderedFromClauseExp++                tableExprWithWhere <-+                  case maybeWhereClause of+                    Nothing -> pure baseTableExpr+                    Just wc -> do+                      renderedWC <- renderPGTAExpr wc+                      pure $+                        InfixE+                          (Just baseTableExpr)+                          (VarE '(S.&))+                          (Just (AppE (VarE 'S.where_) renderedWC))++                tableExprWithGroupBy <-+                  applyPGTGroupBy tableExprWithWhere maybeGroupClause++                tableExprWithHaving <-+                  case maybeHavingClause of+                    Nothing -> pure tableExprWithGroupBy+                    Just hc -> do+                      when (isNothing maybeGroupClause) $+                        fail "HAVING clause requires a GROUP BY clause."+                      renderedHC <- renderPGTAExpr hc+                      pure $+                        InfixE+                          (Just tableExprWithGroupBy)+                          (VarE '(S.&))+                          (Just (AppE (VarE 'S.having) renderedHC))++                tableExprWithOrderBy <-+                  case maybeSortClause of+                    Nothing -> pure tableExprWithHaving+                    Just sortClause -> do+                      renderedSC <- renderPGTSortClause sortClause+                      pure $+                        InfixE+                          (Just tableExprWithHaving)+                          (VarE '(S.&))+                          (Just (AppE (VarE 'S.orderBy) renderedSC))++                (tableExprWithOffset, mTableExprWithLimit) <-+                  processSelectLimit tableExprWithOrderBy maybeSelectLimit++                let+                  baseFinalTableExpr =+                    fromMaybe tableExprWithOffset mTableExprWithLimit++                -- Apply FOR LOCKING clause if present+                finalTableExprWithPotentialLocking <-+                  case maybeForLockingClause of+                    Nothing -> pure baseFinalTableExpr+                    Just flc -> do+                      lockingClauseExps <- renderPGTForLockingClauseItems flc+                      pure $+                        foldl'+                          ( \accTableExpr lockingClauseExp ->+                              InfixE+                                (Just accTableExpr)+                                (VarE '(S.&))+                                (Just (AppE (VarE 'S.lockRows) lockingClauseExp))+                          )+                          baseFinalTableExpr+                          lockingClauseExps++                (selectionTargetExp, maybeDistinctOnExprs) <-+                  renderPGTTargeting targeting++                squealSelectFn <-+                  case maybeDistinctOnExprs of+                    Nothing ->+                      case targeting of+                        PGT_AST.DistinctTargeting Nothing _ ->+                          pure $ VarE 'S.selectDistinct+                        _ -> pure $ VarE 'S.select -- Normal or ALL+                    Just distinctOnAstExprs -> do+                      distinctOnSquealSortExps <-+                        renderPGTOnExpressionsClause distinctOnAstExprs+                      pure $+                        VarE 'S.selectDistinctOn+                          `AppE` distinctOnSquealSortExps++                pure $+                  squealSelectFn+                    `AppE` selectionTargetExp+                    `AppE` finalTableExprWithPotentialLocking+    unsupportedSimpleSelect ->+      fail $+        "Unsupported simple select statement: "+          <> show unsupportedSimpleSelect+++-- Helper for VALUES clause: Assumes S.values_ for a single row of values.+-- PGT_AST.ValuesClause is NonEmpty (NonEmpty PGT_AST.AExpr)+renderValuesClauseToNP :: PGT_AST.ValuesClause -> Q Exp+renderValuesClauseToNP (firstRowExps NE.:| restRowExps) = do+    unless (null restRowExps) $+      fail $+        "Multi-row VALUES clause requires S.values, this translation "+          <> "currently supports single row S.values_."+    convertRowToNP firstRowExps+  where+    convertRowToNP :: NE.NonEmpty PGT_AST.AExpr -> Q Exp+    convertRowToNP exprs =+        go (NE.toList exprs) 1+      where+        go :: [PGT_AST.AExpr] -> Int -> Q Exp+        go [] _ = pure $ ConE 'S.Nil+        go (expr : fs) idx = do+          renderedExpr <- renderPGTAExpr expr+          let+            aliasText = "_column" <> show idx -- Default alias for VALUES+            aliasedExp = VarE 'S.as `AppE` renderedExpr `AppE` LabelE aliasText+          restExp <- go fs (idx + 1) -- restExp is Exp here+          -- Correct construction: aliasedExp :* restExp+          pure $ ConE '(S.:*) `AppE` aliasedExp `AppE` restExp+++renderPGTForLockingClauseItems :: PGT_AST.ForLockingClause -> Q [Exp]+renderPGTForLockingClauseItems = \case+  PGT_AST.ReadOnlyForLockingClause ->+    fail $+      "FOR READ ONLY is not supported as a row-level locking "+        <> "clause by Squeal-QQ."+  PGT_AST.ItemsForLockingClause itemsNe ->+    mapM renderPGTForLockingItem (NE.toList itemsNe)+++renderPGTForLockingItem :: PGT_AST.ForLockingItem -> Q Exp+renderPGTForLockingItem+  ( PGT_AST.ForLockingItem+      strength+      maybeTables+      waitingOpt+    ) = do+    squealStrength <- renderPGTForLockingStrength strength+    squealTables <-+      case maybeTables of+        Nothing ->+          {- Empty list for "OF" tables means all tables in query -}+          pure $ ConE 'S.Nil+        Just tablesNe -> do+          aliasExps <-+            mapM+              ( \qn -> case qn of+                  PGT_AST.SimpleQualifiedName ident ->+                    pure $ LabelE (Text.unpack $ getIdentText ident)+                  _ ->+                    fail $+                      "Qualified table names like schema.table in "+                        <> "FOR UPDATE/SHARE OF clauses are not yet "+                        <> "supported. Please use simple table aliases "+                        <> "that refer to tables in the FROM clause."+              )+              (NE.toList tablesNe)+          pure $+            foldr+              (\itemExp acc -> ConE '(S.:*) `AppE` itemExp `AppE` acc)+              (ConE 'S.Nil)+              aliasExps++    squealWaiting <- renderPGTWaiting waitingOpt++    pure $+      ConE 'S.For `AppE` squealStrength `AppE` squealTables `AppE` squealWaiting+++renderPGTForLockingStrength :: PGT_AST.ForLockingStrength -> Q Exp+renderPGTForLockingStrength = \case+  PGT_AST.UpdateForLockingStrength -> pure $ ConE 'S.Update+  PGT_AST.NoKeyUpdateForLockingStrength -> pure $ ConE 'S.NoKeyUpdate+  PGT_AST.ShareForLockingStrength -> pure $ ConE 'S.Share+  PGT_AST.KeyForLockingStrength -> pure $ ConE 'S.KeyShare+++renderPGTWaiting :: Maybe Bool -> Q Exp+renderPGTWaiting = \case+  Nothing -> pure $ ConE 'S.Wait -- Default (no NOWAIT or SKIP LOCKED)+  Just False -> pure $ ConE 'S.NoWait -- NOWAIT+  Just True -> pure $ ConE 'S.SkipLocked -- SKIP LOCKED+++applyPGTGroupBy :: Exp -> Maybe PGT_AST.GroupClause -> Q Exp+applyPGTGroupBy currentTableExpr = \case+    Nothing -> pure currentTableExpr+    Just groupClause -> do+      renderedGB <- renderPGTGroupByClauseElements groupClause+      pure $+        InfixE+          (Just currentTableExpr)+          (VarE '(S.&))+          (Just (AppE (VarE 'S.groupBy) renderedGB))+  where+    renderPGTGroupByClauseElements :: PGT_AST.GroupClause -> Q Exp+    renderPGTGroupByClauseElements = \case+      PGT_AST.EmptyGroupingSetGroupByItem NE.:| [] ->+        pure $ ConE 'S.Nil+      groupByItems -> do+        renderedExprs <- mapM renderPGTGroupByItem (NE.toList groupByItems)+        pure $+          foldr+            (\expr acc -> ConE '(S.:*) `AppE` expr `AppE` acc)+            (ConE 'S.Nil)+            renderedExprs+++renderPGTGroupByItem :: PGT_AST.GroupByItem -> Q Exp+renderPGTGroupByItem = \case+  PGT_AST.ExprGroupByItem scalarExpr -> renderPGTAExpr scalarExpr+  PGT_AST.EmptyGroupingSetGroupByItem -> pure (ConE 'S.Nil)+  unsupportedGroup ->+    fail $+      "Unsupported grouping expression: " <> show unsupportedGroup+++processSelectLimit :: Exp -> Maybe PGT_AST.SelectLimit -> Q (Exp, Maybe Exp)+processSelectLimit tableExpr Nothing = pure (tableExpr, Nothing)+processSelectLimit tableExpr (Just selectLimit) = do+  let+    (maybeOffsetClause, maybeLimitClause) = case selectLimit of+      PGT_AST.LimitOffsetSelectLimit lim off -> (Just off, Just lim)+      PGT_AST.OffsetLimitSelectLimit off lim -> (Just off, Just lim)+      PGT_AST.LimitSelectLimit lim -> (Nothing, Just lim)+      PGT_AST.OffsetSelectLimit off -> (Just off, Nothing)++  tableExprWithOffset <-+    case maybeOffsetClause of+      Nothing -> pure tableExpr+      Just offsetVal -> do+        offsetExp <- renderPGTOffsetClause offsetVal+        pure $+          InfixE+            (Just tableExpr)+            (VarE '(S.&))+            (Just (AppE (VarE 'S.offset) offsetExp))++  case maybeLimitClause of+    Nothing -> pure (tableExprWithOffset, Nothing)+    Just limitVal -> do+      limitExp <- renderPGTLimitClause limitVal+      pure+        ( tableExprWithOffset+        , Just+            ( InfixE+                (Just tableExprWithOffset)+                (VarE '(S.&))+                (Just (AppE (VarE 'S.limit) limitExp))+            )+        )+++renderPGTLimitClause :: PGT_AST.LimitClause -> Q Exp+renderPGTLimitClause = \case+  PGT_AST.LimitLimitClause slValue mOffsetVal -> do+    when (isJust mOffsetVal) $+      fail+        "LIMIT with comma (e.g. LIMIT x, y) is not supported. Use separate LIMIT and OFFSET clauses."+    case slValue of+      PGT_AST.ExprSelectLimitValue+        ( PGT_AST.CExprAExpr+            ( PGT_AST.FuncCExpr+                ( PGT_AST.ApplicationFuncExpr+                    ( PGT_AST.FuncApplication+                        (PGT_AST.TypeFuncName (PGT_AST.UnquotedIdent "inline"))+                        ( Just+                            ( PGT_AST.NormalFuncApplicationParams+                                Nothing+                                ( PGT_AST.ExprFuncArgExpr+                                    ( PGT_AST.CExprAExpr+                                        (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref ident Nothing))+                                      )+                                    NE.:| []+                                  )+                                Nothing+                              )+                          )+                      )+                    Nothing+                    Nothing+                    Nothing+                  )+              )+          ) -> pure $ VarE (mkName (Text.unpack (getIdentText ident)))+      PGT_AST.ExprSelectLimitValue+        (PGT_AST.CExprAExpr (PGT_AST.AexprConstCExpr (PGT_AST.IAexprConst n))) ->+          if n >= 0+            then pure (LitE (IntegerL (fromIntegral n)))+            else fail $ "LIMIT value must be non-negative: " <> show n+      PGT_AST.AllSelectLimitValue ->+        fail "LIMIT ALL not supported in this translation."+      expr -> fail $ "Unsupported LIMIT expression: " <> show expr+  PGT_AST.FetchOnlyLimitClause{} ->+    fail "FETCH clause is not fully supported yet."+++renderPGTOffsetClause :: PGT_AST.OffsetClause -> Q Exp+renderPGTOffsetClause = \case+  PGT_AST.ExprOffsetClause+    ( PGT_AST.CExprAExpr+        ( PGT_AST.FuncCExpr+            ( PGT_AST.ApplicationFuncExpr+                ( PGT_AST.FuncApplication+                    (PGT_AST.TypeFuncName (PGT_AST.UnquotedIdent "inline"))+                    ( Just+                        ( PGT_AST.NormalFuncApplicationParams+                            Nothing+                            ( PGT_AST.ExprFuncArgExpr+                                ( PGT_AST.CExprAExpr+                                    (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref ident Nothing))+                                  )+                                NE.:| []+                              )+                            Nothing+                          )+                      )+                  )+                Nothing+                Nothing+                Nothing+              )+          )+      ) -> pure $ VarE (mkName (Text.unpack (getIdentText ident)))+  PGT_AST.ExprOffsetClause+    (PGT_AST.CExprAExpr (PGT_AST.AexprConstCExpr (PGT_AST.IAexprConst n))) ->+      if n >= 0+        then pure (LitE (IntegerL (fromIntegral n)))+        else fail $ "OFFSET value must be non-negative: " <> show n+  PGT_AST.ExprOffsetClause expr ->+    fail $+      "Unsupported OFFSET expression: " <> show expr+  PGT_AST.FetchFirstOffsetClause{} ->+    fail "OFFSET with FETCH FIRST clause is not supported yet."+++-- Helper to render a single TargetEl for S.values_+-- Each expression must be aliased.+renderPGTTargetElForValues :: PGT_AST.TargetEl -> Int -> Q Exp+renderPGTTargetElForValues targetEl idx = do+  (exprAST, mUserAlias) <-+    case targetEl of+      PGT_AST.AliasedExprTargetEl e an -> pure (e, Just an)+      PGT_AST.ImplicitlyAliasedExprTargetEl e an -> pure (e, Just an)+      PGT_AST.ExprTargetEl e -> pure (e, Nothing)+      PGT_AST.AsteriskTargetEl ->+        fail "SELECT * is not supported unless there is a from clause."+  renderedScalarExp <- renderPGTAExpr exprAST+  let+    aliasLabelStr =+      case mUserAlias of+        Just ident -> Text.unpack $ getIdentText ident+        Nothing -> "_col" <> show idx -- Default alias for VALUES items+  pure $ VarE 'S.as `AppE` renderedScalarExp `AppE` LabelE aliasLabelStr+++-- Helper to render a TargetList into an NP list for S.values_+renderPGTTargetListForValues :: PGT_AST.TargetList -> Q Exp+renderPGTTargetListForValues (item NE.:| items) = do+  renderedItems <-+    mapM+      (\(el, idx) -> renderPGTTargetElForValues el idx)+      (zip (item : items) [1 ..])+  -- Construct NP list: e1 :* e2 :* ... :* Nil+  -- Each element in renderedItems is an Exp.+  -- The result of the fold should be an Exp.+  -- Then pure the final Exp.+  pure $+    foldr+      (\hd acc -> ConE '(S.:*) `AppE` hd `AppE` acc)+      (ConE 'S.Nil)+      renderedItems+++-- New function to render Targeting specifically for S.values_+renderPGTTargetingForValues :: PGT_AST.Targeting -> Q Exp+renderPGTTargetingForValues = \case+  PGT_AST.NormalTargeting targetList -> renderPGTTargetListForValues targetList+  PGT_AST.AllTargeting (Just targetList) ->+    renderPGTTargetListForValues targetList+  PGT_AST.AllTargeting Nothing ->+    fail $+      "SELECT * (ALL targeting without a list) is not supported "+        <> "with VALUES clause."+  PGT_AST.DistinctTargeting{} ->+    -- Handles both DISTINCT and DISTINCT ON+    fail $+      "DISTINCT and DISTINCT ON queries are not supported with VALUES clause in "+        <> "this translation."+++renderPGTOnExpressionsClause :: [PGT_AST.AExpr] -> Q Exp+renderPGTOnExpressionsClause exprs = do+    renderedSortExps <- mapM renderToSortExpr exprs+    pure $ ListE renderedSortExps+  where+    renderToSortExpr :: PGT_AST.AExpr -> Q Exp+    renderToSortExpr astExpr = do+      squealExpr <- renderPGTAExpr astExpr+      -- For DISTINCT ON, the direction (ASC/DESC) and NULLS order+      -- are typically specified in the ORDER BY clause.+      -- Here, we default to ASC for the SortExpression constructor.+      pure $ ConE 'S.Asc `AppE` squealExpr+++renderPGTSortClause :: PGT_AST.SortClause -> Q Exp+renderPGTSortClause sortBys = ListE <$> mapM renderPGTSortBy (NE.toList sortBys)+++renderPGTSortBy :: PGT_AST.SortBy -> Q Exp+renderPGTSortBy = \case+  PGT_AST.AscDescSortBy aExpr maybeAscDesc maybeNullsOrder -> do+    squealExpr <- renderPGTAExpr aExpr+    let+      (asc, desc) = case maybeNullsOrder of+        Nothing -> ('S.Asc, 'S.Desc)+        Just PGT_AST.FirstNullsOrder -> ('S.AscNullsFirst, 'S.DescNullsFirst)+        Just PGT_AST.LastNullsOrder -> ('S.AscNullsLast, 'S.DescNullsLast)++    let+      constructor = case maybeAscDesc of+        Just PGT_AST.DescAscDesc -> desc+        _ -> asc -- default to ASC+    pure $ ConE constructor `AppE` squealExpr+  PGT_AST.UsingSortBy{} -> fail "ORDER BY USING is not supported"++

@@ -0,0 +1,150 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{- |+  Description: Monomorphic squeal row types.++  This module provides a type family that converts a squeal row type into+  a specific, monomorphic tuple representation meant to be consumed by the+  user. The purpose of this so that the squeal quasiquoter won't produce+  polymorphic types, though it will produce a *different* monomorphic+  type depending on the columns returned by the query. The reason we want+  this is to help type inference as much as possible. Squeal already+  has some problems with type inference, and the burden on the user of+  navigating them is only likely to increase when a lot of the squeal+  "code" itself is hidden behind a quasiquoter.+-}+module Squeal.QuasiQuotes.RowType (+  RowType,+  monoQuery,+  monoManipulation,+  Field (..),+) where++import Data.Aeson (Value)+import Data.Int (Int32, Int64)+import Data.Text (Text)+import Data.Time (Day, UTCTime)+import Data.UUID (UUID)+import GHC.TypeLits (Symbol)+import Generics.SOP (SListI)+import Prelude (Applicative(pure), (<$>), Bool, Maybe)+import Squeal.PostgreSQL+  ( FromValue(fromValue), IsLabel(fromLabel), NullType(NotNull, Null)+  , PGType(PGbool, PGdate, PGint4, PGint8, PGjson, PGjsonb, PGtext, PGtimestamptz, PGuuid)+  , (:::), Json, Jsonb+  )+import qualified Squeal.PostgreSQL as Squeal+++++{- FOURMOLU_DISABLE -}+type family RowType a = b | b -> a where+  {-+    It would be more convenient to use a helper type family here that+    would map PGtypes to Haskell types. But if we did that, we would+    not be able to make this type family injective.++    This is Because GHC would not be able to tell that the right-hand+    side of this type family did not overlap even if that the helper+    type family were itself injective. Injectivity of the helper is not+    enough. The specific helper definition must happen to not produce+    instances that overlap with any Maybe type when used here.++    For instance, this example helper type family is injective, but when+    used here it would produce overlapping values for the `NotNull PGint4`+    and `Null PGbool` equations.++    type family Helper x = a | a -> x where+      Helper Int32 = Maybe Bool+      Helper Bool = Bool+  -}+  RowType (fld ::: 'NotNull PGbool ': more) = (Field fld Bool, RowType more)+  RowType (fld ::: 'NotNull PGint4 ': more) = (Field fld Int32, RowType more)+  RowType (fld ::: 'NotNull PGint8 ': more) = (Field fld Int64, RowType more)+  RowType (fld ::: 'NotNull PGtext ': more) = (Field fld Text, RowType more)+  RowType (fld ::: 'NotNull PGuuid ': more) = (Field fld UUID, RowType more)+  RowType (fld ::: 'NotNull PGdate ': more) = (Field fld Day, RowType more)+  RowType (fld ::: 'NotNull PGtimestamptz ': more) = (Field fld UTCTime, RowType more)+  RowType (fld ::: 'NotNull PGjsonb ': more) = (Field fld (Jsonb Value), RowType more)+  RowType (fld ::: 'NotNull PGjson ': more) = (Field fld (Json Value), RowType more)++  RowType (fld ::: 'Null PGbool ': more) = (Field fld (Maybe Bool), RowType more)+  RowType (fld ::: 'Null PGint4 ': more) = (Field fld (Maybe Int32), RowType more)+  RowType (fld ::: 'Null PGint8 ': more) = (Field fld (Maybe Int64), RowType more)+  RowType (fld ::: 'Null PGtext ': more) = (Field fld (Maybe Text), RowType more)+  RowType (fld ::: 'Null PGuuid ': more) = (Field fld (Maybe UUID), RowType more)+  RowType (fld ::: 'Null PGdate ': more) = (Field fld (Maybe Day), RowType more)+  RowType (fld ::: 'Null PGtimestamptz ': more) = (Field fld (Maybe UTCTime), RowType more)+  RowType (fld ::: 'Null PGjsonb ': more) = (Field fld (Maybe (Jsonb Value)), RowType more)+  RowType (fld ::: 'Null PGjson ': more) = (Field fld (Maybe (Json Value)), RowType more)+  RowType '[] = ()+{- FOURMOLU_ENABLE -}+++newtype Field (name :: Symbol) a = Field+  { unField :: a+  }+instance+    (Squeal.FromValue pg hask)+  =>+    Squeal.FromValue pg (Field name hask)+  where+    fromValue mbs = Field @name <$> Squeal.fromValue @pg mbs+++{- |+  Like 'Squeal.query', but use the monomorphizing 'RowType' family to+  fully specify the output rows. This is mainly a convenience to the+  template haskell code so it can simply quote this function instead of+  having to basically inline it directly in TH.+-}+monoQuery+  :: forall db params input row ignored.+     ( HasRowDecoder row (RowType row)+     , SListI row+     , Squeal.GenericParams db params input ignored+     )+  => Squeal.Query '[] '[] db params row+  -> Squeal.Statement db input (RowType row)+monoQuery = Squeal.Query Squeal.genericParams getRowDecoder+++monoManipulation+  :: forall db params input row ignored.+     ( HasRowDecoder row (RowType row)+     , SListI row+     , Squeal.GenericParams db params input ignored+     )+  => Squeal.Manipulation '[] db params row+  -> Squeal.Statement db input (RowType row)+monoManipulation = Squeal.Manipulation Squeal.genericParams getRowDecoder+++class HasRowDecoder row x where+  getRowDecoder :: Squeal.DecodeRow row x+instance+    ( HasRowDecoder moreRow moreFields+    , Squeal.FromValue typ t+    )+  =>+    HasRowDecoder ((fld ::: typ) ': moreRow) (Field fld t, moreFields)+  where+    getRowDecoder =+      Squeal.consRow+        (,)+        (fromLabel @fld)+        (getRowDecoder @moreRow @moreFields)+instance () => HasRowDecoder '[] () where+  getRowDecoder = pure ()++

@@ -0,0 +1,131 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE ViewPatterns #-}++-- | Description: Translate update statements.+module Squeal.QuasiQuotes.Update (+  toSquealUpdate,+) where++import Data.Text (Text)+import Control.Monad (when)+import Data.Maybe (isJust)+import Language.Haskell.TH.Syntax (Exp(AppE, ConE, LabelE, VarE), Q)+import Prelude+  ( Applicative(pure), Foldable(foldr), Maybe(Just, Nothing), MonadFail(fail)+  , Traversable(mapM), ($), (<$>)+  )+import Squeal.QuasiQuotes.Common+  ( getIdentText, renderPGTAExpr, renderPGTTableRef, renderPGTTargetList+  )+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as Text+import qualified PostgresqlSyntax.Ast as PGT_AST+import qualified Squeal.PostgreSQL as S+++toSquealUpdate :: PGT_AST.UpdateStmt -> Q Exp+toSquealUpdate+  ( PGT_AST.UpdateStmt+      maybeWithClause+      relationExprOptAlias+      setClauseList+      maybeFromClause+      maybeWhereClause+      maybeReturningClause+    ) = do+    when (isJust maybeWithClause) $+      fail "WITH clauses are not supported in UPDATE statements yet."+    targetTableExp <- renderPGTRelationExprOptAlias' relationExprOptAlias++    setClauseExp <- renderPGTSetClauseList setClauseList++    usingClauseExp <-+      case maybeFromClause of+        Nothing -> pure $ ConE 'S.NoUsing+        Just fromClause -> AppE (ConE 'S.Using) <$> renderPGTTableRef fromClause++    whereConditionExp <-+      case maybeWhereClause of+        Nothing ->+          fail+            "UPDATE statements must have a WHERE clause for safety. Use WHERE TRUE to update all rows."+        Just (PGT_AST.ExprWhereOrCurrentClause whereAExpr) -> renderPGTAExpr whereAExpr+        Just (PGT_AST.CursorWhereOrCurrentClause _) -> fail "WHERE CURRENT OF is not supported."++    returningClauseExp <-+      case maybeReturningClause of+        Nothing -> pure $ ConE 'S.Returning_ `AppE` ConE 'S.Nil+        Just returningClause -> AppE (ConE 'S.Returning) <$> renderPGTTargetList returningClause++    pure $+      ( VarE 'S.update+          `AppE` targetTableExp+          `AppE` setClauseExp+          `AppE` usingClauseExp+          `AppE` whereConditionExp+          `AppE` returningClauseExp+      )+++renderPGTRelationExprOptAlias' :: PGT_AST.RelationExprOptAlias -> Q Exp+renderPGTRelationExprOptAlias' (PGT_AST.RelationExprOptAlias relationExpr maybeAlias) = do+  (tableName, schemaName) <-+    case relationExpr of+      PGT_AST.SimpleRelationExpr (PGT_AST.SimpleQualifiedName ident) _ ->+        pure (getIdentText ident, Nothing)+      PGT_AST.SimpleRelationExpr+        ( PGT_AST.IndirectedQualifiedName+            schemaIdent+            (PGT_AST.AttrNameIndirectionEl tableIdent NE.:| [])+          )+        _ ->+          pure (getIdentText tableIdent, Just (getIdentText schemaIdent))+      _ -> fail "Unsupported relation expression in UPDATE statement."++  let+    aliasName :: Text+    aliasName =+      case maybeAlias of+        Just (_, colId) -> getIdentText colId+        Nothing -> tableName++    qualifiedAlias :: Exp+    qualifiedAlias =+      case schemaName of+        Nothing -> LabelE (Text.unpack tableName)+        Just schema ->+          VarE '(S.!)+            `AppE` LabelE (Text.unpack schema)+            `AppE` LabelE (Text.unpack tableName)++  pure $ VarE 'S.as `AppE` qualifiedAlias `AppE` LabelE (Text.unpack aliasName)+++renderPGTSetClauseList :: PGT_AST.SetClauseList -> Q Exp+renderPGTSetClauseList setClauses = do+  renderedItems <- mapM renderPGTSetClause (NE.toList setClauses)+  pure $+    foldr+      (\item acc -> ConE '(S.:*) `AppE` item `AppE` acc)+      (ConE 'S.Nil)+      renderedItems+++renderPGTSetClause :: PGT_AST.SetClause -> Q Exp+renderPGTSetClause = \case+  PGT_AST.TargetSetClause (PGT_AST.SetTarget colId maybeIndirection) aExpr -> do+    when (isJust maybeIndirection) $+      fail "UPDATE SET with indirection (e.g., array access) is not supported."+    let colNameStr = Text.unpack (getIdentText colId)+    renderedExpr <- renderPGTAExpr aExpr+    pure $+      VarE 'S.as+        `AppE` (ConE 'S.Set `AppE` renderedExpr)+        `AppE` LabelE colNameStr+  PGT_AST.TargetListSetClause _ _ ->+    fail+      "UPDATE with multiple SET targets (e.g. (col1, col2) = (val1, val2)) is not yet supported."++

@@ -0,0 +1,1530 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++-- {-# OPTIONS_GHC -ddump-splices #-}++module Main (main) where++import Data.Aeson (Value)+import Data.Int (Int32, Int64)+import Data.Text (Text)+import Data.Time (Day, UTCTime)+import Data.UUID (UUID)+import Data.Word (Word64)+import GHC.Generics (Generic)+import Prelude+  ( Applicative(pure), Eq((==)), Maybe(Just, Nothing), MonadFail(fail)+  , Semigroup((<>)), Show(show), ($), (.), Bool, IO, putStrLn+  )+import Squeal.PostgreSQL+  ( NullType(NotNull, Null), Optionality(Def, NoDef)+  , PGType(PGint4, PGjson, PGjsonb, PGtext, PGuuid), RenderSQL(renderSQL)+  , SchemumType(Table), TableConstraint(ForeignKey, PrimaryKey), (:::), (:=>)+  , Json, Jsonb, Only, Statement+  )+import Squeal.QuasiQuotes (Field, ssql)+import Test.Hspec (describe, hspec, it)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Generics.SOP as SOP+++++{- FOURMOLU_DISABLE -}+{- Copied mostly from the squeal documentation: -}+type UsersColumns =+  '[          "id" :::   'Def :=> 'NotNull 'PGtext+   ,        "name" ::: 'NoDef :=> 'NotNull 'PGtext+   , "employee_id" ::: 'NoDef :=> 'NotNull 'PGuuid+   ,         "bio" ::: 'NoDef :=> 'Null    'PGtext+   ]+type UsersConstraints = '[ "pk_users" ::: 'PrimaryKey '["id"] ]+type EmailsColumns =+  '[      "id" :::   'Def :=> 'NotNull 'PGint4+   , "user_id" ::: 'NoDef :=> 'NotNull 'PGtext+   ,   "email" ::: 'NoDef :=> 'Null 'PGtext+   ]+type EmailsConstraints =+  '[ "pk_emails"  ::: 'PrimaryKey '["id"]+   , "fk_user_id" ::: 'ForeignKey '["user_id"] "public" "users" '["id"]+   ]+type Schema =+  '[      "users" ::: 'Table (UsersConstraints :=> UsersColumns)+   ,     "emails" ::: 'Table (EmailsConstraints :=> EmailsColumns)+   , "jsonb_test" ::: 'Table ('[] :=> '["data" ::: 'NoDef :=> 'NotNull 'PGjsonb])+   ,  "json_test" ::: 'Table ('[] :=> '["data" ::: 'NoDef :=> 'NotNull 'PGjson])+   , "users_copy" ::: 'Table (UsersCopyConstraints :=> UsersCopyColumns)+   ]+type UsersCopyColumns =+  '[ "id"   ::: 'NoDef :=> 'NotNull 'PGtext+   , "name" ::: 'NoDef :=> 'NotNull 'PGtext+   , "bio"  ::: 'NoDef :=> 'Null    'PGtext+   ]+type UsersCopyConstraints = '[ "pk_users_copy" ::: 'PrimaryKey '["id"] ]+type DB =+  '[ "public" ::: Schema+   ,  "other" ::: Schema+   ]+{- FOURMOLU_ENABLE -}+++data User = User+  { id :: Text+  , name :: Text+  }+  deriving stock (Generic, Show)+  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)+++main :: IO ()+main =+  hspec $ do+    describe "queries" $ do+      it "select * from users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          statement = [ssql| select * from users |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select * from public.users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          statement = [ssql| select * from public.users |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "SELECT * FROM \"users\" AS \"users\"" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          statement = [ssql| SELECT * FROM "users" AS "users" |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select * from users where name = 'bob'" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          statement = [ssql| select * from users where name = 'bob' |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"users\" AS \"users\" WHERE (\"name\" = (E'bob' :: text))"+        checkStatement squealRendering statement++      it "select user.name from users" $ do+        let+          statement :: Statement DB () (Field "name" Text, ())+          statement = [ssql| select users.name from users |]+          squealRendering :: Text+          squealRendering = "SELECT \"users\".\"name\" AS \"name\" FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select name from users" $ do+        let+          statement :: Statement DB () (Field "name" Text, ())+          statement = [ssql| select name from users |]+          squealRendering :: Text+          squealRendering = "SELECT \"name\" AS \"name\" FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select count(*) from users group by ()" $ do+        let+          statement :: Statement DB () (Field "_col1" Int64, ())+          statement = [ssql| select count(*) from users group by () |]+          squealRendering :: Text+          squealRendering = "SELECT count(*) AS \"_col1\" FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select name, id from users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "name" Text+                 , ( Field "id" Text+                   , ()+                   )+                 )+          statement = [ssql| select name, id from users |]+          squealRendering :: Text+          squealRendering = "SELECT \"name\" AS \"name\", \"id\" AS \"id\" FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select id, name from users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ()+                   )+                 )+          statement = [ssql| select id, name from users |]+          squealRendering :: Text+          squealRendering = "SELECT \"id\" AS \"id\", \"name\" AS \"name\" FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select users.id, employee_id from users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "employee_id" UUID+                   , ()+                   )+                 )+          statement = [ssql| select users.id, employee_id from users |]+          squealRendering :: Text+          squealRendering =+            "SELECT \"users\".\"id\" AS \"id\", \"employee_id\" AS \"employee_id\" FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select users.* from users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          statement = [ssql| select users.* from users |]+          squealRendering :: Text+          squealRendering = "SELECT \"users\".* FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select users.* from other.users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          statement = [ssql| select users.* from other.users |]+          squealRendering :: Text+          squealRendering = "SELECT \"users\".* FROM \"other\".\"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select * from users limit 3" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          statement = [ssql| select * from users limit 3 |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"users\" AS \"users\" LIMIT 3"+        checkStatement squealRendering statement++      it "select * from users limit inline(lim)" $ do+        let+          mkStatement+            :: Word64+            -> Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          mkStatement lim =+            [ssql| select * from users limit inline(lim) |]++          squealRendering1 :: Text+          squealRendering1 = "SELECT * FROM \"users\" AS \"users\" LIMIT 10"++          squealRendering2 :: Text+          squealRendering2 = "SELECT * FROM \"users\" AS \"users\" LIMIT 20"++        checkStatement squealRendering1 (mkStatement 10)+        checkStatement squealRendering2 (mkStatement 20)++      it "select * from users offset inline(off)" $ do+        let+          mkStatement+            :: Word64+            -> Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          mkStatement off =+            [ssql| select * from users offset inline(off) |]++          squealRendering1 :: Text+          squealRendering1 = "SELECT * FROM \"users\" AS \"users\" OFFSET 5"++          squealRendering2 :: Text+          squealRendering2 = "SELECT * FROM \"users\" AS \"users\" OFFSET 15"++        checkStatement squealRendering1 (mkStatement 5)+        checkStatement squealRendering2 (mkStatement 15)++      it "select * from users offset 1" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          statement = [ssql| select * from users offset 1 |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"users\" AS \"users\" OFFSET 1"+        checkStatement squealRendering statement++      it "select users.id, employee_id as emp_id from users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "emp_id" UUID+                   , ()+                   )+                 )+          statement = [ssql| select users.id, employee_id as emp_id from users |]+          squealRendering :: Text+          squealRendering =+            "SELECT \"users\".\"id\" AS \"id\", \"employee_id\" AS \"emp_id\" FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select users.id as user_id, employee_id from users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "user_id" Text+                 , ( Field "employee_id" UUID+                   , ()+                   )+                 )+          statement = [ssql| select users.id as user_id, employee_id from users |]+          squealRendering :: Text+          squealRendering =+            "SELECT \"users\".\"id\" AS \"user_id\", \"employee_id\" AS \"employee_id\" FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it+        "select users.id from users left outer join emails on users.id == emails.user_id"+        $ do+          let+            statement+              :: Statement+                   DB+                   ()+                   ( Field "id" Text+                   , ()+                   )+            statement =+              [ssql|+                select users.id+                from users+                left outer join emails+                on emails.user_id = users.id+              |]+            squealRendering :: Text+            squealRendering =+              "SELECT \"users\".\"id\" AS \"id\" FROM \"users\" AS \"users\" LEFT OUTER JOIN \"emails\" AS \"emails\" ON (\"emails\".\"user_id\" = \"users\".\"id\")"+          checkStatement squealRendering statement++      it+        "select * from users left outer join emails on users.id == emails.user_id"+        $ do+          let+            targetEmail :: Text+            targetEmail = "foo@bar.com"++            statement+              :: Statement+                   DB+                   ()+                   ( Field "id" Text+                   , ( Field "name" Text+                     , ( Field "email" (Maybe Text)+                       , ()+                       )+                     )+                   )+            statement =+              [ssql|+                select users.id, users.name, emails.email+                from users+                left outer join emails+                on emails.user_id = users.id+                where emails.email = inline("targetEmail")+              |]++            squealRendering :: Text+            squealRendering =+              "SELECT \"users\".\"id\" AS \"id\", \"users\".\"name\" AS \"name\", \"emails\".\"email\" AS \"email\" FROM \"users\" AS \"users\" LEFT OUTER JOIN \"emails\" AS \"emails\" ON (\"emails\".\"user_id\" = \"users\".\"id\") WHERE (\"emails\".\"email\" = (E'foo@bar.com' :: text))"++          checkStatement squealRendering statement++      it "select 'text_val'" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "_col1" Text+                 , ()+                 )+          statement = [ssql| select 'text_val' |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM (VALUES ((E'text_val' :: text))) AS t (\"_col1\")"+        checkStatement squealRendering statement++      it "select 1" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "_col1" Int64+                 , ()+                 )+          statement = [ssql| select 1 |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM (VALUES (1)) AS t (\"_col1\")"+        checkStatement squealRendering statement++      it "select 1 AS num, 'text_val' AS txt" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "num" Int64+                 , ( Field "txt" Text+                   , ()+                   )+                 )+          statement = [ssql| select 1 AS num, 'text_val' AS txt |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM (VALUES (1, (E'text_val' :: text))) AS t (\"num\", \"txt\")"+        checkStatement squealRendering statement++      describe "group by" $ do+        it "select name from users group by name" $ do+          let+            statement :: Statement DB () (Field "name" Text, ())+            statement = [ssql| select name from users group by name |]+            squealRendering :: Text+            squealRendering = "SELECT \"name\" AS \"name\" FROM \"users\" AS \"users\" GROUP BY \"name\""+          checkStatement squealRendering statement++        it "select employee_id, count(id) from users group by employee_id" $ do+          let+            statement+              :: Statement+                   DB+                   ()+                   ( Field "employee_id" UUID+                   , ( Field "_col2" Int64 -- Assuming count returns Int64+                     , ()+                     )+                   )+            statement = [ssql| select employee_id, count(id) from users group by employee_id |]+            squealRendering :: Text+            squealRendering =+              "SELECT \"employee_id\" AS \"employee_id\", count(ALL \"id\") AS \"_col2\" FROM \"users\" AS \"users\" GROUP BY \"employee_id\""+          checkStatement squealRendering statement++        it "select employee_id, name, count(id) from users group by employee_id, name" $ do+          let+            statement+              :: Statement+                   DB+                   ()+                   ( Field "employee_id" UUID+                   , ( Field "name" Text+                     , ( Field "_col3" Int64+                       , ()+                       )+                     )+                   )+            statement =+              [ssql| select employee_id, name, count(id) from users group by employee_id, name |]+            squealRendering :: Text+            squealRendering =+              "SELECT \"employee_id\" AS \"employee_id\", \"name\" AS \"name\", count(ALL \"id\") AS \"_col3\" FROM \"users\" AS \"users\" GROUP BY \"employee_id\", \"name\""+          checkStatement squealRendering statement++    describe "inserts" $ do+      it "insert into emails (id, user_id, email) values (1, 'user-1', 'foo@bar')" $ do+        let+          statement+            :: Statement DB () ()+          statement =+            [ssql|+              insert into+                emails (id, user_id, email)+                values (1, 'user-1', 'foo@bar')+            |]+          squealRendering :: Text+          squealRendering =+            "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (1, (E'user-1' :: text), (E'foo@bar' :: text))"+        checkStatement squealRendering statement++      it "insert into emails (id, user_id, email) values (1, 'user-1', $1)" $ do+        let+          statement+            :: Statement+                 DB+                 (Only (Maybe Text))+                 ()+          statement =+            [ssql|+              insert into+                emails (id, user_id, email)+                values (1, 'user-1', $1)+            |]+          squealRendering :: Text+          squealRendering =+            "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (1, (E'user-1' :: text), ($1 :: text))"+        checkStatement squealRendering statement++      it "insert into emails (id, user_id, email) values (1, $2, $1)" $ do+        let+          statement+            :: Statement+                 DB+                 (Maybe Text, Text)+                 ()+          statement =+            {-+              Note the parameters are backwards (i.e. $2 comes before $1),+              to test that you can do this kind of thing out of order.+            -}+            [ssql|+              insert into+                emails (id, user_id, email)+                values (1, $2, $1)+            |]+          squealRendering :: Text+          squealRendering =+            "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (1, ($2 :: text), ($1 :: text))"+        checkStatement squealRendering statement++      it+        "insert into emails (id, user_id, email) values (inline(i), inline(uid), inline(e))"+        $ do+          let+            mkStatement :: Int32 -> Text -> Maybe Text -> Statement DB () ()+            mkStatement i uid e =+              [ssql|+                insert into+                  emails (id, user_id, email)+                  values (inline(i), inline(uid), inline_param(e))+              |]++          checkStatement+            "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES ((1 :: int4), (E'user-1' :: text), NULL)"+            (mkStatement 1 "user-1" Nothing)+          checkStatement+            "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES ((1 :: int4), (E'user-1' :: text), (E'foo@bar.com' :: text))"+            (mkStatement 1 "user-1" (Just "foo@bar.com"))++      describe "default keyword" $ do+        it "insert into emails (id, user_id, email) values (default, 'foo', 'bar')" $ do+          let+            statement+              :: Statement+                   DB+                   (Maybe Text, Text)+                   ()+            statement =+              [ssql|+                insert into+                  emails (id, user_id, email)+                  values (default, 'foo', 'bar')+              |]+            squealRendering :: Text+            squealRendering =+              "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (DEFAULT, (E'foo' :: text), (E'bar' :: text))"+          checkStatement squealRendering statement++        it "insert into emails (id, user_id, email) values (deFault, 'foo', 'bar')" $ do+          let+            statement+              :: Statement+                   DB+                   (Maybe Text, Text)+                   ()+            statement =+              [ssql|+                insert into+                  emails (id, user_id, email)+                  values (deFault, 'foo', 'bar')+              |]+            squealRendering :: Text+            squealRendering =+              "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (DEFAULT, (E'foo' :: text), (E'bar' :: text))"+          checkStatement squealRendering statement++        it "insert into emails (id, user_id, email) values (DEFAULT, 'foo', 'bar')" $ do+          let+            statement+              :: Statement+                   DB+                   (Maybe Text, Text)+                   ()+            statement =+              [ssql|+                insert into+                  emails (id, user_id, email)+                  values (DEFAULT, 'foo', 'bar')+              |]+            squealRendering :: Text+            squealRendering =+              "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (DEFAULT, (E'foo' :: text), (E'bar' :: text))"+          checkStatement squealRendering statement++      describe "null keyword" $ do+        it "insert into emails (id, user_id, email) values (DEFAULT, 'foo', null)" $ do+          let+            statement+              :: Statement+                   DB+                   (Maybe Text, Text)+                   ()+            statement =+              [ssql|+                insert into+                  emails (id, user_id, email)+                  values (DEFAULT, 'foo', null)+              |]+            squealRendering :: Text+            squealRendering =+              "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (DEFAULT, (E'foo' :: text), NULL)"+          checkStatement squealRendering statement++        it "insert into emails (id, user_id, email) values (DEFAULT, 'foo', NULL)" $ do+          let+            statement+              :: Statement+                   DB+                   (Maybe Text, Text)+                   ()+            statement =+              [ssql|+                insert into+                  emails (id, user_id, email)+                  values (DEFAULT, 'foo', NULL)+              |]+            squealRendering :: Text+            squealRendering =+              "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (DEFAULT, (E'foo' :: text), NULL)"+          checkStatement squealRendering statement++        it "insert into emails (id, user_id, email) values (DEFAULT, 'foo', NuLL)" $ do+          let+            statement+              :: Statement+                   DB+                   (Maybe Text, Text)+                   ()+            statement =+              [ssql|+                insert into+                  emails (id, user_id, email)+                  values (DEFAULT, 'foo', NuLL)+              |]+            squealRendering :: Text+            squealRendering =+              "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (DEFAULT, (E'foo' :: text), NULL)"+          checkStatement squealRendering statement++      describe "insert ... select ..." $ do+        it "insert into emails select id, user_id, email from emails where id = 1" $ do+          let+            statement :: Statement DB () ()+            statement =+              [ssql|+                insert into emails+                select id, user_id, email from emails where id = 1+              |]+            squealRendering :: Text+            squealRendering =+              "INSERT INTO \"emails\" AS \"emails\" SELECT \"id\" AS \"id\", \"user_id\" AS \"user_id\", \"email\" AS \"email\" FROM \"emails\" AS \"emails\" WHERE (\"id\" = 1)"+          checkStatement squealRendering statement++        it "insert into emails select id, user_id, email from emails where id = $1" $ do+          let+            statement :: Statement DB (Only Int32) ()+            statement =+              [ssql|+                insert into emails+                select id, user_id, email from emails where id = $1+              |]+            squealRendering :: Text+            squealRendering =+              "INSERT INTO \"emails\" AS \"emails\" SELECT \"id\" AS \"id\", \"user_id\" AS \"user_id\", \"email\" AS \"email\" FROM \"emails\" AS \"emails\" WHERE (\"id\" = ($1 :: int4))"+          checkStatement squealRendering statement++        it+          "insert into users_copy select id, name, bio from users where users.id = 'uid1'"+          $ do+            let+              statement :: Statement DB () ()+              statement =+                [ssql|+                  insert into users_copy+                  select id, name, bio from users where users.id = 'uid1'+                |]+              squealRendering :: Text+              squealRendering =+                "INSERT INTO \"users_copy\" AS \"users_copy\" SELECT \"id\" AS \"id\", \"name\" AS \"name\", \"bio\" AS \"bio\" FROM \"users\" AS \"users\" WHERE (\"users\".\"id\" = (E'uid1' :: text))"+            checkStatement squealRendering statement++      describe "returning clause" $ do+        it+          "insert into emails (id, user_id, email) values (1, 'user-1', 'foo@bar') returning id"+          $ do+            let+              statement+                :: Statement DB () (Field "id" Int32, ())+              statement =+                [ssql|+                insert into+                  emails (id, user_id, email)+                  values (1, 'user-1', 'foo@bar')+                returning id+              |]+              squealRendering :: Text+              squealRendering =+                "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (1, (E'user-1' :: text), (E'foo@bar' :: text)) RETURNING \"id\" AS \"id\""+            checkStatement squealRendering statement++        it+          "insert into emails (id, user_id, email) values (1, 'user-1', 'foo@bar') returning *"+          $ do+            let+              statement+                :: Statement+                     DB+                     ()+                     ( Field "id" Int32+                     , ( Field "user_id" Text+                       , ( Field "email" (Maybe Text)+                         , ()+                         )+                       )+                     )+              statement =+                [ssql|+                insert into+                  emails (id, user_id, email)+                  values (1, 'user-1', 'foo@bar')+                returning *+              |]+              squealRendering :: Text+              squealRendering =+                "INSERT INTO \"emails\" AS \"emails\" (\"id\", \"user_id\", \"email\") VALUES (1, (E'user-1' :: text), (E'foo@bar' :: text)) RETURNING *"+            checkStatement squealRendering statement++    describe "deletes" $ do+      it "delete from users where true" $ do+        let+          statement :: Statement DB () ()+          statement = [ssql| delete from users where true |]+          squealRendering :: Text+          squealRendering = "DELETE FROM \"users\" AS \"users\" WHERE TRUE"++        checkStatement squealRendering statement++      it "delete from emails where id = 1" $ do+        let+          statement :: Statement DB () ()+          statement = [ssql| delete from emails where id = 1 |]+          squealRendering :: Text+          squealRendering =+            "DELETE FROM \"emails\" AS \"emails\" WHERE (\"id\" = 1)"+        checkStatement squealRendering statement++      it "delete from emails where email = inline(e)" $ do+        let+          statement :: Statement DB () ()+          statement = [ssql| delete from emails where email = inline(e) |]+          e :: Text+          e = "foo"+          squealRendering :: Text+          squealRendering =+            "DELETE FROM \"emails\" AS \"emails\" WHERE (\"email\" = (E'foo' :: text))"+        checkStatement squealRendering statement++      it "delete from users where id = 'some-id' returning id" $ do+        let+          statement :: Statement DB () (Field "id" Text, ())+          statement = [ssql| delete from users where id = 'some-id' returning id |]+          squealRendering :: Text+          squealRendering =+            "DELETE FROM \"users\" AS \"users\" WHERE (\"id\" = (E'some-id' :: text)) RETURNING \"id\" AS \"id\""+        checkStatement squealRendering statement++    describe "updates" $ do+      it "update users set name = 'new name' where id = 'some-id'" $ do+        let+          statement :: Statement DB () ()+          statement = [ssql| update users set name = 'new name' where id = 'some-id' |]+          squealRendering :: Text+          squealRendering =+            "UPDATE \"users\" AS \"users\" SET \"name\" = (E'new name' :: text) WHERE (\"id\" = (E'some-id' :: text))"+        checkStatement squealRendering statement++      it "update users set name = 'new name', bio = 'new bio' where id = 'some-id'" $ do+        let+          statement :: Statement DB () ()+          statement =+            [ssql| update users set name = 'new name', bio = 'new bio' where id = 'some-id' |]+          squealRendering :: Text+          squealRendering =+            "UPDATE \"users\" AS \"users\" SET \"name\" = (E'new name' :: text), \"bio\" = (E'new bio' :: text) WHERE (\"id\" = (E'some-id' :: text))"+        checkStatement squealRendering statement++      it "update users set name = inline(n) where id = 'some-id'" $ do+        let+          n :: Text+          n = "new name"+          statement :: Statement DB () ()+          statement = [ssql| update users set name = inline(n) where id = 'some-id' |]+          squealRendering :: Text+          squealRendering =+            "UPDATE \"users\" AS \"users\" SET \"name\" = (E'new name' :: text) WHERE (\"id\" = (E'some-id' :: text))"+        checkStatement squealRendering statement++      it "update users set name = 'new name' where id = 'some-id' returning id" $ do+        let+          statement :: Statement DB () (Field "id" Text, ())+          statement =+            [ssql| update users set name = 'new name' where id = 'some-id' returning id |]+          squealRendering :: Text+          squealRendering =+            "UPDATE \"users\" AS \"users\" SET \"name\" = (E'new name' :: text) WHERE (\"id\" = (E'some-id' :: text)) RETURNING \"id\" AS \"id\""+        checkStatement squealRendering statement++    describe "scalar expressions" $ do+      -- Binary Operators+      it "select id != 'no-such-user' as neq from users" $ do+        let+          stmt :: Statement DB () (Field "neq" (Maybe Bool), ())+          stmt = [ssql| select users.id != 'no-such-user' as neq from users |]+          squealRendering :: Text+          squealRendering =+            "SELECT (\"users\".\"id\" <> (E'no-such-user' :: text)) AS "+              <> "\"neq\" FROM \"users\" AS \"users\""+        checkStatement squealRendering stmt++      it "select * from users where id <> 'no-such-user'" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          stmt = [ssql| select * from users where users.id <> 'no-such-user' |]+          squealRendering :: Text+          squealRendering =+            "SELECT * FROM \"users\" AS \"users\" WHERE (\"users\".\"id\" <> (E'no-such-user' :: text))"+        checkStatement squealRendering stmt++      it "select * from emails where id > 0" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 (Field "id" Int32, (Field "user_id" Text, (Field "email" (Maybe Text), ())))+          stmt = [ssql| select * from emails where emails.id > 0 |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"emails\" AS \"emails\" WHERE (\"emails\".\"id\" > 0)"+        checkStatement squealRendering stmt++      it "select * from emails where id >= 0" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 (Field "id" Int32, (Field "user_id" Text, (Field "email" (Maybe Text), ())))+          stmt = [ssql| select * from emails where emails.id >= 0 |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"emails\" AS \"emails\" WHERE (\"emails\".\"id\" >= 0)"+        checkStatement squealRendering stmt++      it "select * from emails where id < 10" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 (Field "id" Int32, (Field "user_id" Text, (Field "email" (Maybe Text), ())))+          stmt = [ssql| select * from emails where emails.id < 10 |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"emails\" AS \"emails\" WHERE (\"emails\".\"id\" < 10)"+        checkStatement squealRendering stmt++      it "select * from emails where id <= 10" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 (Field "id" Int32, (Field "user_id" Text, (Field "email" (Maybe Text), ())))+          stmt = [ssql| select * from emails where emails.id <= 10 |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"emails\" AS \"emails\" WHERE (\"emails\".\"id\" <= 10)"+        checkStatement squealRendering stmt++      it "select id + 1 as plus_one from emails" $ do+        let+          stmt :: Statement DB () (Field "plus_one" Int32, ())+          stmt = [ssql| select emails.id + 1 as plus_one from emails |]+          squealRendering :: Text+          squealRendering =+            "SELECT (\"emails\".\"id\" + 1) AS \"plus_one\" FROM \"emails\" AS \"emails\""+        checkStatement squealRendering stmt++      it "select id - 1 as minus_one from emails" $ do+        let+          stmt :: Statement DB () (Field "minus_one" Int32, ())+          stmt = [ssql| select emails.id - 1 as minus_one from emails |]+          squealRendering :: Text+          squealRendering =+            "SELECT (\"emails\".\"id\" - 1) AS \"minus_one\" FROM \"emails\" AS \"emails\""+        checkStatement squealRendering stmt++      it "select id * 2 as times_two from emails" $ do+        let+          stmt :: Statement DB () (Field "times_two" Int32, ())+          stmt = [ssql| select emails.id * 2 as times_two from emails |]+          squealRendering :: Text+          squealRendering =+            "SELECT (\"emails\".\"id\" * 2) AS \"times_two\" FROM \"emails\" AS \"emails\""+        checkStatement squealRendering stmt++      it "select * from users where id = 'a' and name = 'b'" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , (Field "name" Text, (Field "employee_id" UUID, (Field "bio" (Maybe Text), ())))+                 )+          stmt = [ssql| select * from users where users.id = 'a' and users.name = 'b' |]+          squealRendering :: Text+          squealRendering =+            "SELECT * FROM \"users\" AS \"users\" WHERE ((\"users\".\"id\" = (E'a' :: text)) AND (\"users\".\"name\" = (E'b' :: text)))"+        checkStatement squealRendering stmt++      it "select * from users where id = 'a' or name = 'b'" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , (Field "name" Text, (Field "employee_id" UUID, (Field "bio" (Maybe Text), ())))+                 )+          stmt = [ssql| select * from users where users.id = 'a' or users.name = 'b' |]+          squealRendering :: Text+          squealRendering =+            "SELECT * FROM \"users\" AS \"users\" WHERE ((\"users\".\"id\" = (E'a' :: text)) OR (\"users\".\"name\" = (E'b' :: text)))"+        checkStatement squealRendering stmt++      it "select * from users where name like 'A%'" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , (Field "name" Text, (Field "employee_id" UUID, (Field "bio" (Maybe Text), ())))+                 )+          stmt = [ssql| select * from users where users.name like 'A%' |]+          squealRendering :: Text+          squealRendering =+            "SELECT * FROM \"users\" AS \"users\" WHERE (\"users\".\"name\" LIKE (E'A%' :: text))"+        checkStatement squealRendering stmt++      it "select * from users where name ilike 'a%'" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , (Field "name" Text, (Field "employee_id" UUID, (Field "bio" (Maybe Text), ())))+                 )+          stmt = [ssql| select * from users where users.name ilike 'a%' |]+          squealRendering :: Text+          squealRendering =+            "SELECT * FROM \"users\" AS \"users\" WHERE (\"users\".\"name\" ILIKE (E'a%' :: text))"+        checkStatement squealRendering stmt++      -- Prefix Operators+      it "select * from users where not (name = 'no-one')" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , (Field "name" Text, (Field "employee_id" UUID, (Field "bio" (Maybe Text), ())))+                 )+          stmt = [ssql| select * from users where not (users.name = 'no-one') |]+          squealRendering :: Text+          squealRendering =+            "SELECT * FROM \"users\" AS \"users\" WHERE (NOT (\"users\".\"name\" = (E'no-one' :: text)))"+        checkStatement squealRendering stmt++      it "select -id as neg_id from emails" $ do+        let+          stmt :: Statement DB () (Field "neg_id" Int32, ())+          stmt = [ssql| select -emails.id as neg_id from emails |]+          squealRendering :: Text+          squealRendering =+            "SELECT ((0 :: int4) - \"emails\".\"id\") AS \"neg_id\" FROM \"emails\" AS \"emails\""+        checkStatement squealRendering stmt++      -- Postfix Operators+      it "select * from users where bio is null" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , (Field "name" Text, (Field "employee_id" UUID, (Field "bio" (Maybe Text), ())))+                 )+          stmt = [ssql| select * from users where users.bio is null |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"users\" AS \"users\" WHERE \"users\".\"bio\" IS NULL"+        checkStatement squealRendering stmt++      it "select * from users where bio is not null" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , (Field "name" Text, (Field "employee_id" UUID, (Field "bio" (Maybe Text), ())))+                 )+          stmt = [ssql| select * from users where users.bio is not null |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"users\" AS \"users\" WHERE \"users\".\"bio\" IS NOT NULL"+        checkStatement squealRendering stmt++      describe "function calls" $ do+        -- Function Calls+        it "select coalesce(bio, 'no bio') as bio from users" $ do+          let+            stmt :: Statement DB () (Field "bio" Text, ())+            stmt = [ssql| select coalesce(users.bio, 'no bio') as bio from users |]+            squealRendering :: Text+            squealRendering =+              "SELECT COALESCE(\"users\".\"bio\", (E'no bio' :: text)) AS \"bio\" FROM \"users\" AS \"users\""+          checkStatement squealRendering stmt++        it "select lower(name) as lower_name from users" $ do+          let+            stmt :: Statement DB () (Field "lower_name" Text, ())+            stmt = [ssql| select lower(users.name) as lower_name from users |]+            squealRendering :: Text+            squealRendering =+              "SELECT lower(\"users\".\"name\") AS \"lower_name\" FROM \"users\" AS \"users\""+          checkStatement squealRendering stmt++        it "select char_length(name) as name_len from users" $ do+          let+            stmt :: Statement DB () (Field "name_len" Int32, ())+            stmt = [ssql| select char_length(users.name) as name_len from users |]+            squealRendering :: Text+            squealRendering =+              "SELECT char_length(\"users\".\"name\") AS \"name_len\" FROM \"users\" AS \"users\""+          checkStatement squealRendering stmt++        it "select character_length(name) as name_len_alias from users" $ do+          let+            stmt :: Statement DB () (Field "name_len_alias" Int32, ())+            stmt = [ssql| select character_length(users.name) as name_len_alias from users |]+            squealRendering :: Text+            squealRendering =+              "SELECT char_length(\"users\".\"name\") AS \"name_len_alias\" FROM \"users\" AS \"users\""+          checkStatement squealRendering stmt++        it "select upper(name) as upper_name from users" $ do+          let+            stmt :: Statement DB () (Field "upper_name" Text, ())+            stmt = [ssql| select "upper"(users.name) as upper_name from users |]+            squealRendering :: Text+            squealRendering =+              "SELECT upper(\"users\".\"name\") AS \"upper_name\" FROM \"users\" AS \"users\""+          checkStatement squealRendering stmt++        it "select now() as current_time" $ do+          let+            stmt :: Statement DB () (Field "current_time" UTCTime, ())+            stmt = [ssql| select now() as current_time |]+            squealRendering :: Text+            squealRendering = "SELECT * FROM (VALUES (now())) AS t (\"current_time\")"+          checkStatement squealRendering stmt++        it "select current_date as today" $ do+          let+            stmt :: Statement DB () (Field "today" Day, ())+            stmt = [ssql| select current_date as today |]+            squealRendering :: Text+            squealRendering = "SELECT * FROM (VALUES (CURRENT_DATE)) AS t (\"today\")"+          checkStatement squealRendering stmt++        it "haskell variables in expressions" $ do+          let+            mkStatement+              :: Text+              -> Statement+                   DB+                   ()+                   ( Field "id" Text+                   , ( Field "name" Text+                     , ( Field "employee_id" UUID+                       , ( Field "bio" (Maybe Text)+                         , ()+                         )+                       )+                     )+                   )+            mkStatement someName =+              [ssql| select * from users where name = inline("someName") |]++            squealRendering1 :: Text+            squealRendering1 = "SELECT * FROM \"users\" AS \"users\" WHERE (\"name\" = (E'Alice' :: text))"++            squealRendering2 :: Text+            squealRendering2 = "SELECT * FROM \"users\" AS \"users\" WHERE (\"name\" = (E'Bob' :: text))"++          checkStatement squealRendering1 (mkStatement "Alice")+          checkStatement squealRendering2 (mkStatement "Bob")++      -- PARENS (implicitly tested by complex expressions)+      it "select (id + 1) * 2 as calc from emails" $ do+        let+          stmt :: Statement DB () (Field "calc" Int32, ())+          stmt = [ssql| select (emails.id + 1) * 2 as calc from emails |]+          squealRendering :: Text+          squealRendering =+            "SELECT ((\"emails\".\"id\" + 1) * 2) AS \"calc\" FROM \"emails\" AS \"emails\""+        checkStatement squealRendering stmt++      -- IN / NOT IN+      it "select * from users where name in ('Alice', 'Bob')" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , (Field "name" Text, (Field "employee_id" UUID, (Field "bio" (Maybe Text), ())))+                 )+          stmt = [ssql| select * from users where users.name in ('Alice', 'Bob') |]+          squealRendering :: Text+          squealRendering =+            "SELECT * FROM \"users\" AS \"users\" WHERE \"users\".\"name\" IN ((E'Alice' :: text), (E'Bob' :: text))"+        checkStatement squealRendering stmt++      it "select * from users where name not in ('Alice', 'Bob')" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , (Field "name" Text, (Field "employee_id" UUID, (Field "bio" (Maybe Text), ())))+                 )+          stmt = [ssql| select * from users where users.name not in ('Alice', 'Bob') |]+          squealRendering :: Text+          squealRendering =+            "SELECT * FROM \"users\" AS \"users\" WHERE \"users\".\"name\" NOT IN ((E'Alice' :: text), (E'Bob' :: text))"+        checkStatement squealRendering stmt++      -- BETWEEN / NOT BETWEEN+      it "select * from emails where id between 0 and 10" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 (Field "id" Int32, (Field "user_id" Text, (Field "email" (Maybe Text), ())))+          stmt = [ssql| select * from emails where emails.id between 0 and 10 |]+          squealRendering :: Text+          squealRendering =+            "SELECT * FROM \"emails\" AS \"emails\" WHERE \"emails\".\"id\" BETWEEN 0 AND 10"+        checkStatement squealRendering stmt++      it "select * from emails where id not between 0 and 10" $ do+        let+          stmt+            :: Statement+                 DB+                 ()+                 (Field "id" Int32, (Field "user_id" Text, (Field "email" (Maybe Text), ())))+          stmt = [ssql| select * from emails where emails.id not between 0 and 10 |]+          squealRendering :: Text+          squealRendering =+            "SELECT * FROM \"emails\" AS \"emails\" WHERE \"emails\".\"id\" NOT BETWEEN 0 AND 10"+        checkStatement squealRendering stmt++      -- CAST+      it "select cast(e.id as text) as casted_id from emails as e" $ do+        let+          stmt :: Statement DB () (Field "casted_id" Text, ())+          stmt = [ssql| select (e.id :: text) as casted_id from emails as e |]+          squealRendering :: Text+          squealRendering = "SELECT (\"e\".\"id\" :: text) AS \"casted_id\" FROM \"emails\" AS \"e\""+        checkStatement squealRendering stmt++      it "select * from users for update" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          statement = [ssql| select * from users for update |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"users\" AS \"users\" FOR UPDATE"+        checkStatement squealRendering statement++      it "select * from jsonb_test" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "data" (Jsonb Value)+                 , ()+                 )+          statement = [ssql| select * from jsonb_test |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"jsonb_test\" AS \"jsonb_test\""+        checkStatement squealRendering statement++      it "select * from json_test" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "data" (Json Value)+                 , ()+                 )+          statement = [ssql| select * from json_test |]+          squealRendering :: Text+          squealRendering = "SELECT * FROM \"json_test\" AS \"json_test\""+        checkStatement squealRendering statement++      it "select distinct name from users" $ do+        let+          statement :: Statement DB () (Field "name" Text, ())+          statement = [ssql| select distinct name from users |]+          squealRendering :: Text+          squealRendering = "SELECT DISTINCT \"name\" AS \"name\" FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select distinct * from users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "id" Text+                 , ( Field "name" Text+                   , ( Field "employee_id" UUID+                     , ( Field "bio" (Maybe Text)+                       , ()+                       )+                     )+                   )+                 )+          statement = [ssql| select distinct * from users |]+          squealRendering :: Text+          squealRendering = "SELECT DISTINCT * FROM \"users\" AS \"users\""+        checkStatement squealRendering statement++      it "select distinct on (employee_id) employee_id, name from users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "employee_id" UUID+                 , ( Field "name" Text+                   , ()+                   )+                 )+          statement = [ssql| select distinct on (employee_id) employee_id, name from users |]+          squealRendering :: Text+          squealRendering =+            "SELECT DISTINCT ON (\"employee_id\") \"employee_id\" AS \"employee_id\", \"name\" AS \"name\" FROM \"users\" AS \"users\" ORDER BY \"employee_id\" ASC"+        checkStatement squealRendering statement++      it "select distinct on (employee_id, name) employee_id, name, id from users" $ do+        let+          statement+            :: Statement+                 DB+                 ()+                 ( Field "employee_id" UUID+                 , ( Field "name" Text+                   , ( Field "id" Text+                     , ()+                     )+                   )+                 )+          statement =+            [ssql| select distinct on (employee_id, name) employee_id, name, id from users |]+          squealRendering :: Text+          squealRendering =+            "SELECT DISTINCT ON (\"employee_id\", \"name\") \"employee_id\" AS \"employee_id\", \"name\" AS \"name\", \"id\" AS \"id\" FROM \"users\" AS \"users\" ORDER BY \"employee_id\" ASC, \"name\" ASC"+        checkStatement squealRendering statement++      describe "order by" $ do+        it "select * from users order by name" $ do+          let+            statement+              :: Statement+                   DB+                   ()+                   ( Field "id" Text+                   , ( Field "name" Text+                     , ( Field "employee_id" UUID+                       , ( Field "bio" (Maybe Text)+                         , ()+                         )+                       )+                     )+                   )+            statement = [ssql| select * from users order by name |]+            squealRendering :: Text+            squealRendering = "SELECT * FROM \"users\" AS \"users\" ORDER BY \"name\" ASC"+          checkStatement squealRendering statement++        it "select * from users order by name asc" $ do+          let+            statement+              :: Statement+                   DB+                   ()+                   ( Field "id" Text+                   , ( Field "name" Text+                     , ( Field "employee_id" UUID+                       , ( Field "bio" (Maybe Text)+                         , ()+                         )+                       )+                     )+                   )+            statement = [ssql| select * from users order by name asc |]+            squealRendering :: Text+            squealRendering = "SELECT * FROM \"users\" AS \"users\" ORDER BY \"name\" ASC"+          checkStatement squealRendering statement++        it "select * from users order by name desc" $ do+          let+            statement+              :: Statement+                   DB+                   ()+                   ( Field "id" Text+                   , ( Field "name" Text+                     , ( Field "employee_id" UUID+                       , ( Field "bio" (Maybe Text)+                         , ()+                         )+                       )+                     )+                   )+            statement = [ssql| select * from users order by name desc |]+            squealRendering :: Text+            squealRendering = "SELECT * FROM \"users\" AS \"users\" ORDER BY \"name\" DESC"+          checkStatement squealRendering statement++      describe "having clause" $ do+        it+          "select employee_id, count(id) from users group by employee_id having count(id) > 1"+          $ do+            let+              statement+                :: Statement+                     DB+                     ()+                     ( Field "employee_id" UUID+                     , ( Field "_col2" Int64 -- Assuming count returns Int64+                       , ()+                       )+                     )+              statement =+                [ssql|+                  select employee_id, count(id)+                  from users+                  group by employee_id+                  having count(id) > 1+                |]+              squealRendering :: Text+              squealRendering =+                "SELECT \"employee_id\" AS \"employee_id\", count(ALL \"id\") AS \"_col2\" FROM \"users\" AS \"users\" GROUP BY \"employee_id\" HAVING (count(ALL \"id\") > 1)"+            checkStatement squealRendering statement+++_printQuery :: (RenderSQL a) => a -> IO ()+_printQuery = putStrLn . T.unpack . TE.decodeUtf8 . renderSQL+++checkStatement+  :: (RenderSQL sql)+  => Text+  -> sql+  -> IO ()+checkStatement expect statement =+  let+    rendered :: Text+    rendered = TE.decodeUtf8 (renderSQL statement)+  in+    if rendered == expect+      then+        pure ()+      else+        fail $+          "SQL statements do not match.\nExpected:\n"+            <> show expect+            <> "\nActual:\n"+            <> show rendered+            <> "\n"++