relational-query: untype-guard: move case definitions.

This commit is contained in:
Kei Hibino 2019-05-23 00:39:13 +09:00
parent 1f97436bdf
commit 900156da6c
2 changed files with 42 additions and 39 deletions

View File

@ -11,17 +11,14 @@
module Database.Relational.SqlSyntax.Query (
flatSubQuery, aggregatedSubQuery,
union, except, intersect,
caseSearch, case',
) where
import Database.Relational.Internal.Config (Config)
import Database.Relational.SqlSyntax.Types
(Duplication (..), SetOp (..), BinOp (..),
OrderingTerm, AggregateElem,
JoinProduct, WhenClauses (..), CaseClause (..), SubQuery (..),
Column (..), Tuple, Guard, )
import Database.Relational.SqlSyntax.Record
(Predicate, Record, record, untypeRecord, recordWidth, )
JoinProduct, SubQuery (..),
Tuple, Guard, )
-- | Unsafely generate flat 'SubQuery' from untyped components.
@ -60,36 +57,3 @@ except = setBin Except
-- | Intersect binary operator on 'SubQuery'
intersect :: Duplication -> SubQuery -> SubQuery -> SubQuery
intersect = setBin Intersect
whenClauses :: String -- ^ Error tag
-> [(Record c a, Record c b)] -- ^ Each when clauses
-> Record c b -- ^ Else result record
-> WhenClauses -- ^ Result clause
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
-- | 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 ws e =
record [ Case c i | i <- [0 .. recordWidth e - 1] ]
where
c = CaseSearch $ whenClauses "caseSearch" ws 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' v ws e =
record [ Case c i | i <- [0 .. recordWidth e - 1] ]
where
c = CaseSimple (untypeRecord v) $ whenClauses "case'" ws e

View File

@ -19,11 +19,16 @@ module Database.Relational.SqlSyntax.Record (
-- * Predicate to restrict Query result
Predicate,
-- * case records
caseSearch, case',
) where
import Database.Relational.Internal.String (StringSQL)
import Database.Relational.SqlSyntax.Fold (showColumn)
import Database.Relational.SqlSyntax.Types (SubQuery, Tuple, Column (..))
import Database.Relational.SqlSyntax.Types
(SubQuery, Tuple, Column (..),
WhenClauses (..), CaseClause (..),)
-- | Phantom typed record. Projected into Haskell record type 't'.
@ -58,3 +63,37 @@ typeFromScalarSubQuery = record . (:[]) . Scalar
recordRawColumns :: Record c r -- ^ Source 'Record'
-> [StringSQL] -- ^ Result SQL string list
recordRawColumns = map showColumn . untypeRecord
-----
whenClauses :: String -- ^ Error tag
-> [(Record c a, Record c b)] -- ^ Each when clauses
-> Record c b -- ^ Else result record
-> WhenClauses -- ^ Result clause
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
-- | 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 ws e =
record [ Case c i | i <- [0 .. recordWidth e - 1] ]
where
c = CaseSearch $ whenClauses "caseSearch" ws 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' v ws e =
record [ Case c i | i <- [0 .. recordWidth e - 1] ]
where
c = CaseSimple (untypeRecord v) $ whenClauses "case'" ws e