module Database.Relational.Set (
JoinRestriction,
inner', left', right', full',
inner, left, right, full,
on',
union, except, intersect,
unionAll, exceptAll, intersectAll,
union', except', intersect',
unionAll', exceptAll', intersectAll',
) where
import Data.Functor.ProductIsomorphic ((|$|), (|*|))
import Database.Relational.Internal.ContextType (Flat)
import Database.Relational.SqlSyntax
(Duplication (Distinct, All), SubQuery, Predicate, Record, )
import qualified Database.Relational.SqlSyntax as Syntax
import Database.Relational.Monad.BaseType
(Relation, unsafeTypeRelation, untypeRelation, )
import Database.Relational.Monad.Class (MonadQuery (query', queryMaybe'), on)
import Database.Relational.Monad.Simple (QuerySimple)
import Database.Relational.Projectable (PlaceHolders)
import Database.Relational.Relation (relation', relation, query, queryMaybe, )
type JoinRestriction a b = Record Flat a -> Record Flat b -> Predicate Flat
join' :: (qa -> QuerySimple (PlaceHolders pa, Record Flat a))
-> (qb -> QuerySimple (PlaceHolders pb, Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation (pa, pb) (a, b)
join' qL qR r0 r1 rs = relation' $ do
(ph0, pj0) <- qL r0
(ph1, pj1) <- qR r1
sequence_ [ on $ f pj0 pj1 | f <- rs ]
return ((,) |$| ph0 |*| ph1, (,) |$| pj0 |*| pj1)
inner' :: Relation pa a
-> Relation pb b
-> [JoinRestriction a b]
-> Relation (pa, pb) (a, b)
inner' = join' query' query'
left' :: Relation pa a
-> Relation pb b
-> [JoinRestriction a (Maybe b)]
-> Relation (pa, pb) (a, Maybe b)
left' = join' query' queryMaybe'
right' :: Relation pa a
-> Relation pb b
-> [JoinRestriction (Maybe a) b]
-> Relation (pa, pb)(Maybe a, b)
right' = join' queryMaybe' query'
full' :: Relation pa a
-> Relation pb b
-> [JoinRestriction (Maybe a) (Maybe b)]
-> Relation (pa, pb) (Maybe a, Maybe b)
full' = join' queryMaybe' queryMaybe'
join_ :: (qa -> QuerySimple (Record Flat a))
-> (qb -> QuerySimple (Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation () (a, b)
join_ qL qR r0 r1 rs = relation $ do
pj0 <- qL r0
pj1 <- qR r1
sequence_ [ on $ f pj0 pj1 | f <- rs ]
return $ (,) |$| pj0 |*| pj1
inner :: Relation () a
-> Relation () b
-> [JoinRestriction a b]
-> Relation () (a, b)
inner = join_ query query
left :: Relation () a
-> Relation () b
-> [JoinRestriction a (Maybe b)]
-> Relation () (a, Maybe b)
left = join_ query queryMaybe
right :: Relation () a
-> Relation () b
-> [JoinRestriction (Maybe a) b]
-> Relation () (Maybe a, b)
right = join_ queryMaybe query
full :: Relation () a
-> Relation () b
-> [JoinRestriction (Maybe a) (Maybe b)]
-> Relation () (Maybe a, Maybe b)
full = join_ queryMaybe queryMaybe
on' :: ([JoinRestriction a b] -> Relation pc (a, b))
-> [JoinRestriction a b]
-> Relation pc (a, b)
on' = ($)
infixl 8 `inner'`, `left'`, `right'`, `full'`, `inner`, `left`, `right`, `full`, `on'`
unsafeLiftAppend :: (SubQuery -> SubQuery -> SubQuery)
-> Relation p a
-> Relation q a
-> Relation r a
unsafeLiftAppend op a0 a1 = unsafeTypeRelation $ do
s0 <- untypeRelation a0
s1 <- untypeRelation a1
return $ s0 `op` s1
liftAppend :: (SubQuery -> SubQuery -> SubQuery)
-> Relation () a
-> Relation () a
-> Relation () a
liftAppend = unsafeLiftAppend
union :: Relation () a -> Relation () a -> Relation () a
union = liftAppend $ Syntax.union Distinct
unionAll :: Relation () a -> Relation () a -> Relation () a
unionAll = liftAppend $ Syntax.union All
except :: Relation () a -> Relation () a -> Relation () a
except = liftAppend $ Syntax.except Distinct
exceptAll :: Relation () a -> Relation () a -> Relation () a
exceptAll = liftAppend $ Syntax.except All
intersect :: Relation () a -> Relation () a -> Relation () a
intersect = liftAppend $ Syntax.intersect Distinct
intersectAll :: Relation () a -> Relation () a -> Relation () a
intersectAll = liftAppend $ Syntax.intersect All
liftAppend' :: (SubQuery -> SubQuery -> SubQuery)
-> Relation p a
-> Relation q a
-> Relation (p, q) a
liftAppend' = unsafeLiftAppend
union' :: Relation p a -> Relation q a -> Relation (p, q) a
union' = liftAppend' $ Syntax.union Distinct
unionAll' :: Relation p a -> Relation q a -> Relation (p, q) a
unionAll' = liftAppend' $ Syntax.union All
except' :: Relation p a -> Relation q a -> Relation (p, q) a
except' = liftAppend' $ Syntax.except Distinct
exceptAll' :: Relation p a -> Relation q a -> Relation (p, q) a
exceptAll' = liftAppend' $ Syntax.except All
intersect' :: Relation p a -> Relation q a -> Relation (p, q) a
intersect' = liftAppend' $ Syntax.intersect Distinct
intersectAll' :: Relation p a -> Relation q a -> Relation (p, q) a
intersectAll' = liftAppend' $ Syntax.intersect All
infixl 7 `union`, `except`, `unionAll`, `exceptAll`
infixl 8 `intersect`, `intersectAll`
infixl 7 `union'`, `except'`, `unionAll'`, `exceptAll'`
infixl 8 `intersect'`, `intersectAll'`