From f057fc05686e9f0056a396d927fa30f50faf5f6e Mon Sep 17 00:00:00 2001 From: Kei Hibino Date: Fri, 6 Sep 2013 08:57:45 +0900 Subject: [PATCH] Add configure query seed type to replace qualify. --- .../Relational/Query/Monad/Aggregate.hs | 23 +++++++++--------- .../Database/Relational/Query/Monad/Simple.hs | 19 +++++++-------- .../Database/Relational/Query/Monad/Type.hs | 22 +++++++++++++---- .../src/Database/Relational/Query/Relation.hs | 24 +++++++++---------- 4 files changed, 50 insertions(+), 38 deletions(-) diff --git a/relational-join/src/Database/Relational/Query/Monad/Aggregate.hs b/relational-join/src/Database/Relational/Query/Monad/Aggregate.hs index 4c62e48c..d13890f0 100644 --- a/relational-join/src/Database/Relational/Query/Monad/Aggregate.hs +++ b/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. -toSQL :: AggregatedQuery r -- ^ 'AggregatedQuery' to run - -> Qualify String -- ^ Result SQL string with 'Qualify' computation +-- | Run 'AggregatedQuery' to get SQL with 'ConfigureQuery' computation. +toSQL :: AggregatedQuery r -- ^ 'AggregatedQuery' to run + -> ConfigureQuery String -- ^ Result SQL string with 'ConfigureQuery' computation toSQL = fmap fst . expandSQL --- | Run 'AggregatedQuery' to get 'SubQuery' with 'Qualify' computation. -toSubQuery :: AggregatedQuery r -- ^ 'AggregatedQuery' to run - -> Qualify SubQuery -- ^ Result 'SubQuery' with 'Qualify' computation +-- | Run 'AggregatedQuery' to get 'SubQuery' with 'ConfigureQuery' computation. +toSubQuery :: AggregatedQuery r -- ^ 'AggregatedQuery' to run + -> ConfigureQuery SubQuery -- ^ Result 'SubQuery' with 'ConfigureQuery' computation toSubQuery q = do (sql, pj) <- expandSQL q return $ subQuery sql (Projection.width pj) diff --git a/relational-join/src/Database/Relational/Query/Monad/Simple.hs b/relational-join/src/Database/Relational/Query/Monad/Simple.hs index 3f4eecfa..592c34d5 100644 --- a/relational-join/src/Database/Relational/Query/Monad/Simple.hs +++ b/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 - -> Qualify String -- ^ Result SQL string with 'Qualify' computation +toSQL :: SimpleQuery r -- ^ 'SimpleQuery' to run + -> 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 - -> Qualify SubQuery -- ^ Result 'SubQuery' with 'Qualify' computation +toSubQuery :: SimpleQuery r -- ^ 'SimpleQuery' to run + -> ConfigureQuery SubQuery -- ^ Result 'SubQuery' with 'Qualify' computation toSubQuery q = do (sql, pj) <- expandSQL q return $ subQuery sql (Projection.width pj) diff --git a/relational-join/src/Database/Relational/Query/Monad/Type.hs b/relational-join/src/Database/Relational/Query/Monad/Type.hs index 257f0353..eac6120d 100644 --- a/relational-join/src/Database/Relational/Query/Monad/Type.hs +++ b/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. -type QueryCore = Restrictings Flat (QueryJoin Qualify) +-- | Thin monad type for untyped structure. +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) diff --git a/relational-join/src/Database/Relational/Query/Relation.hs b/relational-join/src/Database/Relational/Query/Relation.hs index 9279a16f..8d79a492 100644 --- a/relational-join/src/Database/Relational/Query/Relation.hs +++ b/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