khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2024-12-15 14:53:28 +03:00
Code Issues Projects Releases Wiki Activity

Add configure query seed type to replace qualify.

Browse Source
This commit is contained in:
Kei Hibino 2013-09-06 08:57:45 +09:00
parent 6be7ec9b97
commit f057fc0568
4 changed files with 50 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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
-> 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
-> 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)

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

@ -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
-> 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
-> ConfigureQuery SubQuery -- ^ Result 'SubQuery' with 'Qualify' computation
toSubQuery q = do
(sql, pj) <- expandSQL q
return $ subQuery sql (Projection.width pj)

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

@ -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)

24
relational-join/src/Database/Relational/Query/Relation.hs
View File

@ -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