{-# 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 All = StringSQL
ALL
dup Distinct = StringSQL
DISTINCT
showsSetOp' :: SetOp -> StringSQL
showsSetOp' :: SetOp -> StringSQL
showsSetOp' = SetOp -> StringSQL
d where
d :: SetOp -> StringSQL
d Union = StringSQL
UNION
d Except = StringSQL
EXCEPT
d Intersect = StringSQL
INTERSECT
showsSetOp :: SetOp -> Duplication -> StringSQL
showsSetOp :: SetOp -> Duplication -> StringSQL
showsSetOp op :: SetOp
op dup0 :: 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 Distinct = StringSQL
forall a. Monoid a => a
mempty
showQualifier :: Qualifier -> StringSQL
showQualifier :: Qualifier -> StringSQL
showQualifier (Qualifier i :: Int
i) = String -> StringSQL
stringSQL (String -> StringSQL) -> String -> StringSQL
forall a b. (a -> b) -> a -> b
$ 'T' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i
(<.>) :: Qualifier -> StringSQL -> StringSQL
i :: Qualifier
i <.> :: Qualifier -> StringSQL -> StringSQL
<.> n :: StringSQL
n = Qualifier -> StringSQL
showQualifier Qualifier
i StringSQL -> StringSQL -> StringSQL
SQL.<.> StringSQL
n
columnN :: Int -> StringSQL
columnN :: Int -> StringSQL
columnN i :: Int
i = String -> StringSQL
stringSQL (String -> StringSQL) -> String -> StringSQL
forall a b. (a -> b) -> a -> b
$ 'f' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i
asColumnN :: StringSQL -> Int -> StringSQL
c :: StringSQL
c asColumnN :: StringSQL -> Int -> StringSQL
`asColumnN` n :: Int
n =StringSQL
c StringSQL -> StringSQL -> StringSQL
`SQL.as` Int -> StringSQL
columnN Int
n
columnFromId :: Qualifier -> Int -> StringSQL
columnFromId :: Qualifier -> Int -> StringSQL
columnFromId qi :: Qualifier
qi i :: 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 u :: Untyped
u) = Untyped -> Int
UntypedTable.width' Untyped
u
d (Bin _ l :: SubQuery
l _) = SubQuery -> Int
width SubQuery
l
d (Flat _ up :: Tuple
up _ _ _ _) = Tuple -> Int
Syntax.tupleWidth Tuple
up
d (Aggregated _ up :: Tuple
up _ _ _ _ _ _) = 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 t :: 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 t :: 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)
[(0 :: Int)..]
selectPrefixSQL :: Tuple -> Duplication -> StringSQL
selectPrefixSQL :: Tuple -> Duplication -> StringSQL
selectPrefixSQL up :: Tuple
up da :: 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)
[(0 :: Int)..]
normalizedSQL :: SubQuery -> StringSQL
normalizedSQL :: SubQuery -> StringSQL
normalizedSQL = SubQuery -> StringSQL
d where
d :: SubQuery -> StringSQL
d (Table t :: Untyped
t) = Untyped -> StringSQL
fromTableToNormalizedSQL Untyped
t
d sub :: SubQuery
sub@(Bin {}) = SubQuery -> StringSQL
showUnitSQL SubQuery
sub
d sub :: SubQuery
sub@(Flat _ _ _ _ _ ots :: [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 _ _ _ _ _ _ _ ots :: [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 u :: 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 (op :: SetOp
op, da :: Duplication
da)) l :: SubQuery
l r :: 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 cf :: Config
cf up :: Tuple
up da :: Duplication
da pd :: JoinProduct
pd rs :: [Predicate Flat]
rs od :: [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 cf :: Config
cf up :: Tuple
up da :: Duplication
da pd :: JoinProduct
pd rs :: [Predicate Flat]
rs ag :: [AggregateElem]
ag grs :: [Predicate Aggregated]
grs od :: [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 addAS :: Bool
addAS qq :: 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 qs :: 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 u :: Untyped
u) i :: Int
i = Qualifier
q Qualifier -> StringSQL -> StringSQL
<.> (Untyped
u Untyped -> Int -> StringSQL
! Int
i)
d (Bin {}) i :: Int
i = Qualifier
q Qualifier -> Int -> StringSQL
`columnFromId` Int
i
d (Flat _ up :: Tuple
up _ _ _ _) i :: Int
i = Tuple -> Int -> StringSQL
showTupleIndex Tuple
up Int
i
d (Aggregated _ up :: Tuple
up _ _ _ _ _ _) i :: Int
i = Tuple -> Int -> StringSQL
showTupleIndex Tuple
up Int
i
tupleFromJoinedSubQuery :: Qualified SubQuery -> Tuple
tupleFromJoinedSubQuery :: Qualified SubQuery -> Tuple
tupleFromJoinedSubQuery qs :: 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 (\q :: SubQuery
q -> [0 .. SubQuery -> Int
width SubQuery
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]) Qualified SubQuery
qs
d :: SubQuery -> Tuple
d (Table _) = (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) [0..]
d (Bin {}) = Tuple
normalized
d (Flat {}) = Tuple
normalized
d (Aggregated {}) = Tuple
normalized
indexWhensClause :: WhenClauses -> Int -> StringSQL
indexWhensClause :: WhenClauses -> Int -> StringSQL
indexWhensClause (WhenClauses ps :: [(Tuple, Tuple)]
ps e :: Tuple
e) i :: Int
i =
[StringSQL] -> StringSQL
forall a. Monoid a => [a] -> a
mconcat [ Tuple -> Tuple -> StringSQL
when' Tuple
p Tuple
r | (p :: Tuple
p, r :: 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' p :: Tuple
p r :: 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 c :: CaseClause
c i :: Int
i = CaseClause -> StringSQL
d CaseClause
c where
d :: CaseClause -> StringSQL
d (CaseSearch wcl :: 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 m :: Tuple
m wcl :: 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 e :: StringSQL
e) = StringSQL
e
d (SubQueryRef qi :: 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 sub :: SubQuery
sub) = SubQuery -> StringSQL
showUnitSQL SubQuery
sub
d (Case c :: CaseClause
c i :: Int
i) = CaseClause -> Int -> StringSQL
caseClause CaseClause
c Int
i
showTupleIndex :: Tuple
-> Int
-> StringSQL
showTupleIndex :: Tuple -> Int -> StringSQL
showTupleIndex up :: Tuple
up i :: Int
i
| 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
$ "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 Just' Just' = StringSQL
INNER
joinType Just' Maybe = StringSQL
LEFT
joinType Maybe Just' = StringSQL
RIGHT
joinType Maybe Maybe = StringSQL
FULL
urec :: Node [Record c r] -> StringSQL
urec n :: 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 _) -> 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 q :: (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 left' :: Node [Record c r]
left' right' :: Node [Record c r]
right' rs :: [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 ups :: 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 qp :: 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 PUSupported = p
forall a. Monoid a => a
mempty
up PUNotSupported = String -> p
forall a. HasCallStack => String -> a
error "relation: Unit product support mode is disabled!"
composeRestrict :: Keyword -> [Predicate c] -> StringSQL
composeRestrict :: StringSQL -> [Predicate c] -> StringSQL
composeRestrict k :: 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@(_:_) = 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 qshow :: 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 ts :: 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@(_:_) = 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 op :: StringSQL
op ss :: [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 s :: [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 t :: Column
t) = Column -> StringSQL
showColumn Column
t
showsE (Rollup ss :: [AggregateBitKey]
ss) = StringSQL -> [AggregateBitKey] -> StringSQL
keyList StringSQL
ROLLUP [AggregateBitKey]
ss
showsE (Cube ss :: [AggregateBitKey]
ss) = StringSQL -> [AggregateBitKey] -> StringSQL
keyList StringSQL
CUBE [AggregateBitKey]
ss
showsE (GroupingSets ss :: [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@(_:_) = 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@(_:_) = 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 ((o :: Order
o, mn :: Maybe Nulls
mn), e :: 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 Asc = StringSQL
ASC
order Desc = StringSQL
DESC
nulls :: Nulls -> StringSQL
nulls NullsFirst = StringSQL
FIRST
nulls NullsLast = StringSQL
LAST