{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE ViewPatterns #-}

-- | Description: Translate query expressions.
module Squeal.QuasiQuotes.Query (
  toSquealQuery,
  renderPGTTableRef,
  renderPGTTargeting,
  renderPGTTargetList,
  renderPGTAExpr,
  getIdentText,
) where

import Control.Applicative (Alternative((<|>)))
import Control.Monad (unless, when)
import Data.Foldable (Foldable(elem, foldl'), foldlM)
import Data.Maybe (fromMaybe, isJust, isNothing)
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((==))
  , Foldable(foldr, length, null), Functor(fmap), Maybe(Just, Nothing)
  , MonadFail(fail), Num((*), (+), (-), fromInteger), Ord((<), (>=))
  , Semigroup((<>)), Show(show), Traversable(mapM), ($), (&&), (.), (<$>), (||)
  , Int, Integer, any, either, error, fromIntegral, id, otherwise, zip
  )
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


toSquealQuery
  :: [Text.Text]
  -> Maybe (NE.NonEmpty PGT_AST.Ident)
  -> PGT_AST.SelectStmt
  -> Q Exp
toSquealQuery :: [Text] -> Maybe (NonEmpty Ident) -> SelectStmt -> Q Exp
toSquealQuery [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases SelectStmt
selectStmt = case SelectStmt
selectStmt of
  Left SelectNoParens
selectNoParens -> [Text] -> Maybe (NonEmpty Ident) -> SelectNoParens -> Q Exp
toSquealSelectNoParens [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases SelectNoParens
selectNoParens
  Right SelectWithParens
selectWithParens -> [Text] -> Maybe (NonEmpty Ident) -> SelectWithParens -> Q Exp
toSquealSelectWithParens [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases SelectWithParens
selectWithParens


toSquealSelectWithParens
  :: [Text.Text]
  -> Maybe (NE.NonEmpty PGT_AST.Ident)
  -> PGT_AST.SelectWithParens
  -> Q Exp
toSquealSelectWithParens :: [Text] -> Maybe (NonEmpty Ident) -> SelectWithParens -> Q Exp
toSquealSelectWithParens [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases = \case
  PGT_AST.NoParensSelectWithParens SelectNoParens
snp -> [Text] -> Maybe (NonEmpty Ident) -> SelectNoParens -> Q Exp
toSquealSelectNoParens [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases SelectNoParens
snp
  PGT_AST.WithParensSelectWithParens SelectWithParens
swp ->
    {- The AST structure itself should handle precedence.  Just recurse.  -}
    [Text] -> Maybe (NonEmpty Ident) -> SelectWithParens -> Q Exp
toSquealSelectWithParens [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases SelectWithParens
swp


toSquealSelectNoParens
  :: [Text.Text]
  -> Maybe (NE.NonEmpty PGT_AST.Ident)
  -> PGT_AST.SelectNoParens
  -> Q Exp
toSquealSelectNoParens :: [Text] -> Maybe (NonEmpty Ident) -> SelectNoParens -> Q Exp
toSquealSelectNoParens
  [Text]
initialCteNames
  Maybe (NonEmpty Ident)
maybeColAliases
  ( PGT_AST.SelectNoParens
      Maybe WithClause
maybeWithClause
      SelectClause
selectClause
      Maybe SortClause
maybeSortClause
      Maybe SelectLimit
maybeSelectLimit
      Maybe ForLockingClause
maybeForLockingClause
    ) = do
    (cteNames, renderedWithClause) <-
      case Maybe WithClause
maybeWithClause of
        Maybe WithClause
Nothing -> ([Text], Maybe Exp) -> Q ([Text], Maybe Exp)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
initialCteNames, Maybe Exp
forall a. Maybe a
Nothing)
        Just WithClause
withClause -> do
          (names, exp) <- [Text] -> WithClause -> Q ([Text], Exp)
renderPGTWithClause [Text]
initialCteNames WithClause
withClause
          pure (names, Just exp)

    squealQueryBody <-
      case selectClause of
        Left SimpleSelect
simpleSelect ->
          [Text]
-> Maybe (NonEmpty Ident)
-> SimpleSelect
-> Maybe SortClause
-> Maybe SelectLimit
-> Maybe ForLockingClause
-> Q Exp
toSquealSimpleSelect
            [Text]
cteNames
            Maybe (NonEmpty Ident)
maybeColAliases
            SimpleSelect
simpleSelect
            Maybe SortClause
maybeSortClause
            Maybe SelectLimit
maybeSelectLimit
            Maybe ForLockingClause
maybeForLockingClause
        Right SelectWithParens
selectWithParens' -> [Text] -> Maybe (NonEmpty Ident) -> SelectWithParens -> Q Exp
toSquealSelectWithParens [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases SelectWithParens
selectWithParens'

    case renderedWithClause of
      Maybe Exp
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
squealQueryBody
      Just Exp
withExp -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.with Exp -> Exp -> Exp
`AppE` Exp
withExp Exp -> Exp -> Exp
`AppE` Exp
squealQueryBody


renderPGTWithClause :: [Text.Text] -> PGT_AST.WithClause -> Q ([Text.Text], Exp)
renderPGTWithClause :: [Text] -> WithClause -> Q ([Text], Exp)
renderPGTWithClause [Text]
initialCteNames (PGT_AST.WithClause Bool
recursive NonEmpty CommonTableExpr
ctes) = do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
recursive (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Recursive WITH clauses are not supported yet."
    let
      cteList :: [CommonTableExpr]
cteList = NonEmpty CommonTableExpr -> [CommonTableExpr]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty CommonTableExpr
ctes
    (finalCteNames, renderedCtes) <-
      (([Text], [Exp]) -> CommonTableExpr -> Q ([Text], [Exp]))
-> ([Text], [Exp]) -> [CommonTableExpr] -> Q ([Text], [Exp])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
        ( \([Text]
names, [Exp]
exps) CommonTableExpr
cte -> do
            (name, exp) <- [Text] -> CommonTableExpr -> Q (Text, Exp)
renderCte [Text]
names CommonTableExpr
cte
            pure (names <> [name], exps <> [exp])
        )
        ([Text]
initialCteNames, [])
        [CommonTableExpr]
cteList

    let
      withExp =
        (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          (\Exp
cte Exp
acc -> Name -> Exp
ConE '(S.:>>) Exp -> Exp -> Exp
`AppE` Exp
cte Exp -> Exp -> Exp
`AppE` Exp
acc)
          (Name -> Exp
ConE 'S.Done)
          [Exp]
renderedCtes
    pure (finalCteNames, withExp)
  where
    renderCte :: [Text.Text] -> PGT_AST.CommonTableExpr -> Q (Text.Text, Exp)
    renderCte :: [Text] -> CommonTableExpr -> Q (Text, Exp)
renderCte [Text]
existingCteNames (PGT_AST.CommonTableExpr Ident
ident Maybe (NonEmpty Ident)
maybeColNames Maybe Bool
maybeMaterialized PreparableStmt
stmt) = do
      Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (NonEmpty Ident) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (NonEmpty Ident)
maybeColNames) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
        String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Column name lists in CTEs are not supported yet."
      Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust Maybe Bool
maybeMaterialized) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
        String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"MATERIALIZED/NOT MATERIALIZED for CTEs is not supported yet."
      cteQueryExp <-
        case PreparableStmt
stmt of
          PGT_AST.SelectPreparableStmt SelectStmt
selectStmt -> [Text] -> Maybe (NonEmpty Ident) -> SelectStmt -> Q Exp
toSquealQuery [Text]
existingCteNames Maybe (NonEmpty Ident)
forall a. Maybe a
Nothing SelectStmt
selectStmt
          PreparableStmt
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Only SELECT statements are supported in CTEs."
      let
        cteName = Ident -> Text
getIdentText Ident
ident
      pure
        (cteName, VarE 'S.as `AppE` cteQueryExp `AppE` LabelE (Text.unpack cteName))


toSquealSimpleSelect
  :: [Text.Text]
  -> Maybe (NE.NonEmpty PGT_AST.Ident)
  -> PGT_AST.SimpleSelect
  -> Maybe PGT_AST.SortClause
  -> Maybe PGT_AST.SelectLimit
  -> Maybe PGT_AST.ForLockingClause
  -> Q Exp
toSquealSimpleSelect :: [Text]
-> Maybe (NonEmpty Ident)
-> SimpleSelect
-> Maybe SortClause
-> Maybe SelectLimit
-> Maybe ForLockingClause
-> Q Exp
toSquealSimpleSelect [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases SimpleSelect
simpleSelect Maybe SortClause
maybeSortClause Maybe SelectLimit
maybeSelectLimit Maybe ForLockingClause
maybeForLockingClause =
  case SimpleSelect
simpleSelect of
    PGT_AST.ValuesSimpleSelect ValuesClause
valuesClause -> do
      Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
        ( Maybe SortClause -> Bool
forall a. Maybe a -> Bool
isNothing Maybe SortClause
maybeSortClause
            Bool -> Bool -> Bool
&& Maybe SelectLimit -> Bool
forall a. Maybe a -> Bool
isNothing Maybe SelectLimit
maybeSelectLimit
            Bool -> Bool -> Bool
&& Maybe ForLockingClause -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ForLockingClause
maybeForLockingClause
        )
        (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
        (String -> Q ()) -> String -> Q ()
forall a b. (a -> b) -> a -> b
$ String
"ORDER BY / OFFSET / LIMIT / FOR UPDATE etc. not supported with VALUES clause "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"in this translation yet."
      renderedValues <- [Text] -> Maybe (NonEmpty Ident) -> ValuesClause -> Q Exp
renderValuesClauseToNP [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases ValuesClause
valuesClause
      pure $ VarE 'S.values_ `AppE` renderedValues
    PGT_AST.NormalSimpleSelect
      Maybe Targeting
maybeTargeting
      Maybe IntoClause
maybeIntoClause
      Maybe FromClause
maybeFromClause
      Maybe AExpr
maybeWhereClause
      Maybe GroupClause
maybeGroupClause
      Maybe AExpr
maybeHavingClause
      Maybe WindowClause
maybeWindowClause ->
        do
          targeting <-
            case Maybe Targeting
maybeTargeting of
              Maybe Targeting
Nothing ->
                String -> Q Targeting
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SELECT without a selection list is not supported."
              Just Targeting
targeting -> Targeting -> Q Targeting
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Targeting
targeting
          case
              ( maybeFromClause
              , maybeGroupClause
              , maybeHavingClause
              , maybeIntoClause
              , maybeSelectLimit
              , maybeWhereClause
              , maybeWindowClause
              )
            of
              ( Maybe FromClause
Nothing
                , Maybe GroupClause
Nothing
                , Maybe AExpr
Nothing
                , Maybe IntoClause
Nothing
                , Maybe SelectLimit
Nothing
                , Maybe AExpr
Nothing
                , Maybe WindowClause
Nothing
                ) ->
                  do
                    -- Case: SELECT <targeting_list> (no FROM, no other clauses)
                    -- Translate to S.values_
                    renderedTargetingForValues <-
                      [Text] -> Targeting -> Q Exp
renderPGTTargetingForValues [Text]
cteNames Targeting
targeting
                    pure $
                      VarE 'S.values_ `AppE` renderedTargetingForValues
              (Maybe FromClause
Nothing, Maybe GroupClause
_, Maybe AExpr
_, Maybe IntoClause
_, Maybe SelectLimit
_, Maybe AExpr
_, Maybe WindowClause
_) ->
                {-
                  Case: SELECT <targeting_list> (no FROM, but other
                  clauses are present)
                -}
                String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$
                  String
"SELECT with targeting but no FROM clause cannot have "
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"other clauses like INTO, WHERE, GROUP BY, HAVING, "
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"WINDOW, or LIMIT/OFFSET."
              (Just FromClause
fromClause, Maybe GroupClause
_, Maybe AExpr
_, Maybe IntoClause
_, Maybe SelectLimit
_, Maybe AExpr
_, Maybe WindowClause
_) -> do
                -- Case: SELECT ... FROM ... (original logic)

                Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe IntoClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe IntoClause
maybeIntoClause) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
                  String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"INTO clause is not yet supported in this translation."
                Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe WindowClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe WindowClause
maybeWindowClause) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
                  String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q ()) -> String -> Q ()
forall a b. (a -> b) -> a -> b
$
                    String
"WINDOW clause is not yet supported in this translation "
                      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"for NormalSimpleSelect with FROM."

                renderedFromClauseExp <- [Text] -> FromClause -> Q Exp
renderPGTTableRef [Text]
cteNames FromClause
fromClause
                let
                  baseTableExpr = Name -> Exp
VarE 'S.from Exp -> Exp -> Exp
`AppE` Exp
renderedFromClauseExp

                tableExprWithWhere <-
                  case maybeWhereClause of
                    Maybe AExpr
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
baseTableExpr
                    Just AExpr
wc -> do
                      renderedWC <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
wc
                      pure $
                        InfixE
                          (Just baseTableExpr)
                          (VarE '(S.&))
                          (Just (AppE (VarE 'S.where_) renderedWC))

                tableExprWithGroupBy <-
                  applyPGTGroupBy cteNames tableExprWithWhere maybeGroupClause

                tableExprWithHaving <-
                  case maybeHavingClause of
                    Maybe AExpr
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
tableExprWithGroupBy
                    Just AExpr
hc -> do
                      Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe GroupClause -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupClause
maybeGroupClause) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
                        String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"HAVING clause requires a GROUP BY clause."
                      renderedHC <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
hc
                      pure $
                        InfixE
                          (Just tableExprWithGroupBy)
                          (VarE '(S.&))
                          (Just (AppE (VarE 'S.having) renderedHC))

                tableExprWithOrderBy <-
                  case maybeSortClause of
                    Maybe SortClause
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
tableExprWithHaving
                    Just SortClause
sortClause -> do
                      renderedSC <- [Text] -> SortClause -> Q Exp
renderPGTSortClause [Text]
cteNames SortClause
sortClause
                      pure $
                        InfixE
                          (Just tableExprWithHaving)
                          (VarE '(S.&))
                          (Just (AppE (VarE 'S.orderBy) renderedSC))

                (tableExprWithOffset, mTableExprWithLimit) <-
                  processSelectLimit cteNames tableExprWithOrderBy maybeSelectLimit

                let
                  baseFinalTableExpr =
                    Exp -> Maybe Exp -> Exp
forall a. a -> Maybe a -> a
fromMaybe Exp
tableExprWithOffset Maybe Exp
mTableExprWithLimit

                -- Apply FOR LOCKING clause if present
                finalTableExprWithPotentialLocking <-
                  case maybeForLockingClause of
                    Maybe ForLockingClause
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
baseFinalTableExpr
                    Just ForLockingClause
flc -> do
                      lockingClauseExps <- ForLockingClause -> Q [Exp]
renderPGTForLockingClauseItems ForLockingClause
flc
                      pure $
                        foldl'
                          ( \Exp
accTableExpr Exp
lockingClauseExp ->
                              Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE
                                (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
accTableExpr)
                                (Name -> Exp
VarE '(S.&))
                                (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'S.lockRows) Exp
lockingClauseExp))
                          )
                          baseFinalTableExpr
                          lockingClauseExps

                (selectionTargetExp, maybeDistinctOnExprs) <-
                  renderPGTTargeting cteNames targeting

                squealSelectFn <-
                  case maybeDistinctOnExprs of
                    Maybe [AExpr]
Nothing ->
                      case Targeting
targeting of
                        PGT_AST.DistinctTargeting Maybe TypeModifiers
Nothing TargetList
_ ->
                          Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.selectDistinct
                        Targeting
_ -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.select -- Normal or ALL
                    Just [AExpr]
distinctOnAstExprs -> do
                      distinctOnSquealSortExps <-
                        [Text] -> [AExpr] -> Q Exp
renderPGTOnExpressionsClause [Text]
cteNames [AExpr]
distinctOnAstExprs
                      pure $
                        VarE 'S.selectDistinctOn
                          `AppE` distinctOnSquealSortExps

                pure $
                  squealSelectFn
                    `AppE` selectionTargetExp
                    `AppE` finalTableExprWithPotentialLocking
    SimpleSelect
unsupportedSimpleSelect ->
      String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$
        String
"Unsupported simple select statement: "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SimpleSelect -> String
forall a. Show a => a -> String
show SimpleSelect
unsupportedSimpleSelect


-- Helper for VALUES clause: Assumes S.values_ for a single row of values.
-- PGT_AST.ValuesClause is NonEmpty (NonEmpty PGT_AST.AExpr)
renderValuesClauseToNP
  :: [Text.Text]
  -> Maybe (NE.NonEmpty PGT_AST.Ident)
  -> PGT_AST.ValuesClause
  -> Q Exp
renderValuesClauseToNP :: [Text] -> Maybe (NonEmpty Ident) -> ValuesClause -> Q Exp
renderValuesClauseToNP [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases (TypeModifiers
firstRowExps NE.:| [TypeModifiers]
restRowExps) = do
  Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TypeModifiers] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeModifiers]
restRowExps) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
    String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q ()) -> String -> Q ()
forall a b. (a -> b) -> a -> b
$
      String
"Multi-row VALUES clause requires S.values, this translation "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"currently supports single row S.values_."
  TypeModifiers -> Q Exp
convertRowToNP TypeModifiers
firstRowExps
 where
  colAliasTexts :: Maybe [Text]
colAliasTexts = (NonEmpty Ident -> [Text])
-> Maybe (NonEmpty Ident) -> Maybe [Text]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ident -> Text) -> [Ident] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ident -> Text
getIdentText ([Ident] -> [Text])
-> (NonEmpty Ident -> [Ident]) -> NonEmpty Ident -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Ident -> [Ident]
forall a. NonEmpty a -> [a]
NE.toList) Maybe (NonEmpty Ident)
maybeColAliases

  convertRowToNP :: NE.NonEmpty PGT_AST.AExpr -> Q Exp
  convertRowToNP :: TypeModifiers -> Q Exp
convertRowToNP TypeModifiers
exprs = do
    let
      exprList :: [AExpr]
exprList = TypeModifiers -> [AExpr]
forall a. NonEmpty a -> [a]
NE.toList TypeModifiers
exprs
    aliasTexts <-
      case Maybe [Text]
colAliasTexts of
        Just [Text]
aliases ->
          if [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
aliases Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [AExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AExpr]
exprList
            then [Text] -> Q [Text]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
aliases
            else
              String -> Q [Text]
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                String
"Number of column aliases in CTE does not match number of columns in VALUES clause."
        Maybe [Text]
Nothing -> [Text] -> Q [Text]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Q [Text]) -> [Text] -> Q [Text]
forall a b. (a -> b) -> a -> b
$ (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"_column" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int
1 :: Int ..]
    go (zip exprList aliasTexts)
   where
    go :: [(PGT_AST.AExpr, Text.Text)] -> Q Exp
    go :: [(AExpr, Text)] -> Q Exp
go [] = Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Nil
    go ((AExpr
expr, Text
aliasText) : [(AExpr, Text)]
fs) = do
      renderedExpr <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
expr
      let
        aliasedExp = Name -> Exp
VarE 'S.as Exp -> Exp -> Exp
`AppE` Exp
renderedExpr Exp -> Exp -> Exp
`AppE` String -> Exp
LabelE (Text -> String
Text.unpack Text
aliasText)
      restExp <- go fs
      pure $ ConE '(S.:*) `AppE` aliasedExp `AppE` restExp


renderPGTForLockingClauseItems :: PGT_AST.ForLockingClause -> Q [Exp]
renderPGTForLockingClauseItems :: ForLockingClause -> Q [Exp]
renderPGTForLockingClauseItems = \case
  ForLockingClause
PGT_AST.ReadOnlyForLockingClause ->
    String -> Q [Exp]
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q [Exp]) -> String -> Q [Exp]
forall a b. (a -> b) -> a -> b
$
      String
"FOR READ ONLY is not supported as a row-level locking "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"clause by Squeal-QQ."
  PGT_AST.ItemsForLockingClause NonEmpty ForLockingItem
itemsNe ->
    (ForLockingItem -> Q Exp) -> [ForLockingItem] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ForLockingItem -> Q Exp
renderPGTForLockingItem (NonEmpty ForLockingItem -> [ForLockingItem]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ForLockingItem
itemsNe)


renderPGTForLockingItem :: PGT_AST.ForLockingItem -> Q Exp
renderPGTForLockingItem :: ForLockingItem -> Q Exp
renderPGTForLockingItem
  ( PGT_AST.ForLockingItem
      ForLockingStrength
strength
      Maybe (NonEmpty QualifiedName)
maybeTables
      Maybe Bool
waitingOpt
    ) = do
    squealStrength <- ForLockingStrength -> Q Exp
renderPGTForLockingStrength ForLockingStrength
strength
    squealTables <-
      case maybeTables of
        Maybe (NonEmpty QualifiedName)
Nothing ->
          {- Empty list for "OF" tables means all tables in query -}
          Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Nil
        Just NonEmpty QualifiedName
tablesNe -> do
          aliasExps <-
            (QualifiedName -> Q Exp) -> [QualifiedName] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
              ( \QualifiedName
qn -> case QualifiedName
qn of
                  PGT_AST.SimpleQualifiedName Ident
ident ->
                    Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Exp
LabelE (Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Ident -> Text
getIdentText Ident
ident)
                  QualifiedName
_ ->
                    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$
                      String
"Qualified table names like schema.table in "
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"FOR UPDATE/SHARE OF clauses are not yet "
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"supported. Please use simple table aliases "
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"that refer to tables in the FROM clause."
              )
              (NonEmpty QualifiedName -> [QualifiedName]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty QualifiedName
tablesNe)
          pure $
            foldr
              (\Exp
itemExp Exp
acc -> Name -> Exp
ConE '(S.:*) Exp -> Exp -> Exp
`AppE` Exp
itemExp Exp -> Exp -> Exp
`AppE` Exp
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 :: ForLockingStrength -> Q Exp
renderPGTForLockingStrength = \case
  ForLockingStrength
PGT_AST.UpdateForLockingStrength -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Update
  ForLockingStrength
PGT_AST.NoKeyUpdateForLockingStrength -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.NoKeyUpdate
  ForLockingStrength
PGT_AST.ShareForLockingStrength -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Share
  ForLockingStrength
PGT_AST.KeyForLockingStrength -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.KeyShare


renderPGTWaiting :: Maybe Bool -> Q Exp
renderPGTWaiting :: Maybe Bool -> Q Exp
renderPGTWaiting = \case
  Maybe Bool
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Wait -- Default (no NOWAIT or SKIP LOCKED)
  Just Bool
False -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.NoWait -- NOWAIT
  Just Bool
True -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.SkipLocked -- SKIP LOCKED


applyPGTGroupBy :: [Text.Text] -> Exp -> Maybe PGT_AST.GroupClause -> Q Exp
applyPGTGroupBy :: [Text] -> Exp -> Maybe GroupClause -> Q Exp
applyPGTGroupBy [Text]
cteNames Exp
currentTableExpr = \case
  Maybe GroupClause
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
currentTableExpr
  Just GroupClause
groupClause -> do
    renderedGB <- [Text] -> GroupClause -> Q Exp
renderPGTGroupByClauseElements [Text]
cteNames GroupClause
groupClause
    pure $
      InfixE
        (Just currentTableExpr)
        (VarE '(S.&))
        (Just (AppE (VarE 'S.groupBy) renderedGB))


renderPGTGroupByClauseElements :: [Text.Text] -> PGT_AST.GroupClause -> Q Exp
renderPGTGroupByClauseElements :: [Text] -> GroupClause -> Q Exp
renderPGTGroupByClauseElements [Text]
cteNames = \case
  GroupByItem
PGT_AST.EmptyGroupingSetGroupByItem NE.:| [] ->
    Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Nil
  GroupClause
groupByItems -> do
    renderedExprs <- (GroupByItem -> Q Exp) -> [GroupByItem] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Text] -> GroupByItem -> Q Exp
renderPGTGroupByItem [Text]
cteNames) (GroupClause -> [GroupByItem]
forall a. NonEmpty a -> [a]
NE.toList GroupClause
groupByItems)
    pure $
      foldr
        (\Exp
expr Exp
acc -> Name -> Exp
ConE '(S.:*) Exp -> Exp -> Exp
`AppE` Exp
expr Exp -> Exp -> Exp
`AppE` Exp
acc)
        (ConE 'S.Nil)
        renderedExprs

renderPGTGroupByItem :: [Text.Text] -> PGT_AST.GroupByItem -> Q Exp
renderPGTGroupByItem :: [Text] -> GroupByItem -> Q Exp
renderPGTGroupByItem [Text]
cteNames = \case
  PGT_AST.ExprGroupByItem AExpr
scalarExpr -> [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
scalarExpr
  GroupByItem
PGT_AST.EmptyGroupingSetGroupByItem -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
ConE 'S.Nil)
  GroupByItem
unsupportedGroup ->
    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$
      String
"Unsupported grouping expression: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> GroupByItem -> String
forall a. Show a => a -> String
show GroupByItem
unsupportedGroup


processSelectLimit :: [Text.Text] -> Exp -> Maybe PGT_AST.SelectLimit -> Q (Exp, Maybe Exp)
processSelectLimit :: [Text] -> Exp -> Maybe SelectLimit -> Q (Exp, Maybe Exp)
processSelectLimit [Text]
_cteNames Exp
tableExpr Maybe SelectLimit
Nothing = (Exp, Maybe Exp) -> Q (Exp, Maybe Exp)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp
tableExpr, Maybe Exp
forall a. Maybe a
Nothing)
processSelectLimit [Text]
cteNames Exp
tableExpr (Just SelectLimit
selectLimit) = do
  let
    (Maybe OffsetClause
maybeOffsetClause, Maybe LimitClause
maybeLimitClause) = case SelectLimit
selectLimit of
      PGT_AST.LimitOffsetSelectLimit LimitClause
lim OffsetClause
off -> (OffsetClause -> Maybe OffsetClause
forall a. a -> Maybe a
Just OffsetClause
off, LimitClause -> Maybe LimitClause
forall a. a -> Maybe a
Just LimitClause
lim)
      PGT_AST.OffsetLimitSelectLimit OffsetClause
off LimitClause
lim -> (OffsetClause -> Maybe OffsetClause
forall a. a -> Maybe a
Just OffsetClause
off, LimitClause -> Maybe LimitClause
forall a. a -> Maybe a
Just LimitClause
lim)
      PGT_AST.LimitSelectLimit LimitClause
lim -> (Maybe OffsetClause
forall a. Maybe a
Nothing, LimitClause -> Maybe LimitClause
forall a. a -> Maybe a
Just LimitClause
lim)
      PGT_AST.OffsetSelectLimit OffsetClause
off -> (OffsetClause -> Maybe OffsetClause
forall a. a -> Maybe a
Just OffsetClause
off, Maybe LimitClause
forall a. Maybe a
Nothing)

  tableExprWithOffset <-
    case Maybe OffsetClause
maybeOffsetClause of
      Maybe OffsetClause
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
tableExpr
      Just OffsetClause
offsetVal -> do
        offsetExp <- [Text] -> OffsetClause -> Q Exp
renderPGTOffsetClause [Text]
cteNames OffsetClause
offsetVal
        pure $
          InfixE
            (Just tableExpr)
            (VarE '(S.&))
            (Just (AppE (VarE 'S.offset) offsetExp))

  case maybeLimitClause of
    Maybe LimitClause
Nothing -> (Exp, Maybe Exp) -> Q (Exp, Maybe Exp)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp
tableExprWithOffset, Maybe Exp
forall a. Maybe a
Nothing)
    Just LimitClause
limitVal -> do
      limitExp <- [Text] -> LimitClause -> Q Exp
renderPGTLimitClause [Text]
cteNames LimitClause
limitVal
      pure
        ( tableExprWithOffset
        , Just
            ( InfixE
                (Just tableExprWithOffset)
                (VarE '(S.&))
                (Just (AppE (VarE 'S.limit) limitExp))
            )
        )


renderPGTLimitClause :: [Text.Text] -> PGT_AST.LimitClause -> Q Exp
renderPGTLimitClause :: [Text] -> LimitClause -> Q Exp
renderPGTLimitClause [Text]
cteNames = \case
  PGT_AST.LimitLimitClause SelectLimitValue
slValue Maybe AExpr
mOffsetVal -> do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AExpr -> Bool
forall a. Maybe a -> Bool
isJust Maybe AExpr
mOffsetVal) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
      String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
        String
"LIMIT with comma (e.g. LIMIT x, y) is not supported. Use separate LIMIT and OFFSET clauses."
    case SelectLimitValue
slValue of
      PGT_AST.ExprSelectLimitValue
        ( PGT_AST.CExprAExpr
            ( PGT_AST.FuncCExpr
                ( PGT_AST.ApplicationFuncExpr
                    ( PGT_AST.FuncApplication
                        (PGT_AST.TypeFuncName (PGT_AST.UnquotedIdent Text
"inline"))
                        ( Just
                            ( PGT_AST.NormalFuncApplicationParams
                                Maybe Bool
Nothing
                                ( PGT_AST.ExprFuncArgExpr
                                    ( PGT_AST.CExprAExpr
                                        (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref Ident
ident Maybe Indirection
Nothing))
                                      )
                                    NE.:| []
                                  )
                                Maybe SortClause
Nothing
                              )
                          )
                      )
                    Maybe SortClause
Nothing
                    Maybe AExpr
Nothing
                    Maybe OverClause
Nothing
                  )
              )
          ) -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE (String -> Name
mkName (Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
ident)))
      PGT_AST.ExprSelectLimitValue
        (PGT_AST.CExprAExpr (PGT_AST.AexprConstCExpr (PGT_AST.IAexprConst Iconst
n))) ->
          if Iconst
n Iconst -> Iconst -> Bool
forall a. Ord a => a -> a -> Bool
>= Iconst
0
            then Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Iconst -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Iconst
n)))
            else String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"LIMIT value must be non-negative: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Iconst -> String
forall a. Show a => a -> String
show Iconst
n
      SelectLimitValue
PGT_AST.AllSelectLimitValue ->
        String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LIMIT ALL not supported in this translation."
      PGT_AST.ExprSelectLimitValue AExpr
expr -> [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
expr
  PGT_AST.FetchOnlyLimitClause{} ->
    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"FETCH clause is not fully supported yet."


renderPGTOffsetClause :: [Text.Text] -> PGT_AST.OffsetClause -> Q Exp
renderPGTOffsetClause :: [Text] -> OffsetClause -> Q Exp
renderPGTOffsetClause [Text]
cteNames = \case
  PGT_AST.ExprOffsetClause
    ( PGT_AST.CExprAExpr
        ( PGT_AST.FuncCExpr
            ( PGT_AST.ApplicationFuncExpr
                ( PGT_AST.FuncApplication
                    (PGT_AST.TypeFuncName (PGT_AST.UnquotedIdent Text
"inline"))
                    ( Just
                        ( PGT_AST.NormalFuncApplicationParams
                            Maybe Bool
Nothing
                            ( PGT_AST.ExprFuncArgExpr
                                ( PGT_AST.CExprAExpr
                                    (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref Ident
ident Maybe Indirection
Nothing))
                                  )
                                NE.:| []
                              )
                            Maybe SortClause
Nothing
                          )
                      )
                  )
                Maybe SortClause
Nothing
                Maybe AExpr
Nothing
                Maybe OverClause
Nothing
              )
          )
      ) -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE (String -> Name
mkName (Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
ident)))
  PGT_AST.ExprOffsetClause
    (PGT_AST.CExprAExpr (PGT_AST.AexprConstCExpr (PGT_AST.IAexprConst Iconst
n))) ->
      if Iconst
n Iconst -> Iconst -> Bool
forall a. Ord a => a -> a -> Bool
>= Iconst
0
        then Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Iconst -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Iconst
n)))
        else String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"OFFSET value must be non-negative: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Iconst -> String
forall a. Show a => a -> String
show Iconst
n
  PGT_AST.ExprOffsetClause AExpr
expr -> [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
expr
  PGT_AST.FetchFirstOffsetClause{} ->
    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"OFFSET with FETCH FIRST clause is not supported yet."


-- Helper to render a single TargetEl for S.values_
-- Each expression must be aliased.
renderPGTTargetElForValues :: [Text.Text] -> PGT_AST.TargetEl -> Int -> Q Exp
renderPGTTargetElForValues :: [Text] -> TargetEl -> Int -> Q Exp
renderPGTTargetElForValues [Text]
cteNames TargetEl
targetEl Int
idx = do
  (exprAST, mUserAlias) <-
    case TargetEl
targetEl of
      PGT_AST.AliasedExprTargetEl AExpr
e Ident
an -> (AExpr, Maybe Ident) -> Q (AExpr, Maybe Ident)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AExpr
e, Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
an)
      PGT_AST.ImplicitlyAliasedExprTargetEl AExpr
e Ident
an -> (AExpr, Maybe Ident) -> Q (AExpr, Maybe Ident)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AExpr
e, Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
an)
      PGT_AST.ExprTargetEl AExpr
e -> (AExpr, Maybe Ident) -> Q (AExpr, Maybe Ident)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AExpr
e, Maybe Ident
forall a. Maybe a
Nothing)
      TargetEl
PGT_AST.AsteriskTargetEl ->
        String -> Q (AExpr, Maybe Ident)
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SELECT * is not supported unless there is a from clause."
  renderedScalarExp <- renderPGTAExpr cteNames exprAST
  let
    aliasLabelStr =
      case Maybe Ident
mUserAlias of
        Just Ident
ident -> Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Ident -> Text
getIdentText Ident
ident
        Maybe Ident
Nothing -> String
"_col" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
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 :: [Text.Text] -> PGT_AST.TargetList -> Q Exp
renderPGTTargetListForValues :: [Text] -> TargetList -> Q Exp
renderPGTTargetListForValues [Text]
cteNames (TargetEl
item NE.:| [TargetEl]
items) = do
  renderedItems <-
    ((TargetEl, Int) -> Q Exp) -> [(TargetEl, Int)] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
      (\(TargetEl
el, Int
idx) -> [Text] -> TargetEl -> Int -> Q Exp
renderPGTTargetElForValues [Text]
cteNames TargetEl
el Int
idx)
      ([TargetEl] -> [Int] -> [(TargetEl, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (TargetEl
item TargetEl -> [TargetEl] -> [TargetEl]
forall a. a -> [a] -> [a]
: [TargetEl]
items) [Int
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
      (\Exp
hd Exp
acc -> Name -> Exp
ConE '(S.:*) Exp -> Exp -> Exp
`AppE` Exp
hd Exp -> Exp -> Exp
`AppE` Exp
acc)
      (ConE 'S.Nil)
      renderedItems


-- New function to render Targeting specifically for S.values_
renderPGTTargetingForValues :: [Text.Text] -> PGT_AST.Targeting -> Q Exp
renderPGTTargetingForValues :: [Text] -> Targeting -> Q Exp
renderPGTTargetingForValues [Text]
cteNames = \case
  PGT_AST.NormalTargeting TargetList
targetList -> [Text] -> TargetList -> Q Exp
renderPGTTargetListForValues [Text]
cteNames TargetList
targetList
  PGT_AST.AllTargeting (Just TargetList
targetList) ->
    [Text] -> TargetList -> Q Exp
renderPGTTargetListForValues [Text]
cteNames TargetList
targetList
  PGT_AST.AllTargeting Maybe TargetList
Nothing ->
    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$
      String
"SELECT * (ALL targeting without a list) is not supported "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"with VALUES clause."
  PGT_AST.DistinctTargeting{} ->
    -- Handles both DISTINCT and DISTINCT ON
    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$
      String
"DISTINCT and DISTINCT ON queries are not supported with VALUES clause in "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"this translation."


renderPGTOnExpressionsClause :: [Text.Text] -> [PGT_AST.AExpr] -> Q Exp
renderPGTOnExpressionsClause :: [Text] -> [AExpr] -> Q Exp
renderPGTOnExpressionsClause [Text]
cteNames [AExpr]
exprs = do
  renderedSortExps <- (AExpr -> Q Exp) -> [AExpr] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AExpr -> Q Exp
renderToSortExpr [AExpr]
exprs
  pure $ ListE renderedSortExps
 where
  renderToSortExpr :: PGT_AST.AExpr -> Q Exp
  renderToSortExpr :: AExpr -> Q Exp
renderToSortExpr AExpr
astExpr = do
    squealExpr <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
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 :: [Text.Text] -> PGT_AST.SortClause -> Q Exp
renderPGTSortClause :: [Text] -> SortClause -> Q Exp
renderPGTSortClause [Text]
cteNames SortClause
sortBys = [Exp] -> Exp
ListE ([Exp] -> Exp) -> Q [Exp] -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SortBy -> Q Exp) -> [SortBy] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Text] -> SortBy -> Q Exp
renderPGTSortBy [Text]
cteNames) (SortClause -> [SortBy]
forall a. NonEmpty a -> [a]
NE.toList SortClause
sortBys)


renderPGTSortBy :: [Text.Text] -> PGT_AST.SortBy -> Q Exp
renderPGTSortBy :: [Text] -> SortBy -> Q Exp
renderPGTSortBy [Text]
cteNames = \case
  PGT_AST.AscDescSortBy AExpr
aExpr Maybe AscDesc
maybeAscDesc Maybe NullsOrder
maybeNullsOrder -> do
    squealExpr <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
aExpr
    let
      (asc, desc) = case maybeNullsOrder of
        Maybe NullsOrder
Nothing -> ('S.Asc, 'S.Desc)
        Just NullsOrder
PGT_AST.FirstNullsOrder -> ('S.AscNullsFirst, 'S.DescNullsFirst)
        Just NullsOrder
PGT_AST.LastNullsOrder -> ('S.AscNullsLast, 'S.DescNullsLast)

    let
      constructor = case Maybe AscDesc
maybeAscDesc of
        Just AscDesc
PGT_AST.DescAscDesc -> Name
desc
        Maybe AscDesc
_ -> Name
asc -- default to ASC
    pure $ ConE constructor `AppE` squealExpr
  PGT_AST.UsingSortBy{} -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ORDER BY USING is not supported"


renderPGTTableRef :: [Text.Text] -> NE.NonEmpty PGT_AST.TableRef -> Q Exp
renderPGTTableRef :: [Text] -> FromClause -> Q Exp
renderPGTTableRef [Text]
cteNames FromClause
tableRefs = do
  renderedTableRefs <- (TableRef -> Q Exp) -> [TableRef] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Text] -> TableRef -> Q Exp
renderSingleTableRef [Text]
cteNames) (FromClause -> [TableRef]
forall a. NonEmpty a -> [a]
NE.toList FromClause
tableRefs)
  case renderedTableRefs of
    [] -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty FROM clause" -- Should not happen with NonEmpty
    (Exp
firstTbl : [Exp]
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.
      Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Exp
acc Exp
tbl -> Name -> Exp
VarE 'S.also Exp -> Exp -> Exp
`AppE` Exp
tbl Exp -> Exp -> Exp
`AppE` Exp
acc) Exp
firstTbl [Exp]
restTbls


renderSingleTableRef :: [Text.Text] -> PGT_AST.TableRef -> Q Exp
renderSingleTableRef :: [Text] -> TableRef -> Q Exp
renderSingleTableRef [Text]
cteNames = \case
  PGT_AST.RelationExprTableRef RelationExpr
relationExpr Maybe AliasClause
maybeAliasClause Maybe TablesampleClause
sampleClause -> do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe TablesampleClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe TablesampleClause
sampleClause) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"TABLESAMPLE clause is not supported yet."
    [Text] -> RelationExpr -> Maybe AliasClause -> Q Exp
renderPGTRelationExprTableRef [Text]
cteNames RelationExpr
relationExpr Maybe AliasClause
maybeAliasClause
  PGT_AST.JoinTableRef JoinedTable
joinedTable Maybe AliasClause
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 Maybe AliasClause
maybeAliasClause of
      Just AliasClause
_ ->
        String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
          String
"Aliasing a JOIN clause directly is not supported. Consider a subquery: (SELECT * FROM ...) AS alias"
      Maybe AliasClause
Nothing -> [Text] -> JoinedTable -> Q Exp
renderPGTJoinedTable [Text]
cteNames JoinedTable
joinedTable
  -- PGT_AST.InParensTableRefTableRef was an incorrect pattern, removing it.
  -- Parenthesized joins are handled by PGT_AST.InParensJoinedTable within renderPGTJoinedTable.
  TableRef
unsupported ->
    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported TableRef type in renderSingleTableRef: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TableRef -> String
forall a. Show a => a -> String
show TableRef
unsupported


renderPGTJoinedTable :: [Text.Text] -> PGT_AST.JoinedTable -> Q Exp
renderPGTJoinedTable :: [Text] -> JoinedTable -> Q Exp
renderPGTJoinedTable [Text]
cteNames = \case
  PGT_AST.InParensJoinedTable JoinedTable
joinedTable -> [Text] -> JoinedTable -> Q Exp
renderPGTJoinedTable [Text]
cteNames JoinedTable
joinedTable
  PGT_AST.MethJoinedTable JoinMeth
joinMeth TableRef
leftRef TableRef
rightRef -> do
    leftTableExp <- [Text] -> TableRef -> Q Exp
renderSingleTableRef [Text]
cteNames TableRef
leftRef
    rightTableExp <- renderSingleTableRef cteNames rightRef
    case joinMeth of
      PGT_AST.QualJoinMeth Maybe JoinType
maybeJoinType JoinQual
joinQual ->
        case JoinQual
joinQual of
          PGT_AST.OnJoinQual AExpr
onConditionAExpr -> do
            onConditionExp <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
onConditionAExpr
            squealJoinFn <-
              case maybeJoinType of
                Just (PGT_AST.LeftJoinType Bool
_) -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.leftOuterJoin
                Just (PGT_AST.RightJoinType Bool
_) -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.rightOuterJoin
                Just (PGT_AST.FullJoinType Bool
_) -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.fullOuterJoin
                Just JoinType
PGT_AST.InnerJoinType -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.innerJoin
                Maybe JoinType
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
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 NonEmpty Ident
_identsNE ->
            String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"USING join qualification not yet supported"
      JoinMeth
PGT_AST.CrossJoinMeth ->
        -- Change: Use S.& for crossJoin: leftTableExp & S.crossJoin rightTableExp
        Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
          Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE
            (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
leftTableExp)
            (Name -> Exp
VarE '(S.&))
            (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Name -> Exp
VarE 'S.crossJoin Exp -> Exp -> Exp
`AppE` Exp
rightTableExp))
      PGT_AST.NaturalJoinMeth Maybe JoinType
_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.
        String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"NATURAL JOIN is not supported by Squeal-QQ."


renderPGTRelationExprTableRef
  :: [Text.Text] -> PGT_AST.RelationExpr -> Maybe PGT_AST.AliasClause -> Q Exp
renderPGTRelationExprTableRef :: [Text] -> RelationExpr -> Maybe AliasClause -> Q Exp
renderPGTRelationExprTableRef [Text]
cteNames RelationExpr
relationExpr Maybe AliasClause
maybeAliasClause = do
  (tableName, schemaName) <-
    case RelationExpr
relationExpr of
      PGT_AST.SimpleRelationExpr (PGT_AST.SimpleQualifiedName Ident
ident) Bool
_ ->
        (Text, Maybe Text) -> Q (Text, Maybe Text)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ident -> Text
getIdentText Ident
ident, Maybe Text
forall a. Maybe a
Nothing)
      PGT_AST.SimpleRelationExpr
        ( PGT_AST.IndirectedQualifiedName
            Ident
schemaIdent
            (Indirection -> IndirectionEl
forall a. NonEmpty a -> a
NE.last -> PGT_AST.AttrNameIndirectionEl Ident
tableIdent)
          )
        Bool
_ ->
          (Text, Maybe Text) -> Q (Text, Maybe Text)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ident -> Text
getIdentText Ident
tableIdent, Text -> Maybe Text
forall a. a -> Maybe a
Just (Ident -> Text
getIdentText Ident
schemaIdent))
      RelationExpr
_ ->
        String -> Q (Text, Maybe Text)
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q (Text, Maybe Text)) -> String -> Q (Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$
          String
"Unsupported relation expression: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RelationExpr -> String
forall a. Show a => a -> String
show RelationExpr
relationExpr

  aliasStr <-
    case maybeAliasClause of
      Just (PGT_AST.AliasClause Bool
_ Ident
aliasIdent Maybe (NonEmpty Ident)
_) -> String -> Q String
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Q String) -> String -> Q String
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
aliasIdent)
      Maybe AliasClause
Nothing -> case RelationExpr
relationExpr of -- Infer default alias if none provided
        PGT_AST.SimpleRelationExpr (PGT_AST.SimpleQualifiedName Ident
ident) Bool
_ -> String -> Q String
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Q String) -> String -> Q String
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
ident)
        PGT_AST.SimpleRelationExpr
          ( PGT_AST.IndirectedQualifiedName
              Ident
_
              (Indirection -> IndirectionEl
forall a. NonEmpty a -> a
NE.last -> PGT_AST.AttrNameIndirectionEl Ident
ident)
            )
          Bool
_ -> String -> Q String
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Q String) -> String -> Q String
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
ident)
        RelationExpr
_ ->
          String -> Q String
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q String) -> String -> Q String
forall a b. (a -> b) -> a -> b
$
            String
"Cannot determine default alias for relation expression: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RelationExpr -> String
forall a. Show a => a -> String
show RelationExpr
relationExpr

  let
    isCte = Text
tableName Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cteNames
    squealFn = if Bool
isCte then Name -> Exp
VarE 'S.common else Name -> Exp
VarE 'S.table

  tableExpr <-
    case schemaName of
      Maybe Text
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Exp
LabelE (Text -> String
Text.unpack Text
tableName)
      Just Text
schema ->
        if Bool
isCte
          then
            String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"CTEs cannot be schema-qualified."
          else
            Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
              Name -> Exp
VarE '(S.!)
                Exp -> Exp -> Exp
`AppE` String -> Exp
LabelE (Text -> String
Text.unpack Text
schema)
                Exp -> Exp -> Exp
`AppE` String -> Exp
LabelE (Text -> String
Text.unpack Text
tableName)

  pure $ squealFn `AppE` (VarE 'S.as `AppE` tableExpr `AppE` LabelE aliasStr)


{- |
  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
  :: [Text.Text]
  -> PGT_AST.Targeting
  -> Q (Exp, Maybe [PGT_AST.AExpr])
renderPGTTargeting :: [Text] -> Targeting -> Q (Exp, Maybe [AExpr])
renderPGTTargeting [Text]
cteNames = \case
  PGT_AST.NormalTargeting TargetList
targetList -> do
    selListExp <- [Text] -> TargetList -> Q Exp
renderPGTTargetList [Text]
cteNames TargetList
targetList
    pure (selListExp, Nothing)
  PGT_AST.AllTargeting Maybe TargetList
maybeTargetList -> do
    selListExp <-
      case Maybe TargetList
maybeTargetList of
        Maybe TargetList
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Star -- SELECT ALL (which is like SELECT *)
        Just TargetList
tl -> [Text] -> TargetList -> Q Exp
renderPGTTargetList [Text]
cteNames TargetList
tl
    pure (selListExp, Nothing)
  PGT_AST.DistinctTargeting Maybe TypeModifiers
maybeOnExprs TargetList
targetList -> do
    selListExp <- [Text] -> TargetList -> Q Exp
renderPGTTargetList [Text]
cteNames TargetList
targetList
    pure (selListExp, fmap NE.toList maybeOnExprs)


renderPGTTargetEl :: [Text.Text] -> PGT_AST.TargetEl -> Maybe PGT_AST.Ident -> Int -> Q Exp
renderPGTTargetEl :: [Text] -> TargetEl -> Maybe Ident -> Int -> Q Exp
renderPGTTargetEl [Text]
cteNames TargetEl
targetEl Maybe Ident
mOuterAlias Int
idx =
  let
    (AExpr
exprAST, Maybe Ident
mInternalAlias) = case TargetEl
targetEl of
      PGT_AST.AliasedExprTargetEl AExpr
e Ident
an -> (AExpr
e, Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
an)
      PGT_AST.ImplicitlyAliasedExprTargetEl AExpr
e Ident
an -> (AExpr
e, Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
an)
      PGT_AST.ExprTargetEl AExpr
e -> (AExpr
e, Maybe Ident
forall a. Maybe a
Nothing)
      TargetEl
PGT_AST.AsteriskTargetEl ->
        ( CExpr -> AExpr
PGT_AST.CExprAExpr
            ( AexprConst -> CExpr
PGT_AST.AexprConstCExpr
                AexprConst
PGT_AST.NullAexprConst
            )
        , Maybe Ident
forall a. Maybe a
Nothing -- Placeholder for Star, should be S.Star
        )
    finalAliasName :: Maybe Ident
finalAliasName = Maybe Ident
mOuterAlias Maybe Ident -> Maybe Ident -> Maybe Ident
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Ident
mInternalAlias
  in
    case TargetEl
targetEl of
      TargetEl
PGT_AST.AsteriskTargetEl -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Star
      TargetEl
_ -> do
        renderedScalarExp <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
exprAST
        case exprAST of
          PGT_AST.CExprAExpr (PGT_AST.ColumnrefCExpr Columnref
_)
            | Maybe Ident
Nothing <- Maybe Ident
finalAliasName ->
                Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
renderedScalarExp
          AExpr
_ -> do
            let
              aliasLabelStr :: String
aliasLabelStr =
                case Maybe Ident
finalAliasName of
                  Just Ident
ident -> Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Ident -> Text
getIdentText Ident
ident
                  Maybe Ident
Nothing -> String
"_col" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
idx
            Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
              Name -> Exp
VarE 'S.as
                Exp -> Exp -> Exp
`AppE` Exp
renderedScalarExp
                Exp -> Exp -> Exp
`AppE` String -> Exp
LabelE String
aliasLabelStr


renderPGTTargetList :: [Text.Text] -> PGT_AST.TargetList -> Q Exp
renderPGTTargetList :: [Text] -> TargetList -> Q Exp
renderPGTTargetList [Text]
cteNames (TargetEl
item NE.:| [TargetEl]
items) = [TargetEl] -> Int -> Q Exp
go (TargetEl
item TargetEl -> [TargetEl] -> [TargetEl]
forall a. a -> [a] -> [a]
: [TargetEl]
items) Int
1
  where
    isAsterisk :: PGT_AST.TargetEl -> Bool
    isAsterisk :: TargetEl -> Bool
isAsterisk TargetEl
PGT_AST.AsteriskTargetEl = Bool
True
    isAsterisk TargetEl
_ = Bool
False

    isDotStar :: PGT_AST.TargetEl -> Bool
    isDotStar :: TargetEl -> Bool
isDotStar
      ( PGT_AST.ExprTargetEl
          ( PGT_AST.CExprAExpr
              (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref Ident
_ (Just Indirection
indirection)))
            )
        ) =
        (IndirectionEl -> Bool) -> [IndirectionEl] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IndirectionEl -> Bool
isAllIndirectionEl (Indirection -> [IndirectionEl]
forall a. NonEmpty a -> [a]
NE.toList Indirection
indirection)
    isDotStar TargetEl
_ = Bool
False

    isAllIndirectionEl :: PGT_AST.IndirectionEl -> Bool
    isAllIndirectionEl :: IndirectionEl -> Bool
isAllIndirectionEl IndirectionEl
PGT_AST.AllIndirectionEl = Bool
True
    isAllIndirectionEl IndirectionEl
_ = Bool
False

    renderPGTTargetElDotStar :: PGT_AST.TargetEl -> Q Exp
    renderPGTTargetElDotStar :: TargetEl -> Q Exp
renderPGTTargetElDotStar
      ( PGT_AST.ExprTargetEl
          ( PGT_AST.CExprAExpr
              ( PGT_AST.ColumnrefCExpr
                  ( PGT_AST.Columnref
                      Ident
qualName
                      Maybe Indirection
_ -- indirectionOpt
                    )
                )
            )
        ) =
        Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
          Name -> Exp
ConE 'S.DotStar
            Exp -> Exp -> Exp
`AppE` (String -> Exp
LabelE (Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
qualName)))
    renderPGTTargetElDotStar TargetEl
_ =
      String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"renderPGTTargetElDotStar called with unexpected TargetEl"

    go :: [PGT_AST.TargetEl] -> Int -> Q Exp
    go :: [TargetEl] -> Int -> Q Exp
go [] Int
_ = String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty selection list items in go."
    go [TargetEl
el] Int
currentIdx = TargetEl -> Int -> Q Exp
renderOne TargetEl
el Int
currentIdx
    go (TargetEl
el : [TargetEl]
more) Int
currentIdx = do
      renderedEl <- TargetEl -> Int -> Q Exp
renderOne TargetEl
el Int
currentIdx
      restRendered <- go more (currentIdx + 1)
      pure $ ConE 'S.Also `AppE` restRendered `AppE` renderedEl

    renderOne :: PGT_AST.TargetEl -> Int -> Q Exp
    renderOne :: TargetEl -> Int -> Q Exp
renderOne TargetEl
el Int
idx
      | TargetEl -> Bool
isAsterisk TargetEl
el = Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Star
      | TargetEl -> Bool
isDotStar TargetEl
el = TargetEl -> Q Exp
renderPGTTargetElDotStar TargetEl
el
      | Bool
otherwise = [Text] -> TargetEl -> Maybe Ident -> Int -> Q Exp
renderPGTTargetEl [Text]
cteNames TargetEl
el Maybe Ident
forall a. Maybe a
Nothing Int
idx


-- | Defines associativity of an operator.
data Associativity = LeftAssoc | RightAssoc | NonAssoc
  deriving stock (Associativity -> Associativity -> Bool
(Associativity -> Associativity -> Bool)
-> (Associativity -> Associativity -> Bool) -> Eq Associativity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Associativity -> Associativity -> Bool
== :: Associativity -> Associativity -> Bool
$c/= :: Associativity -> Associativity -> Bool
/= :: Associativity -> Associativity -> Bool
Eq, Int -> Associativity -> String -> String
[Associativity] -> String -> String
Associativity -> String
(Int -> Associativity -> String -> String)
-> (Associativity -> String)
-> ([Associativity] -> String -> String)
-> Show Associativity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Associativity -> String -> String
showsPrec :: Int -> Associativity -> String -> String
$cshow :: Associativity -> String
show :: Associativity -> String
$cshowList :: [Associativity] -> String -> String
showList :: [Associativity] -> String -> String
Show)


-- | Holds details for a binary operator relevant to precedence restructuring.
data OperatorDetails = OperatorDetails
  { OperatorDetails -> AExpr -> AExpr -> AExpr
odConstructor :: PGT_AST.AExpr -> PGT_AST.AExpr -> PGT_AST.AExpr
  , OperatorDetails -> Int
odPrecedence :: Int
  , OperatorDetails -> Associativity
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 :: AExpr -> Maybe (AExpr, OperatorDetails, AExpr)
getOperatorDetails = \case
  PGT_AST.SymbolicBinOpAExpr AExpr
l SymbolicExprBinOp
symOp AExpr
r ->
    let
      details :: p
-> (AExpr -> AExpr -> AExpr)
-> Int
-> Associativity
-> Maybe (AExpr, OperatorDetails, AExpr)
details p
_op AExpr -> AExpr -> AExpr
constr Int
prec Associativity
assoc = (AExpr, OperatorDetails, AExpr)
-> Maybe (AExpr, OperatorDetails, AExpr)
forall a. a -> Maybe a
Just (AExpr
l, (AExpr -> AExpr -> AExpr)
-> Int -> Associativity -> OperatorDetails
OperatorDetails AExpr -> AExpr -> AExpr
constr Int
prec Associativity
assoc, AExpr
r)
      mathDetails :: MathOp
-> Int -> Associativity -> Maybe (AExpr, OperatorDetails, AExpr)
mathDetails MathOp
mathOp Int
prec Associativity
assoc =
        SymbolicExprBinOp
-> (AExpr -> AExpr -> AExpr)
-> Int
-> Associativity
-> Maybe (AExpr, OperatorDetails, AExpr)
forall {p}.
p
-> (AExpr -> AExpr -> AExpr)
-> Int
-> Associativity
-> Maybe (AExpr, OperatorDetails, AExpr)
details
          (MathOp -> SymbolicExprBinOp
PGT_AST.MathSymbolicExprBinOp MathOp
mathOp)
          ( \AExpr
l' AExpr
r' -> AExpr -> SymbolicExprBinOp -> AExpr -> AExpr
PGT_AST.SymbolicBinOpAExpr AExpr
l' (MathOp -> SymbolicExprBinOp
PGT_AST.MathSymbolicExprBinOp MathOp
mathOp) AExpr
r'
          )
          Int
prec
          Associativity
assoc
    in
      case SymbolicExprBinOp
symOp of
        PGT_AST.MathSymbolicExprBinOp MathOp
PGT_AST.ArrowUpMathOp -> MathOp
-> Int -> Associativity -> Maybe (AExpr, OperatorDetails, AExpr)
mathDetails MathOp
PGT_AST.ArrowUpMathOp Int
8 Associativity
LeftAssoc
        -- \^ (exponentiation)
        PGT_AST.MathSymbolicExprBinOp MathOp
op
          | MathOp
op MathOp -> [MathOp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MathOp
PGT_AST.AsteriskMathOp, MathOp
PGT_AST.SlashMathOp, MathOp
PGT_AST.PercentMathOp] ->
              MathOp
-> Int -> Associativity -> Maybe (AExpr, OperatorDetails, AExpr)
mathDetails MathOp
op Int
7 Associativity
LeftAssoc
        -- \* / %
        PGT_AST.MathSymbolicExprBinOp MathOp
op
          | MathOp
op MathOp -> [MathOp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MathOp
PGT_AST.PlusMathOp, MathOp
PGT_AST.MinusMathOp] ->
              MathOp
-> Int -> Associativity -> Maybe (AExpr, OperatorDetails, AExpr)
mathDetails MathOp
op Int
6 Associativity
LeftAssoc -- binary + -
        PGT_AST.MathSymbolicExprBinOp MathOp
op -- Comparisons
          | MathOp
op
              MathOp -> [MathOp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ MathOp
PGT_AST.ArrowLeftMathOp
                     , MathOp
PGT_AST.ArrowRightMathOp
                     , MathOp
PGT_AST.EqualsMathOp
                     , MathOp
PGT_AST.LessEqualsMathOp
                     , MathOp
PGT_AST.GreaterEqualsMathOp
                     , MathOp
PGT_AST.ArrowLeftArrowRightMathOp
                     , MathOp
PGT_AST.ExclamationEqualsMathOp
                     ] ->
              MathOp
-> Int -> Associativity -> Maybe (AExpr, OperatorDetails, AExpr)
mathDetails MathOp
op Int
3 Associativity
LeftAssoc -- < > = <= >= <> !=
        PGT_AST.QualSymbolicExprBinOp QualOp
qualOp ->
          -- User-defined operators, bitwise, etc.
          SymbolicExprBinOp
-> (AExpr -> AExpr -> AExpr)
-> Int
-> Associativity
-> Maybe (AExpr, OperatorDetails, AExpr)
forall {p}.
p
-> (AExpr -> AExpr -> AExpr)
-> Int
-> Associativity
-> Maybe (AExpr, OperatorDetails, AExpr)
details
            (QualOp -> SymbolicExprBinOp
PGT_AST.QualSymbolicExprBinOp QualOp
qualOp)
            ( \AExpr
l' AExpr
r' -> AExpr -> SymbolicExprBinOp -> AExpr -> AExpr
PGT_AST.SymbolicBinOpAExpr AExpr
l' (QualOp -> SymbolicExprBinOp
PGT_AST.QualSymbolicExprBinOp QualOp
qualOp) AExpr
r'
            )
            Int
5
            Associativity
LeftAssoc
        SymbolicExprBinOp
_ -> Maybe (AExpr, OperatorDetails, AExpr)
forall a. Maybe a
Nothing -- Should be exhaustive for PGT_AST.MathSymbolicExprBinOp if it's a binary op
  PGT_AST.AndAExpr AExpr
l AExpr
r -> (AExpr, OperatorDetails, AExpr)
-> Maybe (AExpr, OperatorDetails, AExpr)
forall a. a -> Maybe a
Just (AExpr
l, (AExpr -> AExpr -> AExpr)
-> Int -> Associativity -> OperatorDetails
OperatorDetails AExpr -> AExpr -> AExpr
PGT_AST.AndAExpr Int
2 Associativity
LeftAssoc, AExpr
r) -- AND (precedence 2 in PG docs example)
  PGT_AST.OrAExpr AExpr
l AExpr
r -> (AExpr, OperatorDetails, AExpr)
-> Maybe (AExpr, OperatorDetails, AExpr)
forall a. a -> Maybe a
Just (AExpr
l, (AExpr -> AExpr -> AExpr)
-> Int -> Associativity -> OperatorDetails
OperatorDetails AExpr -> AExpr -> AExpr
PGT_AST.OrAExpr Int
1 Associativity
LeftAssoc, AExpr
r) -- OR (precedence 1 in PG docs example)
  PGT_AST.VerbalExprBinOpAExpr AExpr
l Bool
notOp VerbalExprBinOp
verbalOp AExpr
r Maybe AExpr
mEscape ->
    -- LIKE, ILIKE, SIMILAR TO
    (AExpr, OperatorDetails, AExpr)
-> Maybe (AExpr, OperatorDetails, AExpr)
forall a. a -> Maybe a
Just
      ( AExpr
l
      , (AExpr -> AExpr -> AExpr)
-> Int -> Associativity -> OperatorDetails
OperatorDetails
          (\AExpr
l' AExpr
r' -> AExpr -> Bool -> VerbalExprBinOp -> AExpr -> Maybe AExpr -> AExpr
PGT_AST.VerbalExprBinOpAExpr AExpr
l' Bool
notOp VerbalExprBinOp
verbalOp AExpr
r' Maybe AExpr
mEscape)
          Int
3
          Associativity
LeftAssoc
      , AExpr
r -- Same as comparisons
      )
  PGT_AST.ReversableOpAExpr AExpr
l Bool
notOp (PGT_AST.DistinctFromAExprReversableOp AExpr
r) ->
    -- IS DISTINCT FROM
    (AExpr, OperatorDetails, AExpr)
-> Maybe (AExpr, OperatorDetails, AExpr)
forall a. a -> Maybe a
Just
      ( AExpr
l
      , (AExpr -> AExpr -> AExpr)
-> Int -> Associativity -> OperatorDetails
OperatorDetails
          ( \AExpr
l' AExpr
r' ->
              AExpr -> Bool -> AExprReversableOp -> AExpr
PGT_AST.ReversableOpAExpr AExpr
l' Bool
notOp (AExpr -> AExprReversableOp
PGT_AST.DistinctFromAExprReversableOp AExpr
r')
          )
          Int
3
          Associativity
LeftAssoc
      , AExpr
r -- Same as =
      )
  AExpr
_ -> Maybe (AExpr, OperatorDetails, AExpr)
forall a. Maybe a
Nothing


-- | Rearranges the AExpr syntax tree to account for operator precedence.
fixOperatorPrecedence :: PGT_AST.AExpr -> PGT_AST.AExpr
fixOperatorPrecedence :: AExpr -> AExpr
fixOperatorPrecedence = AExpr -> AExpr
go
  where
    go :: AExpr -> AExpr
go AExpr
expr =
      case AExpr -> Maybe (AExpr, OperatorDetails, AExpr)
getOperatorDetails AExpr
expr of
        Just (AExpr
l1, OperatorDetails
op1Details, AExpr
r1) ->
          let
            l1Fixed :: AExpr
l1Fixed = AExpr -> AExpr
go AExpr
l1
            r1Fixed :: AExpr
r1Fixed = AExpr -> AExpr
go AExpr
r1
            currentOpConstructor :: AExpr -> AExpr -> AExpr
currentOpConstructor = OperatorDetails -> AExpr -> AExpr -> AExpr
odConstructor OperatorDetails
op1Details
            currentPrecedence :: Int
currentPrecedence = OperatorDetails -> Int
odPrecedence OperatorDetails
op1Details
            currentAssociativity :: Associativity
currentAssociativity = OperatorDetails -> Associativity
odAssociativity OperatorDetails
op1Details
          in
            case AExpr -> Maybe (AExpr, OperatorDetails, AExpr)
getOperatorDetails AExpr
r1Fixed of
              Just (AExpr
l2, OperatorDetails
op2Details, AExpr
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 :: AExpr -> AExpr -> AExpr
innerOpConstructor = OperatorDetails -> AExpr -> AExpr -> AExpr
odConstructor OperatorDetails
op2Details
                  innerPrecedence :: Int
innerPrecedence = OperatorDetails -> Int
odPrecedence OperatorDetails
op2Details
                in
                  -- innerAssociativity = odAssociativity op2Details -- Not used in this branch's logic directly

                  if Int
currentPrecedence Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
innerPrecedence
                    Bool -> Bool -> Bool
|| (Int
currentPrecedence Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
innerPrecedence Bool -> Bool -> Bool
&& Associativity
currentAssociativity Associativity -> Associativity -> Bool
forall a. Eq a => a -> a -> Bool
== Associativity
RightAssoc)
                    then
                      -- op2 binds tighter, or op1 is right-associative with same precedence.
                      -- Structure l1Fixed `op1` (l2 `op2` r2) is correct.
                      AExpr -> AExpr -> AExpr
currentOpConstructor AExpr
l1Fixed AExpr
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 :: AExpr
newLeftChild = AExpr -> AExpr -> AExpr
currentOpConstructor AExpr
l1Fixed AExpr
l2
                      in
                        AExpr -> AExpr
go (AExpr -> AExpr -> AExpr
innerOpConstructor AExpr
newLeftChild AExpr
r2) -- Recursively fix the new structure
              Maybe (AExpr, OperatorDetails, AExpr)
Nothing ->
                -- Right child r1Fixed is not a binary operator we're rebalancing.
                -- The structure l1Fixed `op1` r1Fixed is locally correct.
                AExpr -> AExpr -> AExpr
currentOpConstructor AExpr
l1Fixed AExpr
r1Fixed
        Maybe (AExpr, OperatorDetails, AExpr)
Nothing ->
          -- Current expression `expr` is not a binary operator handled by getOperatorDetails,
          -- or it's an atom. Recursively fix its children.
          case AExpr
expr of
            PGT_AST.CExprAExpr CExpr
c -> CExpr -> AExpr
PGT_AST.CExprAExpr CExpr
c -- CExprs are atoms or structured (FuncCExpr, CaseCExpr etc.)
            PGT_AST.TypecastAExpr AExpr
e Typename
t -> AExpr -> Typename -> AExpr
PGT_AST.TypecastAExpr (AExpr -> AExpr
go AExpr
e) Typename
t
            PGT_AST.CollateAExpr AExpr
e AnyName
c -> AExpr -> AnyName -> AExpr
PGT_AST.CollateAExpr (AExpr -> AExpr
go AExpr
e) AnyName
c
            PGT_AST.AtTimeZoneAExpr AExpr
e1 AExpr
e2 -> AExpr -> AExpr -> AExpr
PGT_AST.AtTimeZoneAExpr (AExpr -> AExpr
go AExpr
e1) (AExpr -> AExpr
go AExpr
e2)
            PGT_AST.PlusAExpr AExpr
e -> AExpr -> AExpr
PGT_AST.PlusAExpr (AExpr -> AExpr
go AExpr
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 AExpr
e -> AExpr -> AExpr
PGT_AST.MinusAExpr (AExpr -> AExpr
go AExpr
e)
            PGT_AST.PrefixQualOpAExpr QualOp
op AExpr
e -> QualOp -> AExpr -> AExpr
PGT_AST.PrefixQualOpAExpr QualOp
op (AExpr -> AExpr
go AExpr
e)
            PGT_AST.SuffixQualOpAExpr AExpr
e QualOp
op -> AExpr -> QualOp -> AExpr
PGT_AST.SuffixQualOpAExpr (AExpr -> AExpr
go AExpr
e) QualOp
op
            PGT_AST.NotAExpr AExpr
e -> AExpr -> AExpr
PGT_AST.NotAExpr (AExpr -> AExpr
go AExpr
e)
            PGT_AST.ReversableOpAExpr AExpr
e Bool
notFlag AExprReversableOp
revOp ->
              let
                eFixed :: AExpr
eFixed = AExpr -> AExpr
go AExpr
e
              in
                case AExprReversableOp
revOp of
                  PGT_AST.DistinctFromAExprReversableOp{} -> AExpr
expr -- Should have been caught by getOperatorDetails
                  PGT_AST.BetweenAExprReversableOp Bool
symm BExpr
bExpr AExpr
aExpr ->
                    AExpr -> Bool -> AExprReversableOp -> AExpr
PGT_AST.ReversableOpAExpr
                      AExpr
eFixed
                      Bool
notFlag
                      (Bool -> BExpr -> AExpr -> AExprReversableOp
PGT_AST.BetweenAExprReversableOp Bool
symm (BExpr -> BExpr
goBExpr BExpr
bExpr) (AExpr -> AExpr
go AExpr
aExpr))
                  PGT_AST.InAExprReversableOp InExpr
inExpr ->
                    AExpr -> Bool -> AExprReversableOp -> AExpr
PGT_AST.ReversableOpAExpr
                      AExpr
eFixed
                      Bool
notFlag
                      (InExpr -> AExprReversableOp
PGT_AST.InAExprReversableOp (InExpr -> InExpr
goInExpr InExpr
inExpr))
                  AExprReversableOp
_ -> AExpr -> Bool -> AExprReversableOp -> AExpr
PGT_AST.ReversableOpAExpr AExpr
eFixed Bool
notFlag AExprReversableOp
revOp -- For IS NULL, IS TRUE etc.
            PGT_AST.IsnullAExpr AExpr
e -> AExpr -> AExpr
PGT_AST.IsnullAExpr (AExpr -> AExpr
go AExpr
e)
            PGT_AST.NotnullAExpr AExpr
e -> AExpr -> AExpr
PGT_AST.NotnullAExpr (AExpr -> AExpr
go AExpr
e)
            PGT_AST.OverlapsAExpr Row
row1 Row
row2 -> Row -> Row -> AExpr
PGT_AST.OverlapsAExpr (Row -> Row
goRow Row
row1) (Row -> Row
goRow Row
row2)
            PGT_AST.SubqueryAExpr AExpr
e SubqueryOp
op SubType
st Either SelectWithParens AExpr
sub ->
              AExpr
-> SubqueryOp -> SubType -> Either SelectWithParens AExpr -> AExpr
PGT_AST.SubqueryAExpr
                (AExpr -> AExpr
go AExpr
e)
                SubqueryOp
op
                SubType
st
                ((SelectWithParens -> Either SelectWithParens AExpr)
-> (AExpr -> Either SelectWithParens AExpr)
-> Either SelectWithParens AExpr
-> Either SelectWithParens AExpr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SelectWithParens -> Either SelectWithParens AExpr
forall a b. a -> Either a b
Left (SelectWithParens -> Either SelectWithParens AExpr)
-> (SelectWithParens -> SelectWithParens)
-> SelectWithParens
-> Either SelectWithParens AExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectWithParens -> SelectWithParens
goSelectWithParens) (AExpr -> Either SelectWithParens AExpr
forall a b. b -> Either a b
Right (AExpr -> Either SelectWithParens AExpr)
-> (AExpr -> AExpr) -> AExpr -> Either SelectWithParens AExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AExpr -> AExpr
go) Either SelectWithParens AExpr
sub)
            PGT_AST.UniqueAExpr SelectWithParens
s -> SelectWithParens -> AExpr
PGT_AST.UniqueAExpr (SelectWithParens -> SelectWithParens
goSelectWithParens SelectWithParens
s)
            AExpr
PGT_AST.DefaultAExpr -> AExpr
PGT_AST.DefaultAExpr
            AExpr
_ -> AExpr
expr -- Leaf node or unhandled construct
    goBExpr :: PGT_AST.BExpr -> PGT_AST.BExpr
    goBExpr :: BExpr -> BExpr
goBExpr = \case
      PGT_AST.CExprBExpr CExpr
c -> CExpr -> BExpr
PGT_AST.CExprBExpr CExpr
c
      PGT_AST.TypecastBExpr BExpr
be Typename
t -> BExpr -> Typename -> BExpr
PGT_AST.TypecastBExpr (BExpr -> BExpr
goBExpr BExpr
be) Typename
t
      PGT_AST.PlusBExpr BExpr
be -> BExpr -> BExpr
PGT_AST.PlusBExpr (BExpr -> BExpr
goBExpr BExpr
be)
      PGT_AST.MinusBExpr BExpr
be -> BExpr -> BExpr
PGT_AST.MinusBExpr (BExpr -> BExpr
goBExpr BExpr
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 BExpr
l SymbolicExprBinOp
op BExpr
r -> BExpr -> SymbolicExprBinOp -> BExpr -> BExpr
PGT_AST.SymbolicBinOpBExpr (BExpr -> BExpr
goBExpr BExpr
l) SymbolicExprBinOp
op (BExpr -> BExpr
goBExpr BExpr
r)
      PGT_AST.QualOpBExpr QualOp
op BExpr
be -> QualOp -> BExpr -> BExpr
PGT_AST.QualOpBExpr QualOp
op (BExpr -> BExpr
goBExpr BExpr
be)
      PGT_AST.IsOpBExpr BExpr
be Bool
notFlag BExprIsOp
isOp ->
        let
          beFixed :: BExpr
beFixed = BExpr -> BExpr
goBExpr BExpr
be
        in
          case BExprIsOp
isOp of
            PGT_AST.DistinctFromBExprIsOp BExpr
b ->
              BExpr -> Bool -> BExprIsOp -> BExpr
PGT_AST.IsOpBExpr BExpr
beFixed Bool
notFlag (BExpr -> BExprIsOp
PGT_AST.DistinctFromBExprIsOp (BExpr -> BExpr
goBExpr BExpr
b))
            BExprIsOp
_ -> BExpr -> Bool -> BExprIsOp -> BExpr
PGT_AST.IsOpBExpr BExpr
beFixed Bool
notFlag BExprIsOp
isOp

    goRow :: PGT_AST.Row -> PGT_AST.Row
    goRow :: Row -> Row
goRow = \case
      PGT_AST.ExplicitRowRow Maybe TypeModifiers
mExprs -> Maybe TypeModifiers -> Row
PGT_AST.ExplicitRowRow ((TypeModifiers -> TypeModifiers)
-> Maybe TypeModifiers -> Maybe TypeModifiers
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AExpr -> AExpr) -> TypeModifiers -> TypeModifiers
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map AExpr -> AExpr
go) Maybe TypeModifiers
mExprs)
      PGT_AST.ImplicitRowRow (PGT_AST.ImplicitRow TypeModifiers
exprs AExpr
aexpr) -> ImplicitRow -> Row
PGT_AST.ImplicitRowRow (TypeModifiers -> AExpr -> ImplicitRow
PGT_AST.ImplicitRow ((AExpr -> AExpr) -> TypeModifiers -> TypeModifiers
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map AExpr -> AExpr
go TypeModifiers
exprs) (AExpr -> AExpr
go AExpr
aexpr))

    goSelectWithParens :: PGT_AST.SelectWithParens -> PGT_AST.SelectWithParens
    goSelectWithParens :: SelectWithParens -> SelectWithParens
goSelectWithParens = SelectWithParens -> SelectWithParens
forall a. a -> a
id -- Placeholder: A full traversal would be needed.
    goInExpr :: PGT_AST.InExpr -> PGT_AST.InExpr
    goInExpr :: InExpr -> InExpr
goInExpr = \case
      PGT_AST.SelectInExpr SelectWithParens
s -> SelectWithParens -> InExpr
PGT_AST.SelectInExpr (SelectWithParens -> SelectWithParens
goSelectWithParens SelectWithParens
s)
      PGT_AST.ExprListInExpr TypeModifiers
exprs -> TypeModifiers -> InExpr
PGT_AST.ExprListInExpr ((AExpr -> AExpr) -> TypeModifiers -> TypeModifiers
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map AExpr -> AExpr
go TypeModifiers
exprs)


renderPGTAExpr :: [Text.Text] -> PGT_AST.AExpr -> Q Exp
renderPGTAExpr :: [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
astExpr = case AExpr -> AExpr
fixOperatorPrecedence AExpr
astExpr of
  PGT_AST.CExprAExpr CExpr
cExpr -> [Text] -> CExpr -> Q Exp
renderPGTCExpr [Text]
cteNames CExpr
cExpr
  PGT_AST.TypecastAExpr AExpr
aExpr Typename
typename -> do
    tnExp <- Typename -> Q Exp
renderPGTTypename Typename
typename
    aExp <- renderPGTAExpr cteNames aExpr
    pure $ VarE 'S.cast `AppE` tnExp `AppE` aExp
  PGT_AST.SymbolicBinOpAExpr AExpr
left SymbolicExprBinOp
op AExpr
right -> do
    lExp <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
left
    rExp <- renderPGTAExpr cteNames right
    squealOpExp <-
      case op of
        PGT_AST.MathSymbolicExprBinOp MathOp
mathOp -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ MathOp -> Exp
renderPGTMathOp MathOp
mathOp
        PGT_AST.QualSymbolicExprBinOp QualOp
qualOp -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ QualOp -> Exp
renderPGTQualOp QualOp
qualOp
    pure (squealOpExp `AppE` lExp `AppE` rExp)
  PGT_AST.PrefixQualOpAExpr QualOp
op AExpr
expr -> do
    let
      opExp' :: Exp
opExp' = QualOp -> Exp
renderPGTQualOp QualOp
op
    eExp' <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
expr
    pure (opExp' `AppE` eExp')
  PGT_AST.AndAExpr AExpr
left AExpr
right -> do
    lExp' <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
left
    rExp' <- renderPGTAExpr cteNames right
    pure (VarE '(S..&&) `AppE` lExp' `AppE` rExp')
  PGT_AST.OrAExpr AExpr
left AExpr
right -> do
    lExp' <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
left
    rExp' <- renderPGTAExpr cteNames right
    pure (VarE '(S..||) `AppE` lExp' `AppE` rExp')
  PGT_AST.NotAExpr AExpr
expr -> do
    eExp' <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
expr
    pure (VarE 'S.not_ `AppE` eExp')
  PGT_AST.VerbalExprBinOpAExpr AExpr
left Bool
not VerbalExprBinOp
op AExpr
right Maybe AExpr
mEscape -> do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AExpr -> Bool
forall a. Maybe a -> Bool
isJust Maybe AExpr
mEscape) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LIKE with ESCAPE is not supported yet."
    lExp' <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
left
    rExp' <- renderPGTAExpr cteNames right
    baseOpExp <-
      case op of
        VerbalExprBinOp
PGT_AST.LikeVerbalExprBinOp -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.like
        VerbalExprBinOp
PGT_AST.IlikeVerbalExprBinOp -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.ilike
        VerbalExprBinOp
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported verbal binary operator: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> VerbalExprBinOp -> String
forall a. Show a => a -> String
show VerbalExprBinOp
op
    let
      finalOpExp = if Bool
not then Name -> Exp
VarE 'S.not_ Exp -> Exp -> Exp
`AppE` Exp
baseOpExp else Exp
baseOpExp
    pure (finalOpExp `AppE` lExp' `AppE` rExp')
  PGT_AST.ReversableOpAExpr AExpr
expr Bool
not AExprReversableOp
reversableOp -> do
    renderedExpr' <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
expr
    case reversableOp of
      AExprReversableOp
PGT_AST.NullAExprReversableOp ->
        Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ (if Bool
not then Name -> Exp
VarE 'S.isNotNull else Name -> Exp
VarE 'S.isNull) Exp -> Exp -> Exp
`AppE` Exp
renderedExpr'
      PGT_AST.BetweenAExprReversableOp Bool
_asymmetric BExpr
bExpr AExpr
andAExpr -> do
        bExp' <- [Text] -> BExpr -> Q Exp
renderPGTBExpr [Text]
cteNames BExpr
bExpr
        aExp' <- renderPGTAExpr cteNames andAExpr
        let
          opVar' = if Bool
not then Name -> Exp
VarE 'S.notBetween else Name -> Exp
VarE 'S.between
        pure $ opVar' `AppE` renderedExpr' `AppE` TupE [Just bExp', Just aExp']
      PGT_AST.InAExprReversableOp InExpr
inExpr ->
        case InExpr
inExpr of
          PGT_AST.ExprListInExpr TypeModifiers
exprList -> do
            let opVar' :: Exp
opVar' = if Bool
not then Name -> Exp
VarE 'S.notIn else Name -> Exp
VarE 'S.in_
            listExp' <- [Exp] -> Exp
ListE ([Exp] -> Exp) -> Q [Exp] -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AExpr -> Q Exp) -> [AExpr] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames) (TypeModifiers -> [AExpr]
forall a. NonEmpty a -> [a]
NE.toList TypeModifiers
exprList)
            pure $ opVar' `AppE` renderedExpr' `AppE` listExp'
          PGT_AST.SelectInExpr SelectWithParens
selectWithParens -> do
            let
              (Exp
squealOp, Exp
squealFn) =
                if Bool
not
                  then (Name -> Exp
VarE '(S../=), Name -> Exp
VarE 'S.subAll)
                  else (Name -> Exp
VarE '(S..==), Name -> Exp
VarE 'S.subAny)
            subqueryExp <- [Text] -> Maybe (NonEmpty Ident) -> SelectWithParens -> Q Exp
toSquealSelectWithParens [Text]
cteNames Maybe (NonEmpty Ident)
forall a. Maybe a
Nothing SelectWithParens
selectWithParens
            pure $ squealFn `AppE` renderedExpr' `AppE` squealOp `AppE` subqueryExp
      AExprReversableOp
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported reversable operator: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> AExprReversableOp -> String
forall a. Show a => a -> String
show AExprReversableOp
reversableOp
  AExpr
PGT_AST.DefaultAExpr -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Default
  PGT_AST.MinusAExpr AExpr
expr -> do
    -- Unary minus
    eExp' <- [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
expr
    let
      zeroExp = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'fromInteger) (Lit -> Exp
LitE (Integer -> Lit
IntegerL Integer
0))
    pure (InfixE (Just zeroExp) (VarE '(-)) (Just eExp'))
  AExpr
unsupported -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported AExpr: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> AExpr -> String
forall a. Show a => a -> String
show AExpr
unsupported


renderPGTBExpr :: [Text.Text] -> PGT_AST.BExpr -> Q Exp
renderPGTBExpr :: [Text] -> BExpr -> Q Exp
renderPGTBExpr [Text]
cteNames = \case
  PGT_AST.CExprBExpr CExpr
cExpr -> [Text] -> CExpr -> Q Exp
renderPGTCExpr [Text]
cteNames CExpr
cExpr
  PGT_AST.TypecastBExpr BExpr
bExpr Typename
typename -> do
    tnExp <- Typename -> Q Exp
renderPGTTypename Typename
typename
    bExp <- renderPGTBExpr cteNames bExpr
    pure $ VarE 'S.cast `AppE` tnExp `AppE` bExp
  PGT_AST.SymbolicBinOpBExpr BExpr
left SymbolicExprBinOp
op BExpr
right -> do
    lExp <- [Text] -> BExpr -> Q Exp
renderPGTBExpr [Text]
cteNames BExpr
left
    rExp <- renderPGTBExpr cteNames right
    squealOpExp <-
      case op of
        PGT_AST.MathSymbolicExprBinOp MathOp
mathOp -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ MathOp -> Exp
renderPGTMathOp MathOp
mathOp
        PGT_AST.QualSymbolicExprBinOp QualOp
qualOp -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ QualOp -> Exp
renderPGTQualOp QualOp
qualOp
    pure (squealOpExp `AppE` lExp `AppE` rExp)
  BExpr
unsupported -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported BExpr: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BExpr -> String
forall a. Show a => a -> String
show BExpr
unsupported


renderPGTCExpr :: [Text.Text] -> PGT_AST.CExpr -> Q Exp
renderPGTCExpr :: [Text] -> CExpr -> Q Exp
renderPGTCExpr [Text]
cteNames = \case
  PGT_AST.AexprConstCExpr AexprConst
aexprConst -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ AexprConst -> Exp
renderPGTAexprConst AexprConst
aexprConst
  PGT_AST.ColumnrefCExpr Columnref
columnref -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Columnref -> Exp
renderPGTColumnref Columnref
columnref
  PGT_AST.ParamCExpr Int
n Maybe Indirection
maybeIndirection -> do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Indirection -> Bool
forall a. Maybe a -> Bool
isJust Maybe Indirection
maybeIndirection) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
      String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parameters with indirection (e.g. $1[i]) are not supported."
    Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.param Exp -> Type -> Exp
`AppTypeE` TyLit -> Type
LitT (Integer -> TyLit
NumTyLit (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
  PGT_AST.InParensCExpr AExpr
expr Maybe Indirection
maybeIndirection -> do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Indirection -> Bool
forall a. Maybe a -> Bool
isJust Maybe Indirection
maybeIndirection) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
      String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parenthesized expressions with indirection are not supported."
    [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
expr -- Squeal's operator precedence should handle this
  PGT_AST.FuncCExpr FuncExpr
funcExpr -> [Text] -> FuncExpr -> Q Exp
renderPGTFuncExpr [Text]
cteNames FuncExpr
funcExpr
  CExpr
unsupported -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported CExpr: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CExpr -> String
forall a. Show a => a -> String
show CExpr
unsupported


renderPGTFuncExpr :: [Text.Text] -> PGT_AST.FuncExpr -> Q Exp
renderPGTFuncExpr :: [Text] -> FuncExpr -> Q Exp
renderPGTFuncExpr [Text]
cteNames = \case
  PGT_AST.ApplicationFuncExpr FuncApplication
funcApp Maybe SortClause
maybeWithinGroup Maybe AExpr
maybeFilter Maybe OverClause
maybeOver -> do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe SortClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe SortClause
maybeWithinGroup) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"WITHIN GROUP clause is not supported."
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AExpr -> Bool
forall a. Maybe a -> Bool
isJust Maybe AExpr
maybeFilter) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"FILTER clause is not supported."
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe OverClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe OverClause
maybeOver) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"OVER clause is not supported."
    [Text] -> FuncApplication -> Q Exp
renderPGTFuncApplication [Text]
cteNames FuncApplication
funcApp
  PGT_AST.SubexprFuncExpr FuncExprCommonSubexpr
funcCommonSubexpr -> [Text] -> FuncExprCommonSubexpr -> Q Exp
renderPGTFuncExprCommonSubexpr [Text]
cteNames FuncExprCommonSubexpr
funcCommonSubexpr


renderPGTFuncApplication :: [Text.Text] -> PGT_AST.FuncApplication -> Q Exp
renderPGTFuncApplication :: [Text] -> FuncApplication -> Q Exp
renderPGTFuncApplication [Text]
cteNames (PGT_AST.FuncApplication FuncName
funcName Maybe FuncApplicationParams
maybeParams) =
  case FuncName
funcName of
    PGT_AST.IndirectedFuncName{} ->
      String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Functions with indirection (e.g. schema.func) are not supported."
    PGT_AST.TypeFuncName Ident
fident ->
      let
        fnNameStr :: String
fnNameStr = Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
fident)
      in
        case Text -> Text
Text.toLower (String -> Text
Text.pack String
fnNameStr) of
          Text
"inline" ->
            case Maybe FuncApplicationParams
maybeParams of
              Just (PGT_AST.NormalFuncApplicationParams Maybe Bool
_ NonEmpty FuncArgExpr
args Maybe SortClause
_) ->
                case NonEmpty FuncArgExpr -> [FuncArgExpr]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FuncArgExpr
args of
                  [ PGT_AST.ExprFuncArgExpr
                      (PGT_AST.CExprAExpr (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref Ident
ident Maybe Indirection
Nothing)))
                    ] -> do
                      let
                        varName :: Name
                        varName :: Name
varName = String -> Name
mkName (String -> Name) -> (Ident -> String) -> Ident -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (Ident -> Text) -> Ident -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
getIdentText (Ident -> Name) -> Ident -> Name
forall a b. (a -> b) -> a -> b
$ Ident
ident
                      Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.inline Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
varName
                  [FuncArgExpr]
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"inline() function expects a single variable argument"
              Maybe FuncApplicationParams
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"inline() function expects a single variable argument"
          Text
"inline_param" ->
            case Maybe FuncApplicationParams
maybeParams of
              Just (PGT_AST.NormalFuncApplicationParams Maybe Bool
_ NonEmpty FuncArgExpr
args Maybe SortClause
_) ->
                case NonEmpty FuncArgExpr -> [FuncArgExpr]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FuncArgExpr
args of
                  [ PGT_AST.ExprFuncArgExpr
                      (PGT_AST.CExprAExpr (PGT_AST.ColumnrefCExpr (PGT_AST.Columnref Ident
ident Maybe Indirection
Nothing)))
                    ] -> do
                      let
                        varName :: Name
                        varName :: Name
varName = String -> Name
mkName (String -> Name) -> (Ident -> String) -> Ident -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (Ident -> Text) -> Ident -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
getIdentText (Ident -> Name) -> Ident -> Name
forall a b. (a -> b) -> a -> b
$ Ident
ident
                      Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.inlineParam Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
varName
                  [FuncArgExpr]
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"inline_param() function expects a single variable argument"
              Maybe FuncApplicationParams
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"inline_param() function expects a single variable argument"
          Text
otherFnName ->
            let
              squealFn :: Q Exp
              squealFn :: Q Exp
squealFn =
                case Text
otherFnName of
                  Text
"coalesce" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.coalesce
                  Text
"lower" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.lower
                  Text
"char_length" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.charLength
                  Text
"character_length" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.charLength
                  Text
"upper" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.upper
                  Text
"count" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.count -- Special handling for count(*) might be needed
                  Text
"now" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.now
                  Text
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported function: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fnNameStr
            in
              case Maybe FuncApplicationParams
maybeParams of
                Maybe FuncApplicationParams
Nothing -> Q Exp
squealFn -- No-argument function
                Just FuncApplicationParams
params -> case FuncApplicationParams
params of
                  PGT_AST.NormalFuncApplicationParams Maybe Bool
maybeAllOrDistinct NonEmpty FuncArgExpr
args Maybe SortClause
maybeSortClause -> do
                    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust Maybe Bool
maybeAllOrDistinct) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
                      String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"DISTINCT in function calls is not supported."
                    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe SortClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe SortClause
maybeSortClause) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
                      String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ORDER BY in function calls is not supported."
                    fn <- Q Exp
squealFn
                    argExps <- mapM (renderPGTFuncArgExpr cteNames) (NE.toList args)
                    pure $ foldl' AppE fn argExps
                  FuncApplicationParams
PGT_AST.StarFuncApplicationParams ->
                    -- Specific for count(*)
                    if String
fnNameStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"count"
                      then Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.countStar
                      else String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Star argument only supported for COUNT"
                  FuncApplicationParams
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported function parameters structure: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FuncApplicationParams -> String
forall a. Show a => a -> String
show FuncApplicationParams
params


renderPGTFuncArgExpr :: [Text.Text] -> PGT_AST.FuncArgExpr -> Q Exp
renderPGTFuncArgExpr :: [Text] -> FuncArgExpr -> Q Exp
renderPGTFuncArgExpr [Text]
cteNames = \case
  PGT_AST.ExprFuncArgExpr AExpr
aExpr -> [Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames AExpr
aExpr
  FuncArgExpr
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Named or colon-syntax function arguments not supported"


renderPGTFuncExprCommonSubexpr :: [Text.Text] -> PGT_AST.FuncExprCommonSubexpr -> Q Exp
renderPGTFuncExprCommonSubexpr :: [Text] -> FuncExprCommonSubexpr -> Q Exp
renderPGTFuncExprCommonSubexpr [Text]
cteNames = \case
  PGT_AST.CurrentTimestampFuncExprCommonSubexpr (Just Iconst
_) ->
    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"CURRENT_TIMESTAMP with precision is not supported."
  PGT_AST.CurrentTimestampFuncExprCommonSubexpr Maybe Iconst
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.now -- Or S.currentTimestamp
  FuncExprCommonSubexpr
PGT_AST.CurrentDateFuncExprCommonSubexpr -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.currentDate
  PGT_AST.CoalesceFuncExprCommonSubexpr TypeModifiers
exprListNE -> do
    renderedInitExprs <- (AExpr -> Q Exp) -> [AExpr] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames) (TypeModifiers -> [AExpr]
forall a. NonEmpty a -> [a]
NE.init TypeModifiers
exprListNE)
    renderedLastExpr <- renderPGTAExpr cteNames (NE.last exprListNE)
    pure $ VarE 'S.coalesce `AppE` ListE renderedInitExprs `AppE` renderedLastExpr
  FuncExprCommonSubexpr
e -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported common function subexpression: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FuncExprCommonSubexpr -> String
forall a. Show a => a -> String
show FuncExprCommonSubexpr
e


renderPGTColumnref :: PGT_AST.Columnref -> Exp
renderPGTColumnref :: Columnref -> Exp
renderPGTColumnref (PGT_AST.Columnref Ident
colId Maybe Indirection
maybeIndirection) =
    case Maybe Indirection
maybeIndirection of
      Maybe Indirection
Nothing -> String -> Exp
LabelE (Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
colId))
      Just Indirection
indirection ->
        let
          base :: Exp
base = String -> Exp
LabelE (Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
colId))
        in
          (Exp -> IndirectionEl -> Exp) -> Exp -> [IndirectionEl] -> Exp
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Exp -> IndirectionEl -> Exp
applyIndirection Exp
base (Indirection -> [IndirectionEl]
forall a. NonEmpty a -> [a]
NE.toList Indirection
indirection)
  where
    applyIndirection :: Exp -> IndirectionEl -> Exp
applyIndirection Exp
acc = \case
      PGT_AST.AttrNameIndirectionEl Ident
attrName ->
        Name -> Exp
VarE '(S.!) Exp -> Exp -> Exp
`AppE` Exp
acc Exp -> Exp -> Exp
`AppE` String -> Exp
LabelE (Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
attrName))
      IndirectionEl
_ -> String -> Exp
forall a. HasCallStack => String -> a
error String
"Unsupported column reference indirection"


renderPGTAexprConst :: PGT_AST.AexprConst -> Exp
renderPGTAexprConst :: AexprConst -> Exp
renderPGTAexprConst = \case
  PGT_AST.IAexprConst Iconst
n ->
    Name -> Exp
ConE 'S.UnsafeExpression
      Exp -> Exp -> Exp
`AppE` ( Name -> Exp
VarE 'BS8.pack
                 Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (String -> Lit
StringL (Iconst -> String
forall a. Show a => a -> String
show Iconst
n))
             )
  PGT_AST.FAexprConst Fconst
f ->
    Name -> Exp
ConE 'S.UnsafeExpression
      Exp -> Exp -> Exp
`AppE` ( Name -> Exp
VarE 'BS8.pack
                 Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (String -> Lit
StringL (Fconst -> String
forall a. Show a => a -> String
show Fconst
f))
             )
  PGT_AST.SAexprConst Text
s ->
    Name -> Exp
VarE 'fromString Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (String -> Lit
StringL (Text -> String
Text.unpack Text
s))
  PGT_AST.BoolAexprConst Bool
True -> Name -> Exp
VarE 'S.true
  PGT_AST.BoolAexprConst Bool
False -> Name -> Exp
VarE 'S.false
  AexprConst
PGT_AST.NullAexprConst -> Name -> Exp
VarE 'S.null_
  AexprConst
unsupported -> String -> Exp
forall a. HasCallStack => String -> a
error (String -> Exp) -> String -> Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported AexprConst: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> AexprConst -> String
forall a. Show a => a -> String
show AexprConst
unsupported


renderPGTMathOp :: PGT_AST.MathOp -> Exp
renderPGTMathOp :: MathOp -> Exp
renderPGTMathOp = \case
  MathOp
PGT_AST.PlusMathOp -> Name -> Exp
VarE '(+)
  MathOp
PGT_AST.MinusMathOp -> Name -> Exp
VarE '(-)
  MathOp
PGT_AST.AsteriskMathOp -> Name -> Exp
VarE '(*)
  MathOp
PGT_AST.EqualsMathOp -> Name -> Exp
VarE '(S..==)
  MathOp
PGT_AST.ArrowLeftArrowRightMathOp -> Name -> Exp
VarE '(S../=) -- <>
  MathOp
PGT_AST.ExclamationEqualsMathOp -> Name -> Exp
VarE '(S../=) -- !=
  MathOp
PGT_AST.ArrowRightMathOp -> Name -> Exp
VarE '(S..>)
  MathOp
PGT_AST.GreaterEqualsMathOp -> Name -> Exp
VarE '(S..>=)
  MathOp
PGT_AST.ArrowLeftMathOp -> Name -> Exp
VarE '(S..<)
  MathOp
PGT_AST.LessEqualsMathOp -> Name -> Exp
VarE '(S..<=)
  MathOp
_ -> String -> Exp
forall a. HasCallStack => String -> a
error String
"Unsupported math operator"


renderPGTQualOp :: PGT_AST.QualOp -> Exp
renderPGTQualOp :: QualOp -> Exp
renderPGTQualOp = \case
  PGT_AST.OpQualOp Text
opText ->
    case Text -> Text
Text.toLower Text
opText of
      Text
"+" -> Name -> Exp
VarE '(+)
      Text
"-" -> Name -> Exp
VarE '(-)
      Text
"*" -> Name -> Exp
VarE '(*)
      Text
"=" -> Name -> Exp
VarE '(S..==)
      Text
"<>" -> Name -> Exp
VarE '(S../=)
      Text
"!=" -> Name -> Exp
VarE '(S../=)
      Text
">" -> Name -> Exp
VarE '(S..>)
      Text
">=" -> Name -> Exp
VarE '(S..>=)
      Text
"<" -> Name -> Exp
VarE '(S..<)
      Text
"<=" -> Name -> Exp
VarE '(S..<=)
      Text
"and" -> Name -> Exp
VarE '(S..&&)
      Text
"or" -> Name -> Exp
VarE '(S..||)
      Text
"not" -> Name -> Exp
VarE 'S.not_
      Text
"like" -> Name -> Exp
VarE 'S.like
      Text
"ilike" -> Name -> Exp
VarE 'S.ilike
      Text
_ -> String -> Exp
forall a. HasCallStack => String -> a
error (String -> Exp) -> String -> Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported QualOp operator text: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
opText
  PGT_AST.OperatorQualOp AnyOperator
_anyOperator ->
    String -> Exp
forall a. HasCallStack => String -> a
error String
"OPERATOR(any_operator) syntax not supported"


renderPGTTypename :: PGT_AST.Typename -> Q Exp
renderPGTTypename :: Typename -> Q Exp
renderPGTTypename (PGT_AST.Typename Bool
setof SimpleTypename
simpleTypename Bool
nullable Maybe (TypenameArrayDimensions, Bool)
arrayInfo) = do
  Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
setof (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SETOF type modifier is not supported."
  Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
nullable (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Nullable type modifier '?' is not supported."
  baseTypeExp <- SimpleTypename -> Q Exp
renderPGTSimpleTypename SimpleTypename
simpleTypename
  case arrayInfo of
    Maybe (TypenameArrayDimensions, Bool)
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
baseTypeExp
    Just (TypenameArrayDimensions
dims, Bool
nullableArray) -> do
      Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
nullableArray (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Nullable array modifier '?' is not supported."
      Exp -> TypenameArrayDimensions -> Q Exp
renderPGTArrayDimensions Exp
baseTypeExp TypenameArrayDimensions
dims


renderPGTArrayDimensions :: Exp -> PGT_AST.TypenameArrayDimensions -> Q Exp
renderPGTArrayDimensions :: Exp -> TypenameArrayDimensions -> Q Exp
renderPGTArrayDimensions Exp
baseTypeExp = \case
  PGT_AST.BoundsTypenameArrayDimensions ArrayBounds
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 ArrayBounds -> [Maybe Iconst]
forall a. NonEmpty a -> [a]
NE.toList ArrayBounds
bounds of
      [Just Iconst
dim] ->
        Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
          Name -> Exp
VarE 'S.fixarray
            Exp -> Type -> Exp
`AppTypeE` TyLit -> Type
LitT (Integer -> TyLit
NumTyLit (Iconst -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Iconst
dim))
            Exp -> Exp -> Exp
`AppE` Exp
baseTypeExp
      [Maybe Iconst
_] -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.vararray Exp -> Exp -> Exp
`AppE` Exp
baseTypeExp -- e.g. int[]
      [Maybe Iconst]
_ ->
        String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Multidimensional arrays with explicit bounds not yet supported"
  PGT_AST.ExplicitTypenameArrayDimensions Maybe Iconst
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.vararray Exp -> Exp -> Exp
`AppE` Exp
baseTypeExp -- e.g. sometype ARRAY
  PGT_AST.ExplicitTypenameArrayDimensions (Just Iconst
dim) ->
    Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
      Name -> Exp
VarE 'S.fixarray
        Exp -> Type -> Exp
`AppTypeE` TyLit -> Type
LitT (Integer -> TyLit
NumTyLit (Iconst -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Iconst
dim))
        Exp -> Exp -> Exp
`AppE` Exp
baseTypeExp -- e.g. sometype ARRAY[N]


renderPGTSimpleTypename :: PGT_AST.SimpleTypename -> Q Exp
renderPGTSimpleTypename :: SimpleTypename -> Q Exp
renderPGTSimpleTypename = \case
  PGT_AST.GenericTypeSimpleTypename
    (PGT_AST.GenericType Ident
typeFnName Maybe (NonEmpty Ident)
attrs Maybe TypeModifiers
maybeModifiers) -> do
      Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (NonEmpty Ident) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (NonEmpty Ident)
attrs) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
        String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Qualified type names (e.g. schema.my_type) are not supported."
      let
        nameLower :: Text
nameLower = Text -> Text
Text.toLower (Ident -> Text
getIdentText Ident
typeFnName)
        extractLength :: Maybe PGT_AST.TypeModifiers -> Q Integer
        extractLength :: Maybe TypeModifiers -> Q Integer
extractLength = \case
          Just
            ((PGT_AST.CExprAExpr (PGT_AST.AexprConstCExpr (PGT_AST.IAexprConst Iconst
n))) NE.:| []) -> Integer -> Q Integer
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Iconst -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Iconst
n)
          Just TypeModifiers
other ->
            String -> Q Integer
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Integer) -> String -> Q Integer
forall a b. (a -> b) -> a -> b
$
              String
"Unsupported type modifier for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
nameLower String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TypeModifiers -> String
forall a. Show a => a -> String
show TypeModifiers
other
          Maybe TypeModifiers
Nothing ->
            String -> Q Integer
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Integer) -> String -> Q Integer
forall a b. (a -> b) -> a -> b
$
              String
"Type "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
nameLower
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" requires a length argument (e.g., "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
nameLower
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"(N))."

        extractLengthOrDefault :: Integer -> Maybe PGT_AST.TypeModifiers -> Q Integer
        extractLengthOrDefault :: Integer -> Maybe TypeModifiers -> Q Integer
extractLengthOrDefault Integer
def = \case
          Just
            ((PGT_AST.CExprAExpr (PGT_AST.AexprConstCExpr (PGT_AST.IAexprConst Iconst
n))) NE.:| []) -> Integer -> Q Integer
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Iconst -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Iconst
n)
          Just TypeModifiers
other ->
            String -> Q Integer
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Integer) -> String -> Q Integer
forall a b. (a -> b) -> a -> b
$
              String
"Unsupported type modifier for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
nameLower String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TypeModifiers -> String
forall a. Show a => a -> String
show TypeModifiers
other
          Maybe TypeModifiers
Nothing -> Integer -> Q Integer
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
def
      case Text
nameLower of
        Text
"char" -> do
          len <- Integer -> Maybe TypeModifiers -> Q Integer
extractLengthOrDefault Integer
1 Maybe TypeModifiers
maybeModifiers
          pure $ VarE 'S.char `AppTypeE` LitT (NumTyLit len)
        Text
"character" -> do
          len <- Integer -> Maybe TypeModifiers -> Q Integer
extractLengthOrDefault Integer
1 Maybe TypeModifiers
maybeModifiers
          pure $ VarE 'S.character `AppTypeE` LitT (NumTyLit len)
        Text
"varchar" -> case Maybe TypeModifiers
maybeModifiers of
          Maybe TypeModifiers
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.text -- varchar without length is text
          Just TypeModifiers
_ -> do
            len <- Maybe TypeModifiers -> Q Integer
extractLength Maybe TypeModifiers
maybeModifiers
            pure $ VarE 'S.varchar `AppTypeE` LitT (NumTyLit len)
        Text
"character varying" -> case Maybe TypeModifiers
maybeModifiers of
          Maybe TypeModifiers
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.text -- character varying without length is text
          Just TypeModifiers
_ -> do
            len <- Maybe TypeModifiers -> Q Integer
extractLength Maybe TypeModifiers
maybeModifiers
            pure $ VarE 'S.characterVarying `AppTypeE` LitT (NumTyLit len)
        Text
"bool" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.bool
        Text
"int2" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.int2
        Text
"smallint" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.smallint
        Text
"int4" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.int4
        Text
"int" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.int
        Text
"integer" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.integer
        Text
"int8" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.int8
        Text
"bigint" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.bigint
        Text
"numeric" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.numeric -- Ignoring precision/scale for now
        Text
"float4" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.float4 -- Ignoring precision for now
        Text
"real" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.real
        Text
"float8" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.float8
        Text
"double precision" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.doublePrecision
        Text
"money" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.money
        Text
"text" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.text
        Text
"bytea" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.bytea
        Text
"timestamp" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.timestamp
        Text
"timestamptz" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.timestamptz
        Text
"timestamp with time zone" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.timestampWithTimeZone
        Text
"date" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.date
        Text
"time" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.time
        Text
"timetz" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.timetz
        Text
"time with time zone" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.timeWithTimeZone
        Text
"interval" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.interval
        Text
"uuid" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.uuid
        Text
"inet" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.inet
        Text
"json" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.json
        Text
"jsonb" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.jsonb
        Text
"tsvector" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.tsvector
        Text
"tsquery" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.tsquery
        Text
"oid" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.oid
        Text
"int4range" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.int4range
        Text
"int8range" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.int8range
        Text
"numrange" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.numrange
        Text
"tsrange" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.tsrange
        Text
"tstzrange" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.tstzrange
        Text
"daterange" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.daterange
        Text
"record" -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.record
        Text
other -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported generic type name: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
other
  PGT_AST.NumericSimpleTypename Numeric
numeric -> Numeric -> Q Exp
renderPGTNumeric Numeric
numeric
  PGT_AST.BitSimpleTypename (PGT_AST.Bit Bool
_varying Maybe TypeModifiers
_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.
    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
      String
"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 Character
charTypeAst ->
    case Character
charTypeAst of
      PGT_AST.CharacterCharacter Bool
False -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.character Exp -> Type -> Exp
`AppTypeE` TyLit -> Type
LitT (Integer -> TyLit
NumTyLit Integer
1) -- SQL CHARACTER -> Squeal character(1)
      PGT_AST.CharacterCharacter Bool
True -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.text -- SQL CHARACTER VARYING -> Squeal text
      PGT_AST.CharCharacter Bool
False -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.char Exp -> Type -> Exp
`AppTypeE` TyLit -> Type
LitT (Integer -> TyLit
NumTyLit Integer
1) -- SQL CHAR -> Squeal char(1)
      PGT_AST.CharCharacter Bool
True -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.text -- SQL CHAR VARYING -> Squeal text
      Character
PGT_AST.VarcharCharacter -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.text -- SQL VARCHAR (no length) -> Squeal text
      -- National character types are often aliases for standard character types in PostgreSQL
      PGT_AST.NationalCharacterCharacter Bool
False -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.character Exp -> Type -> Exp
`AppTypeE` TyLit -> Type
LitT (Integer -> TyLit
NumTyLit Integer
1) -- NCHAR -> character(1)
      PGT_AST.NationalCharacterCharacter Bool
True -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.text -- NCHAR VARYING -> text
      PGT_AST.NationalCharCharacter Bool
False -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.char Exp -> Type -> Exp
`AppTypeE` TyLit -> Type
LitT (Integer -> TyLit
NumTyLit Integer
1) -- NATIONAL CHAR -> char(1)
      PGT_AST.NationalCharCharacter Bool
True -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.text -- NATIONAL CHAR VARYING -> text
      PGT_AST.NcharCharacter Bool
False -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.char Exp -> Type -> Exp
`AppTypeE` TyLit -> Type
LitT (Integer -> TyLit
NumTyLit Integer
1) -- NCHAR (synonym for NATIONAL CHAR) -> char(1)
      PGT_AST.NcharCharacter Bool
True -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.text -- NCHAR VARYING -> text
  PGT_AST.ConstDatetimeSimpleTypename ConstDatetime
dt -> case ConstDatetime
dt of
    PGT_AST.TimestampConstDatetime Maybe Iconst
precision Maybe Bool
maybeTimezone -> do
      Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Iconst -> Bool
forall a. Maybe a -> Bool
isJust Maybe Iconst
precision) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"TIMESTAMP with precision is not supported."
      Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ case Maybe Bool
maybeTimezone of
        Just Bool
False -> Name -> Exp
VarE 'S.timestampWithTimeZone -- WITH TIME ZONE
        Maybe Bool
_ -> Name -> Exp
VarE 'S.timestamp -- WITHOUT TIME ZONE or unspecified
    PGT_AST.TimeConstDatetime Maybe Iconst
precision Maybe Bool
maybeTimezone -> do
      Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Iconst -> Bool
forall a. Maybe a -> Bool
isJust Maybe Iconst
precision) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"TIME with precision is not supported."
      Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ case Maybe Bool
maybeTimezone of
        Just Bool
False -> Name -> Exp
VarE 'S.timeWithTimeZone -- WITH TIME ZONE
        Maybe Bool
_ -> Name -> Exp
VarE 'S.time -- WITHOUT TIME ZONE or unspecified
  PGT_AST.ConstIntervalSimpleTypename (Left (Just Interval
_)) ->
    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"INTERVAL with qualifiers is not supported."
  PGT_AST.ConstIntervalSimpleTypename (Left Maybe Interval
Nothing) ->
    Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.interval
  PGT_AST.ConstIntervalSimpleTypename (Right Iconst
_) ->
    String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"INTERVAL with integer literal is not supported in this context."


renderPGTNumeric :: PGT_AST.Numeric -> Q Exp
renderPGTNumeric :: Numeric -> Q Exp
renderPGTNumeric = \case
  Numeric
PGT_AST.IntNumeric -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.int
  Numeric
PGT_AST.IntegerNumeric -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.integer
  Numeric
PGT_AST.SmallintNumeric -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.smallint
  Numeric
PGT_AST.BigintNumeric -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.bigint
  Numeric
PGT_AST.RealNumeric -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.real
  PGT_AST.FloatNumeric (Just Iconst
_) -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"FLOAT with precision is not supported."
  PGT_AST.FloatNumeric Maybe Iconst
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.float4
  Numeric
PGT_AST.DoublePrecisionNumeric -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.doublePrecision
  PGT_AST.DecimalNumeric (Just TypeModifiers
_) -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"DECIMAL with precision/scale is not supported."
  PGT_AST.DecimalNumeric Maybe TypeModifiers
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.numeric
  PGT_AST.DecNumeric (Just TypeModifiers
_) -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"DEC with precision/scale is not supported."
  PGT_AST.DecNumeric Maybe TypeModifiers
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.numeric
  PGT_AST.NumericNumeric (Just TypeModifiers
_) -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"NUMERIC with precision/scale is not supported."
  PGT_AST.NumericNumeric Maybe TypeModifiers
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.numeric
  Numeric
PGT_AST.BooleanNumeric -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'S.bool


getIdentText :: PGT_AST.Ident -> Text.Text
getIdentText :: Ident -> Text
getIdentText = \case
  PGT_AST.QuotedIdent Text
t -> Text
t
  PGT_AST.UnquotedIdent Text
t -> Text
t