Apply query context tag types.

relational-join/relational-join.cabal

@@ -36,7 +36,6 @@ library
                        Database.Relational.Query.Expr.Unsafe
                        Database.Relational.Query.Sub
                        Database.Relational.Query.Projection
-                       Database.Relational.Query.Aggregation
                        Database.Relational.Query.Monad.Class
                        Database.Relational.Query.Monad.Trans.Ordering
                        Database.Relational.Query.Monad.Trans.Aggregating

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

@@ -16,7 +16,6 @@ module Database.Relational.Query (
   module Database.Relational.Query.Expr,
   module Database.Relational.Query.Sub,
   module Database.Relational.Query.Projection,
-  module Database.Relational.Query.Aggregation,
   module Database.Relational.Query.Projectable,
   module Database.Relational.Query.ProjectableExtended,
   module Database.Relational.Query.Monad.Class,
@@ -45,7 +44,6 @@ import Database.Relational.Query.Constraint
 import Database.Relational.Query.Expr hiding (fromJust, just)
 import Database.Relational.Query.Sub (SubQuery, unitSQL, queryWidth)
 import Database.Relational.Query.Projection (Projection)
-import Database.Relational.Query.Aggregation (Aggregation)
 import Database.Relational.Query.Projectable
 import Database.Relational.Query.ProjectableExtended
 import Database.Relational.Query.Monad.Class

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

@@ -1,85 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-
--- |
--- Module      : Database.Relational.Query.Aggregation
--- Copyright   : 2013 Kei Hibino
--- License     : BSD3
---
--- Maintainer  : ex8k.hibino@gmail.com
--- Stability   : experimental
--- Portability : unknown
---
--- This module defines aggregated query projection type structure and interfaces.
-module Database.Relational.Query.Aggregation (
-  -- * Projection definition for Aggregated query
-  Aggregation,
-  unsafeProjection,
-  mapAggregation,
-
-  unsafeFromProjection,
-
-  -- * Aggregated Query Projections
-  compose,
-
-  pi, piMaybe, piMaybe',
-
-  flattenMaybe, just
-  ) where
-
-
-import Prelude hiding (pi)
-
-import Database.Relational.Query.Projection (Projection)
-import qualified Database.Relational.Query.Projection as Projection
-import Database.Relational.Query.Pi (Pi)
-
-
--- | Projection for aggregated query.
-newtype Aggregation r = Aggregation (Projection r)
-
--- | Get projection of normal query.
-unsafeProjection :: Aggregation r -> Projection r
-unsafeProjection (Aggregation p) = p
-
--- | Map from 'Projection' into 'Aggregation'.
-mapAggregation ::  (Projection a -> Projection b) -> Aggregation a -> Aggregation b
-mapAggregation f = Aggregation . f . unsafeProjection
-
--- | Unsafely make 'Aggregation' from 'Projection'.
-unsafeFromProjection :: Projection r -> Aggregation r
-unsafeFromProjection =  Aggregation
-
--- | Concatenate 'Aggregation'.
-compose :: Aggregation a -> Aggregation b -> Aggregation (c a b)
-compose (Aggregation a) (Aggregation b) = Aggregation $ a `Projection.compose` b
-
--- | Map Projection path into Aggregation.
-definePi :: (Projection a -> Pi a' b' -> Projection b) -> Aggregation a -> Pi a' b' -> Aggregation b
-definePi (!!!) p pi' = mapAggregation (!!! pi') p
-
--- | Trace projection path to get smaller 'Aggregation'.
-pi :: Aggregation a -- ^ Source projection. 'Maybe' type
-   -> Pi a b        -- ^ Projection path
-   -> Aggregation b -- ^ Narrower projection
-pi =  definePi Projection.pi
-
--- | Trace projection path to get smaller 'Aggregation'. From 'Maybe' type to 'Maybe' type.
-piMaybe :: Aggregation (Maybe a) -- ^ Source projection. 'Maybe' type
-        -> Pi a b                -- ^ Projection path
-        -> Aggregation (Maybe b) -- ^ Narrower projection. 'Maybe' type result
-piMaybe = definePi Projection.piMaybe
-
--- | Trace projection path to get smaller 'Aggregation'. From 'Maybe' type to 'Maybe' type.
---   Projection path's leaf is 'Maybe' case.
-piMaybe' :: Aggregation (Maybe a) -- ^ Source projection. 'Maybe' type
-         -> Pi a (Maybe b)        -- ^ Projection path. 'Maybe' type leaf
-         -> Aggregation (Maybe b) -- ^ Narrower projection. 'Maybe' type result
-piMaybe' =  definePi Projection.piMaybe'
-
--- | Composite nested 'Maybe' on projection phantom type.
-flattenMaybe :: Aggregation (Maybe (Maybe a)) -> Aggregation (Maybe a)
-flattenMaybe =  mapAggregation Projection.flattenMaybe
-
--- | Cast into 'Maybe' on projection phantom type.
-just :: Aggregation a -> Aggregation (Maybe a)
-just =  mapAggregation Projection.just

relational-join/src/Database/Relational/Query/Expr/Unsafe.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE KindSignatures #-}
-
 -- |
 -- Module      : Database.Relational.Query.Expr.Unsafe
 -- Copyright   : 2013 Kei Hibino
@@ -17,7 +15,7 @@ module Database.Relational.Query.Expr.Unsafe (
   ) where
 
 -- | Phantom typed SQL expression object. Project from projection type 'p'.
-newtype Expr (p :: * -> *) a = Expr (String)
+newtype Expr p a = Expr String
 
 -- | Get SQL expression from typed object.
 showExpr :: Expr p t -> String

relational-join/src/Database/Relational/Query/Internal/Product.hs

@@ -20,10 +20,10 @@ module Database.Relational.Query.Internal.Product (
   ) where
 
 import Prelude hiding (and, product)
+import Database.Relational.Query.Context (Flat)
 import Database.Relational.Query.Expr (fromTriBool, exprAnd)
 import qualified Database.Relational.Query.Expr as Expr
 import Database.Relational.Query.Expr.Unsafe (showExpr)
-import Database.Relational.Query.Projection (Projection)
 import Database.Relational.Query.Projectable (valueTrue)
 import Database.Relational.Query.Sub (SubQuery, Qualified)
 import qualified Database.Relational.Query.Sub as SubQuery
@@ -37,7 +37,7 @@ import Data.Monoid ((<>))
 import Data.Foldable (Foldable (foldMap))
 
 
-type Expr = Expr.Expr Projection
+type Expr = Expr.Expr Flat
 
 -- | node attribute for product.
 data NodeAttr = Just' | Maybe

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

@@ -22,10 +22,9 @@ module Database.Relational.Query.Monad.Aggregate (
   toSubQuery
   ) where
 
+import Database.Relational.Query.Context (Flat, Aggregated)
 import Database.Relational.Query.Projection (Projection)
 import qualified Database.Relational.Query.Projection as Projection
-import Database.Relational.Query.Aggregation (Aggregation)
-import qualified Database.Relational.Query.Aggregation as Aggregation
 import Database.Relational.Query.SQL (selectSeedSQL)
 import Database.Relational.Query.Sub (SubQuery, subQuery)
 
@@ -43,28 +42,28 @@ import Database.Relational.Query.Monad.Type (QueryCore)
 
 
 -- | Aggregated query monad type.
-type QueryAggregate    = Orderings Aggregation (Aggregatings QueryCore)
+type QueryAggregate    = Orderings Aggregated (Aggregatings QueryCore)
 
--- | Aggregated query type. AggregatedQuery r == QueryAggregate (Aggregation r).
+-- | Aggregated query type. AggregatedQuery r == QueryAggregate (Projection Aggregated r).
-type AggregatedQuery r = OrderedQuery Aggregation (Aggregatings QueryCore) r
+type AggregatedQuery r = OrderedQuery Aggregated (Aggregatings QueryCore) r
 
 -- | Lift from qualified table forms into 'QueryAggregate'.
 aggregatedQuery :: Qualify a -> QueryAggregate a
 aggregatedQuery =  orderings . aggregatings . restrictings . join'
 
 -- | Instance to lift from qualified table forms into 'QueryAggregate'.
-instance MonadQualify Qualify (Orderings Aggregation (Aggregatings QueryCore)) where
+instance MonadQualify Qualify (Orderings Aggregated (Aggregatings QueryCore)) where
   liftQualify = aggregatedQuery
 
 expandPrepend :: AggregatedQuery r
-             -> Qualify ((((Aggregation r, OrderByPrepend), GroupBysPrepend), WherePrepend), FromPrepend)
+                 -> Qualify ((((Projection Aggregated r, OrderByPrepend), GroupBysPrepend), WherePrepend), FromPrepend)
 expandPrepend =  extractFrom . extractWheres . extractGroupBys . extractOrderBys
 
 -- | Run 'AggregatedQuery' to get SQL string.
-expandSQL :: AggregatedQuery r -> Qualify (String, Projection r)
+expandSQL :: AggregatedQuery r -> Qualify (String, Projection Flat r)
 expandSQL q = do
   ((((aggr, ao), ag), aw), af) <- expandPrepend q
-  let projection = Aggregation.unsafeProjection aggr
+  let projection = Projection.unsafeToFlat aggr
   return (selectSeedSQL projection . prependFrom af . prependWhere aw
           . prependGroupBys ag . prependOrderBy ao $ "",
           projection)

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

@@ -20,9 +20,9 @@ module Database.Relational.Query.Monad.Class (
   groupBy, havingE, having
   ) where
 
+import Database.Relational.Query.Context (Flat, Aggregated)
 import Database.Relational.Query.Expr (Expr)
 import Database.Relational.Query.Projection (Projection)
-import Database.Relational.Query.Aggregation (Aggregation)
 import Database.Relational.Query.Projectable (expr)
 import Database.Relational.Query.Sub (SubQuery, Qualified)
 
@@ -31,13 +31,13 @@ import Database.Relational.Query.Internal.Product (NodeAttr)
 -- | Restrict context interface
 class (Functor m, Monad m) => MonadRestrict m where
   -- | Add restriction to this context.
-  restrictContext :: Expr Projection (Maybe Bool) -- ^ 'Expr' 'Projection' which represent restriction
+  restrictContext :: Expr Flat (Maybe Bool) -- ^ 'Expr' 'Projection' which represent restriction
                   -> m ()                         -- ^ Restricted query context
 
 -- | Query building interface.
 class (Functor m, Monad m) => MonadQuery m where
   -- | Add restriction to last join.
-  restrictJoin :: Expr Projection (Maybe Bool) -- ^ 'Expr' 'Projection' which represent restriction
+  restrictJoin :: Expr Flat (Maybe Bool) -- ^ 'Expr' 'Projection' which represent restriction
                -> m ()                   -- ^ Restricted query context
   -- -- | Add restriction to this query.
   -- restrictQuery :: Expr Projection (Maybe Bool) -- ^ 'Expr' 'Projection' which represent restriction
@@ -45,7 +45,7 @@ class (Functor m, Monad m) => MonadQuery m where
   -- | Unsafely join subquery with this query.
   unsafeSubQuery :: NodeAttr              -- ^ Attribute maybe or just
                  -> Qualified SubQuery    -- ^ 'SubQuery' to join
-                 -> m (Projection r)   -- ^ Result joined context and 'SubQuery' result projection.
+                 -> m (Projection Flat r) -- ^ Result joined context and 'SubQuery' result projection.
   -- unsafeMergeAnotherQuery :: NodeAttr -> m (Projection r) -> m (Projection r)
 
 -- | Lift interface from base qualify monad.
@@ -57,38 +57,38 @@ class (Functor q, Monad q, MonadQuery m) => MonadQualify q m where
 -- | Aggregated query building interface extends 'MonadQuery'.
 class MonadQuery m => MonadAggregate m where
   -- | Add /group by/ term into context and get aggregated projection.
-  aggregateKey :: Projection r      -- ^ Projection to add into group by
+  aggregateKey :: Projection Flat r           -- ^ Projection to add into group by
-               -> m (Aggregation r) -- ^ Result context and aggregated projection
+               -> m (Projection Aggregated r) -- ^ Result context and aggregated projection
   -- | Add restriction to this aggregated query.
-  restrictAggregatedQuery :: Expr Aggregation (Maybe Bool) -- ^ 'Expr' 'Aggregation' which represent restriction
+  restrictAggregatedQuery :: Expr Aggregated (Maybe Bool) -- ^ 'Expr' 'Aggregated' which represent restriction
                           -> m ()                          -- ^ Restricted query context
 
 -- | Add restriction to last join.
-onE :: MonadQuery m => Expr Projection (Maybe Bool) -> m ()
+onE :: MonadQuery m => Expr Flat (Maybe Bool) -> m ()
 onE =  restrictJoin
 
 -- | Add restriction to last join. Projection type version.
-on :: MonadQuery m => Projection (Maybe Bool) -> m ()
+on :: MonadQuery m => Projection Flat (Maybe Bool) -> m ()
 on =  restrictJoin . expr
 
 -- | Add restriction to this query.
-wheresE :: MonadRestrict m => Expr Projection (Maybe Bool) -> m ()
+wheresE :: MonadRestrict m => Expr Flat (Maybe Bool) -> m ()
 wheresE =  restrictContext
 
 -- | Add restriction to this query. Projection type version.
-wheres :: MonadRestrict m => Projection (Maybe Bool) -> m ()
+wheres :: MonadRestrict m => Projection Flat (Maybe Bool) -> m ()
 wheres =  restrictContext . expr
 
 -- | Add /group by/ term into context and get aggregated projection.
 groupBy :: MonadAggregate m
-        => Projection r      -- ^ Projection to add into group by
+        => Projection Flat r      -- ^ Projection to add into group by
-        -> m (Aggregation r) -- ^ Result context and aggregated projection
+        -> m (Projection Aggregated r) -- ^ Result context and aggregated projection
 groupBy =  aggregateKey
 
 -- | Add restriction to this aggregated query.
-havingE :: MonadAggregate m => Expr Aggregation (Maybe Bool) -> m ()
+havingE :: MonadAggregate m => Expr Aggregated (Maybe Bool) -> m ()
 havingE =  restrictAggregatedQuery
 
--- | Add restriction to this aggregated query. Aggregation type version.
+-- | Add restriction to this aggregated query. Aggregated Projection type version.
-having :: MonadAggregate m => Aggregation (Maybe Bool) -> m ()
+having :: MonadAggregate m => Projection Aggregated (Maybe Bool) -> m ()
 having =  restrictAggregatedQuery . expr

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

@@ -18,6 +18,7 @@ module Database.Relational.Query.Monad.Restrict (
 
 import Data.Functor.Identity (Identity (..), runIdentity)
 
+import Database.Relational.Query.Context (Flat)
 import Database.Relational.Query.Projection (Projection)
 import Database.Relational.Query.Monad.Trans.Restricting
   (Restrictings, WherePrepend, extractWheres)
@@ -29,7 +30,7 @@ type Restrict = Restrictings Identity
 -- | RestrictedStatement type synonym.
 --   Projection record type 'r' must be
 --   the same as 'Restrictings' type parameter 'r'.
-type RestrictedStatement r a = Projection r -> Restrict a
+type RestrictedStatement r a = Projection Flat r -> Restrict a
 
 -- -- | 'return' of 'Restrict'
 -- restricted :: a -> Restrict a

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

@@ -22,6 +22,7 @@ module Database.Relational.Query.Monad.Simple (
   toSubQuery
   ) where
 
+import Database.Relational.Query.Context (Flat)
 import Database.Relational.Query.Projection (Projection)
 import qualified Database.Relational.Query.Projection as Projection
 import Database.Relational.Query.SQL (selectSeedSQL)
@@ -40,25 +41,25 @@ import Database.Relational.Query.Sub (SubQuery, subQuery)
 
 
 -- | Simple query (not-aggregated) monad type.
-type QuerySimple = Orderings Projection QueryCore
+type QuerySimple = Orderings Flat QueryCore
 
 -- | Simple query (not-aggregated) query type. 'SimpleQuery' r == 'QuerySimple' ('Projection' r).
-type SimpleQuery r = OrderedQuery Projection QueryCore r
+type SimpleQuery r = OrderedQuery Flat QueryCore r
 
 -- | Lift from qualified table forms into 'QuerySimple'.
 simple :: Qualify a -> QuerySimple a
 simple =  orderings . restrictings . join'
 
 -- | Instance to lift from qualified table forms into 'QuerySimple'.
-instance MonadQualify Qualify (Orderings Projection QueryCore) where
+instance MonadQualify Qualify (Orderings Flat QueryCore) where
   liftQualify = simple
 
 expandPrepend :: SimpleQuery r
-              -> Qualify (((Projection r, OrderByPrepend), WherePrepend), FromPrepend)
+              -> Qualify (((Projection Flat r, OrderByPrepend), WherePrepend), FromPrepend)
 expandPrepend =  extractFrom . extractWheres . extractOrderBys
 
 -- | Run 'SimpleQuery' to get SQL string.
-expandSQL :: SimpleQuery r -> Qualify (String, Projection r)
+expandSQL :: SimpleQuery r -> Qualify (String, Projection Flat r)
 expandSQL q = do
   (((pj, ao), aw), af) <- expandPrepend q
   return (selectSeedSQL pj . prependFrom af . prependWhere aw . prependOrderBy ao $ "", pj)

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

@@ -15,6 +15,7 @@ module Database.Relational.Query.Monad.Target (
   expandPrepend
   ) where
 
+import Database.Relational.Query.Context (Flat)
 import Database.Relational.Query.Table (Table)
 import Database.Relational.Query.Projection (Projection)
 import Database.Relational.Query.Monad.Restrict (Restrict, expandWhere)
@@ -28,7 +29,7 @@ type Target r = Assignings r Restrict
 -- | TargetStatement type synonym.
 --   Table and projection record type must be
 --   the same as 'Target' type parameter 'r'.
-type TargetStatement r a = Table r -> Projection r -> Target r a
+type TargetStatement r a = Table r -> Projection Flat r -> Target r a
 
 -- -- | 'return' of 'Update'
 -- updateStatement :: a -> Assignings r (Restrictings Identity) a

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

@@ -24,6 +24,7 @@ import Control.Monad.Trans.State (StateT, runStateT, modify)
 import Control.Applicative (Applicative, (<$>))
 import Control.Arrow (second, (>>>))
 
+import Database.Relational.Query.Context (Flat, Aggregated)
 import Database.Relational.Query.Monad.Trans.StatePrepend (Prepend, prepend, liftToString)
 import Database.Relational.Query.Monad.Trans.AggregatingState
   (AggregatingContext, primeAggregatingContext, addGroupBy, composeGroupBys)
@@ -31,8 +32,6 @@ import qualified Database.Relational.Query.Monad.Trans.AggregatingState as State
 import Database.Relational.Query.Expr (Expr)
 import Database.Relational.Query.Projection (Projection)
 import qualified Database.Relational.Query.Projection as Projection
-import Database.Relational.Query.Aggregation (Aggregation)
-import qualified Database.Relational.Query.Aggregation as Aggregation
 
 import Database.Relational.Query.Monad.Class
   (MonadRestrict(..), MonadQuery(..), MonadAggregate(..))
@@ -77,17 +76,17 @@ addGroupBys' gbs = updateAggregatingContext . foldr (>>>) id $ map addGroupBy gb
 
 -- | Add restrictions for aggregated query.
 addRestriction :: MonadQuery m
-               => Expr Aggregation (Maybe Bool) -- ^ Restriction to add
+               => Expr Aggregated (Maybe Bool) -- ^ Restriction to add
                -> Aggregatings m ()            -- ^ Result restricted context
 addRestriction =  updateAggregatingContext . State.addRestriction
 
 -- | Add aggregating terms.
 addGroupBys :: MonadQuery m
-            => Projection r                   -- ^ Group-by term to add
+            => Projection Flat r              -- ^ Group-by term to add
-            -> Aggregatings m (Aggregation r) -- ^ Result aggregated context
+            -> Aggregatings m (Projection Aggregated r) -- ^ Result aggregated context
 addGroupBys p = do
   addGroupBys' . Projection.columns $ p
-  return $ Aggregation.unsafeFromProjection p
+  return $ Projection.unsafeToAggregated p
 
 -- | Aggregated query instance.
 instance MonadQuery m => MonadAggregate (Aggregatings m) where

relational-join/src/Database/Relational/Query/Monad/Trans/AggregatingState.hs

@@ -27,9 +27,9 @@ import qualified Data.DList as DList
 import Data.Monoid ((<>))
 import Control.Applicative (pure)
 
+import Database.Relational.Query.Context (Aggregated)
 import Database.Relational.Query.Expr (Expr, fromTriBool, exprAnd)
 import Database.Relational.Query.Expr.Unsafe (showExpr)
-import Database.Relational.Query.Aggregation (Aggregation)
 
 import Language.SQL.Keyword (Keyword(..), unwordsSQL)
 import qualified Language.SQL.Keyword as SQL
@@ -46,7 +46,7 @@ type GroupBys = DList GroupByTerm
 data AggregatingContext =
   AggregatingContext
   { groupByTerms :: GroupBys
-  , restriction  :: Maybe (Expr Aggregation Bool)
+  , restriction  :: Maybe (Expr Aggregated Bool)
   }
 
 -- | Initial value of 'AggregatingContext'.
@@ -58,7 +58,7 @@ addGroupBy :: String -> AggregatingContext -> AggregatingContext
 addGroupBy t c =  c { groupByTerms = groupByTerms c <> pure t }
 
 -- | Add having restriction into 'AggregatingContext'.
-addRestriction :: Expr Aggregation (Maybe Bool) -> AggregatingContext -> AggregatingContext
+addRestriction :: Expr Aggregated (Maybe Bool) -> AggregatingContext -> AggregatingContext
 addRestriction e1 ctx =
   ctx { restriction = Just . uf . restriction $ ctx }
   where uf  Nothing  = fromTriBool e1

relational-join/src/Database/Relational/Query/Monad/Trans/Assigning.hs

@@ -23,6 +23,7 @@ module Database.Relational.Query.Monad.Trans.Assigning (
   SetPrepend, prependSet
   ) where
 
+import Database.Relational.Query.Context (Flat)
 import Control.Monad.Trans.Class (MonadTrans (lift))
 import Control.Monad.Trans.State (StateT, runStateT, modify)
 import Control.Applicative (Applicative, (<$>))
@@ -70,12 +71,12 @@ instance MonadRestrict m => MonadRestrict (Assignings r m) where
 -- | Target of assignment.
 newtype AssignTarget r v = AssignTarget (Table r, Pi r v)
 
-targetProjection :: AssignTarget r v -> Projection v
+targetProjection :: AssignTarget r v -> Projection Flat v
 targetProjection (AssignTarget (tbl, pi')) =
   Projection.pi (Projection.unsafeFromTable tbl) pi'
 
 -- | Add an assignment.
-assignTo :: Monad m => Projection v ->  AssignTarget r v -> Assignings r m ()
+assignTo :: Monad m => Projection Flat v ->  AssignTarget r v -> Assignings r m ()
 assignTo vp target = updateAssigningContext . foldr (>>>) id
                      $ zipWith updateAssignments lefts rights  where
   lefts  = Projection.columns $ targetProjection target
@@ -86,7 +87,7 @@ assignTo vp target = updateAssigningContext . foldr (>>>) id
 (!#) =  curry AssignTarget
 
 -- | Add and assginment.
-(<-#) :: Monad m => AssignTarget r v -> Projection v -> Assignings r m ()
+(<-#) :: Monad m => AssignTarget r v -> Projection Flat v -> Assignings r m ()
 (<-#) =  flip assignTo
 
 infix 8 !#

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

@@ -24,6 +24,7 @@ import Control.Monad.Trans.State (modify, StateT, runStateT)
 import Control.Applicative (Applicative, (<$>))
 import Control.Arrow (second)
 
+import Database.Relational.Query.Context (Flat)
 import Database.Relational.Query.Monad.Trans.StatePrepend (Prepend, prepend, liftToString)
 import Database.Relational.Query.Monad.Trans.JoinState
   (JoinContext, primeJoinContext, updateProduct, composeFrom)
@@ -61,7 +62,7 @@ updateContext :: Monad m => (JoinContext -> JoinContext) -> QueryJoin m ()
 updateContext =  QueryJoin . modify
 
 -- | Add last join product restriction.
-updateJoinRestriction :: Monad m => Expr Projection (Maybe Bool) -> QueryJoin m ()
+updateJoinRestriction :: Monad m => Expr Flat (Maybe Bool) -> QueryJoin m ()
 updateJoinRestriction e = updateContext (updateProduct d)  where
   d  Nothing  = error "on: product is empty!"
   d (Just pt) = restrictProduct pt (fromTriBool e)
@@ -84,7 +85,7 @@ instance (Monad q, Functor q) => MonadQuery (QueryJoin q) where
 unsafeSubQueryWithAttr :: Monad q
                        => NodeAttr                        -- ^ Attribute maybe or just
                        -> Qualified SubQuery              -- ^ 'SubQuery' to join
-                       -> QueryJoin q (Projection r) -- ^ Result joined context and 'SubQuery' result projection.
+                       -> QueryJoin q (Projection Flat r) -- ^ Result joined context and 'SubQuery' result projection.
 unsafeSubQueryWithAttr attr qsub = do
   updateContext (updateProduct (`growProduct` (attr, qsub)))
   return $ Projection.unsafeFromQualifiedSubQuery qsub

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

@@ -1,4 +1,4 @@
-{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 -- |
@@ -34,8 +34,6 @@ import Database.Relational.Query.Monad.Trans.OrderingState
   (Order(Asc, Desc), OrderingContext, primeOrderingContext, updateOrderBy, composeOrderBys)
 import Database.Relational.Query.Projection (Projection)
 import qualified Database.Relational.Query.Projection as Projection
-import Database.Relational.Query.Aggregation (Aggregation)
-import qualified Database.Relational.Query.Aggregation as Aggregation
 
 import Database.Relational.Query.Monad.Class
   (MonadRestrict(..), MonadQuery(..), MonadAggregate(..))
@@ -43,7 +41,7 @@ import Database.Relational.Query.Monad.Class
 
 -- | 'StateT' type to accumulate ordering context.
 --   Type 'p' is ordering term projection type.
-newtype Orderings (p :: * -> *) m a =
+newtype Orderings p m a =
   Orderings { orderingState :: StateT OrderingContext m a }
   deriving (MonadTrans, Monad, Functor, Applicative)
 
@@ -78,28 +76,24 @@ instance MonadAggregate m => MonadAggregate (Orderings p m) where
   restrictAggregatedQuery = orderings . restrictAggregatedQuery
 
 -- | OrderedQuery type synonym. Projection must be the same as 'Orderings' type parameter 'p'
-type OrderedQuery p m r = Orderings p m (p r)
+type OrderedQuery p m r = Orderings p m (Projection p r)
 
 -- | Ordering term projection type interface.
 class OrderingTerms p where
   orderTerms :: p t -> [String]
 
 -- | 'Projection' is ordering term.
-instance OrderingTerms Projection where
+instance OrderingTerms (Projection c) where
   orderTerms = Projection.columns
 
--- | 'Aggregation' is ordering term.
-instance OrderingTerms Aggregation where
-  orderTerms = Projection.columns . Aggregation.unsafeProjection
-
 -- | Unsafely update ordering context.
 updateOrderingContext :: Monad m => (OrderingContext -> OrderingContext) -> Orderings p m ()
 updateOrderingContext =  Orderings . modify
 
 -- | Add ordering terms.
-updateOrderBys :: (Monad m, OrderingTerms p)
+updateOrderBys :: (Monad m, OrderingTerms (Projection p))
                => Order            -- ^ Order direction
-               -> p t              -- ^ Ordering terms to add
+               -> Projection p t   -- ^ Ordering terms to add
                -> Orderings p m () -- ^ Result context with ordering
 updateOrderBys order p = updateOrderingContext . foldr (>>>) id $ updates  where
   updates = updateOrderBy order `map` orderTerms p
@@ -125,14 +119,14 @@ unsafeMergeAnotherOrderBys naR qR = do
 
 
 -- | Add ascendant ordering term.
-asc  :: (Monad m, OrderingTerms p)
+asc :: (Monad m, OrderingTerms (Projection p))
-     => p t              -- ^ Ordering terms to add
+    => Projection p t   -- ^ Ordering terms to add
     -> Orderings p m () -- ^ Result context with ordering
 asc  =  updateOrderBys Asc
 
 -- | Add descendant ordering term.
-desc :: (Monad m, OrderingTerms p)
+desc :: (Monad m, OrderingTerms (Projection p))
-     => p t              -- ^ Ordering terms to add
+     => Projection p t   -- ^ Ordering terms to add
      -> Orderings p m () -- ^ Result context with ordering
 desc =  updateOrderBys Desc
 

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

@@ -24,10 +24,10 @@ import Control.Monad.Trans.State (modify, StateT, runStateT)
 import Control.Applicative (Applicative, (<$>))
 import Control.Arrow (second)
 
+import Database.Relational.Query.Context (Flat)
 import Database.Relational.Query.Monad.Trans.StatePrepend (Prepend, prepend, liftToString)
 import Database.Relational.Query.Monad.Trans.RestrictingState
   (RestrictContext, primeRestrictContext, addRestriction, composeWheres)
-import Database.Relational.Query.Projection (Projection)
 import Database.Relational.Query.Expr (Expr)
 
 import Database.Relational.Query.Monad.Class (MonadRestrict(..), MonadQuery (..))
@@ -58,7 +58,7 @@ updateRestrictContext :: Monad m => (RestrictContext -> RestrictContext) -> Rest
 updateRestrictContext =  Restrictings . modify
 
 -- | Add whole query restriction.
-updateRestriction :: Monad m => Expr Projection (Maybe Bool) -> Restrictings m ()
+updateRestriction :: Monad m => Expr Flat (Maybe Bool) -> Restrictings m ()
 updateRestriction e = updateRestrictContext (addRestriction e)
 
 -- | 'MonadRestrict' instance.

relational-join/src/Database/Relational/Query/Monad/Trans/RestrictingState.hs

@@ -20,11 +20,10 @@ module Database.Relational.Query.Monad.Trans.RestrictingState (
   composeWheres
   ) where
 
+import Database.Relational.Query.Context (Flat)
 import Database.Relational.Query.Expr (Expr, fromTriBool, exprAnd)
 import Database.Relational.Query.Expr.Unsafe (showExpr)
 
-import Database.Relational.Query.Projection (Projection)
-
 import Language.SQL.Keyword (Keyword(..), unwordsSQL)
 import qualified Language.SQL.Keyword as SQL
 
@@ -32,21 +31,21 @@ import qualified Language.SQL.Keyword as SQL
 -- | Context type for Restrict.
 data RestrictContext =
   RestrictContext
-  { restriction :: Maybe (Expr Projection Bool) }
+  { restriction :: Maybe (Expr Flat Bool) }
 
 -- | Initial 'RestrictContext'.
 primeRestrictContext :: RestrictContext
 primeRestrictContext =  RestrictContext Nothing
 
 -- | Add restriction of 'RestrictContext'.
-addRestriction :: Expr Projection (Maybe Bool) -> RestrictContext -> RestrictContext
+addRestriction :: Expr Flat (Maybe Bool) -> RestrictContext -> RestrictContext
 addRestriction e1 ctx =
   ctx { restriction = Just . uf . restriction $ ctx }
   where uf  Nothing  = fromTriBool e1
         uf (Just e0) = e0 `exprAnd` fromTriBool e1
 
 -- | Compose SQL String from 'RestrictContext' object.
-composeWheres' :: Maybe (Expr Projection Bool) -> String
+composeWheres' :: Maybe (Expr Flat Bool) -> String
 composeWheres' =  maybe [] (\e -> unwordsSQL [WHERE, SQL.word . showExpr $ e])
 
 -- | Compose SQL String from 'RestrictContext' object.

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

@@ -10,8 +10,8 @@
 -- This module defines operators on various polymorphic projections.
 module Database.Relational.Query.Projectable (
   -- * Conversion between individual Projections
-  ExpressionProjectable (expr),
+  expr,
-  ProjectablePi (pi, piMaybe, piMaybe'),
+  -- ProjectablePi (pi, piMaybe, piMaybe'),
 
   -- * Projectable from SQL strings
   SqlProjectable (unsafeProjectSqlTerms), unsafeProjectSql,
@@ -29,7 +29,6 @@ module Database.Relational.Query.Projectable (
   -- * Projectable into SQL strings
   unsafeShowSqlExpr,
   unsafeShowSqlProjection,
-  unsafeShowSqlAggregation,
   ProjectableShowSql (unsafeShowSql),
 
   -- * Binary Operators
@@ -72,9 +71,6 @@ import Database.Relational.Query.Pi (Pi, piZip)
 import Database.Relational.Query.Projection (Projection, columns, unsafeFromColumns)
 import qualified Database.Relational.Query.Projection as Projection
 
-import Database.Relational.Query.Aggregation (Aggregation)
-import qualified Database.Relational.Query.Aggregation as Aggregation
-
 
 -- | Parened String.
 paren :: String -> String
@@ -88,24 +84,17 @@ sqlTermsString = d  where
   d (cs) =  paren $ intercalate ", " cs
 
 -- | SQL expression strings which represent projection.
-sqlStringOfProjection :: Projection r -> String
+sqlStringOfProjection :: Projection c r -> String
 sqlStringOfProjection =  sqlTermsString . columns
 
 -- | 'Expr' from 'Projection'
-exprOfProjection :: Projection r -> Expr Projection r
+exprOfProjection :: Projection c r -> Expr c r
 exprOfProjection =  UnsafeExpr.Expr . sqlStringOfProjection
 
--- | Projection interface into expression.
+-- | Project from Projection type into expression type.
-class ExpressionProjectable p where
+expr :: Projection p a -> Expr p a
-  -- | Project from Projection type 'p' into expression type.
-  expr :: p a -> Expr p a
-
-instance ExpressionProjectable Projection where
 expr =  exprOfProjection
 
-instance ExpressionProjectable Aggregation where
-  expr = UnsafeExpr.Expr . sqlStringOfProjection . Aggregation.unsafeProjection
-
 -- | Projection interface.
 class ProjectablePi p where
   -- | Trace projection path 'Pi' to get narrower projection type 'p'.
@@ -116,19 +105,14 @@ class ProjectablePi p where
   --   Leaf type of projection path is 'Maybe'.
   piMaybe' :: p (Maybe a) -> Pi a (Maybe b) -> p (Maybe b)
 
-instance ProjectablePi Projection where
+instance ProjectablePi (Projection c) where
   pi       = Projection.pi
   piMaybe  = Projection.piMaybe
   piMaybe' = Projection.piMaybe'
 
-instance ProjectablePi Aggregation where
-  pi       = Aggregation.pi
-  piMaybe  = Aggregation.piMaybe
-  piMaybe' = Aggregation.piMaybe'
-
 
 -- | Unsafely generate 'Projection' from SQL expression strings.
-unsafeSqlTermsProjection :: [String] -> Projection t
+unsafeSqlTermsProjection :: [String] -> Projection c t
 unsafeSqlTermsProjection =  unsafeFromColumns
 
 -- | Interface to project SQL terms unsafely.
@@ -138,17 +122,13 @@ class SqlProjectable p where
                         -> p t      -- ^ Result projection object
 
 -- | Unsafely make 'Projection' from SQL terms.
-instance SqlProjectable Projection where
+instance SqlProjectable (Projection c) where
   unsafeProjectSqlTerms = unsafeSqlTermsProjection
 
 -- | Unsafely make 'Expr' from SQL terms.
 instance SqlProjectable (Expr p) where
   unsafeProjectSqlTerms = UnsafeExpr.Expr . sqlTermsString
 
--- | Unsafely make 'Aggregation' from SQL terms.
-instance SqlProjectable Aggregation where
-  unsafeProjectSqlTerms = Aggregation.unsafeFromProjection . unsafeProjectSqlTerms
-
 -- | Unsafely Project single SQL term.
 unsafeProjectSql :: SqlProjectable p => String -> p t
 unsafeProjectSql =  unsafeProjectSqlTerms . (:[])
@@ -189,21 +169,13 @@ instance ProjectableShowSql (Expr p) where
   unsafeShowSql = unsafeShowSqlExpr
 
 -- | Unsafely get SQL term from 'Proejction'.
-unsafeShowSqlProjection :: Projection r -> String
+unsafeShowSqlProjection :: Projection c r -> String
 unsafeShowSqlProjection = sqlStringOfProjection
 
 -- | Unsafely get SQL term from 'Proejction'.
-instance ProjectableShowSql Projection where
+instance ProjectableShowSql (Projection c) where
   unsafeShowSql = unsafeShowSqlProjection
 
--- | Unsafely get SQL term from 'Aggregation'.
-unsafeShowSqlAggregation :: Aggregation a -> String
-unsafeShowSqlAggregation =  unsafeShowSql . Aggregation.unsafeProjection
-
--- | Unsafely get SQL term from 'Aggregation'.
-instance ProjectableShowSql Aggregation where
-  unsafeShowSql = unsafeShowSqlAggregation
-
 
 -- | Binary operator type for SQL String.
 type SqlBinOp = String -> String -> String
@@ -394,13 +366,9 @@ instance ProjectableZip PlaceHolders where
   projectZip PlaceHolders PlaceHolders = PlaceHolders
 
 -- | Zip 'Projection'.
-instance ProjectableZip Projection where
+instance ProjectableZip (Projection c) where
   projectZip = Projection.compose
 
--- | Zip 'Aggregation'
-instance ProjectableZip Aggregation where
-  projectZip = Aggregation.compose
-
 -- | Zip 'Pi'
 instance ProjectableZip (Pi a) where
   projectZip = piZip
@@ -422,7 +390,7 @@ instance ProjectableMaybe PlaceHolders where
   flattenMaybe = unsafeCastPlaceHolders
 
 -- | Control phantom 'Maybe' type in projection type 'Projection'.
-instance ProjectableMaybe Projection where
+instance ProjectableMaybe (Projection c) where
   just         = Projection.just
   flattenMaybe = Projection.flattenMaybe
 
@@ -431,11 +399,6 @@ instance ProjectableMaybe (Expr p) where
   just         = Expr.just
   flattenMaybe = Expr.fromJust
 
--- | Control phantom 'Maybe' type in aggregate projection type 'Projection'.
-instance ProjectableMaybe Aggregation where
-  just         = Aggregation.just
-  flattenMaybe = Aggregation.flattenMaybe
-
 -- | Zipping except for identity element laws.
 class ProjectableZip p => ProjectableIdZip p where
   leftId  :: p ((), a) -> p a

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

@@ -43,21 +43,21 @@ import Prelude hiding (pi)
 import Data.Int (Int32)
 
 import qualified Language.SQL.Keyword as SQL
+import Database.Relational.Query.Context (Flat, Aggregated)
 import Database.Relational.Query.Expr (Expr, fromJust)
 import Database.Relational.Query.Projection (Projection)
-import Database.Relational.Query.Aggregation (Aggregation)
+import qualified Database.Relational.Query.Projection as Projection
 import Database.Relational.Query.Projectable
-  (ExpressionProjectable (expr), ProjectablePi, PlaceHolders,
+  (expr, PlaceHolders,
    ProjectableMaybe (flattenMaybe), ProjectableIdZip (leftId, rightId),
    SqlProjectable, unsafeProjectSql, ProjectableShowSql (unsafeShowSql))
-import qualified Database.Relational.Query.Projectable as Projectable
 import Database.Relational.Query.Pi (Pi)
 
 
 -- | Projection interface.
 class Projectable p0 p1 where
   -- ｜ Project from projection type 'p0' into weaken projection types 'p1'.
-  project :: p0 a -> p1 a
+  project :: p0 c a -> p1 c a
 
 -- | Parened String.
 paren :: String -> String
@@ -71,40 +71,40 @@ sqlUniOp :: SQL.Keyword -> SqlUniOp
 sqlUniOp kw = (SQL.wordShow kw ++) . (' ' :) . paren
 
 -- | Unsafely make aggregation uni-operator from SQL keyword.
-unsafeAggregateOp :: (SqlProjectable p, Projectable Aggregation p)
+unsafeAggregateOp :: SqlProjectable (p Aggregated)
-                  => SQL.Keyword -> Projection a -> p b
+                  => SQL.Keyword -> Projection Flat a -> p Aggregated b
 unsafeAggregateOp op = unsafeProjectSql . sqlUniOp op . unsafeShowSql
 
 -- | Aggregation function COUNT.
-count :: (SqlProjectable p, Projectable Aggregation p) => Projection a -> p Int32
+count :: SqlProjectable (p Aggregated) => Projection Flat a -> p Aggregated Int32
 count =  unsafeAggregateOp SQL.COUNT
 
 -- | Aggregation function SUM.
-sum'  :: (Num a, SqlProjectable p, Projectable Aggregation p) => Projection a -> p a
+sum'  :: (Num a, SqlProjectable (p Aggregated)) => Projection Flat a -> p Aggregated a
 sum'  =  unsafeAggregateOp SQL.SUM
 
 -- | Aggregation function AVG.
-avg   :: (Num a, Fractional b, SqlProjectable p, Projectable Aggregation p)=> Projection a -> p b
+avg   :: (Num a, Fractional b, SqlProjectable (p Aggregated))=> Projection Flat a -> p Aggregated b
 avg   =  unsafeAggregateOp SQL.AVG
 
 -- | Aggregation function MAX.
-max'  :: (Ord a, SqlProjectable p, Projectable Aggregation p) => Projection a -> p a
+max'  :: (Ord a, SqlProjectable (p Aggregated)) => Projection Flat a -> p Aggregated a
 max'  =  unsafeAggregateOp SQL.MAX
 
 -- | Aggregation function MIN.
-min'  :: (Ord a, SqlProjectable p, Projectable Aggregation p) => Projection a -> p a
+min'  :: (Ord a, SqlProjectable (p Aggregated)) => Projection Flat a -> p Aggregated a
 min'  =  unsafeAggregateOp SQL.MIN
 
 -- | Aggregation function EVERY.
-every :: (SqlProjectable p, Projectable Aggregation p) => Projection (Maybe Bool) -> p (Maybe Bool)
+every :: (SqlProjectable (p Aggregated)) => Projection Flat (Maybe Bool) -> p Aggregated (Maybe Bool)
 every =  unsafeAggregateOp SQL.EVERY
 
 -- | Aggregation function ANY.
-any'  :: (SqlProjectable p, Projectable Aggregation p) => Projection (Maybe Bool) -> p (Maybe Bool)
+any'  :: (SqlProjectable (p Aggregated)) => Projection Flat (Maybe Bool) -> p Aggregated (Maybe Bool)
 any'  =  unsafeAggregateOp SQL.ANY
 
 -- | Aggregation function SOME.
-some' :: (SqlProjectable p, Projectable Aggregation p) => Projection (Maybe Bool) -> p (Maybe Bool)
+some' :: (SqlProjectable (p Aggregated)) => Projection Flat (Maybe Bool) -> p Aggregated (Maybe Bool)
 some' =  unsafeAggregateOp SQL.SOME
 
 -- | Project from 'Projection' into 'Projection'.
@@ -112,93 +112,75 @@ instance Projectable Projection Projection where
   project = id
 
 -- | Project from 'Projection' into 'Expr' 'Projection'.
-instance Projectable Projection (Expr Projection) where
+instance Projectable Projection Expr where
   project = expr
 
--- | Project from 'Aggregation' into 'Aggregation'.
+projectPi :: Projectable Projection p1 => Projection c a -> Pi a b -> p1 c b
-instance Projectable Aggregation Aggregation where
+projectPi p = project . Projection.pi p
-  project = id
 
--- | Project from 'Aggregation' into 'Expr' 'Aggregation'.
+projectPiMaybe :: Projectable Projection p1 => Projection c (Maybe a) -> Pi a b -> p1 c (Maybe b)
-instance Projectable Aggregation (Expr Aggregation) where
+projectPiMaybe p = project . Projection.piMaybe p
-  project = expr
 
-projectPi :: (ProjectablePi p0, Projectable p0 p1) => p0 a -> Pi a b -> p1 b
+projectPiMaybe' :: Projectable Projection p1 => Projection c (Maybe a) -> Pi a (Maybe b) -> p1 c (Maybe b)
-projectPi p = project . Projectable.pi p
+projectPiMaybe' p = project . Projection.piMaybe' p
-
-projectPiMaybe :: (ProjectablePi p0, Projectable p0 p1) => p0 (Maybe a) -> Pi a b -> p1 (Maybe b)
-projectPiMaybe p = project . Projectable.piMaybe p
-
-projectPiMaybe' :: (ProjectablePi p0, Projectable p0 p1) => p0 (Maybe a) -> Pi a (Maybe b) -> p1 (Maybe b)
-projectPiMaybe' p = project . Projectable.piMaybe' p
 
 -- | Get narrower projection along with projection path
 --   and project into result projection type.
 (!) :: Projectable Projection p
-    => Projection a   -- ^ Source projection
+    => Projection c a   -- ^ Source projection
     -> Pi a b -- ^ Projection path
-    -> p b   -- ^ Narrower projected object
+    -> p c b   -- ^ Narrower projected object
 (!) =  projectPi
 
 -- | Get narrower projection along with projection path
 --   and project into result projection type.
 --   'Maybe' phantom type is propagated.
 (?!) :: Projectable Projection p
-     => Projection (Maybe a) -- ^ Source 'Projection'. 'Maybe' type
+     => Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' type
      -> Pi a b       -- ^ Projection path
-     -> p (Maybe b) -- ^ Narrower projected object. 'Maybe' type result
+     -> p c (Maybe b) -- ^ Narrower projected object. 'Maybe' type result
 (?!) =  projectPiMaybe
 
 -- | Get narrower projection along with projection path
 --   and project into result projection type.
 --   'Maybe' phantom type is propagated. Projection path leaf is 'Maybe' case.
 (?!?) :: Projectable Projection p
-      => Projection (Maybe a)   -- ^ Source 'Projection'. 'Maybe' phantom type
+      => Projection c (Maybe a)   -- ^ Source 'Projection'. 'Maybe' phantom type
       -> Pi a (Maybe b) -- ^ Projection path. 'Maybe' type leaf
-      -> p (Maybe b)   -- ^ Narrower projected object. 'Maybe' phantom type result
+      -> p c (Maybe b)   -- ^ Narrower projected object. 'Maybe' phantom type result
 (?!?) =  projectPiMaybe'
 
--- | Get narrower aggregated projection along with projection path
+(<!>) :: Projectable Projection p
---   and project into result projection type.
+    => Projection c a   -- ^ Source projection
-(<!>) :: Projectable Aggregation p
-      => Aggregation a -- ^ Source 'Aggregation'
     -> Pi a b -- ^ Projection path
-      -> p b           -- ^ Narrower projected object
+    -> p c b   -- ^ Narrower projected object
-(<!>) =  projectPi
+(<!>) = (!)
 
--- | Get narrower aggregated projection along with projection path
+(<?!>) :: Projectable Projection p
---   and project into result projection type.
+     => Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' type
---   'Maybe' phantom type is propagated.
-(<?!>) :: Projectable Aggregation p
-       => Aggregation (Maybe a) -- ^ Source 'Aggregation'. 'Maybe' phantom type
      -> Pi a b       -- ^ Projection path
-       -> p (Maybe b)           -- ^ Narrower projected object. 'Maybe' phantom type result
+     -> p c (Maybe b) -- ^ Narrower projected object. 'Maybe' type result
-(<?!>) =  projectPiMaybe
+(<?!>) = (?!)
 
--- | Get narrower aggregated projection along with projection path
+(<?!?>) :: Projectable Projection p
---   and project into result projection type.
+      => Projection c (Maybe a)   -- ^ Source 'Projection'. 'Maybe' phantom type
---   'Maybe' phantom type is propagated. Projection path leaf is 'Maybe' case.
-(<?!?>) :: Projectable Aggregation p
-        => Aggregation (Maybe a) -- ^ Source 'Aggregation'. 'Maybe' phantom type
       -> Pi a (Maybe b) -- ^ Projection path. 'Maybe' type leaf
-        -> p (Maybe b)           -- ^ Narrower projected object. 'Maybe' phantom type result
+      -> p c (Maybe b)   -- ^ Narrower projected object. 'Maybe' phantom type result
-(<?!?>) =  projectPiMaybe'
+(<?!?>) = (?!?)
 
 -- | Get narrower projected expression along with projectino path
 --   and strip 'Maybe' phantom type off.
-(.!) :: (ProjectablePi p, Projectable p (Expr p))
+(.!) :: Projection c (Maybe a) -- ^ Source projection type 'p'. 'Maybe' phantom type
-     => p (Maybe a) -- ^ Source projection type 'p'. 'Maybe' phantom type
      -> Pi a b      -- ^ Projection path
-     -> Expr p b    -- ^ Narrower projected expression. 'Maybe' phantom type is stripped off
+     -> Expr c b    -- ^ Narrower projected expression. 'Maybe' phantom type is stripped off
 (.!) p = fromJust . projectPiMaybe p
 
 -- | Get narrower projected expression along with projectino path
 --   and strip 'Maybe' phantom type off.
 --   Projection path leaf is 'Maybe' case.
-(.?) :: (ProjectablePi p, Projectable p (Expr p))
+(.?) :: Projection c (Maybe a)    -- ^ Source projection type 'p'. 'Maybe' phantom type
-     => p (Maybe a)    -- ^ Source projection type 'p'. 'Maybe' phantom type
      -> Pi a (Maybe b) -- ^ Projection path. 'Maybe' type leaf
-     -> Expr p b       -- ^ Narrower projected expression. 'Maybe' phantom type is stripped off
+     -> Expr c b       -- ^ Narrower projected expression. 'Maybe' phantom type is stripped off
 (.?) p = fromJust . projectPiMaybe' p
 
 
@@ -216,35 +198,34 @@ instance ProjectableFlattenMaybe (Maybe a) (Maybe a) where
   flatten = id
 
 -- | Get narrower projection with flatten leaf phantom Maybe types along with projection path.
-flattenPiMaybe :: (ProjectablePi p, ProjectableMaybe p, ProjectableFlattenMaybe (Maybe b) c)
+flattenPiMaybe :: (ProjectableMaybe (Projection cont), ProjectableFlattenMaybe (Maybe b) c)
-               => p (Maybe a) -- ^ Source 'Projection'. 'Maybe' phantom type
+               => Projection cont (Maybe a) -- ^ Source 'Projection'. 'Maybe' phantom type
                -> Pi a b               -- ^ Projection path
-               -> p c         -- ^ Narrower 'Projection'. Flatten 'Maybe' phantom type
+               -> Projection cont c         -- ^ Narrower 'Projection'. Flatten 'Maybe' phantom type
-flattenPiMaybe p = flatten . Projectable.piMaybe p
+flattenPiMaybe p = flatten . Projection.piMaybe p
 
-projectFlattenPiMaybe :: (ProjectablePi p0, ProjectableMaybe p0, Projectable p0 p1, ProjectableFlattenMaybe (Maybe b) c)
+projectFlattenPiMaybe :: (ProjectableMaybe (Projection cont),
-               => p0 (Maybe a) -- ^ Source 'Projection'. 'Maybe' phantom type
+                          Projectable Projection p1, ProjectableFlattenMaybe (Maybe b) c)
+                      => Projection cont (Maybe a) -- ^ Source 'Projection'. 'Maybe' phantom type
                       -> Pi a b                    -- ^ Projection path
-               -> p1 c         -- ^ Narrower 'Projection'. Flatten 'Maybe' phantom type
+                      -> p1 cont c                 -- ^ Narrower 'Projection'. Flatten 'Maybe' phantom type
 projectFlattenPiMaybe p = project . flattenPiMaybe p
 
 -- | Get narrower projection with flatten leaf phantom Maybe types along with projection path
 --   and project into result projection type.
 (!??) :: (ProjectableFlattenMaybe (Maybe b) c,
-          Projectable Projection p, ProjectableMaybe p)
+          Projectable Projection p, ProjectableMaybe (p cont))
-      => Projection (Maybe a) -- ^ Source 'Aggregation'. 'Maybe' phantom type
+      => Projection cont (Maybe a) -- ^ Source 'Projection'. 'Maybe' phantom type
       -> Pi a b                    -- ^ Projection path
-      -> p c                  -- ^ Narrower flatten and projected object.
+      -> p cont c                  -- ^ Narrower flatten and projected object.
 (!??) =  projectFlattenPiMaybe
 
--- | Get narrower aggregated projection with flatten leaf phantom Maybe types along with projection path
---   and project into result projection type.
 (<!??>) :: (ProjectableFlattenMaybe (Maybe b) c,
-            Projectable Aggregation p, ProjectableMaybe p)
+          Projectable Projection p, ProjectableMaybe (p cont))
-        => Aggregation (Maybe a) -- ^ Source 'Aggregation'. 'Maybe' phantom type
+      => Projection cont (Maybe a) -- ^ Source 'Projection'. 'Maybe' phantom type
       -> Pi a b                    -- ^ Projection path
-        -> p c                   -- ^ Narrower flatten and projected object.
+      -> p cont c                  -- ^ Narrower flatten and projected object.
-(<!??>) =  projectFlattenPiMaybe
+(<!??>) = (!??)
 
 
 -- | Interface to run recursively identity element laws.
@@ -272,5 +253,5 @@ flattenPh =  runIds
 --       => p a -> p b -> p c
 -- (>?<) =  generalizedZip'
 
-infixl 8 !, ?!, ?!?, !??, <!>, <?!>, <?!?>, <!??>, .!, .?
+infixl 8 !, ?!, ?!?, !??, .!, .?, <!>, <?!>, <?!?>, <!??>
 -- infixl 1 >?<

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

@@ -24,11 +24,14 @@ module Database.Relational.Query.Projection (
 
   pi, piMaybe, piMaybe',
 
-  flattenMaybe, just
+  flattenMaybe, just,
+
+  unsafeToAggregated, unsafeToFlat
   ) where
 
 import Prelude hiding (pi)
 
+import Database.Relational.Query.Context (Aggregated, Flat)
 import Database.Relational.Query.Table (Table)
 import qualified Database.Relational.Query.Table as Table
 import Database.Relational.Query.Pi (Pi)
@@ -40,23 +43,23 @@ import Database.Relational.Query.Sub
 
 
 -- | Phantom typed projection. Projected into Haskell record type 't'.
-newtype Projection t = Projection { untypeProjection :: UntypedProjection }
+newtype Projection c t = Projection { untypeProjection :: UntypedProjection }
 
-typedProjection :: UntypedProjection -> Projection t
+typedProjection :: UntypedProjection -> Projection c t
 typedProjection =  Projection
 
-units :: Projection t -> [ProjectionUnit]
+units :: Projection c t -> [ProjectionUnit]
 units =  untypeProjection
 
-fromUnits :: [ProjectionUnit] -> Projection t
+fromUnits :: [ProjectionUnit] -> Projection c t
 fromUnits =  typedProjection
 
 -- | Width of 'Projection'.
-width :: Projection r -> Int
+width :: Projection c r -> Int
 width =  sum . map widthOfProjectionUnit . units  where
 
 -- | Get column SQL string of 'Projection'.
-column :: Projection r -- ^ Source 'Projection'
+column :: Projection c r -- ^ Source 'Projection'
        -> Int            -- ^ Column index
        -> String         -- ^ Result SQL string
 column =  d  where
@@ -68,7 +71,7 @@ column =  d  where
       | otherwise         = rec us (i - widthOfProjectionUnit u)
 
 -- | Get column SQL string list of projection.
-columns :: Projection r -- ^ Source 'Projection'
+columns :: Projection c r -- ^ Source 'Projection'
         -> [String]       -- ^ Result SQL string list
 columns p = map (\n -> column p n) . take w $ [0 .. ]
   where w = width p
@@ -76,53 +79,67 @@ columns p = map (\n -> column p n) . take w $ [0 .. ]
 
 -- | Unsafely generate 'Projection' from SQL string list.
 unsafeFromColumns :: [String]       -- ^ SQL string list specifies columns
-                  -> Projection r -- ^ Result 'Projection'
+                  -> Projection c r -- ^ Result 'Projection'
 unsafeFromColumns =  typedProjection . untypedProjectionFromColumns
 
 -- | Unsafely generate  'Projection' from qualified subquery.
-unsafeFromQualifiedSubQuery :: Qualified SubQuery -> Projection t
+unsafeFromQualifiedSubQuery :: Qualified SubQuery -> Projection c t
 unsafeFromQualifiedSubQuery =  typedProjection . untypedProjectionFromSubQuery
 
 -- | Unsafely generate unqualified 'Projection' from 'Table'.
 unsafeFromTable :: Table r
-                -> Projection r
+                -> Projection c r
 unsafeFromTable =  unsafeFromColumns . Table.columns
 
 -- | Concatenate 'Projection'.
-compose :: Projection a -> Projection b -> Projection (c a b)
+compose :: Projection c a -> Projection c b -> Projection c (pair a b)
 compose a b = fromUnits $ units a ++ units b
 
 
 -- | Unsafely trace projection path.
-unsafeProject :: Projection a' -> Pi a b -> Projection b'
+unsafeProject :: Projection c a' -> Pi a b -> Projection c b'
 unsafeProject p pi' =
   unsafeFromColumns
   . (`UnsafePi.pi` pi')
   . columns $ p
 
 -- | Trace projection path to get narrower 'Projection'.
-pi :: Projection a -- ^ Source 'Projection'
+pi :: Projection c a -- ^ Source 'Projection'
    -> Pi a b         -- ^ Projection path
-   -> Projection b -- ^ Narrower 'Projection'
+   -> Projection c b -- ^ Narrower 'Projection'
 pi =  unsafeProject
 
 -- | Trace projection path to get narrower 'Projection'. From 'Maybe' type to 'Maybe' type.
-piMaybe :: Projection (Maybe a) -- ^ Source 'Projection'. 'Maybe' type
+piMaybe :: Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' type
         -> Pi a b                 -- ^ Projection path
-        -> Projection (Maybe b) -- ^ Narrower 'Projection'. 'Maybe' type result
+        -> Projection c (Maybe b) -- ^ Narrower 'Projection'. 'Maybe' type result
 piMaybe =  unsafeProject
 
 -- | Trace projection path to get narrower 'Projection'. From 'Maybe' type to 'Maybe' type.
 --   Leaf type of projection path is 'Maybe'.
-piMaybe' :: Projection (Maybe a) -- ^ Source 'Projection'. 'Maybe' type
+piMaybe' :: Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' type
          -> Pi a (Maybe b)         -- ^ Projection path. 'Maybe' type leaf
-         -> Projection (Maybe b) -- ^ Narrower 'Projection'. 'Maybe' type result
+         -> Projection c (Maybe b) -- ^ Narrower 'Projection'. 'Maybe' type result
 piMaybe' =  unsafeProject
 
+unsafeCast :: Projection c r -> Projection c r'
+unsafeCast =  typedProjection . untypeProjection
+
 -- | Composite nested 'Maybe' on projection phantom type.
-flattenMaybe :: Projection (Maybe (Maybe a)) -> Projection (Maybe a)
+flattenMaybe :: Projection c (Maybe (Maybe a)) -> Projection c (Maybe a)
-flattenMaybe =  typedProjection . untypeProjection
+flattenMaybe =  unsafeCast
 
 -- | Cast into 'Maybe' on projection phantom type.
-just :: Projection r -> Projection (Maybe r)
+just :: Projection c r -> Projection c (Maybe r)
-just =  typedProjection . untypeProjection
+just =  unsafeCast
+
+unsafeChangeContext :: Projection c r -> Projection c' r
+unsafeChangeContext =  typedProjection . untypeProjection
+
+-- | Unsafely lift to aggregated context.
+unsafeToAggregated :: Projection Flat r -> Projection Aggregated r
+unsafeToAggregated =  unsafeChangeContext
+
+-- | Unsafely down to flat context.
+unsafeToFlat :: Projection Aggregated r -> Projection Flat r
+unsafeToFlat =  unsafeChangeContext

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

@@ -38,6 +38,7 @@ module Database.Relational.Query.Relation (
   union', except', intersect'
   ) where
 
+import Database.Relational.Query.Context (Flat, Aggregated)
 import Database.Relational.Query.Monad.Qualify (Qualify, evalQualifyPrime, qualifyQuery)
 import Database.Relational.Query.Monad.Class
   (MonadQualify (liftQualify), MonadQuery (unsafeSubQuery), on)
@@ -52,7 +53,6 @@ import Database.Relational.Query.Internal.Product (NodeAttr(Just', Maybe))
 
 import Database.Relational.Query.Projection (Projection)
 import qualified Database.Relational.Query.Projection as Projection
-import Database.Relational.Query.Aggregation (Aggregation)
 import Database.Relational.Query.Projectable
   (PlaceHolders, addPlaceHolders, projectZip)
 
@@ -84,7 +84,7 @@ subQueryQualifyFromRelation =  d  where
 
 -- | Basic monadic join operation using 'MonadQuery'.
 queryWithAttr :: MonadQualify Qualify m
-              => NodeAttr -> Relation p r -> m (PlaceHolders p, Projection r)
+              => NodeAttr -> Relation p r -> m (PlaceHolders p, Projection Flat r)
 queryWithAttr attr = addPlaceHolders . run where
   run rel = do
     q <- liftQualify $ do
@@ -94,42 +94,42 @@ 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 r)
+query' :: MonadQualify Qualify 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 r)
+query :: MonadQualify Qualify 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 (Maybe r))
+queryMaybe' :: MonadQualify Qualify 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 (Maybe r))
+queryMaybe :: MonadQualify Qualify m => Relation () r -> m (Projection Flat (Maybe r))
 queryMaybe =  fmap snd . queryMaybe'
 
 -- | Finalize 'QuerySimple' monad and generate 'Relation'.
-relation :: QuerySimple (Projection r) -> Relation () r
+relation :: QuerySimple (Projection Flat r) -> Relation () r
 relation =  SimpleRel
 
 -- | Finalize 'QuerySimple' monad and generate 'Relation' with place-holder parameter 'p'.
-relation' :: QuerySimple (PlaceHolders p, Projection r) -> Relation p r
+relation' :: QuerySimple (PlaceHolders p, Projection Flat r) -> Relation p r
 relation' =  SimpleRel . fmap snd
 
 -- | Finalize 'QueryAggregate' monad and geneate 'Relation'.
-aggregateRelation :: QueryAggregate (Aggregation r) -> Relation () r
+aggregateRelation :: QueryAggregate (Projection Aggregated r) -> Relation () r
 aggregateRelation =  AggregateRel
 
 -- | Finalize 'QueryAggregate' monad and geneate 'Relation' with place-holder parameter 'p'.
-aggregateRelation' :: QueryAggregate (PlaceHolders p, Aggregation r) -> Relation p r
+aggregateRelation' :: QueryAggregate (PlaceHolders p, Projection Aggregated r) -> Relation p r
 aggregateRelation' =  AggregateRel . fmap snd
 
 
 -- | Restriction function type for direct style join operator.
-type JoinRestriction a b = Projection a -> Projection b -> Projection (Maybe Bool)
+type JoinRestriction a b = Projection Flat a -> Projection Flat b -> Projection Flat (Maybe Bool)
 
 unsafeCastPlaceHolder :: Relation a r -> Relation b r
 unsafeCastPlaceHolder =  d  where
@@ -146,8 +146,8 @@ leftPh :: Relation (p, ()) r -> Relation p r
 leftPh =  unsafeCastPlaceHolder
 
 -- | Basic direct join operation with place-holder parameters.
-join' :: (qa -> QuerySimple (PlaceHolders pa, Projection a))
+join' :: (qa -> QuerySimple (PlaceHolders pa, Projection Flat a))
-      -> (qb -> QuerySimple (PlaceHolders pb, Projection b))
+      -> (qb -> QuerySimple (PlaceHolders pb, Projection Flat b))
       -> qa
       -> qb
       -> [JoinRestriction a b]
@@ -187,8 +187,8 @@ full' :: Relation pa a                         -- ^ Left query to join
 full'  =  join' queryMaybe' queryMaybe'
 
 -- | Basic direct join operation.
-join :: (qa -> QuerySimple (Projection a))
+join :: (qa -> QuerySimple (Projection Flat a))
-     -> (qb -> QuerySimple (Projection b))
+     -> (qb -> QuerySimple (Projection Flat b))
      -> qa
      -> qb
      -> [JoinRestriction a b]

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

@@ -25,6 +25,7 @@ module Database.Relational.Query.Restriction (
 
 import Database.Record (PersistableWidth)
 
+import Database.Relational.Query.Context (Flat)
 import Database.Relational.Query.Pi (id')
 import Database.Relational.Query.Table (Table)
 import Database.Relational.Query.Projection (Projection)
@@ -38,14 +39,15 @@ import Database.Relational.Query.Monad.Trans.Restricting (prependWhere)
 import Database.Relational.Query.Monad.Restrict (Restrict, RestrictedStatement, expandWhere)
 import Database.Relational.Query.Monad.Target (Target, TargetStatement, expandPrepend)
 
+
 -- | Restriction type with place-holder parameter 'p' and projection record type 'r'.
-newtype Restriction p r = Restriction (Projection r -> Restrict ())
+newtype Restriction p r = Restriction (Projection Flat r -> Restrict ())
 
 -- | Not finalized 'Restrict' monad type.
 type RestrictionContext p r = RestrictedStatement r (PlaceHolders p)
 
 -- | Finalize 'Restrict' monad and generate 'Restriction'.
-restriction :: (Projection r -> Restrict ()) -> Restriction () r
+restriction :: (Projection Flat r -> Restrict ()) -> Restriction () r
 restriction =  Restriction
 
 -- | Finalize 'Restrict' monad and generate 'Restriction' with place-holder parameter 'p'
@@ -65,13 +67,13 @@ sqlWhereFromRestriction tbl (Restriction q) = prependWhere aw
 
 -- | UpdateTarget type with place-holder parameter 'p' and projection record type 'r'.
 newtype UpdateTarget p r =
-  UpdateTarget (Table r -> Projection r -> Target r ())
+  UpdateTarget (Table r -> Projection Flat r -> Target r ())
 
 -- | Not finalized 'Target' monad type.
 type UpdateTargetContext p r = TargetStatement r (PlaceHolders p)
 
 -- | Finalize 'Target' monad and generate 'UpdateTarget'.
-updateTarget :: (Table r -> Projection r -> Target r ())
+updateTarget :: (Table r -> Projection Flat r -> Target r ())
              -> UpdateTarget () r
 updateTarget =  UpdateTarget
 
@@ -107,13 +109,13 @@ liftTargetAllColumn' rs = updateTarget' $ updateAllColumn rs
 
 -- | Finalize 'Restrict' monad and generate 'UpdateTarget'. Update target columns are all.
 updateTargetAllColumn :: PersistableWidth r
-                      => (Projection r -> Restrict ())
+                      => (Projection Flat r -> Restrict ())
                       -> UpdateTarget r r
 updateTargetAllColumn = liftTargetAllColumn . restriction
 
 -- | Finalize 'Restrict' monad and generate 'UpdateTarget'. Update target columns are all. With placefolder type 'p'.
 updateTargetAllColumn' :: PersistableWidth r
-                       => (Projection r -> Restrict (PlaceHolders p))
+                       => (Projection Flat r -> Restrict (PlaceHolders p))
                        -> UpdateTarget (r, p) r
 updateTargetAllColumn' = liftTargetAllColumn' . restriction'
 

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

@@ -39,7 +39,7 @@ import qualified Database.Relational.Query.Projection as Projection
 
 
 -- | Generate select SQL. Seed SQL string append to this.
-selectSeedSQL :: Projection r -> ShowS
+selectSeedSQL :: Projection c r -> ShowS
 selectSeedSQL pj =
   (unwordsSQL [SELECT, columns' `SQL.sepBy` ", "] ++)
   where columns' = zipWith