From b59cadcf1bd67711ccb85ea244b7d8df111a67d1 Mon Sep 17 00:00:00 2001
From: Kei Hibino <ex8k.hibino@gmail.com>
Date: Fri, 2 Aug 2013 20:15:28 +0900
Subject: [PATCH 1/3] Add MonadRestrict interface divided from MonadQuery.

---
 .../Database/Relational/Query/Monad/Class.hs  | 22 ++++++++++++-------
 .../Relational/Query/Monad/Trans/Aggregate.hs |  7 ++++--
 .../Relational/Query/Monad/Trans/Join.hs      |  9 +++++---
 .../Relational/Query/Monad/Trans/Ordering.hs  |  7 ++++--
 4 files changed, 30 insertions(+), 15 deletions(-)

diff --git a/relational-join/src/Database/Relational/Query/Monad/Class.hs b/relational-join/src/Database/Relational/Query/Monad/Class.hs
index 81e6400f..674756b3 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Class.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Class.hs
@@ -13,7 +13,7 @@
 -- This module defines query building interface classes.
 module Database.Relational.Query.Monad.Class (
   -- * Query interface classes
-  MonadQualify (..),
+  MonadQualify (..), MonadRestrict (..),
   MonadQuery (..), MonadAggregate (..),
 
   onE, on, wheresE, wheres,
@@ -28,14 +28,20 @@ import Database.Relational.Query.Sub (SubQuery, Qualified)
 
 import Database.Relational.Query.Internal.Product (NodeAttr)
 
+-- | Restrict context interface
+class (Functor m, Monad m) => MonadRestrict m where
+  -- | Add restriction to this context.
+  restrict :: Expr Projection (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
                -> m ()                         -- ^ Restricted query context
-  -- | Add restriction to this query.
-  restrictQuery :: Expr Projection (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
+  --               -> m ()                         -- ^ Restricted query context
   -- | Unsafely join subquery with this query.
   unsafeSubQuery :: NodeAttr           -- ^ Attribute maybe or just
                  -> Qualified SubQuery -- ^ 'SubQuery' to join
@@ -66,12 +72,12 @@ on :: MonadQuery m => Projection (Maybe Bool) -> m ()
 on =  restrictJoin . expr
 
 -- | Add restriction to this query.
-wheresE :: MonadQuery m => Expr Projection (Maybe Bool) -> m ()
-wheresE =  restrictQuery
+wheresE :: MonadRestrict m => Expr Projection (Maybe Bool) -> m ()
+wheresE =  restrict
 
 -- | Add restriction to this query. Projection type version.
-wheres :: MonadQuery m => Projection (Maybe Bool) -> m ()
-wheres =  restrictQuery . expr
+wheres :: MonadRestrict m => Projection (Maybe Bool) -> m ()
+wheres =  restrict . expr
 
 -- | Add /group by/ term into context and get aggregated projection.
 groupBy :: MonadAggregate m
diff --git a/relational-join/src/Database/Relational/Query/Monad/Trans/Aggregate.hs b/relational-join/src/Database/Relational/Query/Monad/Trans/Aggregate.hs
index 5d309e03..1a753bb2 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Trans/Aggregate.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Trans/Aggregate.hs
@@ -34,7 +34,7 @@ import Database.Relational.Query.Internal.AggregatingContext (AggregatingContext
 import qualified Database.Relational.Query.Internal.AggregatingContext as Context
 
 import Database.Relational.Query.Monad.Class
-  (MonadQuery(..), MonadAggregate(..))
+  (MonadRestrict(..), MonadQuery(..), MonadAggregate(..))
 
 
 -- | 'StateT' type to accumulate aggregating context.
@@ -57,10 +57,13 @@ runAggregatingPrime =  (`runAggregating` primeAggregatingContext)
 aggregate :: Monad m => m a -> Aggregatings m a
 aggregate =  lift
 
+-- | Aggregated 'MonadRestrict'.
+instance MonadRestrict m => MonadRestrict (Aggregatings m) where
+  restrict =  aggregate . restrict
+
 -- | Aggregated 'MonadQuery'.
 instance MonadQuery m => MonadQuery (Aggregatings m) where
   restrictJoin  =  aggregate . restrictJoin
-  restrictQuery =  aggregate . restrictQuery
   unsafeSubQuery na = aggregate . unsafeSubQuery na
 
 -- | Unsafely update aggregating context.
diff --git a/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs b/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs
index 10952e9e..c16d4525 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs
@@ -32,7 +32,7 @@ import qualified Database.Relational.Query.Projection as Projection
 import Database.Relational.Query.Expr (Expr, fromTriBool)
 import Database.Relational.Query.Sub (SubQuery, Qualified)
 
-import Database.Relational.Query.Monad.Class (MonadQuery (..))
+import Database.Relational.Query.Monad.Class (MonadRestrict(..), MonadQuery (..))
 
 
 -- | 'StateT' type to accumulate join product context.
@@ -77,10 +77,13 @@ restoreLeft :: QueryProductNode -> NodeAttr -> QueryJoin ()
 restoreLeft pL naR = updateContext $ Context.restoreLeft pL naR
 -}
 
--- | Basic query instance.
+-- | 'MonadRestrict' instance for joinable query.
+instance (Monad q, Functor q) => MonadRestrict (QueryJoin q) where
+  restrict = updateRestriction
+
+-- | Joinable query instance.
 instance (Monad q, Functor q) => MonadQuery (QueryJoin q) where
   restrictJoin  =  updateJoinRestriction
-  restrictQuery =  updateRestriction
   unsafeSubQuery          = unsafeSubQueryWithAttr
   -- unsafeMergeAnotherQuery = unsafeQueryMergeWithAttr
 
diff --git a/relational-join/src/Database/Relational/Query/Monad/Trans/Ordering.hs b/relational-join/src/Database/Relational/Query/Monad/Trans/Ordering.hs
index 657e7d42..3405802a 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Trans/Ordering.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Trans/Ordering.hs
@@ -38,7 +38,7 @@ import Database.Relational.Query.Aggregation (Aggregation)
 import qualified Database.Relational.Query.Aggregation as Aggregation
 
 import Database.Relational.Query.Monad.Class
-  (MonadQuery(..), MonadAggregate(..))
+  (MonadRestrict(..), MonadQuery(..), MonadAggregate(..))
 
 
 -- | 'StateT' type to accumulate ordering context.
@@ -62,10 +62,13 @@ runOrderingsPrime q = runOrderings q $ primeOrderingContext
 orderings :: Monad m => m a -> Orderings p m a
 orderings =  lift
 
+-- | 'MonadRestrict' with ordering.
+instance MonadRestrict m => MonadRestrict (Orderings p m) where
+  restrict =  orderings . restrict
+
 -- | 'MonadQuery' with ordering.
 instance MonadQuery m => MonadQuery (Orderings p m) where
   restrictJoin  =  orderings . restrictJoin
-  restrictQuery =  orderings . restrictQuery
   unsafeSubQuery na       = orderings . unsafeSubQuery na
   -- unsafeMergeAnotherQuery = unsafeMergeAnotherOrderBys
 

From 39e6bf75e83cb7230a0d63354fb962580603bd5e Mon Sep 17 00:00:00 2001
From: Kei Hibino <ex8k.hibino@gmail.com>
Date: Sat, 3 Aug 2013 02:26:59 +0900
Subject: [PATCH 2/3] Add Restrict monad transformer devided from QueryJoin.

---
 relational-join/relational-join.cabal         |  2 +
 .../Relational/Query/Internal/Context.hs      | 32 ++-----
 .../Query/Internal/RestrictContext.hs         | 55 ++++++++++++
 .../Relational/Query/Monad/Aggregate.hs       | 24 ++---
 .../Database/Relational/Query/Monad/Class.hs  |  8 +-
 .../Database/Relational/Query/Monad/Core.hs   |  3 +-
 .../Database/Relational/Query/Monad/Simple.hs | 27 +++---
 .../Relational/Query/Monad/Trans/Aggregate.hs |  2 +-
 .../Relational/Query/Monad/Trans/Join.hs      | 12 +--
 .../Relational/Query/Monad/Trans/Ordering.hs  | 17 ++--
 .../Relational/Query/Monad/Trans/Restrict.hs  | 90 +++++++++++++++++++
 11 files changed, 205 insertions(+), 67 deletions(-)
 create mode 100644 relational-join/src/Database/Relational/Query/Internal/RestrictContext.hs
 create mode 100644 relational-join/src/Database/Relational/Query/Monad/Trans/Restrict.hs

diff --git a/relational-join/relational-join.cabal b/relational-join/relational-join.cabal
index 70bf262c..d94d5c59 100644
--- a/relational-join/relational-join.cabal
+++ b/relational-join/relational-join.cabal
@@ -31,6 +31,7 @@ library
                        Database.Relational.Query.Monad.Class
                        Database.Relational.Query.Monad.Trans.Ordering
                        Database.Relational.Query.Monad.Trans.Aggregate
+                       Database.Relational.Query.Monad.Trans.Restrict
                        Database.Relational.Query.Monad.Trans.Join
                        Database.Relational.Query.Monad.Core
                        Database.Relational.Query.Monad.Simple
@@ -51,6 +52,7 @@ library
                        Database.Relational.Query.Internal.AliasId
                        Database.Relational.Query.Internal.ShowS
                        Database.Relational.Query.Internal.Product
+                       Database.Relational.Query.Internal.RestrictContext
                        Database.Relational.Query.Internal.Context
                        Database.Relational.Query.Internal.AggregatingContext
                        Database.Relational.Query.Internal.OrderingContext
diff --git a/relational-join/src/Database/Relational/Query/Internal/Context.hs b/relational-join/src/Database/Relational/Query/Internal/Context.hs
index b6b15984..782e47d3 100644
--- a/relational-join/src/Database/Relational/Query/Internal/Context.hs
+++ b/relational-join/src/Database/Relational/Query/Internal/Context.hs
@@ -19,15 +19,12 @@ module Database.Relational.Query.Internal.Context (
   primeContext,
 
   updateProduct, -- takeProduct, restoreLeft,
-  addRestriction,
 
   composeSQL
   ) where
 
 import Prelude hiding (product)
 
-import Database.Relational.Query.Expr (Expr, fromTriBool, exprAnd)
-import Database.Relational.Query.Expr.Unsafe (showExpr)
 import Database.Relational.Query.Sub (asColumnN)
 
 import Database.Relational.Query.Internal.Product (QueryProductNode, QueryProduct, queryProductSQL)
@@ -42,13 +39,11 @@ import qualified Language.SQL.Keyword as SQL
 
 -- | Context type for QueryJoin.
 data Context = Context
-               { product :: Maybe QueryProductNode
-               , restriction :: Maybe (Expr Projection Bool)
-               }
+               { product :: Maybe QueryProductNode }
 
 -- | Initial 'Context'.
 primeContext :: Context
-primeContext =  Context Nothing Nothing
+primeContext =  Context Nothing
 
 -- | Update product of 'Context'.
 updateProduct' :: (Maybe QueryProductNode -> Maybe QueryProductNode) -> Context -> Context
@@ -64,28 +59,19 @@ updateProduct uf = updateProduct' (Just . uf)
 -- restoreLeft :: QueryProductNode -> Product.NodeAttr -> Context -> Context
 -- restoreLeft pL naR ctx = updateProduct (Product.growLeft pL naR) ctx
 
--- | Add restriction of 'Context'.
-addRestriction :: Expr Projection (Maybe Bool) -> Context -> Context
-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 QueryJoin monad object.
-composeSQL' :: Projection r -> QueryProduct -> Maybe (Expr Projection Bool) -> String
-composeSQL' pj pd re =
+composeSQL' :: Projection r -> QueryProduct -> String
+composeSQL' pj pd =
   unwordsSQL
   $ [SELECT, columns' `SQL.sepBy` ", ",
      FROM, SQL.word . queryProductSQL $ pd]
-  ++ wheres re
-    where columns' = zipWith
-                    (\f n -> SQL.word f `asColumnN` n)
-                    (Projection.columns pj)
-                    [(0 :: Int)..]
-          wheres  = Prelude.maybe [] (\e -> [WHERE, SQL.word . showExpr $ e])
+  where columns' = zipWith
+                   (\f n -> SQL.word f `asColumnN` n)
+                   (Projection.columns pj)
+                   [(0 :: Int)..]
 
 -- | Compose SQL String from QueryJoin monad object.
 composeSQL :: Projection r -> Context -> String
 composeSQL pj c = composeSQL' pj
                   (maybe (error "relation: empty product!") (Product.nodeTree) (product c))
-                  (restriction c)
+
diff --git a/relational-join/src/Database/Relational/Query/Internal/RestrictContext.hs b/relational-join/src/Database/Relational/Query/Internal/RestrictContext.hs
new file mode 100644
index 00000000..ea9f9d39
--- /dev/null
+++ b/relational-join/src/Database/Relational/Query/Internal/RestrictContext.hs
@@ -0,0 +1,55 @@
+-- |
+-- Module      : Database.Relational.Query.Internal.Context
+-- Copyright   : 2013 Kei Hibino
+-- License     : BSD3
+--
+-- Maintainer  : ex8k.hibino@gmail.com
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- This module provides context definition for
+-- "Database.Relational.Query.Monad.Trans.Join" and
+-- "Database.Relational.Query.Monad.Trans.Ordering".
+module Database.Relational.Query.Internal.RestrictContext (
+  -- * Context of restriction
+  RestrictContext,
+
+  primeRestrictContext,
+
+  addRestriction,
+
+  composeWheres
+  ) where
+
+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
+
+
+-- | Context type for Restrict.
+data RestrictContext =
+  RestrictContext
+  { restriction :: Maybe (Expr Projection Bool) }
+
+-- | Initial 'RestrictContext'.
+primeRestrictContext :: RestrictContext
+primeRestrictContext =  RestrictContext Nothing
+
+-- | Add restriction of 'RestrictContext'.
+addRestriction :: Expr Projection (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 QueryJoin monad object.
+composeWheres' :: Maybe (Expr Projection Bool) -> String
+composeWheres' =  maybe [] (\e -> unwordsSQL [WHERE, SQL.word . showExpr $ e])
+
+-- | Compose SQL String from QueryJoin monad object.
+composeWheres :: RestrictContext -> String
+composeWheres = composeWheres' . restriction
diff --git a/relational-join/src/Database/Relational/Query/Monad/Aggregate.hs b/relational-join/src/Database/Relational/Query/Monad/Aggregate.hs
index 231d2d48..83499479 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Aggregate.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Aggregate.hs
@@ -32,10 +32,12 @@ 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 (QueryJoin, join')
+import Database.Relational.Query.Monad.Trans.Join (join')
 import qualified Database.Relational.Query.Monad.Trans.Join as Join
-import Database.Relational.Query.Monad.Trans.Ordering (Orderings, orderings, OrderedQuery)
+import Database.Relational.Query.Monad.Trans.Ordering (Orderings, orderings, OrderedQuery, OrderByAppend, orderByAppend)
 import qualified Database.Relational.Query.Monad.Trans.Ordering as Ordering
+import Database.Relational.Query.Monad.Trans.Restrict (restrict, WheresAppend, wheresAppend)
+import qualified Database.Relational.Query.Monad.Trans.Restrict as Restrict
 import Database.Relational.Query.Monad.Core (QueryCore)
 import Database.Relational.Query.Monad.Trans.Aggregate (Aggregatings, aggregate, appendGroupBys)
 
@@ -48,27 +50,27 @@ type AggregatedQuery r = OrderedQuery Aggregation (Aggregatings QueryCore) r
 
 -- | Lift from qualified table forms into 'QueryAggregate'.
 aggregatedQuery :: Qualify a -> QueryAggregate a
-aggregatedQuery =  orderings . aggregate . join'
+aggregatedQuery =  orderings . aggregate . restrict . join'
 
 -- | Instance to lift from qualified table forms into 'QueryAggregate'.
-instance MonadQualify Qualify (Orderings Aggregation (Aggregatings (QueryJoin Qualify))) where
+instance MonadQualify Qualify (Orderings Aggregation (Aggregatings QueryCore)) where
   liftQualify = aggregatedQuery
 
 -- | Run 'AggregatedQuery' to get SQL string.
-expandSQL :: AggregatedQuery r -> Qualify ((String, Projection r), (String -> String, String -> String))
-expandSQL q = Join.expandSQL $ assoc <$> appendGroupBys (Ordering.appendOrderBys q)  where
-  assoc ((a, b), c) = (Aggregation.unsafeProjection a, (b, c))
+expandSQL :: AggregatedQuery r -> Qualify ((String, Projection r), ((OrderByAppend, String -> String), WheresAppend))
+expandSQL q = Join.expandSQL $ assoc <$> Restrict.appendWheres (appendGroupBys (Ordering.appendOrderBys q))  where
+  assoc (((a, b), c), d) = (Aggregation.unsafeProjection a, ((b, c), d))
 
 -- | Run 'AggregatedQuery' to get SQL with 'Qualify' computation.
 toSQL :: AggregatedQuery r -- ^ 'AggregatedQuery' to run
       -> Qualify String    -- ^ Result SQL string with 'Qualify' computation
 toSQL q = do
-  ((sql, _pj), (appOrd, appGrp)) <- expandSQL q
-  return . appOrd $ appGrp sql
+  ((sql, _pj), ((appOrd, appGrp), appWhere)) <- expandSQL q
+  return . orderByAppend appOrd . appGrp . wheresAppend appWhere $ sql
 
 -- | Run 'AggregatedQuery' to get 'SubQuery' with 'Qualify' computation.
 toSubQuery :: AggregatedQuery r -- ^ 'AggregatedQuery' to run
            -> Qualify SubQuery  -- ^ Result 'SubQuery' with 'Qualify' computation
 toSubQuery q = do
-  ((sql, pj), (appOrd, appGrp)) <- expandSQL q
-  return $ subQuery (appOrd $ appGrp sql) (Projection.width pj)
+  ((sql, pj), ((appOrd, appGrp), appWhere)) <- expandSQL q
+  return $ subQuery (orderByAppend appOrd . appGrp . wheresAppend appWhere $ sql) (Projection.width pj)
diff --git a/relational-join/src/Database/Relational/Query/Monad/Class.hs b/relational-join/src/Database/Relational/Query/Monad/Class.hs
index 674756b3..5affee4e 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Class.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Class.hs
@@ -31,8 +31,8 @@ import Database.Relational.Query.Internal.Product (NodeAttr)
 -- | Restrict context interface
 class (Functor m, Monad m) => MonadRestrict m where
   -- | Add restriction to this context.
-  restrict :: Expr Projection (Maybe Bool) -- ^ 'Expr' 'Projection' which represent restriction
-           -> m ()                         -- ^ Restricted query context
+  restrictContext :: Expr Projection (Maybe Bool) -- ^ 'Expr' 'Projection' which represent restriction
+                  -> m ()                         -- ^ Restricted query context
 
 -- | Query building interface.
 class (Functor m, Monad m) => MonadQuery m where
@@ -73,11 +73,11 @@ on =  restrictJoin . expr
 
 -- | Add restriction to this query.
 wheresE :: MonadRestrict m => Expr Projection (Maybe Bool) -> m ()
-wheresE =  restrict
+wheresE =  restrictContext
 
 -- | Add restriction to this query. Projection type version.
 wheres :: MonadRestrict m => Projection (Maybe Bool) -> m ()
-wheres =  restrict . expr
+wheres =  restrictContext . expr
 
 -- | Add /group by/ term into context and get aggregated projection.
 groupBy :: MonadAggregate m
diff --git a/relational-join/src/Database/Relational/Query/Monad/Core.hs b/relational-join/src/Database/Relational/Query/Monad/Core.hs
index a00dbe22..4d3f7823 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Core.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Core.hs
@@ -15,7 +15,8 @@ module Database.Relational.Query.Monad.Core (
 
 import Database.Relational.Query.Monad.Qualify (Qualify)
 import Database.Relational.Query.Monad.Trans.Join (QueryJoin)
+import Database.Relational.Query.Monad.Trans.Restrict (Restrict)
 
 
 -- | Core query monad type used by simple query and aggregated query.
-type QueryCore = QueryJoin Qualify
+type QueryCore = Restrict (QueryJoin Qualify)
diff --git a/relational-join/src/Database/Relational/Query/Monad/Simple.hs b/relational-join/src/Database/Relational/Query/Monad/Simple.hs
index 8fd85d39..800b21ca 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Simple.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Simple.hs
@@ -29,8 +29,11 @@ import Database.Relational.Query.Monad.Qualify (Qualify)
 import Database.Relational.Query.Monad.Class (MonadQualify(..))
 import Database.Relational.Query.Monad.Trans.Join (join')
 import qualified Database.Relational.Query.Monad.Trans.Join as Join
-import Database.Relational.Query.Monad.Trans.Ordering (Orderings, orderings, OrderedQuery)
+import Database.Relational.Query.Monad.Trans.Ordering
+  (Orderings, orderings, OrderedQuery, OrderByAppend, orderByAppend)
 import qualified Database.Relational.Query.Monad.Trans.Ordering as Ordering
+import Database.Relational.Query.Monad.Trans.Restrict (restrict, WheresAppend, wheresAppend)
+import qualified Database.Relational.Query.Monad.Trans.Restrict as Restrict
 import Database.Relational.Query.Monad.Core (QueryCore)
 
 import Database.Relational.Query.Sub (SubQuery, subQuery)
@@ -44,27 +47,31 @@ type SimpleQuery r = OrderedQuery Projection QueryCore r
 
 -- | Lift from qualified table forms into 'QuerySimple'.
 simple :: Qualify a -> QuerySimple a
-simple =  orderings . join'
+simple =  orderings . restrict . join'
 
 -- | Instance to lift from qualified table forms into 'QuerySimple'.
 instance MonadQualify Qualify (Orderings Projection QueryCore) where
   liftQualify = simple
 
 -- | Run 'SimpleQuery' to get SQL string.
-expandSQL :: SimpleQuery r                                      -- ^ 'SimpleQuery' to run
-          -> Qualify ((String, Projection r), String -> String) -- ^ Result SQL string and ordering appending function
-expandSQL =  Join.expandSQL . Ordering.appendOrderBys
+expandSQL' :: SimpleQuery r                                                   -- ^ 'SimpleQuery' to run
+           -> Qualify ((String, Projection r), (OrderByAppend, WheresAppend)) -- ^ Result SQL string and ordering appending function
+expandSQL' =  Join.expandSQL . fmap assoc . Restrict.appendWheres . Ordering.appendOrderBys  where
+  assoc ((a, b), c) = (a, (b, c))
+
+expandSQL :: SimpleQuery r -> Qualify (String, Projection r)
+expandSQL q = do
+  ((sql, pj), (a1, a2)) <- expandSQL' q
+  return (orderByAppend a1 (wheresAppend a2 sql), 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 q = do
-  ((sql, _), append) <- expandSQL q
-  return $ append sql
+toSQL q = fst `fmap` expandSQL q
 
 -- | Run 'SimpleQuery' to get 'SubQuery' with 'Qualify' computation.
 toSubQuery :: SimpleQuery r    -- ^ 'SimpleQuery' to run
            -> Qualify SubQuery -- ^ Result 'SubQuery' with 'Qualify' computation
 toSubQuery q = do
-  ((sql, pj), append) <- expandSQL q
-  return $ subQuery (append sql) (Projection.width pj)
+  (sql, pj) <- expandSQL q
+  return $ subQuery sql (Projection.width pj)
diff --git a/relational-join/src/Database/Relational/Query/Monad/Trans/Aggregate.hs b/relational-join/src/Database/Relational/Query/Monad/Trans/Aggregate.hs
index 1a753bb2..220b3b6a 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Trans/Aggregate.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Trans/Aggregate.hs
@@ -59,7 +59,7 @@ aggregate =  lift
 
 -- | Aggregated 'MonadRestrict'.
 instance MonadRestrict m => MonadRestrict (Aggregatings m) where
-  restrict =  aggregate . restrict
+  restrictContext =  aggregate . restrictContext
 
 -- | Aggregated 'MonadQuery'.
 instance MonadQuery m => MonadQuery (Aggregatings m) where
diff --git a/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs b/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs
index c16d4525..fdb6be85 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs
@@ -32,7 +32,7 @@ import qualified Database.Relational.Query.Projection as Projection
 import Database.Relational.Query.Expr (Expr, fromTriBool)
 import Database.Relational.Query.Sub (SubQuery, Qualified)
 
-import Database.Relational.Query.Monad.Class (MonadRestrict(..), MonadQuery (..))
+import Database.Relational.Query.Monad.Class (MonadQuery (..))
 
 
 -- | 'StateT' type to accumulate join product context.
@@ -65,10 +65,6 @@ updateJoinRestriction e = updateContext (updateProduct d)  where
   d  Nothing  = error "on: product is empty!"
   d (Just pt) = restrictProduct pt (fromTriBool e)
 
--- | Add whole query restriction.
-updateRestriction :: Monad m => Expr Projection (Maybe Bool) -> QueryJoin m ()
-updateRestriction e = updateContext (Context.addRestriction e)
-
 {-
 takeProduct :: QueryJoin (Maybe QueryProductNode)
 takeProduct =  queryCore Context.takeProduct
@@ -77,10 +73,6 @@ restoreLeft :: QueryProductNode -> NodeAttr -> QueryJoin ()
 restoreLeft pL naR = updateContext $ Context.restoreLeft pL naR
 -}
 
--- | 'MonadRestrict' instance for joinable query.
-instance (Monad q, Functor q) => MonadRestrict (QueryJoin q) where
-  restrict = updateRestriction
-
 -- | Joinable query instance.
 instance (Monad q, Functor q) => MonadQuery (QueryJoin q) where
   restrictJoin  =  updateJoinRestriction
@@ -109,7 +101,7 @@ unsafeQueryMergeWithAttr =  unsafeMergeAnother
 -}
 
 -- | Run 'QueryJoin' to get SQL string.
-expandSQL :: Monad m => QueryJoin m (Projection r, t) -> m ((String, Projection r), t)
+expandSQL :: Monad m => QueryJoin m (Projection r, st) -> m ((String, Projection r), st)
 expandSQL qp = do
   ((pj, st), c) <- runQueryPrime qp
   return ((Context.composeSQL pj c, pj), st)
diff --git a/relational-join/src/Database/Relational/Query/Monad/Trans/Ordering.hs b/relational-join/src/Database/Relational/Query/Monad/Trans/Ordering.hs
index 3405802a..32449e4b 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Trans/Ordering.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Trans/Ordering.hs
@@ -19,8 +19,9 @@ module Database.Relational.Query.Monad.Trans.Ordering (
   -- * API of query with ordering
   asc, desc,
 
-  -- * Result order by SQLs
-  appendOrderBys
+  -- * Result SQL order-by clause
+  appendOrderBys,
+  OrderByAppend (orderByAppend)
   ) where
 
 import Control.Monad.Trans.Class (MonadTrans (lift))
@@ -64,7 +65,7 @@ orderings =  lift
 
 -- | 'MonadRestrict' with ordering.
 instance MonadRestrict m => MonadRestrict (Orderings p m) where
-  restrict =  orderings . restrict
+  restrictContext =  orderings . restrictContext
 
 -- | 'MonadQuery' with ordering.
 instance MonadQuery m => MonadQuery (Orderings p m) where
@@ -143,8 +144,10 @@ appendOrderBys' c = (++ d (Context.composeOrderBys c))  where
   d "" = ""
   d s  = ' ' : s
 
+newtype OrderByAppend = OrderByAppend { orderByAppend :: String -> String }
+
 -- | Run 'Orderings' to get query result and order-by appending function.
-appendOrderBys :: MonadQuery m
-               => Orderings p m a         -- ^ 'Orderings' to run
-               -> m (a, String -> String) -- ^ Query result and order-by appending function.
-appendOrderBys q = second appendOrderBys' <$> runOrderingsPrime q
+appendOrderBys :: (Monad m, Functor m)
+               => Orderings p m a      -- ^ 'Orderings' to run
+               -> m (a, OrderByAppend) -- ^ Query result and order-by appending function.
+appendOrderBys q = second (OrderByAppend . appendOrderBys') <$> runOrderingsPrime q
diff --git a/relational-join/src/Database/Relational/Query/Monad/Trans/Restrict.hs b/relational-join/src/Database/Relational/Query/Monad/Trans/Restrict.hs
new file mode 100644
index 00000000..b989a521
--- /dev/null
+++ b/relational-join/src/Database/Relational/Query/Monad/Trans/Restrict.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- |
+-- Module      : Database.Relational.Query.Monad.Trans.Restrict
+-- Copyright   : 2013 Kei Hibino
+-- License     : BSD3
+--
+-- Maintainer  : ex8k.hibino@gmail.com
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- This module defines monad transformer which lift to basic 'MonadQuery'.
+module Database.Relational.Query.Monad.Trans.Restrict (
+  -- * Transformer into restricted context
+  Restrict, restrict,
+
+  -- * Result SQL wheres clause
+  appendWheres,
+  WheresAppend (wheresAppend)
+  ) where
+
+import Control.Monad.Trans.Class (MonadTrans (lift))
+import Control.Monad.Trans.State (modify, StateT, runStateT)
+import Control.Applicative (Applicative, (<$>))
+import Control.Arrow (second)
+
+import Database.Relational.Query.Internal.RestrictContext
+  (RestrictContext, primeRestrictContext, addRestriction)
+import qualified Database.Relational.Query.Internal.RestrictContext as RestrictContext
+import Database.Relational.Query.Projection (Projection)
+import Database.Relational.Query.Expr (Expr)
+
+import Database.Relational.Query.Monad.Class (MonadRestrict(..), MonadQuery (..))
+
+
+-- | 'StateT' type to accumulate join product context.
+newtype Restrict m a =
+  Restrict { queryState :: StateT RestrictContext m a }
+  deriving (MonadTrans, Monad, Functor, Applicative)
+
+-- | Run 'Restrict' to expand context state.
+runRestrict :: Restrict m a  -- ^ RestrictContext to expand
+             -> RestrictContext        -- ^ Initial context
+             -> m (a, RestrictContext) -- ^ Expanded result
+runRestrict =  runStateT . queryState
+
+-- | Run 'Restrict' with primary empty context to expand context state.
+runRestrictPrime :: Restrict m a           -- ^ RestrictContext to expand
+                 -> m (a, RestrictContext) -- ^ Expanded result
+runRestrictPrime q = runRestrict q primeRestrictContext
+
+-- | Lift to 'Restrict'
+restrict :: Monad m => m a -> Restrict m a
+restrict =  lift
+
+-- | Unsafely update join product context.
+updateRestrictContext :: Monad m => (RestrictContext -> RestrictContext) -> Restrict m ()
+updateRestrictContext =  Restrict . modify
+
+-- | Add whole query restriction.
+updateRestriction :: Monad m => Expr Projection (Maybe Bool) -> Restrict m ()
+updateRestriction e = updateRestrictContext (addRestriction e)
+
+-- | 'MonadRestrict' instance.
+instance (Monad q, Functor q) => MonadRestrict (Restrict q) where
+  restrictContext = updateRestriction
+
+-- | Restricted 'MonadQuery' instance.
+instance MonadQuery q => MonadQuery (Restrict q) where
+  restrictJoin     = restrict . restrictJoin
+  unsafeSubQuery a = restrict . unsafeSubQuery a
+
+-- | Get order-by appending function from 'RestrictContext'.
+appendWheres' :: RestrictContext -> String -> String
+appendWheres' c = (++ d (RestrictContext.composeWheres c))  where
+  d "" = ""
+  d s  = ' ' : s
+
+newtype WheresAppend = WheresAppend { wheresAppend :: String -> String }
+
+-- | Run 'Restricts' to get query result and order-by appending function.
+appendWheres :: (Monad m, Functor m)
+             => Restrict m a            -- ^ 'Restrict' to run
+             -> m (a,  WheresAppend) -- ^ Query result and order-by appending function.
+appendWheres r = second (WheresAppend . appendWheres') <$> runRestrictPrime r
+
+-- expandSQL :: Monad m => Restrict m a -> m (String, a)
+-- expandSQL r = do
+--   (a, c) <- runRestrictPrime r
+--   return (RestrictContext.composeSQL c, a)

From 9a2cf14846b73432041d09945521d3293372c7be Mon Sep 17 00:00:00 2001
From: Kei Hibino <ex8k.hibino@gmail.com>
Date: Mon, 5 Aug 2013 01:17:04 +0900
Subject: [PATCH 3/3] Module renamed.

--HG--
rename : relational-join/src/Database/Relational/Query/Internal/Context.hs => relational-join/src/Database/Relational/Query/Monad/Trans/JoinState.hs
---
 relational-join/relational-join.cabal                 |  2 +-
 .../src/Database/Relational/Query/Monad/Trans/Join.hs | 11 +++++------
 .../{Internal/Context.hs => Monad/Trans/JoinState.hs} |  9 ++++-----
 3 files changed, 10 insertions(+), 12 deletions(-)
 rename relational-join/src/Database/Relational/Query/{Internal/Context.hs => Monad/Trans/JoinState.hs} (89%)

diff --git a/relational-join/relational-join.cabal b/relational-join/relational-join.cabal
index d94d5c59..d2a2ec78 100644
--- a/relational-join/relational-join.cabal
+++ b/relational-join/relational-join.cabal
@@ -53,7 +53,7 @@ library
                        Database.Relational.Query.Internal.ShowS
                        Database.Relational.Query.Internal.Product
                        Database.Relational.Query.Internal.RestrictContext
-                       Database.Relational.Query.Internal.Context
+                       Database.Relational.Query.Monad.Trans.JoinState
                        Database.Relational.Query.Internal.AggregatingContext
                        Database.Relational.Query.Internal.OrderingContext
                        Database.Relational.Query.Monad.Qualify
diff --git a/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs b/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs
index fdb6be85..70197c63 100644
--- a/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Trans/Join.hs
@@ -23,9 +23,8 @@ import Control.Monad.Trans.Class (MonadTrans (lift))
 import Control.Monad.Trans.State (modify, StateT, runStateT)
 import Control.Applicative (Applicative)
 
-import Database.Relational.Query.Internal.Context
-  (Context, primeContext, updateProduct)
-import qualified Database.Relational.Query.Internal.Context as Context
+import Database.Relational.Query.Monad.Trans.JoinState
+  (Context, primeContext, updateProduct, composeSQL)
 import Database.Relational.Query.Internal.Product (NodeAttr, restrictProduct, growProduct)
 import Database.Relational.Query.Projection (Projection)
 import qualified Database.Relational.Query.Projection as Projection
@@ -67,10 +66,10 @@ updateJoinRestriction e = updateContext (updateProduct d)  where
 
 {-
 takeProduct :: QueryJoin (Maybe QueryProductNode)
-takeProduct =  queryCore Context.takeProduct
+takeProduct =  queryCore State.takeProduct
 
 restoreLeft :: QueryProductNode -> NodeAttr -> QueryJoin ()
-restoreLeft pL naR = updateContext $ Context.restoreLeft pL naR
+restoreLeft pL naR = updateContext $ State.restoreLeft pL naR
 -}
 
 -- | Joinable query instance.
@@ -104,4 +103,4 @@ unsafeQueryMergeWithAttr =  unsafeMergeAnother
 expandSQL :: Monad m => QueryJoin m (Projection r, st) -> m ((String, Projection r), st)
 expandSQL qp = do
   ((pj, st), c) <- runQueryPrime qp
-  return ((Context.composeSQL pj c, pj), st)
+  return ((composeSQL pj c, pj), st)
diff --git a/relational-join/src/Database/Relational/Query/Internal/Context.hs b/relational-join/src/Database/Relational/Query/Monad/Trans/JoinState.hs
similarity index 89%
rename from relational-join/src/Database/Relational/Query/Internal/Context.hs
rename to relational-join/src/Database/Relational/Query/Monad/Trans/JoinState.hs
index 782e47d3..2e67128f 100644
--- a/relational-join/src/Database/Relational/Query/Internal/Context.hs
+++ b/relational-join/src/Database/Relational/Query/Monad/Trans/JoinState.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 -- |
--- Module      : Database.Relational.Query.Internal.Context
+-- Module      : Database.Relational.Query.Monad.Trans.JoinState
 -- Copyright   : 2013 Kei Hibino
 -- License     : BSD3
 --
@@ -9,10 +9,9 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- This module provides context definition for
--- "Database.Relational.Query.Monad.Trans.Join" and
--- "Database.Relational.Query.Monad.Trans.Ordering".
-module Database.Relational.Query.Internal.Context (
+-- This module provides state definition for
+-- "Database.Relational.Query.Monad.Trans.Join".
+module Database.Relational.Query.Monad.Trans.JoinState (
   -- * Join context
   Context,