module Hasql.TH.Syntax.Rendering where
import Hasql.TH.Prelude hiding (aExpr, try, option, many, sortBy, bit, fromList)
import Hasql.TH.Syntax.Ast
import Data.ByteString.FastBuilder
import qualified Hasql.TH.Extras.NonEmpty as NonEmpty
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.ByteString.Builder as BsBuilder
import qualified Data.ByteString.Lazy as LazyBs
toByteString :: Builder -> ByteString
toByteString = toStrictByteString
toText :: Builder -> Text
toText = Text.decodeUtf8 . toByteString
text :: Text -> Builder
text = stringUtf8 . Text.unpack
commaNonEmpty :: (a -> Builder) -> NonEmpty a -> Builder
commaNonEmpty = NonEmpty.intersperseFoldMap ", "
spaceNonEmpty :: (a -> Builder) -> NonEmpty a -> Builder
spaceNonEmpty = NonEmpty.intersperseFoldMap " "
lexemes :: [Builder] -> Builder
lexemes = mconcat . intersperse " "
optLexemes :: [Maybe Builder] -> Builder
optLexemes = lexemes . catMaybes
inParens :: Builder -> Builder
inParens a = "(" <> a <> ")"
inBrackets :: Builder -> Builder
inBrackets a = "[" <> a <> "]"
prefixMaybe :: (a -> Builder) -> Maybe a -> Builder
prefixMaybe a = foldMap (flip mappend " " . a)
suffixMaybe :: (a -> Builder) -> Maybe a -> Builder
suffixMaybe a = foldMap (mappend " " . a)
preparableStmt = \ case
SelectPreparableStmt a -> selectStmt a
InsertPreparableStmt a -> insertStmt a
UpdatePreparableStmt a -> updateStmt a
DeletePreparableStmt a -> deleteStmt a
insertStmt (InsertStmt a b c d e) =
prefixMaybe withClause a <>
"INSERT INTO " <>
insertTarget b <> " " <> insertRest c <>
suffixMaybe onConflict d <>
suffixMaybe returningClause e
insertTarget (InsertTarget a b) =
qualifiedName a <> foldMap (mappend " AS " . colId) b
insertRest = \ case
SelectInsertRest a b c ->
optLexemes [
fmap (inParens . insertColumnList) a,
fmap insertRestOverriding b,
Just (selectStmt c)
]
DefaultValuesInsertRest -> "DEFAULT VALUES"
insertRestOverriding a = "OVERRIDING " <> overrideKind a <> " VALUE"
overrideKind = \ case
UserOverrideKind -> "USER"
SystemOverrideKind -> "SYSTEM"
insertColumnList = commaNonEmpty insertColumnItem
insertColumnItem (InsertColumnItem a b) = colId a <> suffixMaybe indirection b
onConflict (OnConflict a b) = "ON CONFLICT" <> suffixMaybe confExpr a <> " DO " <> onConflictDo b
onConflictDo = \ case
UpdateOnConflictDo a b -> "UPDATE SET " <> setClauseList a <> suffixMaybe whereClause b
NothingOnConflictDo -> "NOTHING"
confExpr = \ case
WhereConfExpr a b -> inParens (indexParams a) <> suffixMaybe whereClause b
ConstraintConfExpr a -> "ON CONSTRAINT " <> name a
returningClause = mappend "RETURNING " . targetList
updateStmt (UpdateStmt a b c d e f) =
prefixMaybe withClause a <>
"UPDATE " <> relationExprOptAlias b <> " " <>
"SET " <> setClauseList c <>
suffixMaybe fromClause d <>
suffixMaybe whereOrCurrentClause e <>
suffixMaybe returningClause f
setClauseList = commaNonEmpty setClause
setClause = \ case
TargetSetClause a b -> setTarget a <> " = " <> aExpr b
TargetListSetClause a b -> inParens (setTargetList a) <> " = " <> aExpr b
setTarget (SetTarget a b) = colId a <> suffixMaybe indirection b
setTargetList = commaNonEmpty setTarget
deleteStmt (DeleteStmt a b c d e) =
prefixMaybe withClause a <>
"DELETE FROM " <> relationExprOptAlias b <>
suffixMaybe usingClause c <>
suffixMaybe whereOrCurrentClause d <>
suffixMaybe returningClause e
usingClause = mappend "USING " . fromList
selectStmt = \ case
Left a -> selectNoParens a
Right a -> selectWithParens a
selectNoParens (SelectNoParens a b c d e) =
optLexemes
[
fmap withClause a,
Just (selectClause b),
fmap sortClause c,
fmap selectLimit d,
fmap forLockingClause e
]
selectWithParens = inParens . \ case
NoParensSelectWithParens a -> selectNoParens a
WithParensSelectWithParens a -> selectWithParens a
withClause (WithClause a b) =
"WITH " <> bool "" "RECURSIVE " a <> commaNonEmpty commonTableExpr b
commonTableExpr (CommonTableExpr a b c d) =
optLexemes
[
Just (ident a),
fmap (inParens . commaNonEmpty ident) b,
Just "AS",
fmap materialization c,
Just (inParens (preparableStmt d))
]
materialization = bool "NOT MATERIALIZED" "MATERIALIZED"
selectLimit = \ case
LimitOffsetSelectLimit a b -> lexemes [limitClause a, offsetClause b]
OffsetLimitSelectLimit a b -> lexemes [offsetClause a, limitClause b]
LimitSelectLimit a -> limitClause a
OffsetSelectLimit a -> offsetClause a
limitClause = \ case
LimitLimitClause a b -> "LIMIT " <> selectLimitValue a <> foldMap (mappend ", " . aExpr) b
FetchOnlyLimitClause a b c ->
optLexemes
[
Just "FETCH",
Just (firstOrNext a),
fmap selectFetchFirstValue b,
Just (rowOrRows c),
Just "ONLY"
]
firstOrNext = bool "FIRST" "NEXT"
rowOrRows = bool "ROW" "ROWS"
selectFetchFirstValue = \ case
ExprSelectFetchFirstValue a -> cExpr a
NumSelectFetchFirstValue a b -> bool "+" "-" a <> intOrFloat b
intOrFloat = either int64Dec doubleDec
selectLimitValue = \ case
ExprSelectLimitValue a -> aExpr a
AllSelectLimitValue -> "ALL"
offsetClause = \ case
ExprOffsetClause a -> "OFFSET " <> aExpr a
FetchFirstOffsetClause a b -> "OFFSET " <> selectFetchFirstValue a <> " " <> rowOrRows b
forLockingClause = \ case
ItemsForLockingClause a -> spaceNonEmpty forLockingItem a
ReadOnlyForLockingClause -> "FOR READ ONLY"
forLockingItem (ForLockingItem a b c) =
optLexemes
[
Just (forLockingStrength a),
fmap lockedRelsList b,
fmap nowaitOrSkip c
]
forLockingStrength = \ case
UpdateForLockingStrength -> "FOR UPDATE"
NoKeyUpdateForLockingStrength -> "FOR NO KEY UPDATE"
ShareForLockingStrength -> "FOR SHARE"
KeyForLockingStrength -> "FOR KEY SHARE"
lockedRelsList a = "OF " <> commaNonEmpty qualifiedName a
nowaitOrSkip = bool "NOWAIT" "SKIP LOCKED"
selectClause = either simpleSelect selectWithParens
simpleSelect = \ case
NormalSimpleSelect a b c d e f g ->
optLexemes
[
Just "SELECT",
fmap targeting a,
fmap intoClause b,
fmap fromClause c,
fmap whereClause d,
fmap groupClause e,
fmap havingClause f,
fmap windowClause g
]
ValuesSimpleSelect a -> valuesClause a
TableSimpleSelect a -> "TABLE " <> relationExpr a
BinSimpleSelect a b c d -> selectClause b <> " " <> selectBinOp a <> foldMap (mappend " ". allOrDistinct) c <> " " <> selectClause d
selectBinOp = \ case
UnionSelectBinOp -> "UNION"
IntersectSelectBinOp -> "INTERSECT"
ExceptSelectBinOp -> "EXCEPT"
targeting = \ case
NormalTargeting a -> targetList a
AllTargeting a -> "ALL" <> suffixMaybe targetList a
DistinctTargeting a b -> "DISTINCT" <> suffixMaybe onExpressionsClause a <> " " <> commaNonEmpty targetEl b
targetList = commaNonEmpty targetEl
onExpressionsClause a = "ON (" <> commaNonEmpty aExpr a <> ")"
targetEl = \ case
AliasedExprTargetEl a b -> aExpr a <> " AS " <> ident b
ImplicitlyAliasedExprTargetEl a b -> aExpr a <> " " <> ident b
ExprTargetEl a -> aExpr a
AsteriskTargetEl -> "*"
intoClause a = "INTO " <> optTempTableName a
optTempTableName = \ case
TemporaryOptTempTableName a b -> optLexemes [Just "TEMPORARY", bool Nothing (Just "TABLE") a, Just (qualifiedName b)]
TempOptTempTableName a b -> optLexemes [Just "TEMP", bool Nothing (Just "TABLE") a, Just (qualifiedName b)]
LocalTemporaryOptTempTableName a b -> optLexemes [Just "LOCAL TEMPORARY", bool Nothing (Just "TABLE") a, Just (qualifiedName b)]
LocalTempOptTempTableName a b -> optLexemes [Just "LOCAL TEMP", bool Nothing (Just "TABLE") a, Just (qualifiedName b)]
GlobalTemporaryOptTempTableName a b -> optLexemes [Just "GLOBAL TEMPORARY", bool Nothing (Just "TABLE") a, Just (qualifiedName b)]
GlobalTempOptTempTableName a b -> optLexemes [Just "GLOBAL TEMP", bool Nothing (Just "TABLE") a, Just (qualifiedName b)]
UnloggedOptTempTableName a b -> optLexemes [Just "UNLOGGED", bool Nothing (Just "TABLE") a, Just (qualifiedName b)]
TableOptTempTableName a -> "TABLE " <> qualifiedName a
QualifedOptTempTableName a -> qualifiedName a
fromClause a = "FROM " <> fromList a
fromList = commaNonEmpty tableRef
tableRef = \ case
RelationExprTableRef a b c ->
optLexemes [
Just (relationExpr a),
fmap aliasClause b,
fmap tablesampleClause c
]
FuncTableRef a b c ->
optLexemes [
if a then Just "LATERAL" else Nothing,
Just (funcTable b),
fmap funcAliasClause c
]
SelectTableRef a b c ->
optLexemes [
if a then Just "LATERAL" else Nothing,
Just (selectWithParens b),
fmap aliasClause c
]
JoinTableRef a b -> case b of
Just c -> inParens (joinedTable a) <> " " <> aliasClause c
Nothing -> joinedTable a
relationExpr = \ case
SimpleRelationExpr a b -> qualifiedName a <> bool "" " *" b
OnlyRelationExpr a b -> "ONLY " <> bool qualifiedName (inParens . qualifiedName) b a
relationExprOptAlias (RelationExprOptAlias a b) = relationExpr a <> suffixMaybe optAlias b
optAlias (a, b) = bool "" "AS " a <> colId b
tablesampleClause (TablesampleClause a b c) =
"TABLESAMPLE " <> funcName a <> " (" <> exprList b <> ")" <> suffixMaybe repeatableClause c
repeatableClause a = "REPEATABLE (" <> aExpr a <> ")"
funcTable = \ case
FuncExprFuncTable a b -> funcExprWindownless a <> bool "" " WITH ORDINALITY" b
RowsFromFuncTable a b -> "ROWS FROM (" <> rowsfromList a <> ")" <> bool "" " WITH ORDINALITY" b
rowsfromItem (RowsfromItem a b) = funcExprWindownless a <> suffixMaybe colDefList b
rowsfromList = commaNonEmpty rowsfromItem
colDefList a = "AS (" <> tableFuncElementList a <> ")"
tableFuncElementList = commaNonEmpty tableFuncElement
tableFuncElement (TableFuncElement a b c) = colId a <> " " <> typename b <> suffixMaybe collateClause c
collateClause a = "COLLATE " <> anyName a
aliasClause (AliasClause a b c) =
optLexemes
[
if a then Just "AS" else Nothing,
Just (ident b),
fmap (inParens . commaNonEmpty ident) c
]
funcAliasClause = \ case
AliasFuncAliasClause a -> aliasClause a
AsFuncAliasClause a -> "AS (" <> tableFuncElementList a <> ")"
AsColIdFuncAliasClause a b -> "AS " <> colId a <> " (" <> tableFuncElementList b <> ")"
ColIdFuncAliasClause a b -> colId a <> " (" <> tableFuncElementList b <> ")"
joinedTable = \ case
InParensJoinedTable a -> inParens (joinedTable a)
MethJoinedTable a b c -> case a of
CrossJoinMeth -> tableRef b <> " CROSS JOIN " <> tableRef c
QualJoinMeth d e -> tableRef b <> suffixMaybe joinType d <> " JOIN " <> tableRef c <> " " <> joinQual e
NaturalJoinMeth d -> tableRef b <> " NATURAL" <> suffixMaybe joinType d <> " JOIN " <> tableRef c
joinType = \ case
FullJoinType a -> "FULL" <> if a then " OUTER" else ""
LeftJoinType a -> "LEFT" <> if a then " OUTER" else ""
RightJoinType a -> "RIGHT" <> if a then " OUTER" else ""
InnerJoinType -> "INNER"
joinQual = \ case
UsingJoinQual a -> "USING (" <> commaNonEmpty ident a <> ")"
OnJoinQual a -> "ON " <> aExpr a
whereClause a = "WHERE " <> aExpr a
whereOrCurrentClause = \ case
ExprWhereOrCurrentClause a -> "WHERE " <> aExpr a
CursorWhereOrCurrentClause a -> "WHERE CURRENT OF " <> cursorName a
groupClause a = "GROUP BY " <> commaNonEmpty groupByItem a
groupByItem = \ case
ExprGroupByItem a -> aExpr a
EmptyGroupingSetGroupByItem -> "()"
RollupGroupByItem a -> "ROLLUP (" <> commaNonEmpty aExpr a <> ")"
CubeGroupByItem a -> "CUBE (" <> commaNonEmpty aExpr a <> ")"
GroupingSetsGroupByItem a -> "GROUPING SETS (" <> commaNonEmpty groupByItem a <> ")"
havingClause a = "HAVING " <> aExpr a
windowClause a = "WINDOW " <> commaNonEmpty windowDefinition a
windowDefinition (WindowDefinition a b) = ident a <> " AS " <> windowSpecification b
windowSpecification (WindowSpecification a b c d) =
inParens $ optLexemes
[
fmap ident a,
fmap partitionClause b,
fmap sortClause c,
fmap frameClause d
]
partitionClause a = "PARTITION BY " <> commaNonEmpty aExpr a
frameClause (FrameClause a b c) =
optLexemes
[
Just (frameClauseMode a),
Just (frameExtent b),
fmap windowExclusionCause c
]
frameClauseMode = \ case
RangeFrameClauseMode -> "RANGE"
RowsFrameClauseMode -> "ROWS"
GroupsFrameClauseMode -> "GROUPS"
frameExtent = \ case
SingularFrameExtent a -> frameBound a
BetweenFrameExtent a b -> "BETWEEN " <> frameBound a <> " AND " <> frameBound b
frameBound = \ case
UnboundedPrecedingFrameBound -> "UNBOUNDED PRECEDING"
UnboundedFollowingFrameBound -> "UNBOUNDED FOLLOWING"
CurrentRowFrameBound -> "CURRENT ROW"
PrecedingFrameBound a -> aExpr a <> " PRECEDING"
FollowingFrameBound a -> aExpr a <> " FOLLOWING"
windowExclusionCause = \ case
CurrentRowWindowExclusionClause -> "EXCLUDE CURRENT ROW"
GroupWindowExclusionClause -> "EXCLUDE GROUP"
TiesWindowExclusionClause -> "EXCLUDE TIES"
NoOthersWindowExclusionClause -> "EXCLUDE NO OTHERS"
sortClause a = "ORDER BY " <> commaNonEmpty sortBy a
sortBy = \ case
UsingSortBy a b c -> aExpr a <> " USING " <> qualAllOp b <> suffixMaybe nullsOrder c
AscDescSortBy a b c -> aExpr a <> suffixMaybe ascDesc b <> suffixMaybe nullsOrder c
valuesClause a = "VALUES " <> commaNonEmpty (inParens . commaNonEmpty aExpr) a
exprList = commaNonEmpty aExpr
aExpr = \ case
CExprAExpr a -> cExpr a
TypecastAExpr a b -> aExpr a <> " :: " <> typecastTypename b
CollateAExpr a b -> aExpr a <> " COLLATE " <> anyName b
AtTimeZoneAExpr a b -> aExpr a <> " AT TIME ZONE " <> aExpr b
PlusAExpr a -> "+ " <> aExpr a
MinusAExpr a -> "- " <> aExpr a
SymbolicBinOpAExpr a b c -> aExpr a <> " " <> symbolicExprBinOp b <> " " <> aExpr c
PrefixQualOpAExpr a b -> qualOp a <> " " <> aExpr b
SuffixQualOpAExpr a b -> aExpr a <> " " <> qualOp b
AndAExpr a b -> aExpr a <> " AND " <> aExpr b
OrAExpr a b -> aExpr a <> " OR " <> aExpr b
NotAExpr a -> "NOT " <> aExpr a
VerbalExprBinOpAExpr a b c d e -> aExpr a <> " " <> verbalExprBinOp b c <> " " <> aExpr d <> foldMap (mappend " ESCAPE " . aExpr) e
ReversableOpAExpr a b c -> aExpr a <> " " <> aExprReversableOp b c
IsnullAExpr a -> aExpr a <> " ISNULL"
NotnullAExpr a -> aExpr a <> " NOTNULL"
OverlapsAExpr a b -> row a <> " OVERLAPS " <> row b
SubqueryAExpr a b c d -> aExpr a <> " " <> subqueryOp b <> " " <> subType c <> " " <> either selectWithParens (inParens . aExpr) d
UniqueAExpr a -> "UNIQUE " <> selectWithParens a
DefaultAExpr -> "DEFAULT"
bExpr = \ case
CExprBExpr a -> cExpr a
TypecastBExpr a b -> bExpr a <> " :: " <> typecastTypename b
PlusBExpr a -> "+ " <> bExpr a
MinusBExpr a -> "- " <> bExpr a
SymbolicBinOpBExpr a b c -> bExpr a <> " " <> symbolicExprBinOp b <> " " <> bExpr c
QualOpBExpr a b -> qualOp a <> " " <> bExpr b
IsOpBExpr a b c -> bExpr a <> " " <> bExprIsOp b c
cExpr = \ case
ColumnrefCExpr a -> columnref a
AexprConstCExpr a -> aexprConst a
ParamCExpr a b -> "$" <> intDec a <> foldMap indirection b
InParensCExpr a b -> inParens (aExpr a) <> foldMap indirection b
CaseCExpr a -> caseExpr a
FuncCExpr a -> funcExpr a
SelectWithParensCExpr a b -> selectWithParens a <> foldMap indirection b
ExistsCExpr a -> "EXISTS " <> selectWithParens a
ArrayCExpr a -> "ARRAY " <> either selectWithParens arrayExpr a
ExplicitRowCExpr a -> explicitRow a
ImplicitRowCExpr a -> implicitRow a
GroupingCExpr a -> "GROUPING " <> inParens (exprList a)
aExprReversableOp a = \ case
NullAExprReversableOp -> bool "IS " "IS NOT " a <> "NULL"
TrueAExprReversableOp -> bool "IS " "IS NOT " a <> "TRUE"
FalseAExprReversableOp -> bool "IS " "IS NOT " a <> "FALSE"
UnknownAExprReversableOp -> bool "IS " "IS NOT " a <> "UNKNOWN"
DistinctFromAExprReversableOp b -> bool "IS " "IS NOT " a <> "DISTINCT FROM " <> aExpr b
OfAExprReversableOp b -> bool "IS " "IS NOT " a <> "OF " <> inParens (typeList b)
BetweenAExprReversableOp b c d -> bool "" "NOT " a <> bool "BETWEEN " "BETWEEN ASYMMETRIC " b <> bExpr c <> " AND " <> aExpr d
BetweenSymmetricAExprReversableOp b c -> bool "" "NOT " a <> "BETWEEN SYMMETRIC " <> bExpr b <> " AND " <> aExpr c
InAExprReversableOp b -> bool "" "NOT " a <> "IN " <> inExpr b
DocumentAExprReversableOp -> bool "IS " "IS NOT " a <> "DOCUMENT"
verbalExprBinOp a = mappend (bool "" "NOT " a) . \ case
LikeVerbalExprBinOp -> "LIKE"
IlikeVerbalExprBinOp -> "ILIKE"
SimilarToVerbalExprBinOp -> "SIMILAR TO"
subqueryOp = \ case
AllSubqueryOp a -> allOp a
AnySubqueryOp a -> "OPERATOR " <> inParens (anyOperator a)
LikeSubqueryOp a -> bool "" "NOT " a <> "LIKE"
IlikeSubqueryOp a -> bool "" "NOT " a <> "ILIKE"
bExprIsOp a = mappend (bool "IS " "IS NOT " a) . \ case
DistinctFromBExprIsOp b -> "DISTINCT FROM " <> bExpr b
OfBExprIsOp a -> "OF " <> inParens (typeList a)
DocumentBExprIsOp -> "DOCUMENT"
symbolicExprBinOp = \ case
MathSymbolicExprBinOp a -> mathOp a
QualSymbolicExprBinOp a -> qualOp a
qualOp = \ case
OpQualOp a -> op a
OperatorQualOp a -> "OPERATOR (" <> anyOperator a <> ")"
qualAllOp = \ case
AllQualAllOp a -> allOp a
AnyQualAllOp a -> "OPERATOR (" <> anyOperator a <> ")"
op = text
anyOperator = \ case
AllOpAnyOperator a -> allOp a
QualifiedAnyOperator a b -> colId a <> "." <> anyOperator b
allOp = \ case
OpAllOp a -> op a
MathAllOp a -> mathOp a
mathOp = \ case
PlusMathOp -> char7 '+'
MinusMathOp -> char7 '-'
AsteriskMathOp -> char7 '*'
SlashMathOp -> char7 '/'
PercentMathOp -> char7 '%'
ArrowUpMathOp -> char7 '^'
ArrowLeftMathOp -> char7 '<'
ArrowRightMathOp -> char7 '>'
EqualsMathOp -> char7 '='
LessEqualsMathOp -> "<="
GreaterEqualsMathOp -> ">="
ArrowLeftArrowRightMathOp -> "<>"
ExclamationEqualsMathOp -> "!="
inExpr = \ case
SelectInExpr a -> selectWithParens a
ExprListInExpr a -> inParens (exprList a)
caseExpr (CaseExpr a b c) = optLexemes [
Just "CASE",
fmap aExpr a,
Just (spaceNonEmpty whenClause b),
fmap caseDefault c,
Just "END"
]
whenClause (WhenClause a b) = "WHEN " <> aExpr a <> " THEN " <> aExpr b
caseDefault a = "ELSE " <> aExpr a
arrayExpr = inBrackets . \ case
ExprListArrayExpr a -> exprList a
ArrayExprListArrayExpr a -> arrayExprList a
EmptyArrayExpr -> mempty
arrayExprList = commaNonEmpty arrayExpr
row = \ case
ExplicitRowRow a -> explicitRow a
ImplicitRowRow a -> implicitRow a
explicitRow a = "ROW " <> inParens (foldMap exprList a)
implicitRow (ImplicitRow a b) = inParens (exprList a <> ", " <> aExpr b)
funcApplication (FuncApplication a b) =
funcName a <> "(" <> foldMap funcApplicationParams b <> ")"
funcApplicationParams = \ case
NormalFuncApplicationParams a b c ->
optLexemes
[
fmap allOrDistinct a,
Just (commaNonEmpty funcArgExpr b),
fmap sortClause c
]
VariadicFuncApplicationParams a b c ->
optLexemes
[
fmap (flip mappend "," . commaNonEmpty funcArgExpr) a,
Just "VARIADIC",
Just (funcArgExpr b),
fmap sortClause c
]
StarFuncApplicationParams -> "*"
allOrDistinct = \ case
False -> "ALL"
True -> "DISTINCT"
funcArgExpr = \ case
ExprFuncArgExpr a -> aExpr a
ColonEqualsFuncArgExpr a b -> ident a <> " := " <> aExpr b
EqualsGreaterFuncArgExpr a b -> ident a <> " => " <> aExpr b
funcExpr = \ case
ApplicationFuncExpr a b c d -> optLexemes [
Just (funcApplication a),
fmap withinGroupClause b,
fmap filterClause c,
fmap overClause d
]
SubexprFuncExpr a -> funcExprCommonSubexpr a
funcExprWindownless = \ case
ApplicationFuncExprWindowless a -> funcApplication a
CommonSubexprFuncExprWindowless a -> funcExprCommonSubexpr a
withinGroupClause a = "WITHIN GROUP (" <> sortClause a <> ")"
filterClause a = "FILTER (WHERE " <> aExpr a <> ")"
overClause = \ case
WindowOverClause a -> "OVER " <> windowSpecification a
ColIdOverClause a -> "OVER " <> colId a
funcExprCommonSubexpr = \ case
CollationForFuncExprCommonSubexpr a -> "COLLATION FOR (" <> aExpr a <> ")"
CurrentDateFuncExprCommonSubexpr -> "CURRENT_DATE"
CurrentTimeFuncExprCommonSubexpr a -> "CURRENT_TIME" <> suffixMaybe (inParens . iconst) a
CurrentTimestampFuncExprCommonSubexpr a -> "CURRENT_TIMESTAMP" <> suffixMaybe (inParens . iconst) a
LocalTimeFuncExprCommonSubexpr a -> "LOCALTIME" <> suffixMaybe (inParens . iconst) a
LocalTimestampFuncExprCommonSubexpr a -> "LOCALTIMESTAMP" <> suffixMaybe (inParens . iconst) a
CurrentRoleFuncExprCommonSubexpr -> "CURRENT_ROLE"
CurrentUserFuncExprCommonSubexpr -> "CURRENT_USER"
SessionUserFuncExprCommonSubexpr -> "SESSION_USER"
UserFuncExprCommonSubexpr -> "USER"
CurrentCatalogFuncExprCommonSubexpr -> "CURRENT_CATALOG"
CurrentSchemaFuncExprCommonSubexpr -> "CURRENT_SCHEMA"
CastFuncExprCommonSubexpr a b -> "CAST (" <> aExpr a <> " AS " <> typename b <> ")"
ExtractFuncExprCommonSubexpr a -> "EXTRACT (" <> foldMap extractList a <> ")"
OverlayFuncExprCommonSubexpr a -> "OVERLAY (" <> overlayList a <> ")"
PositionFuncExprCommonSubexpr a -> "POSITION (" <> foldMap positionList a <> ")"
SubstringFuncExprCommonSubexpr a -> "SUBSTRING (" <> foldMap substrList a <> ")"
TreatFuncExprCommonSubexpr a b -> "TREAT (" <> aExpr a <> " AS " <> typename b <> ")"
TrimFuncExprCommonSubexpr a b -> "TRIM (" <> prefixMaybe trimModifier a <> trimList b <> ")"
NullIfFuncExprCommonSubexpr a b -> "NULLIF (" <> aExpr a <> ", " <> aExpr b <> ")"
CoalesceFuncExprCommonSubexpr a -> "COALESCE (" <> exprList a <> ")"
GreatestFuncExprCommonSubexpr a -> "GREATEST (" <> exprList a <> ")"
LeastFuncExprCommonSubexpr a -> "LEAST (" <> exprList a <> ")"
extractList (ExtractList a b) = extractArg a <> " FROM " <> aExpr b
extractArg = \ case
IdentExtractArg a -> ident a
YearExtractArg -> "YEAR"
MonthExtractArg -> "MONTH"
DayExtractArg -> "DAY"
HourExtractArg -> "HOUR"
MinuteExtractArg -> "MINUTE"
SecondExtractArg -> "SECOND"
SconstExtractArg a -> sconst a
overlayList (OverlayList a b c d) = aExpr a <> " " <> overlayPlacing b <> " " <> substrFrom c <> suffixMaybe substrFor d
overlayPlacing a = "PLACING " <> aExpr a
positionList (PositionList a b) = bExpr a <> " IN " <> bExpr b
substrList = \ case
ExprSubstrList a b -> aExpr a <> " " <> substrListFromFor b
ExprListSubstrList a -> exprList a
substrListFromFor = \ case
FromForSubstrListFromFor a b -> substrFrom a <> " " <> substrFor b
ForFromSubstrListFromFor a b -> substrFor a <> " " <> substrFrom b
FromSubstrListFromFor a -> substrFrom a
ForSubstrListFromFor a -> substrFor a
substrFrom a = "FROM " <> aExpr a
substrFor a = "FOR " <> aExpr a
trimModifier = \ case
BothTrimModifier -> "BOTH"
LeadingTrimModifier -> "LEADING"
TrailingTrimModifier -> "TRAILING"
trimList = \ case
ExprFromExprListTrimList a b -> aExpr a <> " FROM " <> exprList b
FromExprListTrimList a -> "FROM " <> exprList a
ExprListTrimList a -> exprList a
aexprConst = \ case
IAexprConst a -> iconst a
FAexprConst a -> fconst a
SAexprConst a -> sconst a
BAexprConst a -> "B'" <> text a <> "'"
XAexprConst a -> "X'" <> text a <> "'"
FuncAexprConst a b c -> funcName a <> foldMap (inParens . funcAexprConstArgList) b <> " " <> sconst c
ConstTypenameAexprConst a b -> constTypename a <> " " <> sconst b
StringIntervalAexprConst a b -> "INTERVAL " <> sconst a <> suffixMaybe interval b
IntIntervalAexprConst a b -> "INTERVAL " <> inParens (int64Dec a) <> " " <> sconst b
BoolAexprConst a -> if a then "TRUE" else "FALSE"
NullAexprConst -> "NULL"
iconst = int64Dec
fconst = doubleDec
sconst a = "'" <> text (Text.replace "'" "''" a) <> "'"
funcAexprConstArgList (FuncConstArgs a b) = commaNonEmpty funcArgExpr a <> suffixMaybe sortClause b
constTypename = \ case
NumericConstTypename a -> numeric a
ConstBitConstTypename a -> constBit a
ConstCharacterConstTypename a -> constCharacter a
ConstDatetimeConstTypename a -> constDatetime a
numeric = \ case
IntNumeric -> "INT"
IntegerNumeric -> "INTEGER"
SmallintNumeric -> "SMALLINT"
BigintNumeric -> "BIGINT"
RealNumeric -> "REAL"
FloatNumeric a -> "FLOAT" <> suffixMaybe (inParens . int64Dec) a
DoublePrecisionNumeric -> "DOUBLE PRECISION"
DecimalNumeric a -> "DECIMAL" <> suffixMaybe (inParens . commaNonEmpty aExpr) a
DecNumeric a -> "DEC" <> suffixMaybe (inParens . commaNonEmpty aExpr )a
NumericNumeric a -> "NUMERIC" <> suffixMaybe (inParens . commaNonEmpty aExpr) a
BooleanNumeric -> "BOOLEAN"
bit (Bit a b) = optLexemes [
Just "BIT",
bool Nothing (Just "VARYING") a,
fmap (inParens . commaNonEmpty aExpr) b
]
constBit = bit
constCharacter (ConstCharacter a b) = character a <> suffixMaybe (inParens . int64Dec) b
character = \ case
CharacterCharacter a -> "CHARACTER" <> bool "" " VARYING" a
CharCharacter a -> "CHAR" <> bool "" " VARYING" a
VarcharCharacter -> "VARCHAR"
NationalCharacterCharacter a -> "NATIONAL CHARACTER" <> bool "" " VARYING" a
NationalCharCharacter a -> "NATIONAL CHAR" <> bool "" " VARYING" a
NcharCharacter a -> "NCHAR" <> bool "" " VARYING" a
constDatetime = \ case
TimestampConstDatetime a b -> optLexemes [
Just "TIMESTAMP",
fmap (inParens . int64Dec) a,
fmap timezone b
]
TimeConstDatetime a b -> optLexemes [
Just "TIME",
fmap (inParens . int64Dec) a,
fmap timezone b
]
timezone = \ case
False -> "WITH TIME ZONE"
True -> "WITHOUT TIME ZONE"
interval = \ case
YearInterval -> "YEAR"
MonthInterval -> "MONTH"
DayInterval -> "DAY"
HourInterval -> "HOUR"
MinuteInterval -> "MINUTE"
SecondInterval a -> intervalSecond a
YearToMonthInterval -> "YEAR TO MONTH"
DayToHourInterval -> "DAY TO HOUR"
DayToMinuteInterval -> "DAY TO MINUTE"
DayToSecondInterval a -> "DAY TO " <> intervalSecond a
HourToMinuteInterval -> "HOUR TO MINUTE"
HourToSecondInterval a -> "HOUR TO " <> intervalSecond a
MinuteToSecondInterval a -> "MINUTE TO " <> intervalSecond a
intervalSecond = \ case
Nothing -> "SECOND"
Just a -> "SECOND " <> inParens (int64Dec a)
columnref (Columnref a b) = colId a <> foldMap indirection b
ident = \ case
QuotedIdent a -> char7 '"' <> text (Text.replace "\"" "\"\"" a) <> char7 '"'
UnquotedIdent a -> text a
qualifiedName = \ case
SimpleQualifiedName a -> ident a
IndirectedQualifiedName a b -> ident a <> indirection b
indirection = foldMap indirectionEl
indirectionEl = \ case
AttrNameIndirectionEl a -> "." <> ident a
AllIndirectionEl -> ".*"
ExprIndirectionEl a -> "[" <> aExpr a <> "]"
SliceIndirectionEl a b -> "[" <> foldMap aExpr a <> ":" <> foldMap aExpr b <> "]"
colId = ident
name = colId
cursorName = name
colLabel = ident
attrName = colLabel
typeFunctionName = ident
funcName = \ case
TypeFuncName a -> typeFunctionName a
IndirectedFuncName a b -> colId a <> indirection b
anyName (AnyName a b) = colId a <> foldMap attrs b
typecastTypename (TypecastTypename a _ b _) =
ident a <>
fold (replicate b "[]")
typename = \ case
ArrayBoundsTypename a b c ->
bool "" "SETOF " a <> simpleTypename b <> suffixMaybe arrayBounds c
ArrayDimTypename a b c ->
bool "" "SETOF " a <> simpleTypename b <> " ARRAY" <> foldMap (inBrackets . iconst) c
arrayBounds = spaceNonEmpty (inBrackets . foldMap iconst)
simpleTypename = \ case
GenericTypeSimpleTypename a -> genericType a
NumericSimpleTypename a -> numeric a
BitSimpleTypename a -> bit a
CharacterSimpleTypename a -> character a
ConstDatetimeSimpleTypename a -> constDatetime a
ConstIntervalSimpleTypename a -> "INTERVAL" <> either (suffixMaybe interval) (mappend " " . inParens . iconst) a
genericType (GenericType a b c) = typeFunctionName a <> foldMap attrs b <> suffixMaybe typeModifiers c
attrs = foldMap (mappend "." . attrName)
typeModifiers = inParens . exprList
typeList = commaNonEmpty typename
subType = \ case
AnySubType -> "ANY"
SomeSubType -> "SOME"
AllSubType -> "ALL"
indexParams = commaNonEmpty indexElem
indexElem (IndexElem a b c d e) =
indexElemDef a <>
suffixMaybe collate b <>
suffixMaybe class_ c <>
suffixMaybe ascDesc d <>
suffixMaybe nullsOrder e
indexElemDef = \ case
IdIndexElemDef a -> colId a
FuncIndexElemDef a -> funcExprWindownless a
ExprIndexElemDef a -> inParens (aExpr a)
collate = mappend "COLLATE " . anyName
class_ = anyName
ascDesc = \ case
AscAscDesc -> "ASC"
DescAscDesc -> "DESC"
nullsOrder = \ case
FirstNullsOrder -> "NULLS FIRST"
LastNullsOrder -> "NULLS LAST"