-- |
-- Module      : Database.Relational.SqlSyntax.Query
-- Copyright   : 2013-2018 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides building and expanding operations of SQL query tree.
module Database.Relational.SqlSyntax.Query (
  flatSubQuery, aggregatedSubQuery,
  union, except, intersect,
  caseSearch, case',
  ) where

import Database.Relational.Internal.Config (Config)
import Database.Relational.Internal.ContextType (Flat, Aggregated)
import Database.Relational.SqlSyntax.Types
  (Duplication (..), SetOp (..), BinOp (..),
   OrderingTerm, AggregateElem,
   JoinProduct, Predicate, WhenClauses (..), CaseClause (..), SubQuery (..),
   Column (..), Tuple, Record, record, untypeRecord, recordWidth, )


-- | Unsafely generate flat 'SubQuery' from untyped components.
flatSubQuery :: Config
             -> Tuple
             -> Duplication
             -> JoinProduct
             -> [Predicate Flat]
             -> [OrderingTerm]
             -> SubQuery
flatSubQuery :: Config
-> Tuple
-> Duplication
-> JoinProduct
-> [Predicate Flat]
-> [OrderingTerm]
-> SubQuery
flatSubQuery = Config
-> Tuple
-> Duplication
-> JoinProduct
-> [Predicate Flat]
-> [OrderingTerm]
-> SubQuery
Flat

-- | Unsafely generate aggregated 'SubQuery' from untyped components.
aggregatedSubQuery :: Config
                   -> Tuple
                   -> Duplication
                   -> JoinProduct
                   -> [Predicate Flat]
                   -> [AggregateElem]
                   -> [Predicate Aggregated]
                   -> [OrderingTerm]
                   -> SubQuery
aggregatedSubQuery :: Config
-> Tuple
-> Duplication
-> JoinProduct
-> [Predicate Flat]
-> [AggregateElem]
-> [Predicate Aggregated]
-> [OrderingTerm]
-> SubQuery
aggregatedSubQuery = Config
-> Tuple
-> Duplication
-> JoinProduct
-> [Predicate Flat]
-> [AggregateElem]
-> [Predicate Aggregated]
-> [OrderingTerm]
-> SubQuery
Aggregated

setBin :: SetOp -> Duplication -> SubQuery -> SubQuery -> SubQuery
setBin :: SetOp -> Duplication -> SubQuery -> SubQuery -> SubQuery
setBin SetOp
op = BinOp -> SubQuery -> SubQuery -> SubQuery
Bin (BinOp -> SubQuery -> SubQuery -> SubQuery)
-> (Duplication -> BinOp)
-> Duplication
-> SubQuery
-> SubQuery
-> SubQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SetOp, Duplication) -> BinOp
BinOp ((SetOp, Duplication) -> BinOp)
-> (Duplication -> (SetOp, Duplication)) -> Duplication -> BinOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) SetOp
op

-- | Union binary operator on 'SubQuery'
union     :: Duplication -> SubQuery -> SubQuery -> SubQuery
union :: Duplication -> SubQuery -> SubQuery -> SubQuery
union     =  SetOp -> Duplication -> SubQuery -> SubQuery -> SubQuery
setBin SetOp
Union

-- | Except binary operator on 'SubQuery'
except    :: Duplication -> SubQuery -> SubQuery -> SubQuery
except :: Duplication -> SubQuery -> SubQuery -> SubQuery
except    =  SetOp -> Duplication -> SubQuery -> SubQuery -> SubQuery
setBin SetOp
Except

-- | Intersect binary operator on 'SubQuery'
intersect :: Duplication -> SubQuery -> SubQuery -> SubQuery
intersect :: Duplication -> SubQuery -> SubQuery -> SubQuery
intersect =  SetOp -> Duplication -> SubQuery -> SubQuery -> SubQuery
setBin SetOp
Intersect


whenClauses :: String                     -- ^ Error tag
            -> [(Record c a, Record c b)] -- ^ Each when clauses
            -> Record c b                 -- ^ Else result record
            -> WhenClauses                -- ^ Result clause
whenClauses :: String -> [(Record c a, Record c b)] -> Record c b -> WhenClauses
whenClauses String
eTag [(Record c a, Record c b)]
ws0 Record c b
e = [(Record c a, Record c b)] -> WhenClauses
forall c t c t. [(Record c t, Record c t)] -> WhenClauses
d [(Record c a, Record c b)]
ws0
  where
    d :: [(Record c t, Record c t)] -> WhenClauses
d []       = String -> WhenClauses
forall a. HasCallStack => String -> a
error (String -> WhenClauses) -> String -> WhenClauses
forall a b. (a -> b) -> a -> b
$ String
eTag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Empty when clauses!"
    d ws :: [(Record c t, Record c t)]
ws@((Record c t, Record c t)
_:[(Record c t, Record c t)]
_) =
      [(Tuple, Tuple)] -> Tuple -> WhenClauses
WhenClauses [ (Record c t -> Tuple
forall c t. Record c t -> Tuple
untypeRecord Record c t
p, Record c t -> Tuple
forall c t. Record c t -> Tuple
untypeRecord Record c t
r) | (Record c t
p, Record c t
r) <- [(Record c t, Record c t)]
ws ]
      (Tuple -> WhenClauses) -> Tuple -> WhenClauses
forall a b. (a -> b) -> a -> b
$ Record c b -> Tuple
forall c t. Record c t -> Tuple
untypeRecord Record c b
e

-- | Search case operator correnponding SQL search /CASE/.
--   Like, /CASE WHEN p0 THEN a WHEN p1 THEN b ... ELSE c END/
caseSearch :: [(Predicate c, Record c a)] -- ^ Each when clauses
           -> Record c a                  -- ^ Else result record
           -> Record c a                  -- ^ Result record
caseSearch :: [(Predicate c, Record c a)] -> Record c a -> Record c a
caseSearch [(Predicate c, Record c a)]
ws Record c a
e =
    Tuple -> Record c a
forall c t. Tuple -> Record c t
record [ CaseClause -> Int -> Column
Case CaseClause
c Int
i | Int
i <- [Int
0 .. Record c a -> Int
forall c r. Record c r -> Int
recordWidth Record c a
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]
  where
    c :: CaseClause
c = WhenClauses -> CaseClause
CaseSearch (WhenClauses -> CaseClause) -> WhenClauses -> CaseClause
forall a b. (a -> b) -> a -> b
$ String -> [(Predicate c, Record c a)] -> Record c a -> WhenClauses
forall c a b.
String -> [(Record c a, Record c b)] -> Record c b -> WhenClauses
whenClauses String
"caseSearch" [(Predicate c, Record c a)]
ws Record c a
e

-- | Simple case operator correnponding SQL simple /CASE/.
--   Like, /CASE x WHEN v THEN a WHEN w THEN b ... ELSE c END/
case' :: Record c a                 -- ^ Record value to match
      -> [(Record c a, Record c b)] -- ^ Each when clauses
      -> Record c b                 -- ^ Else result record
      -> Record c b                 -- ^ Result record
case' :: Record c a
-> [(Record c a, Record c b)] -> Record c b -> Record c b
case' Record c a
v [(Record c a, Record c b)]
ws Record c b
e =
    Tuple -> Record c b
forall c t. Tuple -> Record c t
record [ CaseClause -> Int -> Column
Case CaseClause
c Int
i | Int
i <- [Int
0 .. Record c b -> Int
forall c r. Record c r -> Int
recordWidth Record c b
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]
  where
    c :: CaseClause
c = Tuple -> WhenClauses -> CaseClause
CaseSimple (Record c a -> Tuple
forall c t. Record c t -> Tuple
untypeRecord Record c a
v) (WhenClauses -> CaseClause) -> WhenClauses -> CaseClause
forall a b. (a -> b) -> a -> b
$ String -> [(Record c a, Record c b)] -> Record c b -> WhenClauses
forall c a b.
String -> [(Record c a, Record c b)] -> Record c b -> WhenClauses
whenClauses String
"case'" [(Record c a, Record c b)]
ws Record c b
e