Add definitions to specify duplication attribute.

relational-query-HDBC-pgTest/example/1/queryExample.hs

@@ -197,7 +197,8 @@ userGroupStr :: Relation () (Maybe String)
 userGroupStr =
   relation $
   [ u ?!? User.name' ?||? just (value " - ") ?||? g ?!? Group.name'
-  | ug <- query userGroup2
+  | () <- distinct
+  , ug <- query userGroup2
   , let u = ug ! fst'
         g = ug ! snd'
   ]

relational-query/src/Database/Relational/Query.hs

@@ -53,7 +53,7 @@ import Database.Relational.Query.Projection (Projection, list)
 import Database.Relational.Query.Projectable
 import Database.Relational.Query.ProjectableExtended
 import Database.Relational.Query.Monad.Class
-  (on, wheres, groupBy, having, onE, wheresE, havingE)
+  (distinct, all', on, wheres, groupBy, having, onE, wheresE, havingE)
 import Database.Relational.Query.Monad.Trans.Aggregating
   (groupBy', key, key', set, bkey, rollup, cube, groupingSets)
 import Database.Relational.Query.Monad.Trans.Ordering (orderBy, asc, desc)

relational-query/src/Database/Relational/Query/Monad/Class.hs

@@ -16,6 +16,7 @@ module Database.Relational.Query.Monad.Class (
   MonadQualify (..), MonadRestrict (..),
   MonadQuery (..), MonadAggregate (..), MonadPartition (..),
 
+  distinct, all',
   onE, on, wheresE, wheres,
   groupBy,
   havingE, having
@@ -23,7 +24,8 @@ module Database.Relational.Query.Monad.Class (
 
 import Database.Relational.Query.Context (Flat, Aggregated)
 import Database.Relational.Query.Expr (Expr)
-import Database.Relational.Query.Component (AggregateElem, AggregateColumnRef, aggregateColumnRef)
+import Database.Relational.Query.Component
+  (Duplication (Distinct, All), AggregateElem, AggregateColumnRef, aggregateColumnRef)
 import Database.Relational.Query.Projection (Projection)
 import qualified Database.Relational.Query.Projection as Projection
 import Database.Relational.Query.Projectable (expr)
@@ -39,6 +41,8 @@ class (Functor m, Monad m) => MonadRestrict c m where
 
 -- | Query building interface.
 class (Functor m, Monad m) => MonadQuery m where
+  -- | Specify duplication attribute.
+  specifyDuplication :: Duplication -> m ()
   -- | Add restriction to last join.
   restrictJoin :: Expr Flat (Maybe Bool) -- ^ 'Expr' 'Projection' which represent restriction
                -> m ()                   -- ^ Restricted query context
@@ -64,6 +68,14 @@ class Monad m => MonadPartition m where
   unsafeAddPartitionKey :: AggregateColumnRef -- ^ Partitioning key to add into partition by clause
                         -> m ()               -- ^ Result context
 
+-- | Specify distinct attribute to query context.
+distinct :: MonadQuery m => m ()
+distinct =  specifyDuplication Distinct
+
+-- | Specify all attribute to query context.
+all' :: MonadQuery m => m ()
+all' =  specifyDuplication All
+
 -- | Add restriction to last join.
 onE :: MonadQuery m => Expr Flat (Maybe Bool) -> m ()
 onE =  restrictJoin

relational-query/src/Database/Relational/Query/Monad/Trans/Aggregating.hs

@@ -90,8 +90,9 @@ instance MonadRestrict c m => MonadRestrict c (AggregatingSetT m) where
 
 -- | Aggregated 'MonadQuery'.
 instance MonadQuery m => MonadQuery (AggregatingSetT m) where
-  restrictJoin  =  aggregatings . restrictJoin
-  unsafeSubQuery na = aggregatings . unsafeSubQuery na
+  specifyDuplication = aggregatings . specifyDuplication
+  restrictJoin       = aggregatings . restrictJoin
+  unsafeSubQuery na  = aggregatings . unsafeSubQuery na
 
 -- | Unsafely update aggregating context.
 updateAggregatingContext :: Monad m => (TermsContext at -> TermsContext at) -> Aggregatings ac at m ()

relational-query/src/Database/Relational/Query/Monad/Trans/Join.hs

@@ -26,7 +26,7 @@ import Control.Arrow (second, (&&&))
 
 import Database.Relational.Query.Context (Flat)
 import Database.Relational.Query.Monad.Trans.JoinState
-  (JoinContext, primeJoinContext, updateProduct, joinProduct, duplication)
+  (JoinContext, primeJoinContext, updateProduct, joinProduct, setDuplication, duplication)
 import Database.Relational.Query.Internal.Product (NodeAttr, restrictProduct, growProduct)
 import Database.Relational.Query.Projection (Projection)
 import qualified Database.Relational.Query.Projection as Projection
@@ -69,8 +69,9 @@ updateJoinRestriction e = updateContext (updateProduct d)  where
 
 -- | Joinable query instance.
 instance (Monad q, Functor q) => MonadQuery (QueryJoin q) where
-  restrictJoin  =  updateJoinRestriction
-  unsafeSubQuery          = unsafeSubQueryWithAttr
+  specifyDuplication = updateContext . setDuplication
+  restrictJoin       = updateJoinRestriction
+  unsafeSubQuery     = unsafeSubQueryWithAttr
 
 -- | Unsafely join subquery with this query.
 unsafeSubQueryWithAttr :: Monad q

relational-query/src/Database/Relational/Query/Monad/Trans/JoinState.hs

@@ -13,12 +13,12 @@ module Database.Relational.Query.Monad.Trans.JoinState (
   -- * Join context
   JoinContext, primeJoinContext, updateProduct, joinProduct,
 
-  setDistinct, setAll, duplication
+  setDuplication, duplication
   ) where
 
 import Prelude hiding (product)
 
-import Database.Relational.Query.Component (Duplication (Distinct, All))
+import Database.Relational.Query.Component (Duplication (All))
 import qualified Database.Relational.Query.Internal.Product as Product
 import Database.Relational.Query.Sub (QueryProductNode, JoinProduct)
 
@@ -46,13 +46,9 @@ updateProduct uf = updateProduct' (Just . uf)
 joinProduct :: JoinContext -> JoinProduct
 joinProduct =  fmap Product.nodeTree . product
 
--- | Set duplication attribute to Distinct.
-setDistinct :: JoinContext -> JoinContext
-setDistinct ctx = ctx { duplicationAttribute = Distinct }
-
--- | Set duplication attribute to All.
-setAll :: JoinContext -> JoinContext
-setAll ctx = ctx { duplicationAttribute = All }
+-- | Set duplication attribute.
+setDuplication :: Duplication -> JoinContext -> JoinContext
+setDuplication da ctx = ctx { duplicationAttribute = da }
 
 -- | Take duplication attribute.
 duplication :: JoinContext -> Duplication

relational-query/src/Database/Relational/Query/Monad/Trans/Ordering.hs

@@ -70,9 +70,9 @@ instance MonadRestrict rc m => MonadRestrict rc (Orderings c m) where
 
 -- | 'MonadQuery' with ordering.
 instance MonadQuery m => MonadQuery (Orderings c m) where
-  restrictJoin  =  orderings . restrictJoin
-  unsafeSubQuery na       = orderings . unsafeSubQuery na
-  -- unsafeMergeAnotherQuery = unsafeMergeAnotherOrderBys
+  specifyDuplication = orderings . specifyDuplication
+  restrictJoin       =  orderings . restrictJoin
+  unsafeSubQuery na  = orderings . unsafeSubQuery na
 
 -- | 'MonadAggregate' with ordering.
 instance MonadAggregate m => MonadAggregate (Orderings c m) where

relational-query/src/Database/Relational/Query/Monad/Trans/Restricting.hs

@@ -67,8 +67,9 @@ instance (Monad q, Functor q) => MonadRestrict c (Restrictings c q) where
 
 -- | Restricted 'MonadQuery' instance.
 instance MonadQuery q => MonadQuery (Restrictings c q) where
-  restrictJoin     = restrictings . restrictJoin
-  unsafeSubQuery a = restrictings . unsafeSubQuery a
+  specifyDuplication = restrictings . specifyDuplication
+  restrictJoin       = restrictings . restrictJoin
+  unsafeSubQuery a   = restrictings . unsafeSubQuery a
 
 -- | Resticted 'MonadAggregate' instance.
 instance MonadAggregate m => MonadAggregate (Restrictings c m) where