module Database.Relational.Query.Relation (
table, derivedRelation, tableOf,
relation, relation',
aggregateRelation, aggregateRelation',
UniqueRelation,
unsafeUnique, unUnique,
uniqueRelation', aggregatedUnique,
query, queryMaybe, queryList, queryList', queryScalar, queryScalar',
uniqueQuery', uniqueQueryMaybe',
JoinRestriction,
inner', left', right', full',
inner, left, right, full,
on',
union, except, intersect,
unionAll, exceptAll, intersectAll,
union', except', intersect',
unionAll', exceptAll', intersectAll',
) where
import Control.Applicative ((<$>))
import Database.Relational.Query.Internal.BaseSQL (Duplication (Distinct, All))
import Database.Relational.Query.Context (Flat, Aggregated)
import Database.Relational.Query.Monad.BaseType
(ConfigureQuery, qualifyQuery,
Relation, unsafeTypeRelation, untypeRelation, relationWidth)
import Database.Relational.Query.Monad.Class
(MonadQualify (liftQualify), MonadQuery (query', queryMaybe'), on)
import Database.Relational.Query.Monad.Simple (QuerySimple, SimpleQuery)
import qualified Database.Relational.Query.Monad.Simple as Simple
import Database.Relational.Query.Monad.Aggregate (QueryAggregate, AggregatedQuery)
import qualified Database.Relational.Query.Monad.Aggregate as Aggregate
import Database.Relational.Query.Monad.Unique (QueryUnique, unsafeUniqueSubQuery)
import qualified Database.Relational.Query.Monad.Unique as Unique
import Database.Relational.Query.Table (Table, TableDerivable, derivedTable)
import Database.Relational.Query.Sub (SubQuery, NodeAttr(Just', Maybe))
import qualified Database.Relational.Query.Sub as SubQuery
import Database.Relational.Query.Scalar (ScalarDegree)
import Database.Relational.Query.Pi (Pi)
import Database.Relational.Query.Projection
(Projection, ListProjection)
import qualified Database.Relational.Query.Projection as Projection
import Database.Relational.Query.Projectable
(PlaceHolders, unitPlaceHolder, unsafeAddPlaceHolders, unsafePlaceHolders, projectZip)
table :: Table r -> Relation () r
table = unsafeTypeRelation . return . SubQuery.fromTable
derivedRelation :: TableDerivable r => Relation () r
derivedRelation = table derivedTable
tableOf :: TableDerivable r => Relation () r -> Table r
tableOf = const derivedTable
placeHoldersFromRelation :: Relation p r -> PlaceHolders p
placeHoldersFromRelation = const unsafePlaceHolders
query :: (MonadQualify ConfigureQuery m, MonadQuery m)
=> Relation () r
-> m (Projection Flat r)
query = fmap snd . query'
queryMaybe :: (MonadQualify ConfigureQuery m, MonadQuery m)
=> Relation () r
-> m (Projection Flat (Maybe r))
queryMaybe = fmap snd . queryMaybe'
queryList0 :: MonadQualify ConfigureQuery m => Relation p r -> m (ListProjection (Projection c) r)
queryList0 = liftQualify
. fmap Projection.unsafeListFromSubQuery
. untypeRelation
queryList' :: MonadQualify ConfigureQuery m
=> Relation p r
-> m (PlaceHolders p, ListProjection (Projection c) r)
queryList' rel = do
ql <- queryList0 rel
return (placeHoldersFromRelation rel, ql)
queryList :: MonadQualify ConfigureQuery m
=> Relation () r
-> m (ListProjection (Projection c) r)
queryList = queryList0
addUnitPH :: Functor f => f t -> f (PlaceHolders (), t)
addUnitPH = ((,) unitPlaceHolder <$>)
relation' :: SimpleQuery p r -> Relation p r
relation' = unsafeTypeRelation . Simple.toSubQuery
relation :: QuerySimple (Projection Flat r) -> Relation () r
relation = relation' . addUnitPH
aggregateRelation' :: AggregatedQuery p r -> Relation p r
aggregateRelation' = unsafeTypeRelation . Aggregate.toSubQuery
aggregateRelation :: QueryAggregate (Projection Aggregated r) -> Relation () r
aggregateRelation = aggregateRelation' . addUnitPH
type JoinRestriction a b = Projection Flat a -> Projection Flat b -> Projection Flat (Maybe Bool)
join' :: (qa -> QuerySimple (PlaceHolders pa, Projection Flat a))
-> (qb -> QuerySimple (PlaceHolders pb, Projection 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 `projectZip` ph1, pj0 `projectZip` 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 (Projection Flat a))
-> (qb -> QuerySimple (Projection 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 `projectZip` 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 $ SubQuery.union Distinct
unionAll :: Relation () a -> Relation () a -> Relation () a
unionAll = liftAppend $ SubQuery.union All
except :: Relation () a -> Relation () a -> Relation () a
except = liftAppend $ SubQuery.except Distinct
exceptAll :: Relation () a -> Relation () a -> Relation () a
exceptAll = liftAppend $ SubQuery.except All
intersect :: Relation () a -> Relation () a -> Relation () a
intersect = liftAppend $ SubQuery.intersect Distinct
intersectAll :: Relation () a -> Relation () a -> Relation () a
intersectAll = liftAppend $ SubQuery.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' $ SubQuery.union Distinct
unionAll' :: Relation p a -> Relation q a -> Relation (p, q) a
unionAll' = liftAppend' $ SubQuery.union All
except' :: Relation p a -> Relation q a -> Relation (p, q) a
except' = liftAppend' $ SubQuery.except Distinct
exceptAll' :: Relation p a -> Relation q a -> Relation (p, q) a
exceptAll' = liftAppend' $ SubQuery.except All
intersect' :: Relation p a -> Relation q a -> Relation (p, q) a
intersect' = liftAppend' $ SubQuery.intersect Distinct
intersectAll' :: Relation p a -> Relation q a -> Relation (p, q) a
intersectAll' = liftAppend' $ SubQuery.intersect All
infixl 7 `union`, `except`, `unionAll`, `exceptAll`
infixl 8 `intersect`, `intersectAll`
infixl 7 `union'`, `except'`, `unionAll'`, `exceptAll'`
infixl 8 `intersect'`, `intersectAll'`
newtype UniqueRelation p c r = Unique (Relation p r)
unsafeUnique :: Relation p r -> UniqueRelation p c r
unsafeUnique = Unique
unUnique :: UniqueRelation p c r -> Relation p r
unUnique (Unique r) = r
uniqueQueryWithAttr :: NodeAttr
-> UniqueRelation p c r
-> QueryUnique (PlaceHolders p, Projection c r)
uniqueQueryWithAttr attr = unsafeAddPlaceHolders . run where
run rel = do
q <- liftQualify $ do
sq <- untypeRelation (unUnique rel)
qualifyQuery sq
Projection.unsafeChangeContext <$> unsafeUniqueSubQuery attr q
uniqueQuery' :: UniqueRelation p c r
-> QueryUnique (PlaceHolders p, Projection c r)
uniqueQuery' = uniqueQueryWithAttr Just'
uniqueQueryMaybe' :: UniqueRelation p c r
-> QueryUnique (PlaceHolders p, Projection c (Maybe r))
uniqueQueryMaybe' pr = do
(ph, pj) <- uniqueQueryWithAttr Maybe pr
return (ph, Projection.just pj)
uniqueRelation' :: QueryUnique (PlaceHolders p, Projection c r) -> UniqueRelation p c r
uniqueRelation' = unsafeUnique . unsafeTypeRelation . Unique.toSubQuery
aggregatedUnique :: Relation ph r
-> Pi r a
-> (Projection Flat a -> Projection Aggregated b)
-> UniqueRelation ph Flat b
aggregatedUnique rel k ag = unsafeUnique . aggregateRelation' $ do
(ph, a) <- query' rel
return (ph, ag $ Projection.wpi (relationWidth rel) a k)
queryScalar' :: (MonadQualify ConfigureQuery m, ScalarDegree r)
=> UniqueRelation p c r
-> m (PlaceHolders p, Projection c (Maybe r))
queryScalar' ur =
unsafeAddPlaceHolders . liftQualify $
Projection.unsafeFromScalarSubQuery <$> untypeRelation (unUnique ur)
queryScalar :: (MonadQualify ConfigureQuery m, ScalarDegree r)
=> UniqueRelation () c r
-> m (Projection c (Maybe r))
queryScalar = fmap snd . queryScalar'