mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-12-15 06:43:04 +03:00
Chain configuration into queryList.
This commit is contained in:
parent
751712f7d5
commit
2d073d92e3
@ -73,8 +73,9 @@ haskellUser =
|
|||||||
| ug <- query userGroup0
|
| ug <- query userGroup0
|
||||||
, () <- wheres $ ug ! snd' ?!? Group.name' .=. just (value "Haskell")
|
, () <- wheres $ ug ! snd' ?!? Group.name' .=. just (value "Haskell")
|
||||||
]
|
]
|
||||||
, hu <- query hus
|
, hu <- query hus
|
||||||
, () <- wheres . exists . queryList $ hus
|
, hul <- queryList hus
|
||||||
|
, () <- wheres $ exists hul
|
||||||
]
|
]
|
||||||
|
|
||||||
-- Direct join style
|
-- Direct join style
|
||||||
@ -168,13 +169,14 @@ user3 =
|
|||||||
userGroupAggregate1 :: Relation () ((Maybe String, Int32), Maybe Bool)
|
userGroupAggregate1 :: Relation () ((Maybe String, Int32), Maybe Bool)
|
||||||
userGroupAggregate1 =
|
userGroupAggregate1 =
|
||||||
aggregateRelation $
|
aggregateRelation $
|
||||||
[ g >< c >< every (uid `in'` queryList user3)
|
[ g >< c >< every (uid `in'` us)
|
||||||
| ug <- query userGroup0
|
| ug <- query userGroup0
|
||||||
, g <- groupBy (ug ! snd' ?!? Group.name')
|
, g <- groupBy (ug ! snd' ?!? Group.name')
|
||||||
, let uid = ug ! fst' ?! User.id'
|
, let uid = ug ! fst' ?! User.id'
|
||||||
, let c = count uid
|
, let c = count uid
|
||||||
, () <- having $ c `in'` values [1, 2]
|
, () <- having $ c `in'` values [1, 2]
|
||||||
, () <- asc $ c
|
, () <- asc $ c
|
||||||
|
, us <- queryList user3
|
||||||
]
|
]
|
||||||
|
|
||||||
-- Concatinate operator
|
-- Concatinate operator
|
||||||
|
@ -38,8 +38,6 @@ module Database.Relational.Query.Relation (
|
|||||||
union', except', intersect'
|
union', except', intersect'
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Arrow ((&&&))
|
|
||||||
|
|
||||||
import Database.Relational.Query.Context (Flat, Aggregated)
|
import Database.Relational.Query.Context (Flat, Aggregated)
|
||||||
import Database.Relational.Query.Monad.Type (ConfigureQuery, configureQuery, qualifyQuery)
|
import Database.Relational.Query.Monad.Type (ConfigureQuery, configureQuery, qualifyQuery)
|
||||||
import Database.Relational.Query.Monad.Class
|
import Database.Relational.Query.Monad.Class
|
||||||
@ -116,15 +114,23 @@ queryMaybe' pr = do
|
|||||||
queryMaybe :: MonadQualify ConfigureQuery m => Relation () r -> m (Projection Flat (Maybe r))
|
queryMaybe :: MonadQualify ConfigureQuery m => Relation () r -> m (Projection Flat (Maybe r))
|
||||||
queryMaybe = fmap snd . queryMaybe'
|
queryMaybe = fmap snd . queryMaybe'
|
||||||
|
|
||||||
queryList0 :: Relation p r -> ListProjection (Projection c) r
|
queryList0 :: MonadQualify ConfigureQuery m => Relation p r -> m (ListProjection (Projection c) r)
|
||||||
queryList0 = unsafeListProjectionFromSubQuery . configureQuery . subQueryQualifyFromRelation
|
queryList0 = liftQualify
|
||||||
|
. fmap unsafeListProjectionFromSubQuery
|
||||||
|
. subQueryQualifyFromRelation
|
||||||
|
|
||||||
-- | List subQuery, for /IN/ and /EXIST/ with place-holder parameter 'p'.
|
-- | List subQuery, for /IN/ and /EXIST/ with place-holder parameter 'p'.
|
||||||
queryList' :: Relation p r -> (PlaceHolders p, ListProjection (Projection c) r)
|
queryList' :: MonadQualify ConfigureQuery m
|
||||||
queryList' = placeHoldersFromRelation &&& queryList0
|
=> Relation p r
|
||||||
|
-> m (PlaceHolders p, ListProjection (Projection c) r)
|
||||||
|
queryList' rel = do
|
||||||
|
ql <- queryList0 rel
|
||||||
|
return (placeHoldersFromRelation rel, ql)
|
||||||
|
|
||||||
-- | List subQuery, for /IN/ and /EXIST/.
|
-- | List subQuery, for /IN/ and /EXIST/.
|
||||||
queryList :: Relation () r -> ListProjection (Projection c) r
|
queryList :: MonadQualify ConfigureQuery m
|
||||||
|
=> Relation () r
|
||||||
|
-> m (ListProjection (Projection c) r)
|
||||||
queryList = queryList0
|
queryList = queryList0
|
||||||
|
|
||||||
-- | Finalize 'QuerySimple' monad and generate 'Relation'.
|
-- | Finalize 'QuerySimple' monad and generate 'Relation'.
|
||||||
|
Loading…
Reference in New Issue
Block a user