{-# LANGUAGE FlexibleContexts #-}
module Database.Relational.Relation (
table, derivedRelation, tableOf,
relation, relation',
aggregateRelation, aggregateRelation',
UniqueRelation,
unsafeUnique, unUnique,
uniqueRelation', aggregatedUnique,
query, queryMaybe, queryList, queryList', queryScalar, queryScalar',
uniqueQuery', uniqueQueryMaybe',
) where
import Control.Applicative ((<$>))
import Database.Relational.Internal.ContextType (Flat, Aggregated)
import Database.Relational.SqlSyntax (NodeAttr(Just', Maybe), Record, )
import Database.Relational.Monad.BaseType
(ConfigureQuery, qualifyQuery,
Relation, unsafeTypeRelation, untypeRelation, relationWidth)
import Database.Relational.Monad.Class
(MonadQualify (liftQualify), MonadQuery (query', queryMaybe'), )
import Database.Relational.Monad.Simple (QuerySimple, SimpleQuery)
import qualified Database.Relational.Monad.Simple as Simple
import Database.Relational.Monad.Aggregate (QueryAggregate, AggregatedQuery)
import qualified Database.Relational.Monad.Aggregate as Aggregate
import Database.Relational.Monad.Unique (QueryUnique, unsafeUniqueSubQuery)
import qualified Database.Relational.Monad.Unique as Unique
import Database.Relational.Table (Table, TableDerivable, derivedTable)
import qualified Database.Relational.Table as Table
import Database.Relational.Scalar (ScalarDegree)
import Database.Relational.Pi (Pi)
import Database.Relational.Record (RecordList)
import qualified Database.Relational.Record as Record
import Database.Relational.Projectable
(PlaceHolders, unitPlaceHolder, unsafeAddPlaceHolders, unsafePlaceHolders, )
table :: Table r -> Relation () r
table = unsafeTypeRelation . return . Table.toSubQuery
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 (Record Flat r)
query = fmap snd . query'
queryMaybe :: (MonadQualify ConfigureQuery m, MonadQuery m)
=> Relation () r
-> m (Record Flat (Maybe r))
queryMaybe = fmap snd . queryMaybe'
queryList0 :: MonadQualify ConfigureQuery m => Relation p r -> m (RecordList (Record c) r)
queryList0 = liftQualify
. fmap Record.unsafeListFromSubQuery
. untypeRelation
queryList' :: MonadQualify ConfigureQuery m
=> Relation p r
-> m (PlaceHolders p, RecordList (Record c) r)
queryList' rel = do
ql <- queryList0 rel
return (placeHoldersFromRelation rel, ql)
queryList :: MonadQualify ConfigureQuery m
=> Relation () r
-> m (RecordList (Record 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 (Record Flat r) -> Relation () r
relation = relation' . addUnitPH
aggregateRelation' :: AggregatedQuery p r -> Relation p r
aggregateRelation' = unsafeTypeRelation . Aggregate.toSubQuery
aggregateRelation :: QueryAggregate (Record Aggregated r) -> Relation () r
aggregateRelation = aggregateRelation' . addUnitPH
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, Record c r)
uniqueQueryWithAttr attr = unsafeAddPlaceHolders . run where
run rel = do
q <- liftQualify $ do
sq <- untypeRelation (unUnique rel)
qualifyQuery sq
Record.unsafeChangeContext <$> unsafeUniqueSubQuery attr q
uniqueQuery' :: UniqueRelation p c r
-> QueryUnique (PlaceHolders p, Record c r)
uniqueQuery' = uniqueQueryWithAttr Just'
uniqueQueryMaybe' :: UniqueRelation p c r
-> QueryUnique (PlaceHolders p, Record c (Maybe r))
uniqueQueryMaybe' pr = do
(ph, pj) <- uniqueQueryWithAttr Maybe pr
return (ph, Record.just pj)
uniqueRelation' :: QueryUnique (PlaceHolders p, Record c r) -> UniqueRelation p c r
uniqueRelation' = unsafeUnique . unsafeTypeRelation . Unique.toSubQuery
aggregatedUnique :: Relation ph r
-> Pi r a
-> (Record Flat a -> Record Aggregated b)
-> UniqueRelation ph Flat b
aggregatedUnique rel k ag = unsafeUnique . aggregateRelation' $ do
(ph, a) <- query' rel
return (ph, ag $ Record.wpi (relationWidth rel) a k)
queryScalar' :: (MonadQualify ConfigureQuery m, ScalarDegree r)
=> UniqueRelation p c r
-> m (PlaceHolders p, Record c (Maybe r))
queryScalar' ur =
unsafeAddPlaceHolders . liftQualify $
Record.unsafeFromScalarSubQuery <$> untypeRelation (unUnique ur)
queryScalar :: (MonadQualify ConfigureQuery m, ScalarDegree r)
=> UniqueRelation () c r
-> m (Record c (Maybe r))
queryScalar = fmap snd . queryScalar'