module Database.Relational.SqlSyntax.Query (
flatSubQuery, aggregatedSubQuery,
union, except, intersect,
caseSearch, case',
composeOrderBy,
) where
import Data.Monoid (mempty, (<>))
import Language.SQL.Keyword (Keyword(..), (|*|))
import qualified Language.SQL.Keyword as SQL
import Database.Relational.Internal.Config (Config)
import Database.Relational.Internal.ContextType (Flat, Aggregated)
import Database.Relational.Internal.String (StringSQL)
import Database.Relational.SqlSyntax.Types
(Duplication (..), SetOp (..), BinOp (..),
Order (..), Nulls (..), OrderingTerm, AggregateElem,
JoinProduct, Predicate, WhenClauses (..), CaseClause (..), SubQuery (..),
Column (..), Tuple, Record, record, untypeRecord, recordWidth, )
flatSubQuery :: Config
-> Tuple
-> Duplication
-> JoinProduct
-> [Predicate Flat]
-> [OrderingTerm]
-> SubQuery
flatSubQuery = Flat
aggregatedSubQuery :: Config
-> Tuple
-> Duplication
-> JoinProduct
-> [Predicate Flat]
-> [AggregateElem]
-> [Predicate Aggregated]
-> [OrderingTerm]
-> SubQuery
aggregatedSubQuery = Aggregated
setBin :: SetOp -> Duplication -> SubQuery -> SubQuery -> SubQuery
setBin op = Bin . BinOp . (,) op
union :: Duplication -> SubQuery -> SubQuery -> SubQuery
union = setBin Union
except :: Duplication -> SubQuery -> SubQuery -> SubQuery
except = setBin Except
intersect :: Duplication -> SubQuery -> SubQuery -> SubQuery
intersect = setBin Intersect
whenClauses :: String
-> [(Record c a, Record c b)]
-> Record c b
-> WhenClauses
whenClauses eTag ws0 e = d ws0
where
d [] = error $ eTag ++ ": Empty when clauses!"
d ws@(_:_) =
WhenClauses [ (untypeRecord p, untypeRecord r) | (p, r) <- ws ]
$ untypeRecord e
caseSearch :: [(Predicate c, Record c a)]
-> Record c a
-> Record c a
caseSearch ws e =
record [ Case c i | i <- [0 .. recordWidth e 1] ]
where
c = CaseSearch $ whenClauses "caseSearch" ws e
case' :: Record c a
-> [(Record c a, Record c b)]
-> Record c b
-> Record c b
case' v ws e =
record [ Case c i | i <- [0 .. recordWidth e 1] ]
where
c = CaseSimple (untypeRecord v) $ whenClauses "case'" ws e
composeOrderBy :: [OrderingTerm] -> StringSQL
composeOrderBy = d where
d [] = mempty
d ts@(_:_) = ORDER <> BY <> SQL.fold (|*|) (map showsOt ts)
showsOt ((o, mn), e) = e <> order o <> maybe mempty ((NULLS <>) . nulls) mn
order Asc = ASC
order Desc = DESC
nulls NullsFirst = FIRST
nulls NullsLast = LAST