packages feed

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 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',