Add configure query seed type to replace qualify.

relational-join/src/Database/Relational/Query/Monad/Aggregate.hs

@@ -29,7 +29,6 @@ import qualified Database.Relational.Query.Projection as Projection
 import Database.Relational.Query.SQL (selectSeedSQL)
 import Database.Relational.Query.Sub (SubQuery, subQuery)
 
-import Database.Relational.Query.Monad.Qualify (Qualify)
 import Database.Relational.Query.Monad.Class (MonadQualify(..))
 import Database.Relational.Query.Monad.Trans.Join
   (join', FromPrepend, prependFrom, extractFrom)
@@ -40,7 +39,7 @@ import Database.Relational.Query.Monad.Trans.Aggregating
   (Aggregatings, aggregatings, GroupBysPrepend, prependGroupBys, extractGroupBys)
 import Database.Relational.Query.Monad.Trans.Ordering
   (Orderings, orderings, OrderedQuery, OrderByPrepend, prependOrderBy, extractOrderBys)
-import Database.Relational.Query.Monad.Type (QueryCore)
+import Database.Relational.Query.Monad.Type (ConfigureQuery, QueryCore)
 
 
 -- | Aggregated query monad type.
@@ -50,19 +49,19 @@ type QueryAggregate    = Orderings Aggregated (Restrictings Aggregated (Aggregat
 type AggregatedQuery r = OrderedQuery Aggregated (Restrictings Aggregated (Aggregatings QueryCore)) r
 
 -- | Lift from qualified table forms into 'QueryAggregate'.
-aggregatedQuery :: Qualify a -> QueryAggregate a
+aggregatedQuery :: ConfigureQuery a -> QueryAggregate a
 aggregatedQuery =  orderings . restrictings . aggregatings . restrictings . join'
 
 -- | Instance to lift from qualified table forms into 'QueryAggregate'.
-instance MonadQualify Qualify QueryAggregate where
+instance MonadQualify ConfigureQuery QueryAggregate where
   liftQualify = aggregatedQuery
 
 expandPrepend :: AggregatedQuery r
-                 -> Qualify (((((Projection Aggregated r, OrderByPrepend), HavingPrepend), GroupBysPrepend), WherePrepend), FromPrepend)
+                 -> ConfigureQuery (((((Projection Aggregated r, OrderByPrepend), HavingPrepend), GroupBysPrepend), WherePrepend), FromPrepend)
 expandPrepend =  extractFrom . extractWheres . extractGroupBys . extractHavings . extractOrderBys
 
 -- | Run 'AggregatedQuery' to get SQL string.
-expandSQL :: AggregatedQuery r -> Qualify (String, Projection Flat r)
+expandSQL :: AggregatedQuery r -> ConfigureQuery (String, Projection Flat r)
 expandSQL q = do
   (((((aggr, ao), ah), ag), aw), af) <- expandPrepend q
   let projection = Projection.unsafeToFlat aggr
@@ -70,14 +69,14 @@ expandSQL q = do
           . prependGroupBys ag . prependHaving ah . prependOrderBy ao $ "",
           projection)
 
--- | Run 'AggregatedQuery' to get SQL with 'Qualify' computation.
+-- | Run 'AggregatedQuery' to get SQL with 'ConfigureQuery' computation.
-toSQL :: AggregatedQuery r -- ^ 'AggregatedQuery' to run
+toSQL :: AggregatedQuery r     -- ^ 'AggregatedQuery' to run
-      -> Qualify String    -- ^ Result SQL string with 'Qualify' computation
+      -> ConfigureQuery String -- ^ Result SQL string with 'ConfigureQuery' computation
 toSQL =  fmap fst . expandSQL
 
--- | Run 'AggregatedQuery' to get 'SubQuery' with 'Qualify' computation.
+-- | Run 'AggregatedQuery' to get 'SubQuery' with 'ConfigureQuery' computation.
-toSubQuery :: AggregatedQuery r -- ^ 'AggregatedQuery' to run
+toSubQuery :: AggregatedQuery r       -- ^ 'AggregatedQuery' to run
-           -> Qualify SubQuery  -- ^ Result 'SubQuery' with 'Qualify' computation
+           -> ConfigureQuery SubQuery -- ^ Result 'SubQuery' with 'ConfigureQuery' computation
 toSubQuery q = do
   (sql, pj) <- expandSQL q
   return $ subQuery sql (Projection.width pj)

relational-join/src/Database/Relational/Query/Monad/Simple.hs

@@ -27,7 +27,6 @@ import Database.Relational.Query.Projection (Projection)
 import qualified Database.Relational.Query.Projection as Projection
 import Database.Relational.Query.SQL (selectSeedSQL)
 
-import Database.Relational.Query.Monad.Qualify (Qualify)
 import Database.Relational.Query.Monad.Class (MonadQualify(..))
 import Database.Relational.Query.Monad.Trans.Join
   (join', FromPrepend, prependFrom, extractFrom)
@@ -35,7 +34,7 @@ import Database.Relational.Query.Monad.Trans.Restricting
   (restrictings, WherePrepend, prependWhere, extractWheres)
 import Database.Relational.Query.Monad.Trans.Ordering
   (Orderings, orderings, OrderedQuery, OrderByPrepend, prependOrderBy, extractOrderBys)
-import Database.Relational.Query.Monad.Type (QueryCore)
+import Database.Relational.Query.Monad.Type (ConfigureQuery, QueryCore)
 
 import Database.Relational.Query.Sub (SubQuery, subQuery)
 
@@ -47,31 +46,31 @@ type QuerySimple = Orderings Flat QueryCore
 type SimpleQuery r = OrderedQuery Flat QueryCore r
 
 -- | Lift from qualified table forms into 'QuerySimple'.
-simple :: Qualify a -> QuerySimple a
+simple :: ConfigureQuery a -> QuerySimple a
 simple =  orderings . restrictings . join'
 
 -- | Instance to lift from qualified table forms into 'QuerySimple'.
-instance MonadQualify Qualify (Orderings Flat QueryCore) where
+instance MonadQualify ConfigureQuery (Orderings Flat QueryCore) where
   liftQualify = simple
 
 expandPrepend :: SimpleQuery r
-              -> Qualify (((Projection Flat r, OrderByPrepend), WherePrepend), FromPrepend)
+              -> ConfigureQuery (((Projection Flat r, OrderByPrepend), WherePrepend), FromPrepend)
 expandPrepend =  extractFrom . extractWheres . extractOrderBys
 
 -- | Run 'SimpleQuery' to get SQL string.
-expandSQL :: SimpleQuery r -> Qualify (String, Projection Flat r)
+expandSQL :: SimpleQuery r -> ConfigureQuery (String, Projection Flat r)
 expandSQL q = do
   (((pj, ao), aw), af) <- expandPrepend q
   return (selectSeedSQL pj . prependFrom af . prependWhere aw . prependOrderBy ao $ "", pj)
 
 -- | Run 'SimpleQuery' to get SQL string with 'Qualify' computation.
-toSQL :: SimpleQuery r  -- ^ 'SimpleQuery' to run
+toSQL :: SimpleQuery r         -- ^ 'SimpleQuery' to run
-      -> Qualify String -- ^ Result SQL string with 'Qualify' computation
+      -> ConfigureQuery String -- ^ Result SQL string with 'Qualify' computation
 toSQL =  fmap fst . expandSQL
 
 -- | Run 'SimpleQuery' to get 'SubQuery' with 'Qualify' computation.
-toSubQuery :: SimpleQuery r    -- ^ 'SimpleQuery' to run
+toSubQuery :: SimpleQuery r           -- ^ 'SimpleQuery' to run
-           -> Qualify SubQuery -- ^ Result 'SubQuery' with 'Qualify' computation
+           -> ConfigureQuery SubQuery -- ^ Result 'SubQuery' with 'Qualify' computation
 toSubQuery q = do
   (sql, pj) <- expandSQL q
   return $ subQuery sql (Projection.width pj)

relational-join/src/Database/Relational/Query/Monad/Type.hs

@@ -10,14 +10,28 @@
 -- This module defines core query type.
 module Database.Relational.Query.Monad.Type (
   -- * Core query monad
-  QueryCore,
+  ConfigureQuery, configureQuery, qualifyQuery, QueryCore,
   ) where
 
+import Database.Relational.Query.Sub (Qualified)
 import Database.Relational.Query.Context (Flat)
-import Database.Relational.Query.Monad.Qualify (Qualify)
+import qualified Database.Relational.Query.Monad.Qualify as Qualify
+import Database.Relational.Query.Monad.Qualify (Qualify, evalQualifyPrime)
+import Database.Relational.Query.Monad.Trans.Config (QueryConfig, runQueryDefault, config)
 import Database.Relational.Query.Monad.Trans.Join (QueryJoin)
 import Database.Relational.Query.Monad.Trans.Restricting (Restrictings)
 
 
--- | Core query monad type used from simple query and aggregated query.
+-- | Thin monad type for untyped structure.
-type QueryCore = Restrictings Flat (QueryJoin Qualify)
+type ConfigureQuery = QueryConfig Qualify
+
+-- | Run 'ConfigureQuery' monad with initial state to get only result.
+configureQuery :: ConfigureQuery c -> c
+configureQuery =  evalQualifyPrime . runQueryDefault
+
+-- | Get qualifyed table form query.
+qualifyQuery :: a -> ConfigureQuery (Qualified a)
+qualifyQuery =  config . Qualify.qualifyQuery
+
+-- | Core query monad type used from flat(not-aggregated) query and aggregated query.
+type QueryCore = Restrictings Flat (QueryJoin ConfigureQuery)

relational-join/src/Database/Relational/Query/Relation.hs

@@ -41,7 +41,7 @@ module Database.Relational.Query.Relation (
 import Control.Arrow ((&&&))
 
 import Database.Relational.Query.Context (Flat, Aggregated)
-import Database.Relational.Query.Monad.Qualify (Qualify, evalQualifyPrime, qualifyQuery)
+import Database.Relational.Query.Monad.Type (ConfigureQuery, configureQuery, qualifyQuery)
 import Database.Relational.Query.Monad.Class
   (MonadQualify (liftQualify), MonadQuery (unsafeSubQuery), on)
 import Database.Relational.Query.Monad.Simple (QuerySimple, SimpleQuery)
@@ -64,7 +64,7 @@ import qualified Database.Relational.Query.Sub as SubQuery
 
 
 -- | Relation type with place-holder parameter 'p' and query result type 'r'.
-data Relation p r = SubQuery (Qualify SubQuery)
+data Relation p r = SubQuery (ConfigureQuery SubQuery)
                   | SimpleRel (SimpleQuery r)
                   | AggregateRel (AggregatedQuery r)
 
@@ -77,7 +77,7 @@ placeHoldersFromRelation :: Relation p r -> PlaceHolders p
 placeHoldersFromRelation =  const unsafePlaceHolders
 
 -- | Sub-query Qualify monad from relation.
-subQueryQualifyFromRelation :: Relation p r -> Qualify SubQuery
+subQueryQualifyFromRelation :: Relation p r -> ConfigureQuery SubQuery
 subQueryQualifyFromRelation =  d  where
   d (SubQuery qsub)   = qsub
   d (SimpleRel qp)    = Simple.toSubQuery qp
@@ -85,10 +85,10 @@ subQueryQualifyFromRelation =  d  where
 
 -- -- | Sub-query from relation.
 -- subQueryFromRelation :: Relation p r -> SubQuery
--- subQueryFromRelation =  evalQualifyPrime . subQueryQualifyFromRelation
+-- subQueryFromRelation =  configureQuery . subQueryQualifyFromRelation
 
 -- | Basic monadic join operation using 'MonadQuery'.
-queryWithAttr :: MonadQualify Qualify m
+queryWithAttr :: MonadQualify ConfigureQuery m
               => NodeAttr -> Relation p r -> m (PlaceHolders p, Projection Flat r)
 queryWithAttr attr = addPlaceHolders . run where
   run rel = do
@@ -99,25 +99,25 @@ queryWithAttr attr = addPlaceHolders . run where
   -- d (Relation q) = unsafeMergeAnotherQuery attr q
 
 -- | Join subquery with place-holder parameter 'p'. query result is not 'Maybe'.
-query' :: MonadQualify Qualify m => Relation p r -> m (PlaceHolders p, Projection Flat r)
+query' :: MonadQualify ConfigureQuery m => Relation p r -> m (PlaceHolders p, Projection Flat r)
 query' =  queryWithAttr Just'
 
 -- | Join subquery. Query result is not 'Maybe'.
-query :: MonadQualify Qualify m => Relation () r -> m (Projection Flat r)
+query :: MonadQualify ConfigureQuery m => Relation () r -> m (Projection Flat r)
 query =  fmap snd . query'
 
 -- | Join subquery with place-holder parameter 'p'. Query result is 'Maybe'.
-queryMaybe' :: MonadQualify Qualify m => Relation p r -> m (PlaceHolders p, Projection Flat (Maybe r))
+queryMaybe' :: MonadQualify ConfigureQuery 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 subquery. Query result is 'Maybe'.
-queryMaybe :: MonadQualify Qualify m => Relation () r -> m (Projection Flat (Maybe r))
+queryMaybe :: MonadQualify ConfigureQuery m => Relation () r -> m (Projection Flat (Maybe r))
 queryMaybe =  fmap snd . queryMaybe'
 
 queryList0 :: Relation p r -> ListProjection (Projection c) r
-queryList0 =  unsafeListProjectionFromSubQuery . evalQualifyPrime . subQueryQualifyFromRelation
+queryList0 =  unsafeListProjectionFromSubQuery . configureQuery . subQueryQualifyFromRelation
 
 -- | List subQuery, for /IN/ and /EXIST/ with place-holder parameter 'p'.
 queryList' :: Relation p r -> (PlaceHolders p, ListProjection (Projection c) r)
@@ -299,7 +299,7 @@ intersect' =  liftAppend' SubQuery.intersect
 infixl 7 `union`, `except`, `intersect`, `union'`, `except'`, `intersect'`
 
 -- | SQL string with qualify computation from 'Relation'.
-sqlQualifyFromRelation :: Relation p r -> Qualify String
+sqlQualifyFromRelation :: Relation p r -> ConfigureQuery String
 sqlQualifyFromRelation =  d  where
   d (SubQuery qsub)   = SubQuery.toSQL `fmap` qsub
   d (SimpleRel qp)    = Simple.toSQL qp
@@ -307,7 +307,7 @@ sqlQualifyFromRelation =  d  where
 
 -- | SQL string from 'Relation'.
 sqlFromRelation :: Relation p r -> String
-sqlFromRelation =  evalQualifyPrime . sqlQualifyFromRelation
+sqlFromRelation =  configureQuery . sqlQualifyFromRelation
 
 instance Show (Relation p r) where
   show = sqlFromRelation