{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Database.Relational.SqlSyntax.Fold
-- Copyright   : 2013-2019 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines sub-query structure used in query products.
module Database.Relational.SqlSyntax.Fold (
  -- * Sub-query
  showSQL, toSQL, unitSQL, width,

  -- * Qualified Sub-query
  queryWidth, corrSubQueryTerm,

  -- * Sub-query columns
  column,

  -- * Tuple and Record
  tupleFromJoinedSubQuery,

  recordRawColumns,

  -- * Query restriction
  composeWhere, composeHaving,

  -- * Aggregation
  composeGroupBy, composePartitionBy,

  -- * Ordering
  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


-- | Compose duplication attribute string.
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

-- | Alias string from qualifier
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

-- | Binary operator to qualify.
(<.>) :: 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

-- | Qualified expression from qualifier and projection index.
columnFromId :: Qualifier -> Int -> StringSQL
columnFromId :: Qualifier -> Int -> StringSQL
columnFromId Qualifier
qi Int
i = Qualifier
qi Qualifier -> StringSQL -> StringSQL
<.> Int -> StringSQL
columnN Int
i

-- | Width of 'SubQuery'.
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

-- | Width of 'Qualified' 'SubQUery'.
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

-- | Generate SQL from table for top-level.
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)

-- | Generate normalized column SQL from table.
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)..]

-- | Generate normalized column SQL from joined tuple.
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)..]

-- | Normalized column SQL for union like operations
--   to keep compatibility with engines like Sqlite and MySQL.
--   SQL with no ordering term is not paren-ed.
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

-- | SQL string for nested-query and toplevel-SQL.
toSQLs :: SubQuery
       -> (StringSQL, StringSQL) -- ^ sub-query SQL and top-level SQL
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

-- | SQL string for nested-qeury.
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

-- | SQL StringSQL for toplevel-SQL.
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

-- | SQL string for toplevel-SQL.
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

-- | Term of qualified table or qualified subquery,
--   used in join-clause of SELECT, correlated UPDATE and DELETE statements.
--   When SubQuery is table, expression will be like <TABLE> [AS] T<n>
corrSubQueryTerm :: Bool                -- ^ if True, add AS keyword. SQLite causes syntax error on UPDATE or DELETE statement.
                 -> Qualified SubQuery  -- ^ subquery structure with qualifier
                 -> StringSQL           -- ^ result SQL string
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
(<>)

-- | Get column SQL string of 'Qualified' 'SubQuery'.
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

-- | Make untyped tuple (qualified column list) from joined sub-query ('Qualified' 'SubQuery').
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

-- | index result of each when clause and else clause.
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

-- | index result of each when clause and else clause.
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

-- | Convert from typed' Column' into column string expression.
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

-- | Get column SQL string of 'Tuple'.
showTupleIndex :: Tuple     -- ^ Source 'Tuple'
               -> Int       -- ^ Column index
               -> StringSQL -- ^ Result SQL string
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

-- | Get column SQL string list of record.
recordRawColumns :: Record c r  -- ^ Source 'Record'
                 -> [StringSQL] -- ^ Result SQL string list
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


-- | Show product tree of query into SQL. StringSQL result.
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 ]

-- | Shows join product of query.
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!"


-- | Compose SQL String from 'QueryRestriction'.
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 ]

-- | Compose WHERE clause from 'QueryRestriction'.
composeWhere :: [Predicate Flat] -> StringSQL
composeWhere :: [Predicate Flat] -> StringSQL
composeWhere =  StringSQL -> [Predicate Flat] -> StringSQL
forall c. StringSQL -> [Predicate c] -> StringSQL
composeRestrict StringSQL
WHERE

-- | Compose HAVING clause from 'QueryRestriction'.
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

-- | Compose GROUP BY clause from AggregateElem list.
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

-- | Compose PARTITION BY clause from AggregateColumnRef list.
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)

-----

-- | Compose ORDER BY clause from OrderingTerms
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