{-# 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 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

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

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

-- | Qualified expression from qualifier and projection index.
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 of 'SubQuery'.
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

-- | 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 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)

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

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

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

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

-- | 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 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
(<>)

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

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

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

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

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

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

-- | 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 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 ]

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


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

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

-- | 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@(_:_) = 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

-- | 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@(_:_) = 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@(_:_) = 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