module Hasql.TH.Extraction.ChildExprList where

import Hasql.TH.Prelude hiding (bit, fromList, sortBy)
import PostgresqlSyntax.Ast

-- * Types

data ChildExpr = AChildExpr AExpr | BChildExpr BExpr | CChildExpr CExpr
  deriving (Int -> ChildExpr -> ShowS
[ChildExpr] -> ShowS
ChildExpr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChildExpr] -> ShowS
$cshowList :: [ChildExpr] -> ShowS
show :: ChildExpr -> String
$cshow :: ChildExpr -> String
showsPrec :: Int -> ChildExpr -> ShowS
$cshowsPrec :: Int -> ChildExpr -> ShowS
Show, ChildExpr -> ChildExpr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChildExpr -> ChildExpr -> Bool
$c/= :: ChildExpr -> ChildExpr -> Bool
== :: ChildExpr -> ChildExpr -> Bool
$c== :: ChildExpr -> ChildExpr -> Bool
Eq, Eq ChildExpr
ChildExpr -> ChildExpr -> Bool
ChildExpr -> ChildExpr -> Ordering
ChildExpr -> ChildExpr -> ChildExpr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChildExpr -> ChildExpr -> ChildExpr
$cmin :: ChildExpr -> ChildExpr -> ChildExpr
max :: ChildExpr -> ChildExpr -> ChildExpr
$cmax :: ChildExpr -> ChildExpr -> ChildExpr
>= :: ChildExpr -> ChildExpr -> Bool
$c>= :: ChildExpr -> ChildExpr -> Bool
> :: ChildExpr -> ChildExpr -> Bool
$c> :: ChildExpr -> ChildExpr -> Bool
<= :: ChildExpr -> ChildExpr -> Bool
$c<= :: ChildExpr -> ChildExpr -> Bool
< :: ChildExpr -> ChildExpr -> Bool
$c< :: ChildExpr -> ChildExpr -> Bool
compare :: ChildExpr -> ChildExpr -> Ordering
$ccompare :: ChildExpr -> ChildExpr -> Ordering
Ord)

-- *

-- |
-- Dives one level of recursion.
childExpr :: ChildExpr -> [ChildExpr]
childExpr = \case
  AChildExpr AExpr
a -> AExpr -> [ChildExpr]
aChildExpr AExpr
a
  BChildExpr BExpr
a -> BExpr -> [ChildExpr]
bChildExpr BExpr
a
  CChildExpr CExpr
a -> CExpr -> [ChildExpr]
cChildExpr CExpr
a

aChildExpr :: AExpr -> [ChildExpr]
aChildExpr = \case
  CExprAExpr CExpr
a -> CExpr -> [ChildExpr]
cChildExpr CExpr
a
  TypecastAExpr AExpr
a Typename
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> Typename -> [ChildExpr]
typename Typename
b
  CollateAExpr AExpr
a AnyName
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {a}. AnyName -> [a]
anyName AnyName
b
  AtTimeZoneAExpr AExpr
a AExpr
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b
  PlusAExpr AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  MinusAExpr AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  SymbolicBinOpAExpr AExpr
a SymbolicExprBinOp
b AExpr
c -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {a}. SymbolicExprBinOp -> [a]
symbolicExprBinOp SymbolicExprBinOp
b forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
c
  PrefixQualOpAExpr QualOp
a AExpr
b -> forall {a}. QualOp -> [a]
qualOp QualOp
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b
  SuffixQualOpAExpr AExpr
a QualOp
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {a}. QualOp -> [a]
qualOp QualOp
b
  AndAExpr AExpr
a AExpr
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b
  OrAExpr AExpr
a AExpr
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b
  NotAExpr AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  VerbalExprBinOpAExpr AExpr
a Bool
b VerbalExprBinOp
c AExpr
d Maybe AExpr
e -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {b} {a}. b -> [a]
verbalExprBinOp VerbalExprBinOp
c forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
d forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr Maybe AExpr
e
  ReversableOpAExpr AExpr
a Bool
b AExprReversableOp
c -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> AExprReversableOp -> [ChildExpr]
aExprReversableOp AExprReversableOp
c
  IsnullAExpr AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  NotnullAExpr AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  OverlapsAExpr Row
a Row
b -> Row -> [ChildExpr]
row Row
a forall a. Semigroup a => a -> a -> a
<> Row -> [ChildExpr]
row Row
b
  SubqueryAExpr AExpr
a SubqueryOp
b SubType
c Either SelectWithParens AExpr
d -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {a}. SubqueryOp -> [a]
subqueryOp SubqueryOp
b forall a. Semigroup a => a -> a -> a
<> forall {b} {a}. b -> [a]
subType SubType
c forall a. Semigroup a => a -> a -> a
<> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SelectWithParens -> [ChildExpr]
selectWithParens forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr Either SelectWithParens AExpr
d
  UniqueAExpr SelectWithParens
a -> SelectWithParens -> [ChildExpr]
selectWithParens SelectWithParens
a
  AExpr
DefaultAExpr -> []

bChildExpr :: BExpr -> [ChildExpr]
bChildExpr = \case
  CExprBExpr CExpr
a -> CExpr -> [ChildExpr]
cChildExpr CExpr
a
  TypecastBExpr BExpr
a Typename
b -> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
a forall a. Semigroup a => a -> a -> a
<> Typename -> [ChildExpr]
typename Typename
b
  PlusBExpr BExpr
a -> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
a
  MinusBExpr BExpr
a -> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
a
  SymbolicBinOpBExpr BExpr
a SymbolicExprBinOp
b BExpr
c -> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
a forall a. Semigroup a => a -> a -> a
<> forall {a}. SymbolicExprBinOp -> [a]
symbolicExprBinOp SymbolicExprBinOp
b forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
c
  QualOpBExpr QualOp
a BExpr
b -> forall {a}. QualOp -> [a]
qualOp QualOp
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
b
  IsOpBExpr BExpr
a Bool
b BExprIsOp
c -> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
a forall a. Semigroup a => a -> a -> a
<> BExprIsOp -> [ChildExpr]
bExprIsOp BExprIsOp
c

cChildExpr :: CExpr -> [ChildExpr]
cChildExpr = \case
  ColumnrefCExpr Columnref
a -> Columnref -> [ChildExpr]
columnref Columnref
a
  AexprConstCExpr AexprConst
a -> AexprConst -> [ChildExpr]
aexprConst AexprConst
a
  ParamCExpr Int
a Maybe Indirection
b -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t IndirectionEl -> [ChildExpr]
indirection Maybe Indirection
b
  InParensCExpr AExpr
a Maybe Indirection
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t IndirectionEl -> [ChildExpr]
indirection Maybe Indirection
b
  CaseCExpr CaseExpr
a -> forall {f :: * -> *}.
(Monoid (f ChildExpr), Applicative f) =>
CaseExpr -> f ChildExpr
caseExpr CaseExpr
a
  FuncCExpr FuncExpr
a -> FuncExpr -> [ChildExpr]
funcExpr FuncExpr
a
  SelectWithParensCExpr SelectWithParens
a Maybe Indirection
b -> SelectWithParens -> [ChildExpr]
selectWithParens SelectWithParens
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t IndirectionEl -> [ChildExpr]
indirection Maybe Indirection
b
  ExistsCExpr SelectWithParens
a -> SelectWithParens -> [ChildExpr]
selectWithParens SelectWithParens
a
  ArrayCExpr Either SelectWithParens ArrayExpr
a -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SelectWithParens -> [ChildExpr]
selectWithParens ArrayExpr -> [ChildExpr]
arrayExpr Either SelectWithParens ArrayExpr
a
  ExplicitRowCExpr ExplicitRow
a -> forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
t (t AExpr) -> [ChildExpr]
explicitRow ExplicitRow
a
  ImplicitRowCExpr ImplicitRow
a -> ImplicitRow -> [ChildExpr]
implicitRow ImplicitRow
a
  GroupingCExpr ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a

-- *

preparableStmt :: PreparableStmt -> [ChildExpr]
preparableStmt = \case
  SelectPreparableStmt SelectStmt
a -> SelectStmt -> [ChildExpr]
selectStmt SelectStmt
a
  InsertPreparableStmt InsertStmt
a -> InsertStmt -> [ChildExpr]
insertStmt InsertStmt
a
  UpdatePreparableStmt UpdateStmt
a -> UpdateStmt -> [ChildExpr]
updateStmt UpdateStmt
a
  DeletePreparableStmt DeleteStmt
a -> DeleteStmt -> [ChildExpr]
deleteStmt DeleteStmt
a
  CallPreparableStmt CallStmt
a -> CallStmt -> [ChildExpr]
callStmt CallStmt
a

-- * Call

callStmt :: CallStmt -> [ChildExpr]
callStmt (CallStmt FuncApplication
a) = FuncApplication -> [ChildExpr]
funcApplication FuncApplication
a

-- * Insert

insertStmt :: InsertStmt -> [ChildExpr]
insertStmt (InsertStmt Maybe WithClause
a InsertTarget
b InsertRest
c Maybe OnConflict
d Maybe ReturningClause
e) =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WithClause -> [ChildExpr]
withClause Maybe WithClause
a
    forall a. Semigroup a => a -> a -> a
<> InsertTarget -> [ChildExpr]
insertTarget InsertTarget
b
    forall a. Semigroup a => a -> a -> a
<> InsertRest -> [ChildExpr]
insertRest InsertRest
c
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap OnConflict -> [ChildExpr]
onConflict Maybe OnConflict
d
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t TargetEl -> [ChildExpr]
returningClause Maybe ReturningClause
e

insertTarget :: InsertTarget -> [ChildExpr]
insertTarget (InsertTarget QualifiedName
a Maybe ColId
b) = QualifiedName -> [ChildExpr]
qualifiedName QualifiedName
a forall a. Semigroup a => a -> a -> a
<> forall {b} {a}. b -> [a]
colId Maybe ColId
b

insertRest :: InsertRest -> [ChildExpr]
insertRest = \case
  SelectInsertRest Maybe InsertColumnList
a Maybe OverrideKind
b SelectStmt
c -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}.
Foldable t =>
t InsertColumnItem -> [ChildExpr]
insertColumnList Maybe InsertColumnList
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b} {a}. b -> [a]
overrideKind Maybe OverrideKind
b forall a. Semigroup a => a -> a -> a
<> SelectStmt -> [ChildExpr]
selectStmt SelectStmt
c
  InsertRest
DefaultValuesInsertRest -> []

overrideKind :: p -> [a]
overrideKind p
_ = []

insertColumnList :: t InsertColumnItem -> [ChildExpr]
insertColumnList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap InsertColumnItem -> [ChildExpr]
insertColumnItem

insertColumnItem :: InsertColumnItem -> [ChildExpr]
insertColumnItem (InsertColumnItem ColId
a Maybe Indirection
b) = forall {b} {a}. b -> [a]
colId ColId
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t IndirectionEl -> [ChildExpr]
indirection Maybe Indirection
b

onConflict :: OnConflict -> [ChildExpr]
onConflict (OnConflict Maybe ConfExpr
a OnConflictDo
b) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ConfExpr -> [ChildExpr]
confExpr Maybe ConfExpr
a forall a. Semigroup a => a -> a -> a
<> OnConflictDo -> [ChildExpr]
onConflictDo OnConflictDo
b

onConflictDo :: OnConflictDo -> [ChildExpr]
onConflictDo = \case
  UpdateOnConflictDo SetClauseList
b Maybe AExpr
c -> forall {t :: * -> *}. Foldable t => t SetClause -> [ChildExpr]
setClauseList SetClauseList
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
whereClause Maybe AExpr
c
  OnConflictDo
NothingOnConflictDo -> []

confExpr :: ConfExpr -> [ChildExpr]
confExpr = \case
  WhereConfExpr IndexParams
a Maybe AExpr
b -> forall {t :: * -> *}. Foldable t => t IndexElem -> [ChildExpr]
indexParams IndexParams
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
whereClause Maybe AExpr
b
  ConstraintConfExpr ColId
a -> forall {b} {a}. b -> [a]
name ColId
a

returningClause :: t TargetEl -> [ChildExpr]
returningClause = forall {t :: * -> *}. Foldable t => t TargetEl -> [ChildExpr]
targetList

-- * Update

updateStmt :: UpdateStmt -> [ChildExpr]
updateStmt (UpdateStmt Maybe WithClause
a RelationExprOptAlias
b SetClauseList
c Maybe FromClause
d Maybe WhereOrCurrentClause
e Maybe ReturningClause
f) =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WithClause -> [ChildExpr]
withClause Maybe WithClause
a
    forall a. Semigroup a => a -> a -> a
<> RelationExprOptAlias -> [ChildExpr]
relationExprOptAlias RelationExprOptAlias
b
    forall a. Semigroup a => a -> a -> a
<> forall {t :: * -> *}. Foldable t => t SetClause -> [ChildExpr]
setClauseList SetClauseList
c
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FromClause -> [ChildExpr]
fromClause Maybe FromClause
d
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WhereOrCurrentClause -> [ChildExpr]
whereOrCurrentClause Maybe WhereOrCurrentClause
e
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t TargetEl -> [ChildExpr]
returningClause Maybe ReturningClause
f

setClauseList :: t SetClause -> [ChildExpr]
setClauseList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SetClause -> [ChildExpr]
setClause

setClause :: SetClause -> [ChildExpr]
setClause = \case
  TargetSetClause SetTarget
a AExpr
b -> SetTarget -> [ChildExpr]
setTarget SetTarget
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b
  TargetListSetClause SetTargetList
a AExpr
b -> forall {t :: * -> *}. Foldable t => t SetTarget -> [ChildExpr]
setTargetList SetTargetList
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b

setTarget :: SetTarget -> [ChildExpr]
setTarget (SetTarget ColId
a Maybe Indirection
b) = forall {b} {a}. b -> [a]
colId ColId
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t IndirectionEl -> [ChildExpr]
indirection Maybe Indirection
b

setTargetList :: t SetTarget -> [ChildExpr]
setTargetList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SetTarget -> [ChildExpr]
setTarget

-- * Delete

deleteStmt :: DeleteStmt -> [ChildExpr]
deleteStmt (DeleteStmt Maybe WithClause
a RelationExprOptAlias
b Maybe FromClause
c Maybe WhereOrCurrentClause
d Maybe ReturningClause
e) =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WithClause -> [ChildExpr]
withClause Maybe WithClause
a
    forall a. Semigroup a => a -> a -> a
<> RelationExprOptAlias -> [ChildExpr]
relationExprOptAlias RelationExprOptAlias
b
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FromClause -> [ChildExpr]
usingClause Maybe FromClause
c
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WhereOrCurrentClause -> [ChildExpr]
whereOrCurrentClause Maybe WhereOrCurrentClause
d
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t TargetEl -> [ChildExpr]
returningClause Maybe ReturningClause
e

usingClause :: FromClause -> [ChildExpr]
usingClause = FromClause -> [ChildExpr]
fromList

-- * Select

selectStmt :: SelectStmt -> [ChildExpr]
selectStmt = \case
  Left SelectNoParens
a -> SelectNoParens -> [ChildExpr]
selectNoParens SelectNoParens
a
  Right SelectWithParens
a -> SelectWithParens -> [ChildExpr]
selectWithParens SelectWithParens
a

selectNoParens :: SelectNoParens -> [ChildExpr]
selectNoParens (SelectNoParens Maybe WithClause
a SelectClause
b Maybe SortClause
c Maybe SelectLimit
d Maybe ForLockingClause
e) =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WithClause -> [ChildExpr]
withClause Maybe WithClause
a
    forall a. Semigroup a => a -> a -> a
<> SelectClause -> [ChildExpr]
selectClause SelectClause
b
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t SortBy -> [ChildExpr]
sortClause Maybe SortClause
c
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SelectLimit -> [ChildExpr]
selectLimit Maybe SelectLimit
d
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ForLockingClause -> [ChildExpr]
forLockingClause Maybe ForLockingClause
e

selectWithParens :: SelectWithParens -> [ChildExpr]
selectWithParens = \case
  NoParensSelectWithParens SelectNoParens
a -> SelectNoParens -> [ChildExpr]
selectNoParens SelectNoParens
a
  WithParensSelectWithParens SelectWithParens
a -> SelectWithParens -> [ChildExpr]
selectWithParens SelectWithParens
a

withClause :: WithClause -> [ChildExpr]
withClause (WithClause Bool
_ NonEmpty CommonTableExpr
a) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CommonTableExpr -> [ChildExpr]
commonTableExpr NonEmpty CommonTableExpr
a

commonTableExpr :: CommonTableExpr -> [ChildExpr]
commonTableExpr (CommonTableExpr ColId
a Maybe (NonEmpty ColId)
b Maybe Bool
c PreparableStmt
d) = PreparableStmt -> [ChildExpr]
preparableStmt PreparableStmt
d

selectLimit :: SelectLimit -> [ChildExpr]
selectLimit = \case
  LimitOffsetSelectLimit LimitClause
a OffsetClause
b -> LimitClause -> [ChildExpr]
limitClause LimitClause
a forall a. Semigroup a => a -> a -> a
<> OffsetClause -> [ChildExpr]
offsetClause OffsetClause
b
  OffsetLimitSelectLimit OffsetClause
a LimitClause
b -> OffsetClause -> [ChildExpr]
offsetClause OffsetClause
a forall a. Semigroup a => a -> a -> a
<> LimitClause -> [ChildExpr]
limitClause LimitClause
b
  LimitSelectLimit LimitClause
a -> LimitClause -> [ChildExpr]
limitClause LimitClause
a
  OffsetSelectLimit OffsetClause
a -> OffsetClause -> [ChildExpr]
offsetClause OffsetClause
a

limitClause :: LimitClause -> [ChildExpr]
limitClause = \case
  LimitLimitClause SelectLimitValue
a Maybe AExpr
b -> SelectLimitValue -> [ChildExpr]
selectLimitValue SelectLimitValue
a forall a. Semigroup a => a -> a -> a
<> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList Maybe AExpr
b
  FetchOnlyLimitClause Bool
a Maybe SelectFetchFirstValue
b Bool
c -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SelectFetchFirstValue -> [ChildExpr]
selectFetchFirstValue Maybe SelectFetchFirstValue
b

offsetClause :: OffsetClause -> [ChildExpr]
offsetClause = \case
  ExprOffsetClause AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  FetchFirstOffsetClause SelectFetchFirstValue
a Bool
b -> SelectFetchFirstValue -> [ChildExpr]
selectFetchFirstValue SelectFetchFirstValue
a

selectFetchFirstValue :: SelectFetchFirstValue -> [ChildExpr]
selectFetchFirstValue = \case
  ExprSelectFetchFirstValue CExpr
a -> forall {f :: * -> *}. Applicative f => CExpr -> f ChildExpr
cExpr CExpr
a
  NumSelectFetchFirstValue Bool
_ Either Int64 Double
_ -> []

selectLimitValue :: SelectLimitValue -> [ChildExpr]
selectLimitValue = \case
  ExprSelectLimitValue AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  SelectLimitValue
AllSelectLimitValue -> []

forLockingClause :: ForLockingClause -> [ChildExpr]
forLockingClause = \case
  ItemsForLockingClause NonEmpty ForLockingItem
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ForLockingItem -> [ChildExpr]
forLockingItem NonEmpty ForLockingItem
a
  ForLockingClause
ReadOnlyForLockingClause -> []

forLockingItem :: ForLockingItem -> [ChildExpr]
forLockingItem (ForLockingItem ForLockingStrength
a Maybe (NonEmpty QualifiedName)
b Maybe Bool
c) =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap QualifiedName -> [ChildExpr]
qualifiedName) Maybe (NonEmpty QualifiedName)
b

selectClause :: SelectClause -> [ChildExpr]
selectClause = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SimpleSelect -> [ChildExpr]
simpleSelect SelectWithParens -> [ChildExpr]
selectWithParens

simpleSelect :: SimpleSelect -> [ChildExpr]
simpleSelect = \case
  NormalSimpleSelect Maybe Targeting
a Maybe IntoClause
b Maybe FromClause
c Maybe AExpr
d Maybe GroupClause
e Maybe AExpr
f Maybe WindowClause
g ->
    forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Targeting -> [ChildExpr]
targeting Maybe Targeting
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b} {a}. b -> [a]
intoClause Maybe IntoClause
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FromClause -> [ChildExpr]
fromClause Maybe FromClause
c
      forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
whereClause Maybe AExpr
d
      forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t GroupByItem -> [ChildExpr]
groupClause Maybe GroupClause
e
      forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
havingClause Maybe AExpr
f
      forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}.
Foldable t =>
t WindowDefinition -> [ChildExpr]
windowClause Maybe WindowClause
g
  ValuesSimpleSelect ValuesClause
a -> forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
t (t AExpr) -> [ChildExpr]
valuesClause ValuesClause
a
  TableSimpleSelect RelationExpr
a -> RelationExpr -> [ChildExpr]
relationExpr RelationExpr
a
  BinSimpleSelect SelectBinOp
_ SelectClause
a Maybe Bool
_ SelectClause
b -> SelectClause -> [ChildExpr]
selectClause SelectClause
a forall a. Semigroup a => a -> a -> a
<> SelectClause -> [ChildExpr]
selectClause SelectClause
b

targeting :: Targeting -> [ChildExpr]
targeting = \case
  NormalTargeting ReturningClause
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TargetEl -> [ChildExpr]
targetEl ReturningClause
a
  AllTargeting Maybe ReturningClause
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TargetEl -> [ChildExpr]
targetEl) Maybe ReturningClause
a
  DistinctTargeting ExplicitRow
a ReturningClause
b -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExplicitRow
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TargetEl -> [ChildExpr]
targetEl ReturningClause
b

targetList :: t TargetEl -> [ChildExpr]
targetList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TargetEl -> [ChildExpr]
targetEl

targetEl :: TargetEl -> [ChildExpr]
targetEl = \case
  AliasedExprTargetEl AExpr
a ColId
_ -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  ImplicitlyAliasedExprTargetEl AExpr
a ColId
_ -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  ExprTargetEl AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  TargetEl
AsteriskTargetEl -> []

intoClause :: p -> [a]
intoClause = forall {b} {a}. b -> [a]
optTempTableName

fromClause :: FromClause -> [ChildExpr]
fromClause = FromClause -> [ChildExpr]
fromList

fromList :: FromClause -> [ChildExpr]
fromList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TableRef -> [ChildExpr]
tableRef

whereClause :: AExpr -> f ChildExpr
whereClause = forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr

whereOrCurrentClause :: WhereOrCurrentClause -> [ChildExpr]
whereOrCurrentClause = \case
  ExprWhereOrCurrentClause AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  CursorWhereOrCurrentClause ColId
a -> forall {b} {a}. b -> [a]
cursorName ColId
a

groupClause :: t GroupByItem -> [ChildExpr]
groupClause = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GroupByItem -> [ChildExpr]
groupByItem

havingClause :: AExpr -> f ChildExpr
havingClause = forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr

windowClause :: t WindowDefinition -> [ChildExpr]
windowClause = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WindowDefinition -> [ChildExpr]
windowDefinition

valuesClause :: t (t AExpr) -> [ChildExpr]
valuesClause = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList

optTempTableName :: p -> [a]
optTempTableName p
_ = []

groupByItem :: GroupByItem -> [ChildExpr]
groupByItem = \case
  ExprGroupByItem AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  GroupByItem
EmptyGroupingSetGroupByItem -> []
  RollupGroupByItem ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a
  CubeGroupByItem ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a
  GroupingSetsGroupByItem GroupClause
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GroupByItem -> [ChildExpr]
groupByItem GroupClause
a

windowDefinition :: WindowDefinition -> [ChildExpr]
windowDefinition (WindowDefinition ColId
_ WindowSpecification
a) = WindowSpecification -> [ChildExpr]
windowSpecification WindowSpecification
a

windowSpecification :: WindowSpecification -> [ChildExpr]
windowSpecification (WindowSpecification Maybe ColId
_ ExplicitRow
a Maybe SortClause
b Maybe FrameClause
c) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr) ExplicitRow
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t SortBy -> [ChildExpr]
sortClause Maybe SortClause
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FrameClause -> [ChildExpr]
frameClause Maybe FrameClause
c

frameClause :: FrameClause -> [ChildExpr]
frameClause (FrameClause FrameClauseMode
_ FrameExtent
a Maybe WindowExclusionClause
_) = FrameExtent -> [ChildExpr]
frameExtent FrameExtent
a

frameExtent :: FrameExtent -> [ChildExpr]
frameExtent = \case
  SingularFrameExtent FrameBound
a -> FrameBound -> [ChildExpr]
frameBound FrameBound
a
  BetweenFrameExtent FrameBound
a FrameBound
b -> FrameBound -> [ChildExpr]
frameBound FrameBound
a forall a. Semigroup a => a -> a -> a
<> FrameBound -> [ChildExpr]
frameBound FrameBound
b

frameBound :: FrameBound -> [ChildExpr]
frameBound = \case
  FrameBound
UnboundedPrecedingFrameBound -> []
  FrameBound
UnboundedFollowingFrameBound -> []
  FrameBound
CurrentRowFrameBound -> []
  PrecedingFrameBound AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  FollowingFrameBound AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a

sortClause :: t SortBy -> [ChildExpr]
sortClause = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SortBy -> [ChildExpr]
sortBy

sortBy :: SortBy -> [ChildExpr]
sortBy = \case
  UsingSortBy AExpr
a QualAllOp
b Maybe NullsOrder
c -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {a}. QualAllOp -> [a]
qualAllOp QualAllOp
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b} {a}. b -> [a]
nullsOrder Maybe NullsOrder
c
  AscDescSortBy AExpr
a Maybe AscDesc
b Maybe NullsOrder
c -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b} {a}. b -> [a]
ascDesc Maybe AscDesc
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b} {a}. b -> [a]
nullsOrder Maybe NullsOrder
c

-- * Table refs

tableRef :: TableRef -> [ChildExpr]
tableRef = \case
  RelationExprTableRef RelationExpr
a Maybe AliasClause
b Maybe TablesampleClause
c -> RelationExpr -> [ChildExpr]
relationExpr RelationExpr
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b} {a}. b -> [a]
aliasClause Maybe AliasClause
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TablesampleClause -> [ChildExpr]
tablesampleClause Maybe TablesampleClause
c
  FuncTableRef Bool
a FuncTable
b Maybe FuncAliasClause
c -> FuncTable -> [ChildExpr]
funcTable FuncTable
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FuncAliasClause -> [ChildExpr]
funcAliasClause Maybe FuncAliasClause
c
  SelectTableRef Bool
_ SelectWithParens
a Maybe AliasClause
_ -> SelectWithParens -> [ChildExpr]
selectWithParens SelectWithParens
a
  JoinTableRef JoinedTable
a Maybe AliasClause
_ -> JoinedTable -> [ChildExpr]
joinedTable JoinedTable
a

relationExpr :: RelationExpr -> [ChildExpr]
relationExpr = \case
  SimpleRelationExpr QualifiedName
a Bool
_ -> QualifiedName -> [ChildExpr]
qualifiedName QualifiedName
a
  OnlyRelationExpr QualifiedName
a Bool
_ -> QualifiedName -> [ChildExpr]
qualifiedName QualifiedName
a

relationExprOptAlias :: RelationExprOptAlias -> [ChildExpr]
relationExprOptAlias (RelationExprOptAlias RelationExpr
a Maybe (Bool, ColId)
b) = RelationExpr -> [ChildExpr]
relationExpr RelationExpr
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {b} {a}. b -> [a]
colId forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> b
snd) Maybe (Bool, ColId)
b

tablesampleClause :: TablesampleClause -> [ChildExpr]
tablesampleClause (TablesampleClause FuncName
a ExprList
b Maybe AExpr
c) = FuncName -> [ChildExpr]
funcName FuncName
a forall a. Semigroup a => a -> a -> a
<> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
repeatableClause Maybe AExpr
c

repeatableClause :: AExpr -> f ChildExpr
repeatableClause = forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr

funcTable :: FuncTable -> [ChildExpr]
funcTable = \case
  FuncExprFuncTable FuncExprWindowless
a Bool
b -> FuncExprWindowless -> [ChildExpr]
funcExprWindowless FuncExprWindowless
a forall a. Semigroup a => a -> a -> a
<> forall {b} {a}. b -> [a]
optOrdinality Bool
b
  RowsFromFuncTable RowsfromList
a Bool
b -> forall {t :: * -> *}. Foldable t => t RowsfromItem -> [ChildExpr]
rowsfromList RowsfromList
a forall a. Semigroup a => a -> a -> a
<> forall {b} {a}. b -> [a]
optOrdinality Bool
b

rowsfromItem :: RowsfromItem -> [ChildExpr]
rowsfromItem (RowsfromItem FuncExprWindowless
a Maybe ColDefList
b) = FuncExprWindowless -> [ChildExpr]
funcExprWindowless FuncExprWindowless
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}.
Foldable t =>
t TableFuncElement -> [ChildExpr]
colDefList Maybe ColDefList
b

rowsfromList :: t RowsfromItem -> [ChildExpr]
rowsfromList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap RowsfromItem -> [ChildExpr]
rowsfromItem

colDefList :: t TableFuncElement -> [ChildExpr]
colDefList = forall {t :: * -> *}.
Foldable t =>
t TableFuncElement -> [ChildExpr]
tableFuncElementList

optOrdinality :: b -> [a]
optOrdinality = forall a b. a -> b -> a
const []

tableFuncElementList :: t TableFuncElement -> [ChildExpr]
tableFuncElementList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TableFuncElement -> [ChildExpr]
tableFuncElement

tableFuncElement :: TableFuncElement -> [ChildExpr]
tableFuncElement (TableFuncElement ColId
a Typename
b Maybe AnyName
c) = forall {b} {a}. b -> [a]
colId ColId
a forall a. Semigroup a => a -> a -> a
<> Typename -> [ChildExpr]
typename Typename
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a}. AnyName -> [a]
collateClause Maybe AnyName
c

collateClause :: AnyName -> [a]
collateClause = forall {a}. AnyName -> [a]
anyName

aliasClause :: b -> [a]
aliasClause = forall a b. a -> b -> a
const []

funcAliasClause :: FuncAliasClause -> [ChildExpr]
funcAliasClause = \case
  AliasFuncAliasClause AliasClause
a -> forall {b} {a}. b -> [a]
aliasClause AliasClause
a
  AsFuncAliasClause ColDefList
a -> forall {t :: * -> *}.
Foldable t =>
t TableFuncElement -> [ChildExpr]
tableFuncElementList ColDefList
a
  AsColIdFuncAliasClause ColId
a ColDefList
b -> forall {b} {a}. b -> [a]
colId ColId
a forall a. Semigroup a => a -> a -> a
<> forall {t :: * -> *}.
Foldable t =>
t TableFuncElement -> [ChildExpr]
tableFuncElementList ColDefList
b
  ColIdFuncAliasClause ColId
a ColDefList
b -> forall {b} {a}. b -> [a]
colId ColId
a forall a. Semigroup a => a -> a -> a
<> forall {t :: * -> *}.
Foldable t =>
t TableFuncElement -> [ChildExpr]
tableFuncElementList ColDefList
b

joinedTable :: JoinedTable -> [ChildExpr]
joinedTable = \case
  InParensJoinedTable JoinedTable
a -> JoinedTable -> [ChildExpr]
joinedTable JoinedTable
a
  MethJoinedTable JoinMeth
a TableRef
b TableRef
c -> JoinMeth -> [ChildExpr]
joinMeth JoinMeth
a forall a. Semigroup a => a -> a -> a
<> TableRef -> [ChildExpr]
tableRef TableRef
b forall a. Semigroup a => a -> a -> a
<> TableRef -> [ChildExpr]
tableRef TableRef
c

joinMeth :: JoinMeth -> [ChildExpr]
joinMeth = \case
  JoinMeth
CrossJoinMeth -> []
  QualJoinMeth Maybe JoinType
_ JoinQual
a -> JoinQual -> [ChildExpr]
joinQual JoinQual
a
  NaturalJoinMeth Maybe JoinType
_ -> []

joinQual :: JoinQual -> [ChildExpr]
joinQual = \case
  UsingJoinQual NonEmpty ColId
_ -> []
  OnJoinQual AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a

-- *

exprList :: t AExpr -> [ChildExpr]
exprList = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AExpr -> ChildExpr
AChildExpr forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

aExpr :: AExpr -> f ChildExpr
aExpr = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AExpr -> ChildExpr
AChildExpr

bExpr :: BExpr -> f ChildExpr
bExpr = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BExpr -> ChildExpr
BChildExpr

cExpr :: CExpr -> f ChildExpr
cExpr = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CExpr -> ChildExpr
CChildExpr

funcExpr :: FuncExpr -> [ChildExpr]
funcExpr = \case
  ApplicationFuncExpr FuncApplication
a Maybe SortClause
b Maybe AExpr
c Maybe OverClause
d -> FuncApplication -> [ChildExpr]
funcApplication FuncApplication
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t SortBy -> [ChildExpr]
withinGroupClause Maybe SortClause
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
filterClause Maybe AExpr
c forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap OverClause -> [ChildExpr]
overClause Maybe OverClause
d
  SubexprFuncExpr FuncExprCommonSubexpr
a -> FuncExprCommonSubexpr -> [ChildExpr]
funcExprCommonSubexpr FuncExprCommonSubexpr
a

funcExprWindowless :: FuncExprWindowless -> [ChildExpr]
funcExprWindowless = \case
  ApplicationFuncExprWindowless FuncApplication
a -> FuncApplication -> [ChildExpr]
funcApplication FuncApplication
a
  CommonSubexprFuncExprWindowless FuncExprCommonSubexpr
a -> FuncExprCommonSubexpr -> [ChildExpr]
funcExprCommonSubexpr FuncExprCommonSubexpr
a

withinGroupClause :: t SortBy -> [ChildExpr]
withinGroupClause = forall {t :: * -> *}. Foldable t => t SortBy -> [ChildExpr]
sortClause

filterClause :: AExpr -> f ChildExpr
filterClause AExpr
a = forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a

overClause :: OverClause -> [ChildExpr]
overClause = \case
  WindowOverClause WindowSpecification
a -> WindowSpecification -> [ChildExpr]
windowSpecification WindowSpecification
a
  ColIdOverClause ColId
_ -> []

funcExprCommonSubexpr :: FuncExprCommonSubexpr -> [ChildExpr]
funcExprCommonSubexpr = \case
  CollationForFuncExprCommonSubexpr AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  FuncExprCommonSubexpr
CurrentDateFuncExprCommonSubexpr -> []
  CurrentTimeFuncExprCommonSubexpr Maybe Int64
_ -> []
  CurrentTimestampFuncExprCommonSubexpr Maybe Int64
_ -> []
  LocalTimeFuncExprCommonSubexpr Maybe Int64
_ -> []
  LocalTimestampFuncExprCommonSubexpr Maybe Int64
_ -> []
  FuncExprCommonSubexpr
CurrentRoleFuncExprCommonSubexpr -> []
  FuncExprCommonSubexpr
CurrentUserFuncExprCommonSubexpr -> []
  FuncExprCommonSubexpr
SessionUserFuncExprCommonSubexpr -> []
  FuncExprCommonSubexpr
UserFuncExprCommonSubexpr -> []
  FuncExprCommonSubexpr
CurrentCatalogFuncExprCommonSubexpr -> []
  FuncExprCommonSubexpr
CurrentSchemaFuncExprCommonSubexpr -> []
  CastFuncExprCommonSubexpr AExpr
a Typename
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> Typename -> [ChildExpr]
typename Typename
b
  ExtractFuncExprCommonSubexpr Maybe ExtractList
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExtractList -> [ChildExpr]
extractList Maybe ExtractList
a
  OverlayFuncExprCommonSubexpr OverlayList
a -> forall {f :: * -> *}.
(Monoid (f ChildExpr), Applicative f) =>
OverlayList -> f ChildExpr
overlayList OverlayList
a
  PositionFuncExprCommonSubexpr Maybe PositionList
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}.
(Semigroup (f ChildExpr), Applicative f) =>
PositionList -> f ChildExpr
positionList Maybe PositionList
a
  SubstringFuncExprCommonSubexpr Maybe SubstrList
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SubstrList -> [ChildExpr]
substrList Maybe SubstrList
a
  TreatFuncExprCommonSubexpr AExpr
a Typename
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> Typename -> [ChildExpr]
typename Typename
b
  TrimFuncExprCommonSubexpr Maybe TrimModifier
a TrimList
b -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b} {a}. b -> [a]
trimModifier Maybe TrimModifier
a forall a. Semigroup a => a -> a -> a
<> TrimList -> [ChildExpr]
trimList TrimList
b
  NullIfFuncExprCommonSubexpr AExpr
a AExpr
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b
  CoalesceFuncExprCommonSubexpr ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a
  GreatestFuncExprCommonSubexpr ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a
  LeastFuncExprCommonSubexpr ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a

extractList :: ExtractList -> [ChildExpr]
extractList (ExtractList ExtractArg
a AExpr
b) = forall {b} {a}. b -> [a]
extractArg ExtractArg
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b

extractArg :: p -> [a]
extractArg p
_ = []

overlayList :: OverlayList -> f ChildExpr
overlayList (OverlayList AExpr
a AExpr
b AExpr
c Maybe AExpr
d) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr ([AExpr
a, AExpr
b, AExpr
c] forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe AExpr
d)

positionList :: PositionList -> f ChildExpr
positionList (PositionList BExpr
a BExpr
b) = forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
b

substrList :: SubstrList -> [ChildExpr]
substrList = \case
  ExprSubstrList AExpr
a SubstrListFromFor
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}.
(Semigroup (f ChildExpr), Applicative f) =>
SubstrListFromFor -> f ChildExpr
substrListFromFor SubstrListFromFor
b
  ExprListSubstrList ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a

substrListFromFor :: SubstrListFromFor -> f ChildExpr
substrListFromFor = \case
  FromForSubstrListFromFor AExpr
a AExpr
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b
  ForFromSubstrListFromFor AExpr
a AExpr
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b
  FromSubstrListFromFor AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  ForSubstrListFromFor AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a

trimModifier :: p -> [a]
trimModifier p
_ = []

trimList :: TrimList -> [ChildExpr]
trimList = \case
  ExprFromExprListTrimList AExpr
a ExprList
b -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
b
  FromExprListTrimList ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a
  ExprListTrimList ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a

whenClause :: WhenClause -> f ChildExpr
whenClause (WhenClause AExpr
a AExpr
b) = forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b

funcApplication :: FuncApplication -> [ChildExpr]
funcApplication (FuncApplication FuncName
a Maybe FuncApplicationParams
b) = FuncName -> [ChildExpr]
funcName FuncName
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FuncApplicationParams -> [ChildExpr]
funcApplicationParams Maybe FuncApplicationParams
b

funcApplicationParams :: FuncApplicationParams -> [ChildExpr]
funcApplicationParams = \case
  NormalFuncApplicationParams Maybe Bool
_ NonEmpty FuncArgExpr
a Maybe SortClause
b -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => FuncArgExpr -> f ChildExpr
funcArgExpr NonEmpty FuncArgExpr
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SortBy -> [ChildExpr]
sortBy) Maybe SortClause
b
  VariadicFuncApplicationParams Maybe (NonEmpty FuncArgExpr)
a FuncArgExpr
b Maybe SortClause
c -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => FuncArgExpr -> f ChildExpr
funcArgExpr) Maybe (NonEmpty FuncArgExpr)
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => FuncArgExpr -> f ChildExpr
funcArgExpr FuncArgExpr
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SortBy -> [ChildExpr]
sortBy) Maybe SortClause
c
  FuncApplicationParams
StarFuncApplicationParams -> []

funcArgExpr :: FuncArgExpr -> f ChildExpr
funcArgExpr = \case
  ExprFuncArgExpr AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  ColonEqualsFuncArgExpr ColId
_ AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  EqualsGreaterFuncArgExpr ColId
_ AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a

caseExpr :: CaseExpr -> f ChildExpr
caseExpr (CaseExpr Maybe AExpr
a WhenClauseList
b Maybe AExpr
c) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr Maybe AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {t :: * -> *} {f :: * -> *}.
(Foldable t, Monoid (f ChildExpr), Applicative f) =>
t WhenClause -> f ChildExpr
whenClauseList WhenClauseList
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr Maybe AExpr
c

whenClauseList :: t WhenClause -> f ChildExpr
whenClauseList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}.
(Semigroup (f ChildExpr), Applicative f) =>
WhenClause -> f ChildExpr
whenClause

arrayExpr :: ArrayExpr -> [ChildExpr]
arrayExpr = \case
  ExprListArrayExpr ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a
  ArrayExprListArrayExpr ArrayExprList
a -> ArrayExprList -> [ChildExpr]
arrayExprList ArrayExprList
a
  ArrayExpr
EmptyArrayExpr -> []

arrayExprList :: ArrayExprList -> [ChildExpr]
arrayExprList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ArrayExpr -> [ChildExpr]
arrayExpr

inExpr :: InExpr -> [ChildExpr]
inExpr = \case
  SelectInExpr SelectWithParens
a -> SelectWithParens -> [ChildExpr]
selectWithParens SelectWithParens
a
  ExprListInExpr ExprList
a -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a

-- * Operators

symbolicExprBinOp :: SymbolicExprBinOp -> [a]
symbolicExprBinOp = \case
  MathSymbolicExprBinOp MathOp
a -> forall {b} {a}. b -> [a]
mathOp MathOp
a
  QualSymbolicExprBinOp QualOp
a -> forall {a}. QualOp -> [a]
qualOp QualOp
a

qualOp :: QualOp -> [a]
qualOp = \case
  OpQualOp Op
a -> forall {b} {a}. b -> [a]
op Op
a
  OperatorQualOp AnyOperator
a -> forall {a}. AnyOperator -> [a]
anyOperator AnyOperator
a

qualAllOp :: QualAllOp -> [a]
qualAllOp = \case
  AllQualAllOp AllOp
a -> forall {a}. AllOp -> [a]
allOp AllOp
a
  AnyQualAllOp AnyOperator
a -> forall {a}. AnyOperator -> [a]
anyOperator AnyOperator
a

verbalExprBinOp :: b -> [a]
verbalExprBinOp = forall a b. a -> b -> a
const []

aExprReversableOp :: AExprReversableOp -> [ChildExpr]
aExprReversableOp = \case
  AExprReversableOp
NullAExprReversableOp -> []
  AExprReversableOp
TrueAExprReversableOp -> []
  AExprReversableOp
FalseAExprReversableOp -> []
  AExprReversableOp
UnknownAExprReversableOp -> []
  DistinctFromAExprReversableOp AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  OfAExprReversableOp TypeList
a -> forall {t :: * -> *}. Foldable t => t Typename -> [ChildExpr]
typeList TypeList
a
  BetweenAExprReversableOp Bool
a BExpr
b AExpr
c -> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
b forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
c
  BetweenSymmetricAExprReversableOp BExpr
a AExpr
b -> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b
  InAExprReversableOp InExpr
a -> InExpr -> [ChildExpr]
inExpr InExpr
a
  AExprReversableOp
DocumentAExprReversableOp -> []

subqueryOp :: SubqueryOp -> [a]
subqueryOp = \case
  AllSubqueryOp AllOp
a -> forall {a}. AllOp -> [a]
allOp AllOp
a
  AnySubqueryOp AnyOperator
a -> forall {a}. AnyOperator -> [a]
anyOperator AnyOperator
a
  LikeSubqueryOp Bool
_ -> []
  IlikeSubqueryOp Bool
_ -> []

bExprIsOp :: BExprIsOp -> [ChildExpr]
bExprIsOp = \case
  DistinctFromBExprIsOp BExpr
a -> forall {f :: * -> *}. Applicative f => BExpr -> f ChildExpr
bExpr BExpr
a
  OfBExprIsOp TypeList
a -> forall {t :: * -> *}. Foldable t => t Typename -> [ChildExpr]
typeList TypeList
a
  BExprIsOp
DocumentBExprIsOp -> []

allOp :: AllOp -> [a]
allOp = \case
  OpAllOp Op
a -> forall {b} {a}. b -> [a]
op Op
a
  MathAllOp MathOp
a -> forall {b} {a}. b -> [a]
mathOp MathOp
a

anyOperator :: AnyOperator -> [a]
anyOperator = \case
  AllOpAnyOperator AllOp
a -> forall {a}. AllOp -> [a]
allOp AllOp
a
  QualifiedAnyOperator ColId
a AnyOperator
b -> forall {b} {a}. b -> [a]
colId ColId
a forall a. Semigroup a => a -> a -> a
<> AnyOperator -> [a]
anyOperator AnyOperator
b

op :: b -> [a]
op = forall a b. a -> b -> a
const []

mathOp :: b -> [a]
mathOp = forall a b. a -> b -> a
const []

-- * Rows

row :: Row -> [ChildExpr]
row = \case
  ExplicitRowRow ExplicitRow
a -> forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
t (t AExpr) -> [ChildExpr]
explicitRow ExplicitRow
a
  ImplicitRowRow ImplicitRow
a -> ImplicitRow -> [ChildExpr]
implicitRow ImplicitRow
a

explicitRow :: t (t AExpr) -> [ChildExpr]
explicitRow = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList

implicitRow :: ImplicitRow -> [ChildExpr]
implicitRow (ImplicitRow ExprList
a AExpr
b) = forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExprList
a forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
b

-- * Constants

aexprConst :: AexprConst -> [ChildExpr]
aexprConst = \case
  IAexprConst Int64
_ -> []
  FAexprConst Double
_ -> []
  SAexprConst Op
_ -> []
  BAexprConst Op
_ -> []
  XAexprConst Op
_ -> []
  FuncAexprConst FuncName
a Maybe FuncConstArgs
b Op
_ -> FuncName -> [ChildExpr]
funcName FuncName
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FuncConstArgs -> [ChildExpr]
funcConstArgs Maybe FuncConstArgs
b
  ConstTypenameAexprConst ConstTypename
a Op
_ -> ConstTypename -> [ChildExpr]
constTypename ConstTypename
a
  StringIntervalAexprConst Op
_ Maybe Interval
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b} {a}. b -> [a]
interval Maybe Interval
a
  IntIntervalAexprConst Int64
_ Op
_ -> []
  BoolAexprConst Bool
_ -> []
  AexprConst
NullAexprConst -> []

funcConstArgs :: FuncConstArgs -> [ChildExpr]
funcConstArgs (FuncConstArgs NonEmpty FuncArgExpr
a Maybe SortClause
b) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *}. Applicative f => FuncArgExpr -> f ChildExpr
funcArgExpr NonEmpty FuncArgExpr
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t SortBy -> [ChildExpr]
sortClause Maybe SortClause
b

constTypename :: ConstTypename -> [ChildExpr]
constTypename = \case
  NumericConstTypename Numeric
a -> Numeric -> [ChildExpr]
numeric Numeric
a
  ConstBitConstTypename ConstBit
a -> ConstBit -> [ChildExpr]
constBit ConstBit
a
  ConstCharacterConstTypename ConstCharacter
a -> forall {a}. ConstCharacter -> [a]
constCharacter ConstCharacter
a
  ConstDatetimeConstTypename ConstDatetime
a -> forall {b} {a}. b -> [a]
constDatetime ConstDatetime
a

numeric :: Numeric -> [ChildExpr]
numeric = \case
  Numeric
IntNumeric -> []
  Numeric
IntegerNumeric -> []
  Numeric
SmallintNumeric -> []
  Numeric
BigintNumeric -> []
  Numeric
RealNumeric -> []
  FloatNumeric Maybe Int64
_ -> []
  Numeric
DoublePrecisionNumeric -> []
  DecimalNumeric ExplicitRow
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExplicitRow
a
  DecNumeric ExplicitRow
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExplicitRow
a
  NumericNumeric ExplicitRow
a -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExplicitRow
a
  Numeric
BooleanNumeric -> []

bit :: ConstBit -> [ChildExpr]
bit (Bit Bool
_ ExplicitRow
a) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList ExplicitRow
a

constBit :: ConstBit -> [ChildExpr]
constBit = ConstBit -> [ChildExpr]
bit

constCharacter :: ConstCharacter -> [a]
constCharacter (ConstCharacter Character
_ Maybe Int64
_) = []

constDatetime :: p -> [a]
constDatetime p
_ = []

interval :: p -> [a]
interval p
_ = []

-- * Names

ident :: p -> [a]
ident p
_ = []

colId :: p -> [a]
colId = forall {b} {a}. b -> [a]
ident

name :: p -> [a]
name = forall {b} {a}. b -> [a]
colId

cursorName :: p -> [a]
cursorName = forall {b} {a}. b -> [a]
name

anyName :: AnyName -> [a]
anyName (AnyName ColId
a Maybe (NonEmpty ColId)
b) = forall {b} {a}. b -> [a]
colId ColId
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *} {a} {a}. Foldable t => t a -> [a]
attrs Maybe (NonEmpty ColId)
b

columnref :: Columnref -> [ChildExpr]
columnref (Columnref ColId
a Maybe Indirection
b) = forall {b} {a}. b -> [a]
colId ColId
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t IndirectionEl -> [ChildExpr]
indirection Maybe Indirection
b

funcName :: FuncName -> [ChildExpr]
funcName = \case
  TypeFuncName ColId
a -> forall {b} {a}. b -> [a]
typeFunctionName ColId
a
  IndirectedFuncName ColId
a Indirection
b -> forall {b} {a}. b -> [a]
colId ColId
a forall a. Semigroup a => a -> a -> a
<> forall {t :: * -> *}. Foldable t => t IndirectionEl -> [ChildExpr]
indirection Indirection
b

qualifiedName :: QualifiedName -> [ChildExpr]
qualifiedName = \case
  SimpleQualifiedName ColId
_ -> []
  IndirectedQualifiedName ColId
_ Indirection
a -> forall {t :: * -> *}. Foldable t => t IndirectionEl -> [ChildExpr]
indirection Indirection
a

indirection :: t IndirectionEl -> [ChildExpr]
indirection = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IndirectionEl -> [ChildExpr]
indirectionEl

indirectionEl :: IndirectionEl -> [ChildExpr]
indirectionEl = \case
  AttrNameIndirectionEl ColId
_ -> []
  IndirectionEl
AllIndirectionEl -> []
  ExprIndirectionEl AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a
  SliceIndirectionEl Maybe AExpr
a Maybe AExpr
b -> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList Maybe AExpr
a forall a. Semigroup a => a -> a -> a
<> forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList Maybe AExpr
b

-- * Types

typeList :: t Typename -> [ChildExpr]
typeList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Typename -> [ChildExpr]
typename

typename :: Typename -> [ChildExpr]
typename (Typename Bool
a SimpleTypename
b Bool
c Maybe (TypenameArrayDimensions, Bool)
d) =
  SimpleTypename -> [ChildExpr]
simpleTypename SimpleTypename
b

simpleTypename :: SimpleTypename -> [ChildExpr]
simpleTypename = \case
  GenericTypeSimpleTypename GenericType
a -> GenericType -> [ChildExpr]
genericType GenericType
a
  NumericSimpleTypename Numeric
a -> Numeric -> [ChildExpr]
numeric Numeric
a
  BitSimpleTypename ConstBit
a -> ConstBit -> [ChildExpr]
bit ConstBit
a
  CharacterSimpleTypename Character
a -> forall {b} {a}. b -> [a]
character Character
a
  ConstDatetimeSimpleTypename ConstDatetime
a -> forall {b} {a}. b -> [a]
constDatetime ConstDatetime
a
  ConstIntervalSimpleTypename Either (Maybe Interval) Int64
a -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b} {a}. b -> [a]
interval) (forall a b. a -> b -> a
const []) Either (Maybe Interval) Int64
a

arrayBounds :: p -> [a]
arrayBounds p
_ = []

genericType :: GenericType -> [ChildExpr]
genericType (GenericType ColId
a Maybe (NonEmpty ColId)
b ExplicitRow
c) = forall {b} {a}. b -> [a]
typeFunctionName ColId
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *} {a} {a}. Foldable t => t a -> [a]
attrs Maybe (NonEmpty ColId)
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
typeModifiers ExplicitRow
c

typeFunctionName :: p -> [a]
typeFunctionName = forall {b} {a}. b -> [a]
ident

attrs :: t a -> [a]
attrs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b} {a}. b -> [a]
attrName

attrName :: p -> [a]
attrName p
_ = []

typeModifiers :: t AExpr -> [ChildExpr]
typeModifiers = forall {t :: * -> *}. Foldable t => t AExpr -> [ChildExpr]
exprList

character :: p -> [a]
character p
_ = []

subType :: p -> [a]
subType p
_ = []

-- * Indexes

indexParams :: t IndexElem -> [ChildExpr]
indexParams = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IndexElem -> [ChildExpr]
indexElem

indexElem :: IndexElem -> [ChildExpr]
indexElem (IndexElem IndexElemDef
a Maybe AnyName
b Maybe AnyName
c Maybe AscDesc
d Maybe NullsOrder
e) = IndexElemDef -> [ChildExpr]
indexElemDef IndexElemDef
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a}. AnyName -> [a]
anyName Maybe AnyName
b forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a}. AnyName -> [a]
anyName Maybe AnyName
c

indexElemDef :: IndexElemDef -> [ChildExpr]
indexElemDef = \case
  IdIndexElemDef ColId
a -> forall {b} {a}. b -> [a]
colId ColId
a
  FuncIndexElemDef FuncExprWindowless
a -> FuncExprWindowless -> [ChildExpr]
funcExprWindowless FuncExprWindowless
a
  ExprIndexElemDef AExpr
a -> forall {f :: * -> *}. Applicative f => AExpr -> f ChildExpr
aExpr AExpr
a

ascDesc :: b -> [a]
ascDesc = forall a b. a -> b -> a
const []

nullsOrder :: b -> [a]
nullsOrder = forall a b. a -> b -> a
const []