{-# LANGUAGE OverloadedStrings #-}
module Database.Relational.SqlSyntax.Fold (
showSQL, toSQL, unitSQL, width,
queryWidth, corrSubQueryTerm,
column,
tupleFromJoinedSubQuery,
recordRawColumns,
composeWhere, composeHaving,
composeGroupBy, composePartitionBy,
composeOrderBy,
) where
import Control.Applicative ((<$>), pure)
import Data.Monoid (mempty, (<>), mconcat)
import Data.Traversable (traverse)
import Language.SQL.Keyword (Keyword(..), (|*|))
import qualified Language.SQL.Keyword as SQL
import Database.Relational.Internal.ContextType (Flat, Aggregated)
import Database.Relational.Internal.Config
(Config (productUnitSupport), ProductUnitSupport (PUSupported, PUNotSupported), )
import Database.Relational.Internal.UntypedTable ((!))
import qualified Database.Relational.Internal.UntypedTable as UntypedTable
import Database.Relational.Internal.String
(StringSQL, stringSQL, rowStringSQL, showStringSQL, )
import qualified Database.Relational.Internal.Literal as Lit
import Database.Relational.SqlSyntax.Types
(SubQuery (..), Record, Tuple, Predicate,
Column (..), CaseClause(..), WhenClauses (..),
NodeAttr (Just', Maybe), ProductTree (Leaf, Join), JoinProduct,
Duplication (..), SetOp (..), BinOp (..), Qualifier (..), Qualified (..),
AggregateBitKey (..), AggregateSet (..), AggregateElem (..), AggregateColumnRef,
Order (..), Nulls (..), OrderingTerm, )
import qualified Database.Relational.SqlSyntax.Types as Syntax
showsDuplication :: Duplication -> StringSQL
showsDuplication :: Duplication -> StringSQL
showsDuplication = Duplication -> StringSQL
dup where
dup :: Duplication -> StringSQL
dup Duplication
All = StringSQL
ALL
dup Duplication
Distinct = StringSQL
DISTINCT
showsSetOp' :: SetOp -> StringSQL
showsSetOp' :: SetOp -> StringSQL
showsSetOp' = SetOp -> StringSQL
d where
d :: SetOp -> StringSQL
d SetOp
Union = StringSQL
UNION
d SetOp
Except = StringSQL
EXCEPT
d SetOp
Intersect = StringSQL
INTERSECT
showsSetOp :: SetOp -> Duplication -> StringSQL
showsSetOp :: SetOp -> Duplication -> StringSQL
showsSetOp SetOp
op Duplication
dup0 = SetOp -> StringSQL
showsSetOp' SetOp
op StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> Duplication -> StringSQL
mayDup Duplication
dup0 where
mayDup :: Duplication -> StringSQL
mayDup dup :: Duplication
dup@Duplication
All = Duplication -> StringSQL
showsDuplication Duplication
dup
mayDup Duplication
Distinct = StringSQL
forall a. Monoid a => a
mempty
showQualifier :: Qualifier -> StringSQL
showQualifier :: Qualifier -> StringSQL
showQualifier (Qualifier Int
i) = String -> StringSQL
stringSQL (String -> StringSQL) -> String -> StringSQL
forall a b. (a -> b) -> a -> b
$ Char
'T' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i
(<.>) :: Qualifier -> StringSQL -> StringSQL
Qualifier
i <.> :: Qualifier -> StringSQL -> StringSQL
<.> StringSQL
n = Qualifier -> StringSQL
showQualifier Qualifier
i StringSQL -> StringSQL -> StringSQL
SQL.<.> StringSQL
n
columnN :: Int -> StringSQL
columnN :: Int -> StringSQL
columnN Int
i = String -> StringSQL
stringSQL (String -> StringSQL) -> String -> StringSQL
forall a b. (a -> b) -> a -> b
$ Char
'f' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i
asColumnN :: StringSQL -> Int -> StringSQL
StringSQL
c asColumnN :: StringSQL -> Int -> StringSQL
`asColumnN` Int
n =StringSQL
c StringSQL -> StringSQL -> StringSQL
`SQL.as` Int -> StringSQL
columnN Int
n
columnFromId :: Qualifier -> Int -> StringSQL
columnFromId :: Qualifier -> Int -> StringSQL
columnFromId Qualifier
qi Int
i = Qualifier
qi Qualifier -> StringSQL -> StringSQL
<.> Int -> StringSQL
columnN Int
i
width :: SubQuery -> Int
width :: SubQuery -> Int
width = SubQuery -> Int
d where
d :: SubQuery -> Int
d (Table Untyped
u) = Untyped -> Int
UntypedTable.width' Untyped
u
d (Bin BinOp
_ SubQuery
l SubQuery
_) = SubQuery -> Int
width SubQuery
l
d (Flat Config
_ Tuple
up Duplication
_ JoinProduct
_ [Predicate Flat]
_ [OrderingTerm]
_) = Tuple -> Int
Syntax.tupleWidth Tuple
up
d (Aggregated Config
_ Tuple
up Duplication
_ JoinProduct
_ [Predicate Flat]
_ [AggregateElem]
_ [Predicate Aggregated]
_ [OrderingTerm]
_) = Tuple -> Int
Syntax.tupleWidth Tuple
up
queryWidth :: Qualified SubQuery -> Int
queryWidth :: Qualified SubQuery -> Int
queryWidth = SubQuery -> Int
width (SubQuery -> Int)
-> (Qualified SubQuery -> SubQuery) -> Qualified SubQuery -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified SubQuery -> SubQuery
forall a. Qualified a -> a
Syntax.unQualify
fromTableToSQL :: UntypedTable.Untyped -> StringSQL
fromTableToSQL :: Untyped -> StringSQL
fromTableToSQL Untyped
t =
StringSQL
SELECT StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> (StringSQL -> StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
(|*|) (Untyped -> [StringSQL]
UntypedTable.columns' Untyped
t) StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<>
StringSQL
FROM StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> String -> StringSQL
stringSQL (Untyped -> String
UntypedTable.name' Untyped
t)
fromTableToNormalizedSQL :: UntypedTable.Untyped -> StringSQL
fromTableToNormalizedSQL :: Untyped -> StringSQL
fromTableToNormalizedSQL Untyped
t = StringSQL
SELECT StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> (StringSQL -> StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
(|*|) [StringSQL]
columns' StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<>
StringSQL
FROM StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> String -> StringSQL
stringSQL (Untyped -> String
UntypedTable.name' Untyped
t) where
columns' :: [StringSQL]
columns' = (StringSQL -> Int -> StringSQL)
-> [StringSQL] -> [Int] -> [StringSQL]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith StringSQL -> Int -> StringSQL
asColumnN
(Untyped -> [StringSQL]
UntypedTable.columns' Untyped
t)
[(Int
0 :: Int)..]
selectPrefixSQL :: Tuple -> Duplication -> StringSQL
selectPrefixSQL :: Tuple -> Duplication -> StringSQL
selectPrefixSQL Tuple
up Duplication
da = StringSQL
SELECT StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> Duplication -> StringSQL
showsDuplication Duplication
da StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<>
(StringSQL -> StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
(|*|) [StringSQL]
columns' where
columns' :: [StringSQL]
columns' = (StringSQL -> Int -> StringSQL)
-> [StringSQL] -> [Int] -> [StringSQL]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith StringSQL -> Int -> StringSQL
asColumnN
((Column -> StringSQL) -> Tuple -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map Column -> StringSQL
showColumn Tuple
up)
[(Int
0 :: Int)..]
normalizedSQL :: SubQuery -> StringSQL
normalizedSQL :: SubQuery -> StringSQL
normalizedSQL = SubQuery -> StringSQL
d where
d :: SubQuery -> StringSQL
d (Table Untyped
t) = Untyped -> StringSQL
fromTableToNormalizedSQL Untyped
t
d sub :: SubQuery
sub@(Bin {}) = SubQuery -> StringSQL
showUnitSQL SubQuery
sub
d sub :: SubQuery
sub@(Flat Config
_ Tuple
_ Duplication
_ JoinProduct
_ [Predicate Flat]
_ [OrderingTerm]
ots)
| [OrderingTerm] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OrderingTerm]
ots = SubQuery -> StringSQL
showSQL SubQuery
sub
| Bool
otherwise = SubQuery -> StringSQL
showUnitSQL SubQuery
sub
d sub :: SubQuery
sub@(Aggregated Config
_ Tuple
_ Duplication
_ JoinProduct
_ [Predicate Flat]
_ [AggregateElem]
_ [Predicate Aggregated]
_ [OrderingTerm]
ots)
| [OrderingTerm] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OrderingTerm]
ots = SubQuery -> StringSQL
showSQL SubQuery
sub
| Bool
otherwise = SubQuery -> StringSQL
showUnitSQL SubQuery
sub
toSQLs :: SubQuery
-> (StringSQL, StringSQL)
toSQLs :: SubQuery -> (StringSQL, StringSQL)
toSQLs = SubQuery -> (StringSQL, StringSQL)
d where
d :: SubQuery -> (StringSQL, StringSQL)
d (Table Untyped
u) = (String -> StringSQL
stringSQL (String -> StringSQL) -> String -> StringSQL
forall a b. (a -> b) -> a -> b
$ Untyped -> String
UntypedTable.name' Untyped
u, Untyped -> StringSQL
fromTableToSQL Untyped
u)
d (Bin (BinOp (SetOp
op, Duplication
da)) SubQuery
l SubQuery
r) = (StringSQL -> StringSQL
SQL.paren StringSQL
q, StringSQL
q) where
q :: StringSQL
q = [StringSQL] -> StringSQL
forall a. Monoid a => [a] -> a
mconcat [SubQuery -> StringSQL
normalizedSQL SubQuery
l, SetOp -> Duplication -> StringSQL
showsSetOp SetOp
op Duplication
da, SubQuery -> StringSQL
normalizedSQL SubQuery
r]
d (Flat Config
cf Tuple
up Duplication
da JoinProduct
pd [Predicate Flat]
rs [OrderingTerm]
od) = (StringSQL -> StringSQL
SQL.paren StringSQL
q, StringSQL
q) where
q :: StringSQL
q = Tuple -> Duplication -> StringSQL
selectPrefixSQL Tuple
up Duplication
da StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> ProductUnitSupport -> JoinProduct -> StringSQL
showsJoinProduct (Config -> ProductUnitSupport
productUnitSupport Config
cf) JoinProduct
pd StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [Predicate Flat] -> StringSQL
composeWhere [Predicate Flat]
rs
StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [OrderingTerm] -> StringSQL
composeOrderBy [OrderingTerm]
od
d (Aggregated Config
cf Tuple
up Duplication
da JoinProduct
pd [Predicate Flat]
rs [AggregateElem]
ag [Predicate Aggregated]
grs [OrderingTerm]
od) = (StringSQL -> StringSQL
SQL.paren StringSQL
q, StringSQL
q) where
q :: StringSQL
q = Tuple -> Duplication -> StringSQL
selectPrefixSQL Tuple
up Duplication
da StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> ProductUnitSupport -> JoinProduct -> StringSQL
showsJoinProduct (Config -> ProductUnitSupport
productUnitSupport Config
cf) JoinProduct
pd StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [Predicate Flat] -> StringSQL
composeWhere [Predicate Flat]
rs
StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [AggregateElem] -> StringSQL
composeGroupBy [AggregateElem]
ag StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [Predicate Aggregated] -> StringSQL
composeHaving [Predicate Aggregated]
grs StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [OrderingTerm] -> StringSQL
composeOrderBy [OrderingTerm]
od
showUnitSQL :: SubQuery -> StringSQL
showUnitSQL :: SubQuery -> StringSQL
showUnitSQL = (StringSQL, StringSQL) -> StringSQL
forall a b. (a, b) -> a
fst ((StringSQL, StringSQL) -> StringSQL)
-> (SubQuery -> (StringSQL, StringSQL)) -> SubQuery -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubQuery -> (StringSQL, StringSQL)
toSQLs
unitSQL :: SubQuery -> String
unitSQL :: SubQuery -> String
unitSQL = StringSQL -> String
showStringSQL (StringSQL -> String)
-> (SubQuery -> StringSQL) -> SubQuery -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubQuery -> StringSQL
showUnitSQL
showSQL :: SubQuery -> StringSQL
showSQL :: SubQuery -> StringSQL
showSQL = (StringSQL, StringSQL) -> StringSQL
forall a b. (a, b) -> b
snd ((StringSQL, StringSQL) -> StringSQL)
-> (SubQuery -> (StringSQL, StringSQL)) -> SubQuery -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubQuery -> (StringSQL, StringSQL)
toSQLs
toSQL :: SubQuery -> String
toSQL :: SubQuery -> String
toSQL = StringSQL -> String
showStringSQL (StringSQL -> String)
-> (SubQuery -> StringSQL) -> SubQuery -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubQuery -> StringSQL
showSQL
corrSubQueryTerm :: Bool
-> Qualified SubQuery
-> StringSQL
corrSubQueryTerm :: Bool -> Qualified SubQuery -> StringSQL
corrSubQueryTerm Bool
addAS Qualified SubQuery
qq =
SubQuery -> StringSQL
showUnitSQL (Qualified SubQuery -> SubQuery
forall a. Qualified a -> a
Syntax.unQualify Qualified SubQuery
qq) StringSQL -> StringSQL -> StringSQL
`asOP` Qualifier -> StringSQL
showQualifier (Qualified SubQuery -> Qualifier
forall a. Qualified a -> Qualifier
Syntax.qualifier Qualified SubQuery
qq)
where
asOP :: StringSQL -> StringSQL -> StringSQL
asOP = if Bool
addAS then StringSQL -> StringSQL -> StringSQL
SQL.as else StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
(<>)
column :: Qualified SubQuery -> Int -> StringSQL
column :: Qualified SubQuery -> Int -> StringSQL
column Qualified SubQuery
qs = SubQuery -> Int -> StringSQL
d (Qualified SubQuery -> SubQuery
forall a. Qualified a -> a
Syntax.unQualify Qualified SubQuery
qs) where
q :: Qualifier
q = Qualified SubQuery -> Qualifier
forall a. Qualified a -> Qualifier
Syntax.qualifier Qualified SubQuery
qs
d :: SubQuery -> Int -> StringSQL
d (Table Untyped
u) Int
i = Qualifier
q Qualifier -> StringSQL -> StringSQL
<.> (Untyped
u Untyped -> Int -> StringSQL
! Int
i)
d (Bin {}) Int
i = Qualifier
q Qualifier -> Int -> StringSQL
`columnFromId` Int
i
d (Flat Config
_ Tuple
up Duplication
_ JoinProduct
_ [Predicate Flat]
_ [OrderingTerm]
_) Int
i = Tuple -> Int -> StringSQL
showTupleIndex Tuple
up Int
i
d (Aggregated Config
_ Tuple
up Duplication
_ JoinProduct
_ [Predicate Flat]
_ [AggregateElem]
_ [Predicate Aggregated]
_ [OrderingTerm]
_) Int
i = Tuple -> Int -> StringSQL
showTupleIndex Tuple
up Int
i
tupleFromJoinedSubQuery :: Qualified SubQuery -> Tuple
tupleFromJoinedSubQuery :: Qualified SubQuery -> Tuple
tupleFromJoinedSubQuery Qualified SubQuery
qs = SubQuery -> Tuple
d (SubQuery -> Tuple) -> SubQuery -> Tuple
forall a b. (a -> b) -> a -> b
$ Qualified SubQuery -> SubQuery
forall a. Qualified a -> a
Syntax.unQualify Qualified SubQuery
qs where
normalized :: Tuple
normalized = Qualified Int -> Column
SubQueryRef (Qualified Int -> Column) -> [Qualified Int] -> Tuple
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SubQuery -> [Int]) -> Qualified SubQuery -> [Qualified Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\SubQuery
q -> [Int
0 .. SubQuery -> Int
width SubQuery
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) Qualified SubQuery
qs
d :: SubQuery -> Tuple
d (Table Untyped
_) = (StringSQL -> Column) -> [StringSQL] -> Tuple
forall a b. (a -> b) -> [a] -> [b]
map StringSQL -> Column
RawColumn ([StringSQL] -> Tuple) -> ([Int] -> [StringSQL]) -> [Int] -> Tuple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> StringSQL) -> [Int] -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map (Qualified SubQuery -> Int -> StringSQL
column Qualified SubQuery
qs)
([Int] -> Tuple) -> [Int] -> Tuple
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (Qualified SubQuery -> Int
queryWidth Qualified SubQuery
qs) [Int
0..]
d (Bin {}) = Tuple
normalized
d (Flat {}) = Tuple
normalized
d (Aggregated {}) = Tuple
normalized
indexWhensClause :: WhenClauses -> Int -> StringSQL
indexWhensClause :: WhenClauses -> Int -> StringSQL
indexWhensClause (WhenClauses [(Tuple, Tuple)]
ps Tuple
e) Int
i =
[StringSQL] -> StringSQL
forall a. Monoid a => [a] -> a
mconcat [ Tuple -> Tuple -> StringSQL
when' Tuple
p Tuple
r | (Tuple
p, Tuple
r) <- [(Tuple, Tuple)]
ps] StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
else' StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
SQL.END
where
when' :: Tuple -> Tuple -> StringSQL
when' Tuple
p Tuple
r = StringSQL
SQL.WHEN StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [StringSQL] -> StringSQL
rowStringSQL ((Column -> StringSQL) -> Tuple -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map Column -> StringSQL
showColumn Tuple
p) StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<>
StringSQL
SQL.THEN StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> Tuple -> Int -> StringSQL
showTupleIndex Tuple
r Int
i
else' :: StringSQL
else' = StringSQL
SQL.ELSE StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> Tuple -> Int -> StringSQL
showTupleIndex Tuple
e Int
i
caseClause :: CaseClause -> Int -> StringSQL
caseClause :: CaseClause -> Int -> StringSQL
caseClause CaseClause
c Int
i = CaseClause -> StringSQL
d CaseClause
c where
d :: CaseClause -> StringSQL
d (CaseSearch WhenClauses
wcl) = StringSQL
SQL.CASE StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> WhenClauses -> Int -> StringSQL
indexWhensClause WhenClauses
wcl Int
i
d (CaseSimple Tuple
m WhenClauses
wcl) = StringSQL
SQL.CASE StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [StringSQL] -> StringSQL
rowStringSQL ((Column -> StringSQL) -> Tuple -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map Column -> StringSQL
showColumn Tuple
m) StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> WhenClauses -> Int -> StringSQL
indexWhensClause WhenClauses
wcl Int
i
showColumn :: Column -> StringSQL
showColumn :: Column -> StringSQL
showColumn = Column -> StringSQL
d where
d :: Column -> StringSQL
d (RawColumn StringSQL
e) = StringSQL
e
d (SubQueryRef Qualified Int
qi) = Qualified Int -> Qualifier
forall a. Qualified a -> Qualifier
Syntax.qualifier Qualified Int
qi Qualifier -> Int -> StringSQL
`columnFromId` Qualified Int -> Int
forall a. Qualified a -> a
Syntax.unQualify Qualified Int
qi
d (Scalar SubQuery
sub) = SubQuery -> StringSQL
showUnitSQL SubQuery
sub
d (Case CaseClause
c Int
i) = CaseClause -> Int -> StringSQL
caseClause CaseClause
c Int
i
showTupleIndex :: Tuple
-> Int
-> StringSQL
showTupleIndex :: Tuple -> Int -> StringSQL
showTupleIndex Tuple
up Int
i
| Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tuple -> Int
Syntax.tupleWidth Tuple
up =
Column -> StringSQL
showColumn (Column -> StringSQL) -> Column -> StringSQL
forall a b. (a -> b) -> a -> b
$ Tuple
up Tuple -> Int -> Column
forall a. [a] -> Int -> a
!! Int
i
| Bool
otherwise =
String -> StringSQL
forall a. HasCallStack => String -> a
error (String -> StringSQL) -> String -> StringSQL
forall a b. (a -> b) -> a -> b
$ String
"showTupleIndex: index out of bounds: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
recordRawColumns :: Record c r
-> [StringSQL]
recordRawColumns :: Record c r -> [StringSQL]
recordRawColumns = (Column -> StringSQL) -> Tuple -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map Column -> StringSQL
showColumn (Tuple -> [StringSQL])
-> (Record c r -> Tuple) -> Record c r -> [StringSQL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c r -> Tuple
forall c t. Record c t -> Tuple
Syntax.untypeRecord
showsQueryProduct :: ProductTree [Predicate Flat] -> StringSQL
showsQueryProduct :: ProductTree [Predicate Flat] -> StringSQL
showsQueryProduct = ProductTree [Predicate Flat] -> StringSQL
forall c r. ProductTree [Record c r] -> StringSQL
rec where
joinType :: NodeAttr -> NodeAttr -> StringSQL
joinType NodeAttr
Just' NodeAttr
Just' = StringSQL
INNER
joinType NodeAttr
Just' NodeAttr
Maybe = StringSQL
LEFT
joinType NodeAttr
Maybe NodeAttr
Just' = StringSQL
RIGHT
joinType NodeAttr
Maybe NodeAttr
Maybe = StringSQL
FULL
urec :: Node [Record c r] -> StringSQL
urec Node [Record c r]
n = case Node [Record c r] -> ProductTree [Record c r]
forall rs. Node rs -> ProductTree rs
Syntax.nodeTree Node [Record c r]
n of
p :: ProductTree [Record c r]
p@(Leaf (Bool, Qualified SubQuery)
_) -> ProductTree [Record c r] -> StringSQL
rec ProductTree [Record c r]
p
p :: ProductTree [Record c r]
p@(Join {}) -> StringSQL -> StringSQL
SQL.paren (ProductTree [Record c r] -> StringSQL
rec ProductTree [Record c r]
p)
rec :: ProductTree [Record c r] -> StringSQL
rec (Leaf (Bool, Qualified SubQuery)
q) = (Bool -> Qualified SubQuery -> StringSQL)
-> (Bool, Qualified SubQuery) -> StringSQL
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Qualified SubQuery -> StringSQL
corrSubQueryTerm (Bool, Qualified SubQuery)
q
rec (Join Node [Record c r]
left' Node [Record c r]
right' [Record c r]
rs) =
[StringSQL] -> StringSQL
forall a. Monoid a => [a] -> a
mconcat
[Node [Record c r] -> StringSQL
urec Node [Record c r]
left',
NodeAttr -> NodeAttr -> StringSQL
joinType (Node [Record c r] -> NodeAttr
forall rs. Node rs -> NodeAttr
Syntax.nodeAttr Node [Record c r]
left') (Node [Record c r] -> NodeAttr
forall rs. Node rs -> NodeAttr
Syntax.nodeAttr Node [Record c r]
right'), StringSQL
JOIN,
Node [Record c r] -> StringSQL
urec Node [Record c r]
right',
StringSQL
ON, (StringSQL -> StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 StringSQL -> StringSQL -> StringSQL
SQL.and ([StringSQL] -> StringSQL) -> [StringSQL] -> StringSQL
forall a b. (a -> b) -> a -> b
$ [StringSQL]
ps [StringSQL] -> [StringSQL] -> [StringSQL]
forall a. [a] -> [a] -> [a]
++ [[StringSQL]] -> [StringSQL]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ StringSQL -> [StringSQL]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> [StringSQL]) -> StringSQL -> [StringSQL]
forall a b. (a -> b) -> a -> b
$ Bool -> StringSQL
Lit.bool Bool
True | [StringSQL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [StringSQL]
ps ] ]
where ps :: [StringSQL]
ps = [ [StringSQL] -> StringSQL
rowStringSQL ([StringSQL] -> StringSQL) -> [StringSQL] -> StringSQL
forall a b. (a -> b) -> a -> b
$ Record c r -> [StringSQL]
forall c r. Record c r -> [StringSQL]
recordRawColumns Record c r
p | Record c r
p <- [Record c r]
rs ]
showsJoinProduct :: ProductUnitSupport -> JoinProduct -> StringSQL
showsJoinProduct :: ProductUnitSupport -> JoinProduct -> StringSQL
showsJoinProduct ProductUnitSupport
ups = StringSQL
-> (ProductTree [Predicate Flat] -> StringSQL)
-> JoinProduct
-> StringSQL
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ProductUnitSupport -> StringSQL
forall p. Monoid p => ProductUnitSupport -> p
up ProductUnitSupport
ups) ProductTree [Predicate Flat] -> StringSQL
from where
from :: ProductTree [Predicate Flat] -> StringSQL
from ProductTree [Predicate Flat]
qp = StringSQL
FROM StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> ProductTree [Predicate Flat] -> StringSQL
showsQueryProduct ProductTree [Predicate Flat]
qp
up :: ProductUnitSupport -> p
up ProductUnitSupport
PUSupported = p
forall a. Monoid a => a
mempty
up ProductUnitSupport
PUNotSupported = String -> p
forall a. HasCallStack => String -> a
error String
"relation: Unit product support mode is disabled!"
composeRestrict :: Keyword -> [Predicate c] -> StringSQL
composeRestrict :: StringSQL -> [Predicate c] -> StringSQL
composeRestrict StringSQL
k = [Predicate c] -> StringSQL
forall c r. [Record c r] -> StringSQL
d where
d :: [Record c r] -> StringSQL
d [] = StringSQL
forall a. Monoid a => a
mempty
d ps :: [Record c r]
ps@(Record c r
_:[Record c r]
_) = StringSQL
k StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> (StringSQL -> StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 StringSQL -> StringSQL -> StringSQL
SQL.and [ [StringSQL] -> StringSQL
rowStringSQL ([StringSQL] -> StringSQL) -> [StringSQL] -> StringSQL
forall a b. (a -> b) -> a -> b
$ Record c r -> [StringSQL]
forall c r. Record c r -> [StringSQL]
recordRawColumns Record c r
p | Record c r
p <- [Record c r]
ps ]
composeWhere :: [Predicate Flat] -> StringSQL
composeWhere :: [Predicate Flat] -> StringSQL
composeWhere = StringSQL -> [Predicate Flat] -> StringSQL
forall c. StringSQL -> [Predicate c] -> StringSQL
composeRestrict StringSQL
WHERE
composeHaving :: [Predicate Aggregated] -> StringSQL
composeHaving :: [Predicate Aggregated] -> StringSQL
composeHaving = StringSQL -> [Predicate Aggregated] -> StringSQL
forall c. StringSQL -> [Predicate c] -> StringSQL
composeRestrict StringSQL
HAVING
commaed :: [StringSQL] -> StringSQL
commaed :: [StringSQL] -> StringSQL
commaed = (StringSQL -> StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
(|*|)
pComma :: (a -> StringSQL) -> [a] -> StringSQL
pComma :: (a -> StringSQL) -> [a] -> StringSQL
pComma a -> StringSQL
qshow = StringSQL -> StringSQL
SQL.paren (StringSQL -> StringSQL) -> ([a] -> StringSQL) -> [a] -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StringSQL] -> StringSQL
commaed ([StringSQL] -> StringSQL)
-> ([a] -> [StringSQL]) -> [a] -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> StringSQL) -> [a] -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map a -> StringSQL
qshow
showsAggregateBitKey :: AggregateBitKey -> StringSQL
showsAggregateBitKey :: AggregateBitKey -> StringSQL
showsAggregateBitKey (AggregateBitKey Tuple
ts) = (StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
forall a. (a -> StringSQL) -> [a] -> StringSQL
pComma StringSQL -> StringSQL
forall a. a -> a
id ([StringSQL] -> StringSQL) -> [StringSQL] -> StringSQL
forall a b. (a -> b) -> a -> b
$ (Column -> StringSQL) -> Tuple -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map Column -> StringSQL
showColumn Tuple
ts
composeGroupBy :: [AggregateElem] -> StringSQL
composeGroupBy :: [AggregateElem] -> StringSQL
composeGroupBy = [AggregateElem] -> StringSQL
d where
d :: [AggregateElem] -> StringSQL
d [] = StringSQL
forall a. Monoid a => a
mempty
d es :: [AggregateElem]
es@(AggregateElem
_:[AggregateElem]
_) = StringSQL
GROUP StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
BY StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [AggregateElem] -> StringSQL
rec [AggregateElem]
es
keyList :: StringSQL -> [AggregateBitKey] -> StringSQL
keyList StringSQL
op [AggregateBitKey]
ss = StringSQL
op StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> (AggregateBitKey -> StringSQL) -> [AggregateBitKey] -> StringSQL
forall a. (a -> StringSQL) -> [a] -> StringSQL
pComma AggregateBitKey -> StringSQL
showsAggregateBitKey [AggregateBitKey]
ss
rec :: [AggregateElem] -> StringSQL
rec = [StringSQL] -> StringSQL
commaed ([StringSQL] -> StringSQL)
-> ([AggregateElem] -> [StringSQL]) -> [AggregateElem] -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AggregateElem -> StringSQL) -> [AggregateElem] -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map AggregateElem -> StringSQL
showsE
showsGs :: AggregateSet -> StringSQL
showsGs (AggregateSet [AggregateElem]
s) = StringSQL -> StringSQL
SQL.paren (StringSQL -> StringSQL) -> StringSQL -> StringSQL
forall a b. (a -> b) -> a -> b
$ [AggregateElem] -> StringSQL
rec [AggregateElem]
s
showsE :: AggregateElem -> StringSQL
showsE (ColumnRef Column
t) = Column -> StringSQL
showColumn Column
t
showsE (Rollup [AggregateBitKey]
ss) = StringSQL -> [AggregateBitKey] -> StringSQL
keyList StringSQL
ROLLUP [AggregateBitKey]
ss
showsE (Cube [AggregateBitKey]
ss) = StringSQL -> [AggregateBitKey] -> StringSQL
keyList StringSQL
CUBE [AggregateBitKey]
ss
showsE (GroupingSets [AggregateSet]
ss) = StringSQL
GROUPING StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
SETS StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> (AggregateSet -> StringSQL) -> [AggregateSet] -> StringSQL
forall a. (a -> StringSQL) -> [a] -> StringSQL
pComma AggregateSet -> StringSQL
showsGs [AggregateSet]
ss
composePartitionBy :: [AggregateColumnRef] -> StringSQL
composePartitionBy :: Tuple -> StringSQL
composePartitionBy = Tuple -> StringSQL
d where
d :: Tuple -> StringSQL
d [] = StringSQL
forall a. Monoid a => a
mempty
d ts :: Tuple
ts@(Column
_:Tuple
_) = StringSQL
PARTITION StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
BY StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [StringSQL] -> StringSQL
commaed ((Column -> StringSQL) -> Tuple -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map Column -> StringSQL
showColumn Tuple
ts)
composeOrderBy :: [OrderingTerm] -> StringSQL
composeOrderBy :: [OrderingTerm] -> StringSQL
composeOrderBy = [OrderingTerm] -> StringSQL
d where
d :: [OrderingTerm] -> StringSQL
d [] = StringSQL
forall a. Monoid a => a
mempty
d ts :: [OrderingTerm]
ts@(OrderingTerm
_:[OrderingTerm]
_) = StringSQL
ORDER StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
BY StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> (StringSQL -> StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
(|*|) ((OrderingTerm -> StringSQL) -> [OrderingTerm] -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map OrderingTerm -> StringSQL
showsOt [OrderingTerm]
ts)
showsOt :: OrderingTerm -> StringSQL
showsOt ((Order
o, Maybe Nulls
mn), Column
e) = Column -> StringSQL
showColumn Column
e StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> Order -> StringSQL
order Order
o StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL -> (Nulls -> StringSQL) -> Maybe Nulls -> StringSQL
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StringSQL
forall a. Monoid a => a
mempty ((StringSQL
NULLS StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<>) (StringSQL -> StringSQL)
-> (Nulls -> StringSQL) -> Nulls -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nulls -> StringSQL
nulls) Maybe Nulls
mn
order :: Order -> StringSQL
order Order
Asc = StringSQL
ASC
order Order
Desc = StringSQL
DESC
nulls :: Nulls -> StringSQL
nulls Nulls
NullsFirst = StringSQL
FIRST
nulls Nulls
NullsLast = StringSQL
LAST