mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-12-27 14:02:35 +03:00
relational-query: untype-guard: move case definitions.
This commit is contained in:
parent
1f97436bdf
commit
900156da6c
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user