relational-query 0.5.2.0 → 0.6.0.0
raw patch · 19 files changed
+335/−319 lines, 19 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Database.Relational.Query.Monad.Aggregate: instance MonadQualify ConfigureQuery QueryAggregate
- Database.Relational.Query.Monad.Aggregate: partitionBy :: Projection c r -> Window c ()
- Database.Relational.Query.Monad.Assign: instance MonadQualify ConfigureQuery (Assign r)
- Database.Relational.Query.Monad.Class: class (Functor q, Monad q, MonadQuery m) => MonadQualifyUnique q m
- Database.Relational.Query.Monad.Class: liftQualifyUnique :: MonadQualifyUnique q m => q a -> m a
- Database.Relational.Query.Monad.Class: unsafeAddAggregateElement :: MonadAggregate m => AggregateElem -> m ()
- Database.Relational.Query.Monad.Class: unsafeAddPartitionKey :: MonadPartition m => AggregateColumnRef -> m ()
- Database.Relational.Query.Monad.Class: unsafeSubQuery :: MonadQuery m => NodeAttr -> Qualified SubQuery -> m (Projection Flat r)
- Database.Relational.Query.Monad.Simple: instance MonadQualify ConfigureQuery (Orderings Flat QueryCore)
- Database.Relational.Query.Monad.Trans.Aggregating: data AggregateKey a
- Database.Relational.Query.Monad.Trans.Aggregating: groupBy' :: MonadAggregate m => AggregateKey a -> m a
- Database.Relational.Query.Monad.Trans.Aggregating: instance Monad m => MonadPartition (PartitioningSetT c m)
- Database.Relational.Query.Monad.Trans.Join: instance (Monad q, Functor q) => MonadQuery (QueryJoin q)
- Database.Relational.Query.Monad.Trans.Ordering: instance MonadPartition m => MonadPartition (Orderings c m)
- Database.Relational.Query.Monad.Type: askConfig :: ConfigureQuery Config
- Database.Relational.Query.Monad.Type: configureQuery :: ConfigureQuery q -> Config -> q
- Database.Relational.Query.Monad.Type: qualifyQuery :: a -> ConfigureQuery (Qualified a)
- Database.Relational.Query.Monad.Type: type ConfigureQuery = Qualify (QueryConfig Identity)
- Database.Relational.Query.Monad.Unique: instance MonadQualifyUnique ConfigureQuery QueryUnique
- Database.Relational.Query.Relation: dump :: Relation p r -> String
- Database.Relational.Query.Relation: instance Show (Relation p r)
- Database.Relational.Query.Relation: leftPh :: Relation (p, ()) r -> Relation p r
- Database.Relational.Query.Relation: query' :: (MonadQualify ConfigureQuery m, MonadQuery m) => Relation p r -> m (PlaceHolders p, Projection Flat r)
- Database.Relational.Query.Relation: queryMaybe' :: (MonadQualify ConfigureQuery m, MonadQuery m) => Relation p r -> m (PlaceHolders p, Projection Flat (Maybe r))
- Database.Relational.Query.Relation: rightPh :: Relation ((), p) r -> Relation p r
- Database.Relational.Query.Relation: sqlFromRelation :: Relation p r -> StringSQL
- Database.Relational.Query.Relation: sqlFromRelationWith :: Relation p r -> Config -> StringSQL
+ Database.Relational.Query.Component: aggregateKeyElement :: AggregateKey a -> AggregateElem
+ Database.Relational.Query.Component: aggregateKeyProjection :: AggregateKey a -> a
+ Database.Relational.Query.Component: data AggregateKey a
+ Database.Relational.Query.Component: unsafeAggregateKey :: (a, AggregateElem) -> AggregateKey a
+ Database.Relational.Query.Monad.BaseType: askConfig :: ConfigureQuery Config
+ Database.Relational.Query.Monad.BaseType: configureQuery :: ConfigureQuery q -> Config -> q
+ Database.Relational.Query.Monad.BaseType: data Relation p r
+ Database.Relational.Query.Monad.BaseType: dump :: Relation p r -> String
+ Database.Relational.Query.Monad.BaseType: instance Show (Relation p r)
+ Database.Relational.Query.Monad.BaseType: leftPh :: Relation (p, ()) r -> Relation p r
+ Database.Relational.Query.Monad.BaseType: qualifyQuery :: a -> ConfigureQuery (Qualified a)
+ Database.Relational.Query.Monad.BaseType: rightPh :: Relation ((), p) r -> Relation p r
+ Database.Relational.Query.Monad.BaseType: sqlFromRelation :: Relation p r -> StringSQL
+ Database.Relational.Query.Monad.BaseType: sqlFromRelationWith :: Relation p r -> Config -> StringSQL
+ Database.Relational.Query.Monad.BaseType: type ConfigureQuery = Qualify (QueryConfig Identity)
+ Database.Relational.Query.Monad.BaseType: unsafeTypeRelation :: ConfigureQuery SubQuery -> Relation p r
+ Database.Relational.Query.Monad.BaseType: untypeRelation :: Relation p r -> ConfigureQuery SubQuery
+ Database.Relational.Query.Monad.Class: groupBy' :: MonadAggregate m => AggregateKey (Projection Aggregated r) -> m (Projection Aggregated r)
+ Database.Relational.Query.Monad.Class: instance (Functor q, Monad q) => MonadQualify q q
+ Database.Relational.Query.Monad.Class: partitionBy :: MonadPartition c m => Projection c r -> m ()
+ Database.Relational.Query.Monad.Class: query' :: MonadQuery m => Relation p r -> m (PlaceHolders p, Projection Flat r)
+ Database.Relational.Query.Monad.Class: queryMaybe' :: MonadQuery m => Relation p r -> m (PlaceHolders p, Projection Flat (Maybe r))
+ Database.Relational.Query.Monad.Trans.Aggregating: instance Monad m => MonadPartition c (PartitioningSetT c m)
+ Database.Relational.Query.Monad.Trans.Aggregating: instance MonadQualify q m => MonadQualify q (AggregatingSetT m)
+ Database.Relational.Query.Monad.Trans.Join: instance MonadQualify q m => MonadQualify q (QueryJoin m)
+ Database.Relational.Query.Monad.Trans.Join: instance MonadQuery (QueryJoin ConfigureQuery)
+ Database.Relational.Query.Monad.Trans.Join: unsafeSubQueryWithAttr :: Monad q => NodeAttr -> Qualified SubQuery -> QueryJoin q (Projection c r)
+ Database.Relational.Query.Monad.Trans.Ordering: instance MonadPartition c m => MonadPartition c (Orderings c m)
+ Database.Relational.Query.Monad.Trans.Ordering: instance MonadQualify q m => MonadQualify q (Orderings c m)
+ Database.Relational.Query.Monad.Trans.Restricting: instance MonadQualify q m => MonadQualify q (Restrictings c m)
+ Database.Relational.Query.Monad.Unique: instance MonadQualify ConfigureQuery QueryUnique
+ Database.Relational.Query.Monad.Unique: unsafeUniqueSubQuery :: NodeAttr -> Qualified SubQuery -> QueryUnique (Projection c r)
- Database.Relational.Query.Arrow: groupBy' :: MonadAggregate m => QueryA m (AggregateKey a) a
+ Database.Relational.Query.Arrow: groupBy' :: MonadAggregate m => QueryA m (AggregateKey (Projection Aggregated r)) (Projection Aggregated r)
- Database.Relational.Query.Arrow: uniqueQuery' :: MonadQualifyUnique ConfigureQuery m => UniqueRelation p c r -> QueryA m () (PlaceHolders p, Projection c r)
+ Database.Relational.Query.Arrow: uniqueQuery' :: UniqueRelation p c r -> QueryA QueryUnique () (PlaceHolders p, Projection c r)
- Database.Relational.Query.Arrow: uniqueQueryMaybe' :: MonadQualifyUnique ConfigureQuery m => UniqueRelation p c r -> QueryA m () (PlaceHolders p, Projection c (Maybe r))
+ Database.Relational.Query.Arrow: uniqueQueryMaybe' :: UniqueRelation p c r -> QueryA QueryUnique () (PlaceHolders p, Projection c (Maybe r))
- Database.Relational.Query.Monad.Class: class Monad m => MonadPartition m
+ Database.Relational.Query.Monad.Class: class Monad m => MonadPartition c m
- Database.Relational.Query.Monad.Class: class (Functor m, Monad m) => MonadQuery m
+ Database.Relational.Query.Monad.Class: class (Functor m, Monad m, MonadQualify ConfigureQuery m) => MonadQuery m
- Database.Relational.Query.Relation: uniqueQuery' :: MonadQualifyUnique ConfigureQuery m => UniqueRelation p c r -> m (PlaceHolders p, Projection c r)
+ Database.Relational.Query.Relation: uniqueQuery' :: UniqueRelation p c r -> QueryUnique (PlaceHolders p, Projection c r)
- Database.Relational.Query.Relation: uniqueQueryMaybe' :: MonadQualifyUnique ConfigureQuery m => UniqueRelation p c r -> m (PlaceHolders p, Projection c (Maybe r))
+ Database.Relational.Query.Relation: uniqueQueryMaybe' :: UniqueRelation p c r -> QueryUnique (PlaceHolders p, Projection c (Maybe r))
Files
- ChangeLog.md +5/−0
- relational-query.cabal +2/−1
- src/Database/Relational/Query.hs +10/−4
- src/Database/Relational/Query/Arrow.hs +6/−9
- src/Database/Relational/Query/Component.hs +44/−26
- src/Database/Relational/Query/Monad/Aggregate.hs +6/−19
- src/Database/Relational/Query/Monad/Assign.hs +0/−8
- src/Database/Relational/Query/Monad/BaseType.hs +86/−0
- src/Database/Relational/Query/Monad/Class.hs +29/−39
- src/Database/Relational/Query/Monad/Restrict.hs +1/−1
- src/Database/Relational/Query/Monad/Simple.hs +2/−7
- src/Database/Relational/Query/Monad/Trans/Aggregating.hs +34/−38
- src/Database/Relational/Query/Monad/Trans/Join.hs +38/−14
- src/Database/Relational/Query/Monad/Trans/Ordering.hs +11/−5
- src/Database/Relational/Query/Monad/Trans/Restricting.hs +10/−3
- src/Database/Relational/Query/Monad/Type.hs +8/−26
- src/Database/Relational/Query/Monad/Unique.hs +16/−15
- src/Database/Relational/Query/Relation.hs +25/−103
- src/Database/Relational/Query/Type.hs +2/−1
ChangeLog.md view
@@ -1,3 +1,8 @@+## 0.6.0.0++- Increase type safety of interfaces.+- Simplify interfaces arond unique query.+ ## 0.5.2.0 - Add MonadTrans instance of QueryJoin.
relational-query.cabal view
@@ -1,5 +1,5 @@ name: relational-query-version: 0.5.2.0+version: 0.6.0.0 synopsis: Typeful, Modular, Relational, algebraic query engine description: This package contiains typeful relation structure and relational-algebraic query building DSL which can@@ -39,6 +39,7 @@ Database.Relational.Query.Component Database.Relational.Query.Sub Database.Relational.Query.Projection+ Database.Relational.Query.Monad.BaseType Database.Relational.Query.Monad.Class Database.Relational.Query.Monad.Trans.Ordering Database.Relational.Query.Monad.Trans.Aggregating
src/Database/Relational/Query.hs view
@@ -25,6 +25,7 @@ module Database.Relational.Query.Monad.Trans.Aggregating, module Database.Relational.Query.Monad.Trans.Ordering, module Database.Relational.Query.Monad.Trans.Assigning,+ module Database.Relational.Query.Monad.BaseType, module Database.Relational.Query.Monad.Type, module Database.Relational.Query.Monad.Simple, module Database.Relational.Query.Monad.Aggregate,@@ -57,16 +58,21 @@ import Database.Relational.Query.Projectable import Database.Relational.Query.ProjectableExtended import Database.Relational.Query.Monad.Class- (MonadQualify, MonadRestrict, MonadQuery, MonadAggregate,- distinct, all', on, wheres, groupBy, having, restrict, onE, wheresE, havingE)+ (MonadQualify,+ MonadRestrict, wheres, having, restrict,+ MonadAggregate, groupBy, groupBy',+ MonadQuery, query', queryMaybe',+ MonadPartition, partitionBy,+ distinct, all', on, onE, wheresE, havingE) import Database.Relational.Query.Monad.Trans.Aggregating- (groupBy', key, key', set, bkey, rollup, cube, groupingSets)+ (key, key', set, bkey, rollup, cube, groupingSets) import Database.Relational.Query.Monad.Trans.Ordering (orderBy, asc, desc) import Database.Relational.Query.Monad.Trans.Assigning (assignTo, (<-#))+import Database.Relational.Query.Monad.BaseType import Database.Relational.Query.Monad.Type import Database.Relational.Query.Monad.Simple (QuerySimple, SimpleQuery) import Database.Relational.Query.Monad.Aggregate- (QueryAggregate, AggregatedQuery, Window, partitionBy, over)+ (QueryAggregate, AggregatedQuery, Window, over) import Database.Relational.Query.Monad.Unique (QueryUnique) import Database.Relational.Query.Monad.Restrict (Restrict) import Database.Relational.Query.Monad.Assign (Assign)
src/Database/Relational/Query/Arrow.hs view
@@ -78,9 +78,8 @@ QuerySimple, QueryAggregate, QueryUnique, Window, UpdateTargetContext, RestrictionContext) import qualified Database.Relational.Query as Monadic-import Database.Relational.Query.Monad.Class (MonadQualifyUnique) import Database.Relational.Query.Projection (ListProjection)-import Database.Relational.Query.Monad.Trans.Aggregating (AggregateKey)+import Database.Relational.Query.Component (AggregateKey) import qualified Database.Relational.Query.Monad.Trans.Aggregating as Monadic import qualified Database.Relational.Query.Monad.Trans.Ordering as Monadic import qualified Database.Relational.Query.Monad.Trans.Assigning as Monadic@@ -256,16 +255,14 @@ -- | Same as 'Monadic.uniqueQuery''. Arrow version. -- The result arrow is not injected by local projections.-uniqueQuery' :: MonadQualifyUnique ConfigureQuery m- => UniqueRelation p c r- -> QueryA m () (PlaceHolders p, Projection c r)+uniqueQuery' :: UniqueRelation p c r+ -> QueryA Monadic.QueryUnique () (PlaceHolders p, Projection c r) uniqueQuery' r = queryA $ \() -> Monadic.uniqueQuery' r -- | Same as 'Monadic.uniqueQueryMaybe''. Arrow version. -- The result arrow is not injected by local projections.-uniqueQueryMaybe' :: MonadQualifyUnique ConfigureQuery m- => UniqueRelation p c r- -> QueryA m () (PlaceHolders p, Projection c (Maybe r))+uniqueQueryMaybe' :: UniqueRelation p c r+ -> QueryA Monadic.QueryUnique () (PlaceHolders p, Projection c (Maybe r)) uniqueQueryMaybe' r = queryA $ \() -> Monadic.uniqueQueryMaybe' r -- | Same as 'Monadic.on'. Arrow version.@@ -330,7 +327,7 @@ -- | Same as 'Monadic.groupBy''. -- This arrow is designed to be injected by local 'AggregateKey'.-groupBy' :: MonadAggregate m => QueryA m (AggregateKey a) a+groupBy' :: MonadAggregate m => QueryA m (AggregateKey (Projection Aggregated r)) (Projection Aggregated r) groupBy' = queryA Monadic.groupBy' -- | Same as 'Monadic.key'.
src/Database/Relational/Query/Component.hs view
@@ -12,43 +12,45 @@ -- Portability : unknown -- -- This module provides untyped components for query.-module Database.Relational.Query.Component (- -- * Type for column SQL string- ColumnSQL, columnSQL, columnSQL', showsColumnSQL,+module Database.Relational.Query.Component+ ( -- * Type for column SQL string+ ColumnSQL, columnSQL, columnSQL', showsColumnSQL, - -- * Configuration type for query- Config (productUnitSupport, chunksInsertSize, normalizedTableName),- defaultConfig,- ProductUnitSupport (..), Duplication (..),+ -- * Configuration type for query+ Config (productUnitSupport, chunksInsertSize, normalizedTableName),+ defaultConfig,+ ProductUnitSupport (..), Duplication (..), - -- * Duplication attribute- showsDuplication,+ -- * Duplication attribute+ showsDuplication, - -- * Query restriction- QueryRestriction, composeWhere, composeHaving,+ -- * Query restriction+ QueryRestriction, composeWhere, composeHaving, - -- * Types for aggregation- AggregateColumnRef,+ -- * Types for aggregation+ AggregateColumnRef, - AggregateBitKey, AggregateSet, AggregateElem,+ AggregateBitKey, AggregateSet, AggregateElem, - aggregateColumnRef, aggregateEmpty,- aggregatePowerKey, aggregateGroupingSet,- aggregateRollup, aggregateCube, aggregateSets,+ aggregateColumnRef, aggregateEmpty,+ aggregatePowerKey, aggregateGroupingSet,+ aggregateRollup, aggregateCube, aggregateSets, - composeGroupBy, composePartitionBy,+ composeGroupBy, composePartitionBy, - -- * Types for ordering- Order (..), OrderColumn, OrderingTerm, OrderingTerms,- composeOrderBy,+ AggregateKey, aggregateKeyProjection, aggregateKeyElement, unsafeAggregateKey, - -- * Types for assignments- AssignColumn, AssignTerm, Assignment, Assignments, composeSets,+ -- * Types for ordering+ Order (..), OrderColumn, OrderingTerm, OrderingTerms,+ composeOrderBy, - -- * Compose window clause- composeOver-) where+ -- * Types for assignments+ AssignColumn, AssignTerm, Assignment, Assignments, composeSets, + -- * Compose window clause+ composeOver,+ ) where+ import Data.Monoid (Monoid (..), (<>)) import qualified Database.Relational.Query.Context as Context@@ -211,6 +213,22 @@ composePartitionBy = d where d [] = mempty d ts@(_:_) = PARTITION <> BY <> commaed (map showsAggregateColumnRef ts)++-- | Typeful aggregate element.+newtype AggregateKey a = AggregateKey (a, AggregateElem)++-- | Extract typed projection from 'AggregateKey'.+aggregateKeyProjection :: AggregateKey a -> a+aggregateKeyProjection (AggregateKey (p, _c)) = p++-- | Extract untyped term from 'AggregateKey'.+aggregateKeyElement :: AggregateKey a -> AggregateElem+aggregateKeyElement (AggregateKey (_p, c)) = c++-- | Unsafely bind typed-projection and untyped-term into 'AggregateKey'.+unsafeAggregateKey :: (a, AggregateElem) -> AggregateKey a+unsafeAggregateKey = AggregateKey+ -- | Order direction. Ascendant or Descendant. data Order = Asc | Desc deriving Show
src/Database/Relational/Query/Monad/Aggregate.hs view
@@ -23,7 +23,7 @@ toSubQuery, - Window, partitionBy, over+ Window, over ) where import Data.Functor.Identity (Identity (runIdentity))@@ -38,16 +38,15 @@ import qualified Database.Relational.Query.Sub as SubQuery import Database.Relational.Query.Projectable (PlaceHolders, SqlProjectable) -import Database.Relational.Query.Monad.Class (MonadRestrict(..), MonadQualify(..), MonadPartition (..))-import Database.Relational.Query.Monad.Trans.Join (join')+import Database.Relational.Query.Monad.Class (MonadRestrict(..)) import Database.Relational.Query.Monad.Trans.Restricting (Restrictings, restrictings, extractRestrict) import Database.Relational.Query.Monad.Trans.Aggregating- (aggregatings, extractAggregateTerms, AggregatingSetT, PartitioningSet)+ (extractAggregateTerms, AggregatingSetT, PartitioningSet) import Database.Relational.Query.Monad.Trans.Ordering- (Orderings, orderings, extractOrderingTerms)-import Database.Relational.Query.Monad.Type- (ConfigureQuery, askConfig, QueryCore, extractCore, OrderedQuery)+ (Orderings, extractOrderingTerms)+import Database.Relational.Query.Monad.BaseType (ConfigureQuery, askConfig)+import Database.Relational.Query.Monad.Type (QueryCore, extractCore, OrderedQuery) -- | Aggregated query monad type.@@ -59,18 +58,10 @@ -- | Partition monad type for partition-by clause. type Window c = Orderings c (PartitioningSet c) --- | Lift from qualified table forms into 'QueryAggregate'.-aggregatedQuery :: ConfigureQuery a -> QueryAggregate a-aggregatedQuery = orderings . restrictings . aggregatings . restrictings . join'- -- | Restricted 'MonadRestrict' instance. instance MonadRestrict Flat q => MonadRestrict Flat (Restrictings Aggregated q) where restrict = restrictings . restrict --- | Instance to lift from qualified table forms into 'QueryAggregate'.-instance MonadQualify ConfigureQuery QueryAggregate where- liftQualify = aggregatedQuery- extract :: AggregatedQuery p r -> ConfigureQuery (((((((PlaceHolders p, Projection Aggregated r), OrderingTerms), QueryRestriction Aggregated),@@ -91,10 +82,6 @@ (((((((_ph, pj), ot), grs), ag), rs), pd), da) <- extract q c <- askConfig return $ aggregatedSubQuery c (Projection.untype pj) da pd rs ag grs ot---- | Add /PARTITION BY/ term into context.-partitionBy :: Projection c r -> Window c ()-partitionBy = mapM_ unsafeAddPartitionKey . Projection.columns extractWindow :: Window c a -> ((a, OrderingTerms), [AggregateColumnRef]) extractWindow = runIdentity . extractAggregateTerms . extractOrderingTerms
src/Database/Relational/Query/Monad/Assign.hs view
@@ -19,17 +19,13 @@ extract, ) where -import Control.Monad.Trans.Class (lift)- import Database.Relational.Query.Component (Config, QueryRestriction, Assignments) import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Table (Table) import Database.Relational.Query.Projection (Projection)-import Database.Relational.Query.Monad.Class (MonadQualify(..)) import Database.Relational.Query.Monad.Restrict (Restrict) import qualified Database.Relational.Query.Monad.Restrict as Restrict import Database.Relational.Query.Monad.Trans.Assigning (Assignings, extractAssignments)-import Database.Relational.Query.Monad.Type (ConfigureQuery) -- | Target update monad type used from update statement and merge statement. type Assign r = Assignings r Restrict@@ -39,10 +35,6 @@ -- Projection record type must be -- the same as 'Target' type parameter 'r'. type AssignStatement r a = Projection Flat r -> Assign r a---- | Instance to lift from qualified table forms into 'Restrict'.-instance MonadQualify ConfigureQuery (Assign r) where- liftQualify = lift . liftQualify -- -- | 'return' of 'Update' -- updateStatement :: a -> Assignings r (Restrictings Identity) a
+ src/Database/Relational/Query/Monad/BaseType.hs view
@@ -0,0 +1,86 @@+-- |+-- Module : Database.Relational.Query.Monad.BaseType+-- Copyright : 2015 Kei Hibino+-- License : BSD3+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- This module defines base monad type to build queries.+module Database.Relational.Query.Monad.BaseType+ ( -- * Base monad type to build queries+ ConfigureQuery, configureQuery,+ qualifyQuery, askConfig,++ -- * Relation type+ Relation, unsafeTypeRelation, untypeRelation,++ dump,+ sqlFromRelationWith, sqlFromRelation,++ rightPh, leftPh,+ ) where++import Data.Functor.Identity (Identity, runIdentity)+import Control.Applicative ((<$>))++import Database.Relational.Query.Component (Config, defaultConfig)+import Database.Relational.Query.Internal.SQL (StringSQL, showStringSQL)+import Database.Relational.Query.Sub (Qualified, SubQuery, showSQL)+import qualified Database.Relational.Query.Monad.Trans.Qualify as Qualify+import Database.Relational.Query.Monad.Trans.Qualify (Qualify, qualify, evalQualifyPrime)+import Database.Relational.Query.Monad.Trans.Config (QueryConfig, runQueryConfig, askQueryConfig)++-- | Thin monad type for untyped structure.+type ConfigureQuery = Qualify (QueryConfig Identity)++-- | Run 'ConfigureQuery' monad with initial state to get only result.+configureQuery :: ConfigureQuery q -> Config -> q+configureQuery cq c = runIdentity $ runQueryConfig (evalQualifyPrime cq) c++-- | Get qualifyed table form query.+qualifyQuery :: a -> ConfigureQuery (Qualified a)+qualifyQuery = Qualify.qualifyQuery++-- | Read configuration.+askConfig :: ConfigureQuery Config+askConfig = qualify askQueryConfig+++-- | Relation type with place-holder parameter 'p' and query result type 'r'.+newtype Relation p r = SubQuery (ConfigureQuery SubQuery)++-- | Unsafely type qualified subquery into record typed relation type.+unsafeTypeRelation :: ConfigureQuery SubQuery -> Relation p r+unsafeTypeRelation = SubQuery++-- | Sub-query Qualify monad from relation.+untypeRelation :: Relation p r -> ConfigureQuery SubQuery+untypeRelation (SubQuery qsub) = qsub++unsafeCastPlaceHolder :: Relation a r -> Relation b r+unsafeCastPlaceHolder (SubQuery qsub) = SubQuery qsub++-- | Simplify placeholder type applying left identity element.+rightPh :: Relation ((), p) r -> Relation p r+rightPh = unsafeCastPlaceHolder++-- | Simplify placeholder type applying right identity element.+leftPh :: Relation (p, ()) r -> Relation p r+leftPh = unsafeCastPlaceHolder++-- | Generate SQL string from 'Relation' with configuration.+sqlFromRelationWith :: Relation p r -> Config -> StringSQL+sqlFromRelationWith = configureQuery . (showSQL <$>) . untypeRelation++-- | SQL string from 'Relation'.+sqlFromRelation :: Relation p r -> StringSQL+sqlFromRelation = (`sqlFromRelationWith` defaultConfig)++-- | Dump internal structure tree.+dump :: Relation p r -> String+dump = show . (`configureQuery` defaultConfig) . untypeRelation++instance Show (Relation p r) where+ show = showStringSQL . sqlFromRelation
src/Database/Relational/Query/Monad/Class.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -- |@@ -11,26 +12,23 @@ -- Portability : unknown -- -- This module defines query building interface classes.-module Database.Relational.Query.Monad.Class (- -- * Query interface classes- MonadQualify (..), MonadQualifyUnique(..), MonadRestrict (..),- MonadQuery (..), MonadAggregate (..), MonadPartition (..),+module Database.Relational.Query.Monad.Class+ ( -- * Query interface classes+ MonadQualify (..), MonadRestrict (..),+ MonadQuery (..), MonadAggregate (..), MonadPartition (..), - all', distinct,- onE, on, wheresE, wheres,- groupBy,- havingE, having- ) where+ all', distinct,+ onE, on, wheresE, wheres,+ havingE, having,+ ) where import Database.Relational.Query.Context (Flat, Aggregated) import Database.Relational.Query.Expr (Expr)-import Database.Relational.Query.Component- (Duplication (..), AggregateElem, AggregateColumnRef, aggregateColumnRef)+import Database.Relational.Query.Component (Duplication (..), AggregateKey) import Database.Relational.Query.Projection (Projection, predicateProjectionFromExpr)-import qualified Database.Relational.Query.Projection as Projection-import Database.Relational.Query.Sub (SubQuery, Qualified)+import Database.Relational.Query.Projectable (PlaceHolders)+import Database.Relational.Query.Monad.BaseType (ConfigureQuery, Relation) -import Database.Relational.Query.Internal.Product (NodeAttr) -- | Restrict context interface class (Functor m, Monad m) => MonadRestrict c m where@@ -39,40 +37,40 @@ -> m () -- ^ Restricted query context -- | Query building interface.-class (Functor m, Monad m) => MonadQuery m where+class (Functor m, Monad m, MonadQualify ConfigureQuery m) => MonadQuery m where -- | Specify duplication. setDuplication :: Duplication -> m () -- | Add restriction to last join. restrictJoin :: Projection Flat (Maybe Bool) -- ^ 'Projection' which represent restriction -> m () -- ^ Restricted query context- -- | Unsafely join sub-query with this query.- unsafeSubQuery :: NodeAttr -- ^ Attribute maybe or just- -> Qualified SubQuery -- ^ 'SubQuery' to join- -> m (Projection Flat r) -- ^ Result joined context and 'SubQuery' result projection.+ query' :: Relation p r+ -> m (PlaceHolders p, Projection Flat r) + queryMaybe' :: Relation p r+ -> m (PlaceHolders p, Projection Flat (Maybe r))+ -- | Lift interface from base qualify monad. class (Functor q, Monad q, Functor m, Monad m) => MonadQualify q m where -- | Lift from qualify monad 'q' into 'MonadQuery' m. -- Qualify monad qualifies table form 'SubQuery'. liftQualify :: q a -> m a --- The only method to lift to QueryUnique.--- | Lift interface from base qualify monad. Another constraint to support unique query.-class (Functor q, Monad q, MonadQuery m) => MonadQualifyUnique q m where- -- | Lift from qualify monad 'q' into 'MonadQuery' m.- -- Qualify monad qualifies table form 'SubQuery'.- liftQualifyUnique :: q a -> m a+instance (Functor q, Monad q) => MonadQualify q q where+ liftQualify = id -- | Aggregated query building interface extends 'MonadQuery'. class MonadQuery m => MonadAggregate m where- -- | Add /group by/ term into context and get aggregated projection.- unsafeAddAggregateElement :: AggregateElem -- ^ Grouping element to add into group by clause- -> m () -- ^ Result context+ -- | Add /GROUP BY/ term into context and get aggregated projection.+ groupBy :: Projection Flat r -- ^ Projection to add into group by+ -> m (Projection Aggregated r) -- ^ Result context and aggregated projection+ -- | Add /GROUP BY/ term into context and get aggregated projection. Non-traditional group-by version.+ groupBy' :: AggregateKey (Projection Aggregated r) -- ^ Key to aggretate for non-traditional group-by interface+ -> m (Projection Aggregated r) -- ^ Result context and aggregated projection -- | Window specification building interface.-class Monad m => MonadPartition m where- unsafeAddPartitionKey :: AggregateColumnRef -- ^ Partitioning key to add into partition by clause- -> m () -- ^ Result context+class Monad m => MonadPartition c m where+ -- | Add /PARTITION BY/ term into context.+ partitionBy :: Projection c r -> m () -- | Specify ALL attribute to query context. all' :: MonadQuery m => m ()@@ -97,14 +95,6 @@ -- | Add restriction to this not aggregated query. wheres :: MonadRestrict Flat m => Projection Flat (Maybe Bool) -> m () wheres = restrict---- | Add /GROUP BY/ term into context and get aggregated projection.-groupBy :: MonadAggregate m- => Projection Flat r -- ^ Projection to add into group by- -> m (Projection Aggregated r) -- ^ Result context and aggregated projection-groupBy p = do- mapM_ unsafeAddAggregateElement [ aggregateColumnRef col | col <- Projection.columns p]- return $ Projection.unsafeToAggregated p -- | Add restriction to this aggregated query. Expr type version. havingE :: MonadRestrict Aggregated m => Expr Aggregated (Maybe Bool) -> m ()
src/Database/Relational/Query/Monad/Restrict.hs view
@@ -26,7 +26,7 @@ import Database.Relational.Query.Monad.Class (MonadQualify(..)) import Database.Relational.Query.Monad.Trans.Restricting (Restrictings, restrictings, extractRestrict)-import Database.Relational.Query.Monad.Type (ConfigureQuery, configureQuery)+import Database.Relational.Query.Monad.BaseType (ConfigureQuery, configureQuery) -- | Restrict only monad type used from update statement and delete statement.
src/Database/Relational/Query/Monad/Simple.hs view
@@ -26,13 +26,12 @@ import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection -import Database.Relational.Query.Monad.Class (MonadQualify(..)) import Database.Relational.Query.Monad.Trans.Join (join') import Database.Relational.Query.Monad.Trans.Restricting (restrictings) import Database.Relational.Query.Monad.Trans.Ordering (Orderings, orderings, extractOrderingTerms)-import Database.Relational.Query.Monad.Type- (ConfigureQuery, askConfig, QueryCore, extractCore, OrderedQuery)+import Database.Relational.Query.Monad.BaseType (ConfigureQuery, askConfig)+import Database.Relational.Query.Monad.Type (QueryCore, extractCore, OrderedQuery) import Database.Relational.Query.Projectable (PlaceHolders) import Database.Relational.Query.Component (Duplication, QueryRestriction, OrderingTerms)@@ -49,10 +48,6 @@ -- | Lift from qualified table forms into 'QuerySimple'. simple :: ConfigureQuery a -> QuerySimple a simple = orderings . restrictings . join'---- | Instance to lift from qualified table forms into 'QuerySimple'.-instance MonadQualify ConfigureQuery (Orderings Flat QueryCore) where- liftQualify = simple extract :: SimpleQuery p r -> ConfigureQuery (((((PlaceHolders p, Projection Flat r), OrderingTerms), QueryRestriction Flat),
src/Database/Relational/Query/Monad/Trans/Aggregating.hs view
@@ -13,24 +13,20 @@ -- -- This module defines monad transformer which lift -- from 'MonadQuery' into Aggregated query.-module Database.Relational.Query.Monad.Trans.Aggregating (- -- * Transformer into aggregated query- Aggregatings, aggregatings,-- AggregatingSetT, AggregatingSetListT, AggregatingPowerSetT, PartitioningSetT,-- -- * Result- extractAggregateTerms,+module Database.Relational.Query.Monad.Trans.Aggregating+ ( -- * Transformer into aggregated query+ Aggregatings, aggregatings, - -- * Grouping sets support- AggregateKey,+ AggregatingSetT, AggregatingSetListT, AggregatingPowerSetT, PartitioningSetT, - groupBy',+ -- * Result+ extractAggregateTerms, - AggregatingSet, AggregatingPowerSet, AggregatingSetList, PartitioningSet,- key, key', set,- bkey, rollup, cube, groupingSets- ) where+ -- * Grouping sets support+ AggregatingSet, AggregatingPowerSet, AggregatingSetList, PartitioningSet,+ key, key', set,+ bkey, rollup, cube, groupingSets,+ ) where import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)@@ -43,12 +39,13 @@ import Database.Relational.Query.Context (Flat, Aggregated, Set, Power, SetList) import Database.Relational.Query.Component (AggregateColumnRef, AggregateElem, aggregateColumnRef, AggregateSet, aggregateGroupingSet,- AggregateBitKey, aggregatePowerKey, aggregateRollup, aggregateCube, aggregateSets)+ AggregateBitKey, aggregatePowerKey, aggregateRollup, aggregateCube, aggregateSets,+ AggregateKey, aggregateKeyProjection, aggregateKeyElement, unsafeAggregateKey) import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection import Database.Relational.Query.Monad.Class- (MonadRestrict(..), MonadQuery(..), MonadAggregate(..), MonadPartition(..))+ (MonadQualify (..), MonadRestrict(..), MonadQuery(..), MonadAggregate(..), MonadPartition(..)) -- | Type to accumulate aggregating context.@@ -79,39 +76,40 @@ instance MonadRestrict c m => MonadRestrict c (AggregatingSetT m) where restrict = aggregatings . restrict +-- | Aggregated 'MonadQualify'.+instance MonadQualify q m => MonadQualify q (AggregatingSetT m) where+ liftQualify = aggregatings . liftQualify+ -- | Aggregated 'MonadQuery'. instance MonadQuery m => MonadQuery (AggregatingSetT m) where setDuplication = aggregatings . setDuplication restrictJoin = aggregatings . restrictJoin- unsafeSubQuery na = aggregatings . unsafeSubQuery na+ query' = aggregatings . query'+ queryMaybe' = aggregatings . queryMaybe' unsafeAggregateWithTerm :: Monad m => at -> Aggregatings ac at m () unsafeAggregateWithTerm = Aggregatings . tell . pure +aggregateKey :: Monad m => AggregateKey a -> Aggregatings ac AggregateElem m a+aggregateKey k = do+ unsafeAggregateWithTerm $ aggregateKeyElement k+ return $ aggregateKeyProjection k+ -- | Aggregated query instance. instance MonadQuery m => MonadAggregate (AggregatingSetT m) where- unsafeAddAggregateElement = unsafeAggregateWithTerm+ groupBy p = do+ mapM_ unsafeAggregateWithTerm [ aggregateColumnRef col | col <- Projection.columns p]+ return $ Projection.unsafeToAggregated p+ groupBy' = aggregateKey -- | Partition clause instance-instance Monad m => MonadPartition (PartitioningSetT c m) where- unsafeAddPartitionKey = unsafeAggregateWithTerm+instance Monad m => MonadPartition c (PartitioningSetT c m) where+ partitionBy = mapM_ unsafeAggregateWithTerm . Projection.columns -- | Run 'Aggregatings' to get terms list. extractAggregateTerms :: (Monad m, Functor m) => Aggregatings ac at m a -> m (a, [at]) extractAggregateTerms (Aggregatings ac) = second toList <$> runWriterT ac ---- | Typeful aggregate element.-newtype AggregateKey a = AggregateKey (a, AggregateElem)---- | Add /GROUP BY/ element into context and get aggregated projection.-groupBy' :: MonadAggregate m- => AggregateKey a- -> m a-groupBy' (AggregateKey (p, c)) = do- unsafeAddAggregateElement c- return p- extractTermList :: Aggregatings ac at Identity a -> (a, [at]) extractTermList = runIdentity . extractAggregateTerms @@ -137,9 +135,7 @@ -- | Specify key of single grouping set. key' :: AggregateKey a -> AggregatingSet a-key' (AggregateKey (p, c)) = do- unsafeAggregateWithTerm c- return p+key' = aggregateKey -- | Finalize and specify single grouping set. set :: AggregatingSet a@@ -158,7 +154,7 @@ finalizePower :: ([AggregateBitKey] -> AggregateElem) -> AggregatingPowerSet a -> AggregateKey a-finalizePower finalize pow = AggregateKey . second finalize . extractTermList $ pow+finalizePower finalize pow = unsafeAggregateKey . second finalize . extractTermList $ pow -- | Finalize grouping power set as rollup power set. rollup :: AggregatingPowerSet a -> AggregateKey a@@ -170,4 +166,4 @@ -- | Finalize grouping set list. groupingSets :: AggregatingSetList a -> AggregateKey a-groupingSets = AggregateKey . second aggregateSets . extractTermList+groupingSets = unsafeAggregateKey . second aggregateSets . extractTermList
src/Database/Relational/Query/Monad/Trans/Join.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} -- | -- Module : Database.Relational.Query.Monad.Trans.Join@@ -10,14 +13,17 @@ -- Portability : unknown -- -- This module defines monad transformer which lift to basic 'MonadQuery'.-module Database.Relational.Query.Monad.Trans.Join (- -- * Transformer into join query- QueryJoin, join',+module Database.Relational.Query.Monad.Trans.Join+ ( -- * Transformer into join query+ QueryJoin, join', - -- * Result- extractProduct- ) where+ -- * Result+ extractProduct, + -- * Unsafe API+ unsafeSubQueryWithAttr,+ ) where+ import Prelude hiding (product) import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)@@ -30,15 +36,16 @@ import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Monad.Trans.JoinState (JoinContext, primeJoinContext, updateProduct, joinProduct)-import Database.Relational.Query.Internal.Product (NodeAttr, restrictProduct, growProduct)+import Database.Relational.Query.Internal.Product (NodeAttr (Just', Maybe), restrictProduct, growProduct) import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection import Database.Relational.Query.Expr (Expr, fromJust) import Database.Relational.Query.Component (Duplication (All)) import Database.Relational.Query.Sub (SubQuery, Qualified, JoinProduct)-import Database.Relational.Query.Projectable (expr)+import Database.Relational.Query.Projectable (PlaceHolders, unsafeAddPlaceHolders, expr) -import Database.Relational.Query.Monad.Class (MonadQuery (..))+import Database.Relational.Query.Monad.BaseType (ConfigureQuery, qualifyQuery, Relation, untypeRelation)+import Database.Relational.Query.Monad.Class (MonadQualify (..), MonadQuery (..)) -- | 'StateT' type to accumulate join product context.@@ -63,20 +70,37 @@ d Nothing = error "on: Product is empty! Restrict target product is not found!" d (Just pt) = restrictProduct pt (fromJust e) +instance MonadQualify q m => MonadQualify q (QueryJoin m) where+ liftQualify = join' . liftQualify+ -- | Joinable query instance.-instance (Monad q, Functor q) => MonadQuery (QueryJoin q) where+instance MonadQuery (QueryJoin ConfigureQuery) where setDuplication = QueryJoin . lift . tell . Last . Just restrictJoin = updateJoinRestriction . expr- unsafeSubQuery = unsafeSubQueryWithAttr+ query' = queryWithAttr Just'+ queryMaybe' pr = do+ (ph, pj) <- queryWithAttr Maybe pr+ return (ph, Projection.just pj) -- | Unsafely join sub-query with this query. unsafeSubQueryWithAttr :: Monad q- => NodeAttr -- ^ Attribute maybe or just- -> Qualified SubQuery -- ^ 'SubQuery' to join- -> QueryJoin q (Projection Flat r) -- ^ Result joined context and 'SubQuery' result projection.+ => NodeAttr -- ^ Attribute maybe or just+ -> Qualified SubQuery -- ^ 'SubQuery' to join+ -> QueryJoin q (Projection c r) -- ^ Result joined context and 'SubQuery' result projection. unsafeSubQueryWithAttr attr qsub = do updateContext (updateProduct (`growProduct` (attr, qsub))) return $ Projection.unsafeFromQualifiedSubQuery qsub++-- | Basic monadic join operation using 'MonadQuery'.+queryWithAttr :: NodeAttr+ -> Relation p r+ -> QueryJoin ConfigureQuery (PlaceHolders p, Projection c r)+queryWithAttr attr = unsafeAddPlaceHolders . run where+ run rel = do+ q <- liftQualify $ do+ sq <- untypeRelation rel+ qualifyQuery sq+ unsafeSubQueryWithAttr attr q -- | Run 'QueryJoin' to get 'JoinProduct' extractProduct :: Functor m => QueryJoin m a -> m ((a, JoinProduct), Duplication)
src/Database/Relational/Query/Monad/Trans/Ordering.hs view
@@ -37,7 +37,7 @@ import qualified Database.Relational.Query.Projection as Projection import Database.Relational.Query.Monad.Class- (MonadRestrict(..), MonadQuery(..), MonadAggregate(..), MonadPartition(..))+ (MonadQualify (..), MonadRestrict(..), MonadQuery(..), MonadAggregate(..), MonadPartition(..)) -- | Type to accumulate ordering context.@@ -54,19 +54,25 @@ instance MonadRestrict rc m => MonadRestrict rc (Orderings c m) where restrict = orderings . restrict +-- | 'MonadQualify' with ordering.+instance MonadQualify q m => MonadQualify q (Orderings c m) where+ liftQualify = orderings . liftQualify+ -- | 'MonadQuery' with ordering. instance MonadQuery m => MonadQuery (Orderings c m) where setDuplication = orderings . setDuplication restrictJoin = orderings . restrictJoin- unsafeSubQuery na = orderings . unsafeSubQuery na+ query' = orderings . query'+ queryMaybe' = orderings . queryMaybe' -- | 'MonadAggregate' with ordering. instance MonadAggregate m => MonadAggregate (Orderings c m) where- unsafeAddAggregateElement = orderings . unsafeAddAggregateElement+ groupBy = orderings . groupBy+ groupBy' = orderings . groupBy' -- | 'MonadPartition' with ordering.-instance MonadPartition m => MonadPartition (Orderings c m) where- unsafeAddPartitionKey = orderings . unsafeAddPartitionKey+instance MonadPartition c m => MonadPartition c (Orderings c m) where+ partitionBy = orderings . partitionBy -- | Ordering term projection type interface. class ProjectableOrdering p where
src/Database/Relational/Query/Monad/Trans/Restricting.hs view
@@ -30,7 +30,8 @@ import Database.Relational.Query.Component (QueryRestriction) import Database.Relational.Query.Projectable (expr) -import Database.Relational.Query.Monad.Class (MonadRestrict(..), MonadQuery (..), MonadAggregate(..))+import Database.Relational.Query.Monad.Class+ (MonadQualify (..), MonadRestrict(..), MonadQuery (..), MonadAggregate(..)) -- | Type to accumulate query restrictions.@@ -52,15 +53,21 @@ instance (Monad q, Functor q) => MonadRestrict c (Restrictings c q) where restrict = updateRestriction . expr +-- | Restricted 'MonadQualify' instance.+instance MonadQualify q m => MonadQualify q (Restrictings c m) where+ liftQualify = restrictings . liftQualify+ -- | Restricted 'MonadQuery' instance. instance MonadQuery q => MonadQuery (Restrictings c q) where setDuplication = restrictings . setDuplication restrictJoin = restrictings . restrictJoin- unsafeSubQuery a = restrictings . unsafeSubQuery a+ query' = restrictings . query'+ queryMaybe' = restrictings . queryMaybe' -- | Resticted 'MonadAggregate' instance. instance MonadAggregate m => MonadAggregate (Restrictings c m) where- unsafeAddAggregateElement = restrictings . unsafeAddAggregateElement+ groupBy = restrictings . groupBy+ groupBy' = restrictings . groupBy' -- | Run 'Restrictings' to get 'QueryRestriction' extractRestrict :: (Monad m, Functor m) => Restrictings c m a -> m (a, QueryRestriction c)
src/Database/Relational/Query/Monad/Type.hs view
@@ -8,40 +8,22 @@ -- Portability : unknown -- -- This module defines core query type.-module Database.Relational.Query.Monad.Type (- -- * Core query monad- ConfigureQuery, configureQuery, qualifyQuery, askConfig, QueryCore, extractCore,- OrderedQuery,- ) where--import Data.Functor.Identity (Identity, runIdentity)+module Database.Relational.Query.Monad.Type+ ( -- * Core query monad+ QueryCore, extractCore,+ OrderedQuery,+ ) where -import Database.Relational.Query.Component (Config, Duplication, QueryRestriction)-import Database.Relational.Query.Sub (Qualified, JoinProduct)+import Database.Relational.Query.Component (Duplication, QueryRestriction)+import Database.Relational.Query.Sub (JoinProduct) import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Projection (Projection) import Database.Relational.Query.Projectable (PlaceHolders)-import qualified Database.Relational.Query.Monad.Trans.Qualify as Qualify-import Database.Relational.Query.Monad.Trans.Qualify (Qualify, qualify, evalQualifyPrime)-import Database.Relational.Query.Monad.Trans.Config (QueryConfig, runQueryConfig, askQueryConfig)+import Database.Relational.Query.Monad.BaseType (ConfigureQuery) import Database.Relational.Query.Monad.Trans.Join (QueryJoin, extractProduct) import Database.Relational.Query.Monad.Trans.Restricting (Restrictings, extractRestrict) import Database.Relational.Query.Monad.Trans.Ordering (Orderings) --- | Thin monad type for untyped structure.-type ConfigureQuery = Qualify (QueryConfig Identity)---- | Run 'ConfigureQuery' monad with initial state to get only result.-configureQuery :: ConfigureQuery q -> Config -> q-configureQuery cq c = runIdentity $ runQueryConfig (evalQualifyPrime cq) c---- | Get qualifyed table form query.-qualifyQuery :: a -> ConfigureQuery (Qualified a)-qualifyQuery = Qualify.qualifyQuery---- | Read configuration.-askConfig :: ConfigureQuery Config-askConfig = qualify askQueryConfig -- | Core query monad type used from flat(not-aggregated) query and aggregated query. type QueryCore = Restrictings Flat (QueryJoin ConfigureQuery)
src/Database/Relational/Query/Monad/Unique.hs view
@@ -14,36 +14,37 @@ -- -- This module contains definitions about unique query type -- to support scalar queries.-module Database.Relational.Query.Monad.Unique (- QueryUnique, toSubQuery- ) where+module Database.Relational.Query.Monad.Unique+ ( QueryUnique, unsafeUniqueSubQuery,+ toSubQuery,+ ) where import Control.Applicative (Applicative) import Database.Relational.Query.Context (Flat)+import Database.Relational.Query.Internal.Product (NodeAttr) import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection -import Database.Relational.Query.Monad.Class (MonadQualifyUnique(..), MonadQuery)-import Database.Relational.Query.Monad.Trans.Join (join')+import Database.Relational.Query.Monad.Class (MonadQualify, MonadQuery)+import Database.Relational.Query.Monad.Trans.Join (unsafeSubQueryWithAttr) import Database.Relational.Query.Monad.Trans.Restricting (restrictings)-import Database.Relational.Query.Monad.Type (ConfigureQuery, askConfig, QueryCore, extractCore)+import Database.Relational.Query.Monad.BaseType (ConfigureQuery, askConfig)+import Database.Relational.Query.Monad.Type (QueryCore, extractCore) import Database.Relational.Query.Projectable (PlaceHolders) import Database.Relational.Query.Component (Duplication, QueryRestriction)-import Database.Relational.Query.Sub (SubQuery, flatSubQuery, JoinProduct)+import Database.Relational.Query.Sub (SubQuery, flatSubQuery, Qualified, JoinProduct) -- | Unique query monad type. newtype QueryUnique a = QueryUnique (QueryCore a)- deriving (MonadQuery, Monad, Applicative, Functor)---- | Lift from qualified table forms into 'QueryUnique'.-queryUnique :: ConfigureQuery a -> QueryUnique a-queryUnique = QueryUnique . restrictings . join'+ deriving (MonadQualify ConfigureQuery, MonadQuery, Monad, Applicative, Functor) --- | Instance to lift from qualified table forms into 'QueryUnique'.-instance MonadQualifyUnique ConfigureQuery QueryUnique where- liftQualifyUnique = queryUnique+-- | Unsafely join sub-query with this unique query.+unsafeUniqueSubQuery :: NodeAttr -- ^ Attribute maybe or just+ -> Qualified SubQuery -- ^ 'SubQuery' to join+ -> QueryUnique (Projection c r) -- ^ Result joined context and 'SubQuery' result projection.+unsafeUniqueSubQuery a = QueryUnique . restrictings . unsafeSubQueryWithAttr a extract :: QueryUnique a -> ConfigureQuery (((a, QueryRestriction Flat), JoinProduct), Duplication)
src/Database/Relational/Query/Relation.hs view
@@ -24,17 +24,12 @@ uniqueRelation', aggregatedUnique, - dump,-- sqlFromRelationWith, sqlFromRelation,- -- * Query using relation- query, query', queryMaybe, queryMaybe', queryList, queryList', queryScalar, queryScalar',+ query, queryMaybe, queryList, queryList', queryScalar, queryScalar', uniqueQuery', uniqueQueryMaybe', -- * Direct style join JoinRestriction,- rightPh, leftPh, inner', left', right', full', inner, left, right, full, on',@@ -50,19 +45,20 @@ import Control.Applicative ((<$>)) import Database.Relational.Query.Context (Flat, Aggregated)-import Database.Relational.Query.Monad.Type (ConfigureQuery, configureQuery, qualifyQuery)+import Database.Relational.Query.Monad.BaseType+ (ConfigureQuery, qualifyQuery,+ Relation, unsafeTypeRelation, untypeRelation) import Database.Relational.Query.Monad.Class- (MonadQualify (liftQualify), MonadQualifyUnique (liftQualifyUnique), MonadQuery (unsafeSubQuery), on)+ (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)+import Database.Relational.Query.Monad.Unique (QueryUnique, unsafeUniqueSubQuery) import qualified Database.Relational.Query.Monad.Unique as Unique -import Database.Relational.Query.Component (Config, defaultConfig, Duplication (Distinct, All))+import Database.Relational.Query.Component (Duplication (Distinct, All)) import Database.Relational.Query.Table (Table, TableDerivable, derivedTable)-import Database.Relational.Query.Internal.SQL (StringSQL, showStringSQL) import Database.Relational.Query.Internal.Product (NodeAttr(Just', Maybe)) import Database.Relational.Query.Sub (SubQuery) import qualified Database.Relational.Query.Sub as SubQuery@@ -77,13 +73,9 @@ import Database.Relational.Query.ProjectableExtended ((!)) --- | Relation type with place-holder parameter 'p' and query result type 'r'.-newtype Relation p r = SubQuery (ConfigureQuery SubQuery)-- -- | Simple 'Relation' from 'Table'. table :: Table r -> Relation () r-table = SubQuery . return . SubQuery.fromTable+table = unsafeTypeRelation . return . SubQuery.fromTable -- | Infered 'Relation'. derivedRelation :: TableDerivable r => Relation () r@@ -96,48 +88,12 @@ placeHoldersFromRelation :: Relation p r -> PlaceHolders p placeHoldersFromRelation = const unsafePlaceHolders --- | Sub-query Qualify monad from relation.-subQueryQualifyFromRelation :: Relation p r -> ConfigureQuery SubQuery-subQueryQualifyFromRelation = d where- d (SubQuery qsub) = qsub---- -- | Sub-query from relation.--- subQueryFromRelation :: Relation p r -> SubQuery--- subQueryFromRelation = configureQuery . subQueryQualifyFromRelation---- | Basic monadic join operation using 'MonadQuery'.-queryWithAttr :: (MonadQualify ConfigureQuery m, MonadQuery m)- => NodeAttr- -> Relation p r- -> m (PlaceHolders p, Projection Flat r)-queryWithAttr attr = unsafeAddPlaceHolders . run where- run rel = do- q <- liftQualify $ do- sq <- subQueryQualifyFromRelation rel- qualifyQuery sq- unsafeSubQuery attr q- -- d (Relation q) = unsafeMergeAnotherQuery attr q---- | Join sub-query with place-holder parameter 'p'. query result is not 'Maybe'.-query' :: (MonadQualify ConfigureQuery m, MonadQuery m)- => Relation p r- -> m (PlaceHolders p, Projection Flat r)-query' = queryWithAttr Just'- -- | Join sub-query. Query result is not 'Maybe'. query :: (MonadQualify ConfigureQuery m, MonadQuery m) => Relation () r -> m (Projection Flat r) query = fmap snd . query' --- | Join sub-query with place-holder parameter 'p'. Query result is 'Maybe'.-queryMaybe' :: (MonadQualify ConfigureQuery m, MonadQuery m)- => Relation p r- -> m (PlaceHolders p, Projection Flat (Maybe r))-queryMaybe' pr = do- (ph, pj) <- queryWithAttr Maybe pr- return (ph, Projection.just pj)- -- | Join sub-query. Query result is 'Maybe'. -- The combinations of 'query' and 'queryMaybe' express -- inner joins, left outer joins, right outer joins, and full outer joins.@@ -158,7 +114,7 @@ queryList0 :: MonadQualify ConfigureQuery m => Relation p r -> m (ListProjection (Projection c) r) queryList0 = liftQualify . fmap Projection.unsafeListFromSubQuery- . subQueryQualifyFromRelation+ . untypeRelation -- | List sub-query, for /IN/ and /EXIST/ with place-holder parameter 'p'. queryList' :: MonadQualify ConfigureQuery m@@ -179,7 +135,7 @@ -- | Finalize 'QuerySimple' monad and generate 'Relation' with place-holder parameter 'p'. relation' :: SimpleQuery p r -> Relation p r-relation' = SubQuery . Simple.toSubQuery+relation' = unsafeTypeRelation . Simple.toSubQuery -- | Finalize 'QuerySimple' monad and generate 'Relation'. relation :: QuerySimple (Projection Flat r) -> Relation () r@@ -187,7 +143,7 @@ -- | Finalize 'QueryAggregate' monad and geneate 'Relation' with place-holder parameter 'p'. aggregateRelation' :: AggregatedQuery p r -> Relation p r-aggregateRelation' = SubQuery . Aggregate.toSubQuery+aggregateRelation' = unsafeTypeRelation . Aggregate.toSubQuery -- | Finalize 'QueryAggregate' monad and geneate 'Relation'. aggregateRelation :: QueryAggregate (Projection Aggregated r) -> Relation () r@@ -197,18 +153,6 @@ -- | Restriction function type for direct style join operator. type JoinRestriction a b = Projection Flat a -> Projection Flat b -> Projection Flat (Maybe Bool) -unsafeCastPlaceHolder :: Relation a r -> Relation b r-unsafeCastPlaceHolder = d where- d (SubQuery q) = SubQuery q---- | Simplify placeholder type applying left identity element.-rightPh :: Relation ((), p) r -> Relation p r-rightPh = unsafeCastPlaceHolder---- | Simplify placeholder type applying right identity element.-leftPh :: Relation (p, ()) r -> Relation p r-leftPh = unsafeCastPlaceHolder- -- | Basic direct join operation with place-holder parameters. join' :: (qa -> QuerySimple (PlaceHolders pa, Projection Flat a)) -> (qb -> QuerySimple (PlaceHolders pb, Projection Flat b))@@ -303,9 +247,9 @@ -> Relation p a -> Relation q a -> Relation r a-unsafeLiftAppend op a0 a1 = SubQuery $ do- s0 <- subQueryQualifyFromRelation a0- s1 <- subQueryQualifyFromRelation a1+unsafeLiftAppend op a0 a1 = unsafeTypeRelation $ do+ s0 <- untypeRelation a0+ s1 <- untypeRelation a1 return $ s0 `op` s1 liftAppend :: (SubQuery -> SubQuery -> SubQuery)@@ -373,29 +317,10 @@ infixl 7 `union'`, `except'`, `unionAll'`, `exceptAll'` infixl 8 `intersect'`, `intersectAll'` --- | Generate SQL string from 'Relation' with configuration.-sqlFromRelationWith :: Relation p r -> Config -> StringSQL-sqlFromRelationWith (SubQuery qsub) = configureQuery $ SubQuery.showSQL <$> qsub---- | SQL string from 'Relation'.-sqlFromRelation :: Relation p r -> StringSQL-sqlFromRelation = (`sqlFromRelationWith` defaultConfig)---- | Dump internal structure tree.-dump :: Relation p r -> String-dump = show . (`configureQuery` defaultConfig) . subQueryQualifyFromRelation--instance Show (Relation p r) where- show = showStringSQL . sqlFromRelation- {- -- | Get projection width from 'Relation'. width :: Relation p r -> Int width = SubQuery.width . subQueryFromRelation---- | Finalize internal Query monad.-nested :: Relation p r -> Relation p r-nested = SubQuery . subQueryFromRelation -} -- | Unique relation type to compose scalar queries.@@ -410,34 +335,31 @@ unUnique (Unique r) = r -- | Basic monadic join operation using 'MonadQuery'.-uniqueQueryWithAttr :: MonadQualifyUnique ConfigureQuery m- => NodeAttr+uniqueQueryWithAttr :: NodeAttr -> UniqueRelation p c r- -> m (PlaceHolders p, Projection c r)+ -> QueryUnique (PlaceHolders p, Projection c r) uniqueQueryWithAttr attr = unsafeAddPlaceHolders . run where run rel = do- q <- liftQualifyUnique $ do- sq <- subQueryQualifyFromRelation (unUnique rel)+ q <- liftQualify $ do+ sq <- untypeRelation (unUnique rel) qualifyQuery sq- Projection.unsafeChangeContext <$> unsafeSubQuery attr q+ Projection.unsafeChangeContext <$> unsafeUniqueSubQuery attr q -- | Join unique sub-query with place-holder parameter 'p'.-uniqueQuery' :: MonadQualifyUnique ConfigureQuery m- => UniqueRelation p c r- -> m (PlaceHolders p, Projection c r)+uniqueQuery' :: UniqueRelation p c r+ -> QueryUnique (PlaceHolders p, Projection c r) uniqueQuery' = uniqueQueryWithAttr Just' -- | Join unique sub-query with place-holder parameter 'p'. Query result is 'Maybe'.-uniqueQueryMaybe' :: MonadQualifyUnique ConfigureQuery m- => UniqueRelation p c r- -> m (PlaceHolders p, Projection c (Maybe r))+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) -- | Finalize 'QueryUnique' monad and generate 'UniqueRelation'. uniqueRelation' :: QueryUnique (PlaceHolders p, Projection c r) -> UniqueRelation p c r-uniqueRelation' = unsafeUnique . SubQuery . Unique.toSubQuery+uniqueRelation' = unsafeUnique . unsafeTypeRelation . Unique.toSubQuery -- | Aggregated 'UniqueRelation'. aggregatedUnique :: Relation ph r@@ -454,7 +376,7 @@ -> m (PlaceHolders p, Projection c (Maybe r)) queryScalar' ur = unsafeAddPlaceHolders . liftQualify $- Projection.unsafeFromScalarSubQuery <$> subQueryQualifyFromRelation (unUnique ur)+ Projection.unsafeFromScalarSubQuery <$> untypeRelation (unUnique ur) -- | Scalar sub-query. queryScalar :: (MonadQualify ConfigureQuery m, ScalarDegree r)
src/Database/Relational/Query/Type.hs view
@@ -43,7 +43,8 @@ import Database.Record (PersistableWidth) import Database.Relational.Query.Internal.SQL (showStringSQL)-import Database.Relational.Query.Relation (Relation, sqlFromRelationWith, tableOf)+import Database.Relational.Query.Monad.BaseType (Relation, sqlFromRelationWith)+import Database.Relational.Query.Relation (tableOf) import Database.Relational.Query.Effect (Restriction, RestrictionContext, restriction', UpdateTarget, UpdateTargetContext, updateTarget', liftTargetAllColumn',