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