{-# 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.Monad (when, zipWithM)
import Data.Either (partitionEithers)
import Data.Foldable (Foldable(elem, foldl', foldr, length, null), any, foldlM, mapM_)
import Data.Function (on)
import Data.List (groupBy, partition, sortBy)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Ord (comparing)
import Data.String (IsString(fromString))
import Language.Haskell.TH.Syntax
  ( Exp(AppE, AppTypeE, ConE, InfixE, LabelE, ListE, LitE, TupE, VarE)
  , Lit(IntegerL, StringL), TyLit(NumTyLit), Type(LitT), Name, Q, mkName
  )
import Prelude
  ( Applicative(pure), Bool(False, True), Either(Left, Right), Eq((==))
  , Functor(fmap), Maybe(Just, Nothing), MonadFail(fail)
  , Num((*), (+), (-), fromInteger), Ord((<), (>=), compare), Semigroup((<>))
  , Show(show), Traversable(mapM), ($), (&&), (++), (.), (<$>), (||), Int
  , Integer, either, error, fromIntegral, id, maybe, otherwise, uncurry, 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


-- | Intermediate representation for a window function call in a SELECT list.
data WindowFuncInfo = WindowFuncInfo
  { WindowFuncInfo -> TargetEl
wfiTargetEl :: PGT_AST.TargetEl
  , WindowFuncInfo -> FuncApplication
wfiFuncApp :: PGT_AST.FuncApplication
  , WindowFuncInfo -> OverClause
wfiOverClause :: PGT_AST.OverClause
  }
  deriving stock (WindowFuncInfo -> WindowFuncInfo -> Bool
(WindowFuncInfo -> WindowFuncInfo -> Bool)
-> (WindowFuncInfo -> WindowFuncInfo -> Bool) -> Eq WindowFuncInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowFuncInfo -> WindowFuncInfo -> Bool
== :: WindowFuncInfo -> WindowFuncInfo -> Bool
$c/= :: WindowFuncInfo -> WindowFuncInfo -> Bool
/= :: WindowFuncInfo -> WindowFuncInfo -> Bool
Eq, Int -> WindowFuncInfo -> ShowS
[WindowFuncInfo] -> ShowS
WindowFuncInfo -> String
(Int -> WindowFuncInfo -> ShowS)
-> (WindowFuncInfo -> String)
-> ([WindowFuncInfo] -> ShowS)
-> Show WindowFuncInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowFuncInfo -> ShowS
showsPrec :: Int -> WindowFuncInfo -> ShowS
$cshow :: WindowFuncInfo -> String
show :: WindowFuncInfo -> String
$cshowList :: [WindowFuncInfo] -> ShowS
showList :: [WindowFuncInfo] -> ShowS
Show)


-- | A wrapper for `PGT_AST.OverClause` to provide an `Ord` instance for sorting and grouping.
newtype OrdOverClause = OrdOverClause PGT_AST.OverClause
  deriving stock (OrdOverClause -> OrdOverClause -> Bool
(OrdOverClause -> OrdOverClause -> Bool)
-> (OrdOverClause -> OrdOverClause -> Bool) -> Eq OrdOverClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrdOverClause -> OrdOverClause -> Bool
== :: OrdOverClause -> OrdOverClause -> Bool
$c/= :: OrdOverClause -> OrdOverClause -> Bool
/= :: OrdOverClause -> OrdOverClause -> Bool
Eq, Int -> OrdOverClause -> ShowS
[OrdOverClause] -> ShowS
OrdOverClause -> String
(Int -> OrdOverClause -> ShowS)
-> (OrdOverClause -> String)
-> ([OrdOverClause] -> ShowS)
-> Show OrdOverClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrdOverClause -> ShowS
showsPrec :: Int -> OrdOverClause -> ShowS
$cshow :: OrdOverClause -> String
show :: OrdOverClause -> String
$cshowList :: [OrdOverClause] -> ShowS
showList :: [OrdOverClause] -> ShowS
Show)


-- Manual Ord instance based on the rendered string representation for simplicity.
instance Ord OrdOverClause where
  compare :: OrdOverClause -> OrdOverClause -> Ordering
compare (OrdOverClause OverClause
c1) (OrdOverClause OverClause
c2) =
    String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OverClause -> String
forall a. Show a => a -> String
show OverClause
c1) (OverClause -> String
forall a. Show a => a -> String
show OverClause
c2)


-- | `WindowFuncInfo` using `OrdOverClause`.
data WindowFuncInfo_ = WindowFuncInfo_
  { WindowFuncInfo_ -> TargetEl
wfiTargetEl_ :: PGT_AST.TargetEl
  , WindowFuncInfo_ -> OrdOverClause
wfiOverClause_ :: OrdOverClause
  }


-- | Classifies a `PGT_AST.TargetEl` as either a normal expression or a window function call.
isWindowTarget :: PGT_AST.TargetEl -> Either PGT_AST.TargetEl WindowFuncInfo_
isWindowTarget :: TargetEl -> Either TargetEl WindowFuncInfo_
isWindowTarget TargetEl
el = case TargetEl
el of
    PGT_AST.AliasedExprTargetEl AExpr
expr Ident
_ -> AExpr -> Either TargetEl WindowFuncInfo_
go AExpr
expr
    PGT_AST.ImplicitlyAliasedExprTargetEl AExpr
expr Ident
_ -> AExpr -> Either TargetEl WindowFuncInfo_
go AExpr
expr
    PGT_AST.ExprTargetEl AExpr
expr -> AExpr -> Either TargetEl WindowFuncInfo_
go AExpr
expr
    TargetEl
_ -> TargetEl -> Either TargetEl WindowFuncInfo_
forall a b. a -> Either a b
Left TargetEl
el
  where
    go :: AExpr -> Either TargetEl WindowFuncInfo_
go
      ( PGT_AST.CExprAExpr
          (PGT_AST.FuncCExpr (PGT_AST.ApplicationFuncExpr FuncApplication
_app Maybe WithinGroupClause
_ Maybe AExpr
_ (Just OverClause
over)))
        ) =
        WindowFuncInfo_ -> Either TargetEl WindowFuncInfo_
forall a b. b -> Either a b
Right (WindowFuncInfo_ -> Either TargetEl WindowFuncInfo_)
-> WindowFuncInfo_ -> Either TargetEl WindowFuncInfo_
forall a b. (a -> b) -> a -> b
$ TargetEl -> OrdOverClause -> WindowFuncInfo_
WindowFuncInfo_ TargetEl
el (OverClause -> OrdOverClause
OrdOverClause OverClause
over)
    go AExpr
_ = TargetEl -> Either TargetEl WindowFuncInfo_
forall a b. a -> Either a b
Left TargetEl
el


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


toSquealSelectClause
  :: [Text.Text]
  -> Maybe (NE.NonEmpty PGT_AST.Ident)
  -> PGT_AST.SelectClause
  -> Q Exp
toSquealSelectClause :: [Text] -> Maybe (NonEmpty Ident) -> SelectClause -> Q Exp
toSquealSelectClause [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases = \case
  Left SimpleSelect
simpleSelect ->
    [Text]
-> Maybe (NonEmpty Ident)
-> SimpleSelect
-> Maybe WithinGroupClause
-> Maybe SelectLimit
-> Maybe ForLockingClause
-> Q Exp
toSquealSimpleSelect
      [Text]
cteNames
      Maybe (NonEmpty Ident)
maybeColAliases
      SimpleSelect
simpleSelect
      Maybe WithinGroupClause
forall a. Maybe a
Nothing
      Maybe SelectLimit
forall a. Maybe a
Nothing
      Maybe ForLockingClause
forall a. Maybe a
Nothing
  Right SelectWithParens
selectWithParens -> [Text] -> Maybe (NonEmpty Ident) -> SelectWithParens -> Q Exp
toSquealSelectWithParens [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases SelectWithParens
selectWithParens


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 WithinGroupClause
maybeSortClause
      Maybe SelectLimit
maybeSelectLimit
      Maybe ForLockingClause
maybeForLockingClause
    ) = do
    (cteNames, withApp) <-
      case Maybe WithClause
maybeWithClause of
        Maybe WithClause
Nothing -> ([Text], Exp -> Exp) -> Q ([Text], Exp -> Exp)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
initialCteNames, Exp -> Exp
forall a. a -> a
id)
        Just WithClause
withClause -> [Text] -> WithClause -> Q ([Text], Exp -> Exp)
renderPGTWithClause [Text]
initialCteNames WithClause
withClause

    squealQueryBody <-
      case selectClause of
        Left SimpleSelect
simpleSelect ->
          [Text]
-> Maybe (NonEmpty Ident)
-> SimpleSelect
-> Maybe WithinGroupClause
-> Maybe SelectLimit
-> Maybe ForLockingClause
-> Q Exp
toSquealSimpleSelect
            [Text]
cteNames
            Maybe (NonEmpty Ident)
maybeColAliases
            SimpleSelect
simpleSelect
            Maybe WithinGroupClause
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'

    pure $ withApp squealQueryBody


renderPGTWithClause
  :: [Text.Text] -> PGT_AST.WithClause -> Q ([Text.Text], Exp -> Exp)
renderPGTWithClause :: [Text] -> WithClause -> Q ([Text], Exp -> Exp)
renderPGTWithClause [Text]
initialCteNames (PGT_AST.WithClause Bool
recursive NonEmpty CommonTableExpr
ctes) =
    if Bool
recursive
      then do
        case NonEmpty CommonTableExpr -> [CommonTableExpr]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty CommonTableExpr
ctes of
          [CommonTableExpr
cte] -> do
            (cteName, aliasedCteQueryExp) <- [Text] -> CommonTableExpr -> Q (Text, Exp)
renderRecursiveCte [Text]
initialCteNames CommonTableExpr
cte
            let
              withApp Exp
body = Name -> Exp
VarE 'S.withRecursive Exp -> Exp -> Exp
`AppE` Exp
aliasedCteQueryExp Exp -> Exp -> Exp
`AppE` Exp
body
            pure (initialCteNames <> [cteName], withApp)
          [CommonTableExpr]
_ -> String -> Q ([Text], Exp -> Exp)
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Squeal-QQ currently only supports WITH RECURSIVE with a single CTE."
      else do
        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
        let
          withApp Exp
body = Name -> Exp
VarE 'S.with Exp -> Exp -> Exp
`AppE` Exp
withExp Exp -> Exp -> Exp
`AppE` Exp
body
        pure (finalCteNames, withApp)
  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))

    renderRecursiveCte
      :: [Text.Text] -> PGT_AST.CommonTableExpr -> Q (Text.Text, Exp)
    renderRecursiveCte :: [Text] -> CommonTableExpr -> Q (Text, Exp)
renderRecursiveCte [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."
      let
        cteName :: Text
cteName = Ident -> Text
getIdentText Ident
ident
      -- For a recursive CTE, its own name must be in scope for the query inside it.
      let
        ctesInScope :: [Text]
ctesInScope = [Text]
existingCteNames [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
cteName]
      cteQueryExp <-
        case PreparableStmt
stmt of
          PGT_AST.SelectPreparableStmt SelectStmt
selectStmt -> [Text] -> Maybe (NonEmpty Ident) -> SelectStmt -> Q Exp
toSquealQuery [Text]
ctesInScope 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
        aliasedQuery = Name -> Exp
VarE 'S.as Exp -> Exp -> Exp
`AppE` Exp
cteQueryExp Exp -> Exp -> Exp
`AppE` String -> Exp
LabelE (Text -> String
Text.unpack Text
cteName)
      pure (cteName, aliasedQuery)


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 WithinGroupClause
-> Maybe SelectLimit
-> Maybe ForLockingClause
-> Q Exp
toSquealSimpleSelect [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases SimpleSelect
simpleSelect Maybe WithinGroupClause
maybeSortClause Maybe SelectLimit
maybeSelectLimit Maybe ForLockingClause
maybeForLockingClause =
  case SimpleSelect
simpleSelect of
    PGT_AST.BinSimpleSelect SelectBinOp
op SelectClause
left Maybe Bool
allOrDistinct SelectClause
right -> do
      Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        ( Maybe WithinGroupClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe WithinGroupClause
maybeSortClause
            Bool -> Bool -> Bool
|| Maybe SelectLimit -> Bool
forall a. Maybe a -> Bool
isJust Maybe SelectLimit
maybeSelectLimit
            Bool -> Bool -> Bool
|| Maybe ForLockingClause -> Bool
forall a. Maybe a -> Bool
isJust 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
"ORDER BY, LIMIT, OFFSET, and FOR clauses are not supported on the immediate operands of a set operation. You can use parentheses to specify precedence."

      leftQuery <- [Text] -> Maybe (NonEmpty Ident) -> SelectClause -> Q Exp
toSquealSelectClause [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases SelectClause
left
      rightQuery <- toSquealSelectClause cteNames maybeColAliases right

      let
        squealOp = case (SelectBinOp
op, Maybe Bool
allOrDistinct) of
          (SelectBinOp
PGT_AST.UnionSelectBinOp, Just Bool
False) -> Name -> Exp
VarE 'S.unionAll
          (SelectBinOp
PGT_AST.UnionSelectBinOp, Maybe Bool
_) -> Name -> Exp
VarE 'S.union
          (SelectBinOp
PGT_AST.IntersectSelectBinOp, Just Bool
False) -> Name -> Exp
VarE 'S.intersectAll
          (SelectBinOp
PGT_AST.IntersectSelectBinOp, Maybe Bool
_) -> Name -> Exp
VarE 'S.intersect
          (SelectBinOp
PGT_AST.ExceptSelectBinOp, Just Bool
False) -> Name -> Exp
VarE 'S.exceptAll
          (SelectBinOp
PGT_AST.ExceptSelectBinOp, Maybe Bool
_) -> Name -> Exp
VarE 'S.except

      pure $ squealOp `AppE` leftQuery `AppE` rightQuery
    PGT_AST.ValuesSimpleSelect ValuesClause
valuesClause -> do
      Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        ( Maybe WithinGroupClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe WithinGroupClause
maybeSortClause
            Bool -> Bool -> Bool
|| Maybe SelectLimit -> Bool
forall a. Maybe a -> Bool
isJust Maybe SelectLimit
maybeSelectLimit
            Bool -> Bool -> Bool
|| Maybe ForLockingClause -> Bool
forall a. Maybe a -> Bool
isJust 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 -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"in this translation yet."
      valuesExp <- [Text] -> Maybe (NonEmpty Ident) -> ValuesClause -> Q Exp
renderValuesClauseToNP [Text]
cteNames Maybe (NonEmpty Ident)
maybeColAliases ValuesClause
valuesClause
      pure valuesExp
    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 -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"other clauses like INTO, WHERE, GROUP BY, HAVING, "
                    String -> ShowS
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
"WINDOW clause is not yet supported."

                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 WithinGroupClause
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
tableExprWithHaving
                    Just WithinGroupClause
sortClause -> do
                      renderedSC <- [Text] -> WithinGroupClause -> Q Exp
renderPGTSortClause [Text]
cteNames WithinGroupClause
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 -> ShowS
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
    let
      firstRowList :: [AExpr]
firstRowList = TypeModifiers -> [AExpr]
forall a. NonEmpty a -> [a]
NE.toList TypeModifiers
firstRowExps
      restRowsLists :: [[AExpr]]
restRowsLists = (TypeModifiers -> [AExpr]) -> [TypeModifiers] -> [[AExpr]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeModifiers -> [AExpr]
forall a. NonEmpty a -> [a]
NE.toList [TypeModifiers]
restRowExps

    -- Determine column aliases based on provided aliases or synthesize.
    aliasTexts <-
      case (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 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]
firstRowList
            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 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 -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (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 ..]

    -- Validate all rows have consistent arity.
    let expectedLen = [AExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AExpr]
firstRowList
    let checkLen t a
xs = if t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedLen
          then () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          else String -> f ()
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Mismatched number of columns across VALUES rows."
    mapM_ checkLen restRowsLists

    -- Helper to convert a row to an NP using the established aliases.
    let convertRow :: [PGT_AST.AExpr] -> Q Exp
        convertRow [AExpr]
exprs = [(AExpr, Text)] -> Q Exp
go ([AExpr] -> [Text] -> [(AExpr, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [AExpr]
exprs [Text]
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

    firstRowNP <- convertRow firstRowList
    case restRowsLists of
      [] -> 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.values_ Exp -> Exp -> Exp
`AppE` Exp
firstRowNP
      [[AExpr]]
more -> do
        moreNPs <- ([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
convertRow [[AExpr]]
more
        pure $ VarE 'S.values `AppE` firstRowNP `AppE` ListE moreNPs


renderPGTForLockingClauseItems :: PGT_AST.ForLockingClause -> Q [Exp]
renderPGTForLockingClauseItems :: ForLockingClause -> Q [Exp]
renderPGTForLockingClauseItems = \case
  -- PostgreSQL's `FOR READ ONLY` does not acquire row-level locks and is
  -- effectively equivalent to the absence of a row-locking clause for
  -- SELECT. Squeal does not expose a row-level "read only" lock; instead,
  -- read-only behavior is an AccessMode on the transaction
  -- (TransactionMode { accessMode = ReadOnly }).
  --
  -- We therefore accept and ignore `FOR READ ONLY` here so that the quoted
  -- SQL compiles and renders identically to the same query without the
  -- clause. To enforce read-only semantics, execute the statement inside a
  -- transaction whose AccessMode is ReadOnly.
  ForLockingClause
PGT_AST.ReadOnlyForLockingClause ->
    [Exp] -> Q [Exp]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  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 -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"FOR UPDATE/SHARE OF clauses are not yet "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"supported. Please use simple table aliases "
                        String -> ShowS
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 -> ShowS
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 WithinGroupClause
Nothing
                              )
                          )
                      )
                    Maybe WithinGroupClause
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 -> ShowS
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 WithinGroupClause
Nothing
                          )
                      )
                  )
                Maybe WithinGroupClause
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 -> ShowS
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 -> ShowS
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 -> ShowS
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 -> ShowS
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] -> WithinGroupClause -> Q Exp
renderPGTSortClause [Text]
cteNames WithinGroupClause
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) (WithinGroupClause -> [SortBy]
forall a. NonEmpty a -> [a]
NE.toList WithinGroupClause
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
  -- Support subqueries (including VALUES ...) in FROM with optional column aliases
  PGT_AST.SelectTableRef Bool
isLateral SelectWithParens
selectWithParens Maybe AliasClause
maybeAliasClause -> do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isLateral (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
"LATERAL subqueries are not supported yet."
    -- Alias is required for subqueries in FROM in PostgreSQL; enforce here
    (aliasStr, maybeColAliases) <-
      case Maybe AliasClause
maybeAliasClause of
        Just (PGT_AST.AliasClause Bool
_ Ident
aliasIdent Maybe (NonEmpty Ident)
maybeCols) -> do
          let aliasTxt :: String
aliasTxt = Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
aliasIdent)
          (String, Maybe (NonEmpty Ident))
-> Q (String, Maybe (NonEmpty Ident))
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
aliasTxt, Maybe (NonEmpty Ident)
maybeCols)
        Maybe AliasClause
Nothing -> String -> Q (String, Maybe (NonEmpty Ident))
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Subquery in FROM requires an alias."
    -- Propagate any provided column aliases down into the subquery translation
    subqueryExp <- toSquealSelectWithParens cteNames maybeColAliases selectWithParens
    -- Treat the subquery as a derived table in the FROM clause
    -- Using S.subquery (as subquery alias)
    pure $ VarE 'S.subquery `AppE` (VarE 'S.as `AppE` subqueryExp `AppE` LabelE aliasStr)
  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 -> ShowS
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 -> ShowS
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 -> ShowS
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 -> Int -> Q Exp
renderPGTTargetEl :: [Text] -> TargetEl -> Int -> Q Exp
renderPGTTargetEl [Text]
cteNames TargetEl
targetEl 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
_ -> String -> (AExpr, Maybe Ident)
forall a. HasCallStack => String -> a
error String
"renderPGTTargetEl called with non-expression TargetEl"
  in
    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
mInternalAlias ->
              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
mInternalAlias 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 -> ShowS
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) = do
  let
    allItems :: [TargetEl]
allItems = TargetEl
item TargetEl -> [TargetEl] -> [TargetEl]
forall a. a -> [a] -> [a]
: [TargetEl]
items
    ([TargetEl]
normalTargets, [WindowFuncInfo_]
windowTargets) = [Either TargetEl WindowFuncInfo_]
-> ([TargetEl], [WindowFuncInfo_])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (TargetEl -> Either TargetEl WindowFuncInfo_
isWindowTarget (TargetEl -> Either TargetEl WindowFuncInfo_)
-> [TargetEl] -> [Either TargetEl WindowFuncInfo_]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TargetEl]
allItems)

  -- Group window functions by their OVER clause
  let
    sortedWindowTargets :: [WindowFuncInfo_]
sortedWindowTargets = (WindowFuncInfo_ -> WindowFuncInfo_ -> Ordering)
-> [WindowFuncInfo_] -> [WindowFuncInfo_]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((WindowFuncInfo_ -> OrdOverClause)
-> WindowFuncInfo_ -> WindowFuncInfo_ -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing WindowFuncInfo_ -> OrdOverClause
wfiOverClause_) [WindowFuncInfo_]
windowTargets
    groupedWindowTargets :: [[WindowFuncInfo_]]
groupedWindowTargets = (WindowFuncInfo_ -> WindowFuncInfo_ -> Bool)
-> [WindowFuncInfo_] -> [[WindowFuncInfo_]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (OrdOverClause -> OrdOverClause -> Bool
forall a. Eq a => a -> a -> Bool
(==) (OrdOverClause -> OrdOverClause -> Bool)
-> (WindowFuncInfo_ -> OrdOverClause)
-> WindowFuncInfo_
-> WindowFuncInfo_
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` WindowFuncInfo_ -> OrdOverClause
wfiOverClause_) [WindowFuncInfo_]
sortedWindowTargets

  -- Render normal targets
  renderedNormalSelections <-
    if [TargetEl] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TargetEl]
normalTargets
      then [Exp] -> Q [Exp]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      else (Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: []) (Exp -> [Exp]) -> Q Exp -> Q [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [TargetEl] -> Q Exp
renderNormalTargetList [Text]
cteNames [TargetEl]
normalTargets

  -- Render window target groups
  (_, renderedWindowSelections) <-
    foldlM
      ( \(Int
idx, [Exp]
acc) [WindowFuncInfo_]
grp -> do
          (newIdx, renderedGrp) <- [Text] -> Int -> [WindowFuncInfo_] -> Q (Int, Exp)
renderWindowGroup [Text]
cteNames Int
idx [WindowFuncInfo_]
grp
          pure (newIdx, acc ++ [renderedGrp])
      )
      (1, [])
      groupedWindowTargets

  -- Combine all selections
  let
    allSelections = [Exp]
renderedNormalSelections [Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++ [Exp]
renderedWindowSelections
  case allSelections of
    [] -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty selection list"
    [Exp
sel] -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
sel
    (Exp
sel : [Exp]
sels) -> 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
s -> Name -> Exp
ConE 'S.Also Exp -> Exp -> Exp
`AppE` Exp
s Exp -> Exp -> Exp
`AppE` Exp
acc) Exp
sel [Exp]
sels


renderNormalTargetList :: [Text.Text] -> [PGT_AST.TargetEl] -> Q Exp
renderNormalTargetList :: [Text] -> [TargetEl] -> Q Exp
renderNormalTargetList [Text]
cteNames [TargetEl]
targets = do
    let
      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

    let
      ([TargetEl]
stars, [TargetEl]
notStars) = (TargetEl -> Bool) -> [TargetEl] -> ([TargetEl], [TargetEl])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition TargetEl -> Bool
isAsterisk [TargetEl]
targets
      ([TargetEl]
dotStars, [TargetEl]
normalExprs) = (TargetEl -> Bool) -> [TargetEl] -> ([TargetEl], [TargetEl])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition TargetEl -> Bool
isDotStar [TargetEl]
notStars

    renderedStar <-
      case [TargetEl]
stars of
        [] -> Maybe Exp -> Q (Maybe Exp)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Exp
forall a. Maybe a
Nothing
        [TargetEl
_] -> Maybe Exp -> Q (Maybe Exp)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Exp -> Q (Maybe Exp)) -> Maybe Exp -> Q (Maybe Exp)
forall a b. (a -> b) -> a -> b
$ Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Name -> Exp
ConE 'S.Star)
        [TargetEl]
_ -> String -> Q (Maybe Exp)
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Multiple `*` in SELECT list is not supported."

    renderedDotStars <- mapM renderPGTTargetElDotStar dotStars

    renderedNormalsExp <-
      if null normalExprs
        then pure Nothing
        else do
          renderedEls <- zipWithM (renderPGTTargetEl cteNames) normalExprs [1 ..]
          let
            npList = (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
h Exp
t -> Name -> Exp
ConE '(S.:*) Exp -> Exp -> Exp
`AppE` Exp
h Exp -> Exp -> Exp
`AppE` Exp
t) (Name -> Exp
ConE 'S.Nil) [Exp]
renderedEls
          pure $ Just (ConE 'S.List `AppE` npList)

    let
      allParts =
        [Exp] -> (Exp -> [Exp]) -> Maybe Exp -> [Exp]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Exp -> [Exp]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Exp
renderedStar
          [Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++ [Exp]
renderedDotStars
          [Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++ [Exp] -> (Exp -> [Exp]) -> Maybe Exp -> [Exp]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Exp -> [Exp]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Exp
renderedNormalsExp

    case allParts of
      [] -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty normal selection list"
      [Exp
sel] -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
sel
      (Exp
sel : [Exp]
sels) -> 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
s -> Name -> Exp
ConE 'S.Also Exp -> Exp -> Exp
`AppE` Exp
s Exp -> Exp -> Exp
`AppE` Exp
acc) Exp
sel [Exp]
sels
  where
    renderPGTTargetElDotStar :: TargetEl -> f Exp
renderPGTTargetElDotStar
      ( PGT_AST.ExprTargetEl
          ( PGT_AST.CExprAExpr
              ( PGT_AST.ColumnrefCExpr
                  ( PGT_AST.Columnref
                      Ident
qualName
                      Maybe Indirection
_ -- indirectionOpt
                    )
                )
            )
        ) =
        Exp -> f Exp
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> f Exp) -> Exp -> f 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 -> f Exp
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"renderPGTTargetElDotStar called with unexpected TargetEl"


renderWindowGroup :: [Text.Text] -> Int -> [WindowFuncInfo_] -> Q (Int, Exp)
renderWindowGroup :: [Text] -> Int -> [WindowFuncInfo_] -> Q (Int, Exp)
renderWindowGroup [Text]
cteNames Int
startIdx = \case
  [] -> String -> Q (Int, Exp)
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"renderWindowGroup: received an empty group, this should not happen."
  group :: [WindowFuncInfo_]
group@(WindowFuncInfo_
head_info : [WindowFuncInfo_]
_) -> do
    let
      OrdOverClause OverClause
overClause = WindowFuncInfo_ -> OrdOverClause
wfiOverClause_ WindowFuncInfo_
head_info
    windowDefExp <-
      case OverClause
overClause of
        PGT_AST.ColIdOverClause Ident
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"WINDOW clause with named windows is not supported yet."
        PGT_AST.WindowOverClause WindowSpecification
spec -> [Text] -> WindowSpecification -> Q Exp
renderPGTWindowSpecification [Text]
cteNames WindowSpecification
spec

    (newIdx, windowFuncsNP) <-
      renderWindowFuncsNP cteNames startIdx (wfiTargetEl_ <$> group)

    pure $ (newIdx, ConE 'S.Over `AppE` windowFuncsNP `AppE` windowDefExp)


renderPGTWindowSpecification
  :: [Text.Text] -> PGT_AST.WindowSpecification -> Q Exp
renderPGTWindowSpecification :: [Text] -> WindowSpecification -> Q Exp
renderPGTWindowSpecification [Text]
cteNames (PGT_AST.WindowSpecification Maybe Ident
mExisting Maybe TypeModifiers
mPartition Maybe WithinGroupClause
mSort Maybe FrameClause
mFrame) = do
  Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Ident -> Bool
forall a. Maybe a -> Bool
isJust Maybe Ident
mExisting) (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
"Existing window names are not supported yet."
  Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FrameClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe FrameClause
mFrame) (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
"Frame clauses (ROWS/RANGE/GROUPS) are not supported yet."

  partitionByExp <-
    case Maybe TypeModifiers
mPartition 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.partitionBy Exp -> Exp -> Exp
`AppE` Name -> Exp
ConE 'S.Nil
      Just TypeModifiers
partitionExps -> do
        renderedExps <- (AExpr -> Q Exp) -> TypeModifiers -> Q (NonEmpty 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) -> NonEmpty a -> m (NonEmpty b)
mapM ([Text] -> AExpr -> Q Exp
renderPGTAExpr [Text]
cteNames) TypeModifiers
partitionExps
        let
          np = (Exp -> Exp -> Exp) -> Exp -> NonEmpty Exp -> Exp
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Exp
h Exp
t -> Name -> Exp
ConE '(S.:*) Exp -> Exp -> Exp
`AppE` Exp
h Exp -> Exp -> Exp
`AppE` Exp
t) (Name -> Exp
ConE 'S.Nil) NonEmpty Exp
renderedExps
        pure $ VarE 'S.partitionBy `AppE` np

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


renderWindowFuncsNP :: [Text.Text] -> Int -> [PGT_AST.TargetEl] -> Q (Int, Exp)
renderWindowFuncsNP :: [Text] -> Int -> [TargetEl] -> Q (Int, Exp)
renderWindowFuncsNP [Text]
cteNames Int
startIdx [TargetEl]
targets = do
  let
    indexedTargets :: [(TargetEl, Int)]
indexedTargets = [TargetEl] -> [Int] -> [(TargetEl, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TargetEl]
targets [Int
startIdx ..]
  renderedFuncs <-
    ((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 -> Int -> Q Exp) -> (TargetEl, Int) -> Q Exp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([Text] -> TargetEl -> Int -> Q Exp
renderWindowFuncAsAliasedNP [Text]
cteNames)) [(TargetEl, Int)]
indexedTargets
  let
    newIdx = Int
startIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [TargetEl] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TargetEl]
targets
  pure $
    ( newIdx
    , foldr (\Exp
h Exp
t -> Name -> Exp
ConE '(S.:*) Exp -> Exp -> Exp
`AppE` Exp
h Exp -> Exp -> Exp
`AppE` Exp
t) (ConE 'S.Nil) renderedFuncs
    )


renderWindowFuncAsAliasedNP :: [Text.Text] -> PGT_AST.TargetEl -> Int -> Q Exp
renderWindowFuncAsAliasedNP :: [Text] -> TargetEl -> Int -> Q Exp
renderWindowFuncAsAliasedNP [Text]
cteNames TargetEl
el Int
idx = do
  let
    (FuncApplication
funcApp, Maybe Ident
mAlias) = case TargetEl
el of
      PGT_AST.AliasedExprTargetEl
        (PGT_AST.CExprAExpr (PGT_AST.FuncCExpr (PGT_AST.ApplicationFuncExpr FuncApplication
app Maybe WithinGroupClause
_ Maybe AExpr
_ Maybe OverClause
_)))
        Ident
an -> (FuncApplication
app, Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
an)
      PGT_AST.ImplicitlyAliasedExprTargetEl
        (PGT_AST.CExprAExpr (PGT_AST.FuncCExpr (PGT_AST.ApplicationFuncExpr FuncApplication
app Maybe WithinGroupClause
_ Maybe AExpr
_ Maybe OverClause
_)))
        Ident
an -> (FuncApplication
app, Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
an)
      PGT_AST.ExprTargetEl
        (PGT_AST.CExprAExpr (PGT_AST.FuncCExpr (PGT_AST.ApplicationFuncExpr FuncApplication
app Maybe WithinGroupClause
_ Maybe AExpr
_ Maybe OverClause
_))) -> (FuncApplication
app, Maybe Ident
forall a. Maybe a
Nothing)
      TargetEl
_ -> String -> (FuncApplication, Maybe Ident)
forall a. HasCallStack => String -> a
error String
"renderWindowFuncAsAliasedNP: not a window function"

  let
    aliasStr :: String
aliasStr = case Maybe Ident
mAlias of
      Just Ident
ident -> Text -> String
Text.unpack (Ident -> Text
getIdentText Ident
ident)
      Maybe Ident
Nothing -> String
"_window" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
idx

  renderedFunc <- [Text] -> FuncApplication -> Q Exp
renderPGTFuncAppAsWindowFunc [Text]
cteNames FuncApplication
funcApp

  pure $ VarE 'S.as `AppE` renderedFunc `AppE` LabelE aliasStr


renderPGTFuncAppAsWindowFunc :: [Text.Text] -> PGT_AST.FuncApplication -> Q Exp
renderPGTFuncAppAsWindowFunc :: [Text] -> FuncApplication -> Q Exp
renderPGTFuncAppAsWindowFunc [Text]
cteNames (PGT_AST.FuncApplication FuncName
funcName Maybe FuncApplicationParams
maybeParams) = do
  (squealFn, isCount) <-
    case FuncName
funcName of
      PGT_AST.TypeFuncName Ident
fident -> do
        let
          fnNameStr :: Text
fnNameStr = Text -> Text
Text.toLower (Ident -> Text
getIdentText Ident
fident)
        case Text
fnNameStr of
          Text
"rank" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.rank, Bool
False)
          Text
"row_number" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.rowNumber, Bool
False)
          Text
"dense_rank" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.denseRank, Bool
False)
          Text
"percent_rank" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.percentRank, Bool
False)
          Text
"cume_dist" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.cumeDist, Bool
False)
          Text
"ntile" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.ntile, Bool
False)
          Text
"lag" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.lag, Bool
False)
          Text
"lead" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.lead, Bool
False)
          Text
"first_value" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.firstValue, Bool
False)
          Text
"last_value" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.lastValue, Bool
False)
          Text
"nth_value" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.nthValue, Bool
False)
          Text
"count" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.count, Bool
True)
          Text
"sum" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.sum_, Bool
False)
          Text
"avg" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.avg, Bool
False)
          Text
"min" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.min_, Bool
False)
          Text
"max" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.max_, Bool
False)
          Text
_ -> String -> Q (Exp, Bool)
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q (Exp, Bool)) -> String -> Q (Exp, Bool)
forall a b. (a -> b) -> a -> b
$ String
"Unsupported window function: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
fnNameStr
      FuncName
_ -> String -> Q (Exp, Bool)
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unsupported function name in window function"

  case maybeParams of
    Maybe FuncApplicationParams
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
squealFn
    Just FuncApplicationParams
PGT_AST.StarFuncApplicationParams
      | Bool
isCount -> 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
      | Bool
otherwise ->
          String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Star argument is only supported for COUNT in window functions."
    Just (PGT_AST.NormalFuncApplicationParams (Just Bool
True) NonEmpty FuncArgExpr
_ Maybe WithinGroupClause
_) ->
      String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"DISTINCT is not supported for window functions."
    Just (PGT_AST.NormalFuncApplicationParams Maybe Bool
_ NonEmpty FuncArgExpr
args Maybe WithinGroupClause
_) -> do
      argExps <- (FuncArgExpr -> Q Exp) -> [FuncArgExpr] -> 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] -> FuncArgExpr -> Q Exp
renderPGTFuncArgExpr [Text]
cteNames) (NonEmpty FuncArgExpr -> [FuncArgExpr]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FuncArgExpr
args)
      let
        npArgs = (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
h Exp
t -> Name -> Exp
ConE '(S.:*) Exp -> Exp -> Exp
`AppE` Exp
h Exp -> Exp -> Exp
`AppE` Exp
t) (Name -> Exp
ConE 'S.Nil) [Exp]
argExps
        windowArg = Name -> Exp
ConE 'S.Windows Exp -> Exp -> Exp
`AppE` Exp
npArgs
      pure $ squealFn `AppE` windowArg
    Maybe FuncApplicationParams
_ -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unsupported parameters for window function"


-- | 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 -> ShowS
[Associativity] -> ShowS
Associativity -> String
(Int -> Associativity -> ShowS)
-> (Associativity -> String)
-> ([Associativity] -> ShowS)
-> Show Associativity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Associativity -> ShowS
showsPrec :: Int -> Associativity -> ShowS
$cshow :: Associativity -> String
show :: Associativity -> String
$cshowList :: [Associativity] -> ShowS
showList :: [Associativity] -> ShowS
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 -> ShowS
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 -> ShowS
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 -> ShowS
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 -> ShowS
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 -> ShowS
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 WithinGroupClause
maybeWithinGroup Maybe AExpr
maybeFilter Maybe OverClause
maybeOver -> do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe WithinGroupClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe WithinGroupClause
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 only supported at the top level of a SELECT list item."
    [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)
        fnNameStrLower :: Text
fnNameStrLower = Text -> Text
Text.toLower (Ident -> Text
getIdentText Ident
fident)
      in
        case Text
fnNameStrLower of
          Text
"inline" ->
            case Maybe FuncApplicationParams
maybeParams of
              Just (PGT_AST.NormalFuncApplicationParams Maybe Bool
_ NonEmpty FuncArgExpr
args Maybe WithinGroupClause
_) ->
                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 WithinGroupClause
_) ->
                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
_ -> do
            (squealFn, isAggregate) <-
              case Text
fnNameStrLower of
                Text
"coalesce" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.coalesce, Bool
False)
                Text
"lower" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.lower, Bool
False)
                Text
"char_length" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.charLength, Bool
False)
                Text
"character_length" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.charLength, Bool
False)
                Text
"upper" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.upper, Bool
False)
                Text
"now" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.now, Bool
False)
                Text
"count" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.count, Bool
True)
                Text
"sum" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.sum_, Bool
True)
                Text
"avg" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.avg, Bool
True)
                Text
"min" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.min_, Bool
True)
                Text
"max" -> (Exp, Bool) -> Q (Exp, Bool)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE 'S.max_, Bool
True)
                Text
_ -> String -> Q (Exp, Bool)
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q (Exp, Bool)) -> String -> Q (Exp, Bool)
forall a b. (a -> b) -> a -> b
$ String
"Unsupported function: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fnNameStr

            case maybeParams of
              Maybe FuncApplicationParams
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
squealFn
              Just FuncApplicationParams
params -> case FuncApplicationParams
params of
                PGT_AST.NormalFuncApplicationParams Maybe Bool
maybeAllOrDistinct NonEmpty FuncArgExpr
args Maybe WithinGroupClause
maybeSortClause -> do
                  Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe WithinGroupClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe WithinGroupClause
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."
                  argExps <- (FuncArgExpr -> Q Exp) -> [FuncArgExpr] -> 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] -> FuncArgExpr -> Q Exp
renderPGTFuncArgExpr [Text]
cteNames) (NonEmpty FuncArgExpr -> [FuncArgExpr]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FuncArgExpr
args)
                  if isAggregate
                    then do
                      let
                        aggArgConstructor = case Maybe Bool
maybeAllOrDistinct of
                          Just Bool
True -> Name -> Exp
ConE 'S.Distincts
                          Maybe Bool
_ -> Name -> Exp
ConE 'S.Alls
                        npArgs = (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
h Exp
t -> Name -> Exp
ConE '(S.:*) Exp -> Exp -> Exp
`AppE` Exp
h Exp -> Exp -> Exp
`AppE` Exp
t) (Name -> Exp
ConE 'S.Nil) [Exp]
argExps
                      pure $ squealFn `AppE` (aggArgConstructor `AppE` npArgs)
                    else do
                      when (isJust maybeAllOrDistinct) $
                        fail "DISTINCT is not supported for non-aggregate functions."
                      pure $ foldl' AppE squealFn argExps
                FuncApplicationParams
PGT_AST.StarFuncApplicationParams ->
                  if Text
fnNameStrLower Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"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 -> ShowS
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 -> ShowS
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 -> ShowS
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 -> ShowS
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 -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
nameLower String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
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 -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
nameLower
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" requires a length argument (e.g., "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
nameLower
                String -> ShowS
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 -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
nameLower String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
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 -> ShowS
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