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

-- | Description: Translate query expressions.
module Squeal.QuasiQuotes.Query (
  toSquealQuery,
) where

import Control.Monad (unless, when)
import Data.Foldable (Foldable(foldl', foldr, null))
import Data.Maybe (fromMaybe, isJust, isNothing)
import Language.Haskell.TH.Syntax
  ( Exp(AppE, ConE, InfixE, LabelE, ListE, LitE, VarE), Lit(IntegerL), Q, mkName
  )
import Prelude
  ( Applicative(pure), Bool(False, True), Either(Left, Right)
  , Maybe(Just, Nothing), MonadFail(fail), Num((+)), Ord((>=)), Semigroup((<>))
  , Show(show), Traversable(mapM), ($), (&&), (<$>), Int, fromIntegral, zip
  )
import Squeal.QuasiQuotes.Common
  ( getIdentText, renderPGTAExpr, renderPGTTableRef, renderPGTTargeting
  )
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as Text
import qualified PostgresqlSyntax.Ast as PGT_AST
import qualified Squeal.PostgreSQL as S


toSquealQuery :: PGT_AST.SelectStmt -> Q Exp
toSquealQuery :: SelectStmt -> Q Exp
toSquealQuery SelectStmt
selectStmt = case SelectStmt
selectStmt of
  Left SelectNoParens
selectNoParens -> SelectNoParens -> Q Exp
toSquealSelectNoParens SelectNoParens
selectNoParens
  Right SelectWithParens
selectWithParens -> SelectWithParens -> Q Exp
toSquealSelectWithParens SelectWithParens
selectWithParens


toSquealSelectWithParens :: PGT_AST.SelectWithParens -> Q Exp
toSquealSelectWithParens :: SelectWithParens -> Q Exp
toSquealSelectWithParens = \case
  PGT_AST.NoParensSelectWithParens SelectNoParens
snp -> SelectNoParens -> Q Exp
toSquealSelectNoParens SelectNoParens
snp
  PGT_AST.WithParensSelectWithParens SelectWithParens
swp ->
    {- The AST structure itself should handle precedence.  Just recurse.  -}
    SelectWithParens -> Q Exp
toSquealSelectWithParens SelectWithParens
swp


toSquealSelectNoParens :: PGT_AST.SelectNoParens -> Q Exp
toSquealSelectNoParens :: SelectNoParens -> Q Exp
toSquealSelectNoParens
  ( PGT_AST.SelectNoParens
      Maybe WithClause
maybeWithClause
      SelectClause
selectClause
      Maybe SortClause
maybeSortClause
      Maybe SelectLimit
maybeSelectLimit
      Maybe ForLockingClause
maybeForLockingClause
    ) = do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe WithClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe WithClause
maybeWithClause) (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
"WITH clauses are not supported yet."
    case SelectClause
selectClause of
      Left SimpleSelect
simpleSelect ->
        SimpleSelect
-> Maybe SortClause
-> Maybe SelectLimit
-> Maybe ForLockingClause
-> Q Exp
toSquealSimpleSelect
          SimpleSelect
simpleSelect
          Maybe SortClause
maybeSortClause
          Maybe SelectLimit
maybeSelectLimit
          Maybe ForLockingClause
maybeForLockingClause
      Right SelectWithParens
selectWithParens' -> SelectWithParens -> Q Exp
toSquealSelectWithParens SelectWithParens
selectWithParens'


toSquealSimpleSelect
  :: PGT_AST.SimpleSelect
  -> Maybe PGT_AST.SortClause
  -> Maybe PGT_AST.SelectLimit
  -> Maybe PGT_AST.ForLockingClause
  -> Q Exp
toSquealSimpleSelect :: SimpleSelect
-> Maybe SortClause
-> Maybe SelectLimit
-> Maybe ForLockingClause
-> Q Exp
toSquealSimpleSelect 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 <- ValuesClause -> Q Exp
renderValuesClauseToNP 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 <-
                      Targeting -> Q Exp
renderPGTTargetingForValues 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 <- FromClause -> Q Exp
renderPGTTableRef 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 <- AExpr -> Q Exp
renderPGTAExpr AExpr
wc
                      pure $
                        InfixE
                          (Just baseTableExpr)
                          (VarE '(S.&))
                          (Just (AppE (VarE 'S.where_) renderedWC))

                tableExprWithGroupBy <-
                  applyPGTGroupBy 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 <- AExpr -> Q Exp
renderPGTAExpr 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 <- SortClause -> Q Exp
renderPGTSortClause SortClause
sortClause
                      pure $
                        InfixE
                          (Just tableExprWithHaving)
                          (VarE '(S.&))
                          (Just (AppE (VarE 'S.orderBy) renderedSC))

                (tableExprWithOffset, mTableExprWithLimit) <-
                  processSelectLimit 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 targeting

                squealSelectFn <-
                  case maybeDistinctOnExprs of
                    Maybe [AExpr]
Nothing ->
                      case Targeting
targeting of
                        PGT_AST.DistinctTargeting Maybe ExprList
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 <-
                        [AExpr] -> Q Exp
renderPGTOnExpressionsClause [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 :: PGT_AST.ValuesClause -> Q Exp
renderValuesClauseToNP :: ValuesClause -> Q Exp
renderValuesClauseToNP (ExprList
firstRowExps NE.:| [ExprList]
restRowExps) = do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ExprList] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExprList]
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_."
    ExprList -> Q Exp
convertRowToNP ExprList
firstRowExps
  where
    convertRowToNP :: NE.NonEmpty PGT_AST.AExpr -> Q Exp
    convertRowToNP :: ExprList -> Q Exp
convertRowToNP ExprList
exprs =
        [AExpr] -> Int -> Q Exp
go (ExprList -> [AExpr]
forall a. NonEmpty a -> [a]
NE.toList ExprList
exprs) Int
1
      where
        go :: [PGT_AST.AExpr] -> Int -> Q Exp
        go :: [AExpr] -> Int -> Q Exp
go [] 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
ConE 'S.Nil
        go (AExpr
expr : [AExpr]
fs) Int
idx = do
          renderedExpr <- AExpr -> Q Exp
renderPGTAExpr AExpr
expr
          let
            aliasText = String
"_column" 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
            aliasedExp = Name -> Exp
VarE 'S.as Exp -> Exp -> Exp
`AppE` Exp
renderedExpr Exp -> Exp -> Exp
`AppE` String -> Exp
LabelE String
aliasText
          restExp <- go fs (idx + 1) -- restExp is Exp here
          -- Correct construction: aliasedExp :* restExp
          pure $ ConE '(S.:*) `AppE` aliasedExp `AppE` restExp


renderPGTForLockingClauseItems :: PGT_AST.ForLockingClause -> Q [Exp]
renderPGTForLockingClauseItems :: 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 :: Exp -> Maybe PGT_AST.GroupClause -> Q Exp
applyPGTGroupBy :: Exp -> Maybe GroupClause -> Q Exp
applyPGTGroupBy 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 <- GroupClause -> Q Exp
renderPGTGroupByClauseElements GroupClause
groupClause
      pure $
        InfixE
          (Just currentTableExpr)
          (VarE '(S.&))
          (Just (AppE (VarE 'S.groupBy) renderedGB))
  where
    renderPGTGroupByClauseElements :: PGT_AST.GroupClause -> Q Exp
    renderPGTGroupByClauseElements :: GroupClause -> Q Exp
renderPGTGroupByClauseElements = \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 GroupByItem -> Q Exp
renderPGTGroupByItem (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 :: PGT_AST.GroupByItem -> Q Exp
renderPGTGroupByItem :: GroupByItem -> Q Exp
renderPGTGroupByItem = \case
  PGT_AST.ExprGroupByItem AExpr
scalarExpr -> AExpr -> Q Exp
renderPGTAExpr 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 :: Exp -> Maybe PGT_AST.SelectLimit -> Q (Exp, Maybe Exp)
processSelectLimit :: Exp -> Maybe SelectLimit -> Q (Exp, Maybe Exp)
processSelectLimit 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 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 <- OffsetClause -> Q Exp
renderPGTOffsetClause 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 <- LimitClause -> Q Exp
renderPGTLimitClause LimitClause
limitVal
      pure
        ( tableExprWithOffset
        , Just
            ( InfixE
                (Just tableExprWithOffset)
                (VarE '(S.&))
                (Just (AppE (VarE 'S.limit) limitExp))
            )
        )


renderPGTLimitClause :: PGT_AST.LimitClause -> Q Exp
renderPGTLimitClause :: LimitClause -> Q Exp
renderPGTLimitClause = \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."
      SelectLimitValue
expr -> 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 LIMIT expression: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SelectLimitValue -> String
forall a. Show a => a -> String
show SelectLimitValue
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 :: PGT_AST.OffsetClause -> Q Exp
renderPGTOffsetClause :: OffsetClause -> Q Exp
renderPGTOffsetClause = \case
  PGT_AST.ExprOffsetClause
    ( PGT_AST.CExprAExpr
        ( PGT_AST.FuncCExpr
            ( PGT_AST.ApplicationFuncExpr
                ( PGT_AST.FuncApplication
                    (PGT_AST.TypeFuncName (PGT_AST.UnquotedIdent 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 ->
    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 OFFSET expression: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> AExpr -> String
forall a. Show a => a -> String
show 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 :: PGT_AST.TargetEl -> Int -> Q Exp
renderPGTTargetElForValues :: TargetEl -> Int -> Q Exp
renderPGTTargetElForValues 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 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 :: PGT_AST.TargetList -> Q Exp
renderPGTTargetListForValues :: TargetList -> Q Exp
renderPGTTargetListForValues (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) -> TargetEl -> Int -> Q Exp
renderPGTTargetElForValues 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 :: PGT_AST.Targeting -> Q Exp
renderPGTTargetingForValues :: Targeting -> Q Exp
renderPGTTargetingForValues = \case
  PGT_AST.NormalTargeting TargetList
targetList -> TargetList -> Q Exp
renderPGTTargetListForValues TargetList
targetList
  PGT_AST.AllTargeting (Just TargetList
targetList) ->
    TargetList -> Q Exp
renderPGTTargetListForValues 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 :: [PGT_AST.AExpr] -> Q Exp
renderPGTOnExpressionsClause :: [AExpr] -> Q Exp
renderPGTOnExpressionsClause [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 <- AExpr -> Q Exp
renderPGTAExpr 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 :: PGT_AST.SortClause -> Q Exp
renderPGTSortClause :: SortClause -> Q Exp
renderPGTSortClause 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 SortBy -> Q Exp
renderPGTSortBy (SortClause -> [SortBy]
forall a. NonEmpty a -> [a]
NE.toList SortClause
sortBys)


renderPGTSortBy :: PGT_AST.SortBy -> Q Exp
renderPGTSortBy :: SortBy -> Q Exp
renderPGTSortBy = \case
  PGT_AST.AscDescSortBy AExpr
aExpr Maybe AscDesc
maybeAscDesc Maybe NullsOrder
maybeNullsOrder -> do
    squealExpr <- AExpr -> Q Exp
renderPGTAExpr 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"