Extend types around restrict monad.

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

@@ -25,7 +25,7 @@ import Database.Relational.Query.Monad.Trans.Restricting
 
 
 -- | Restrict only monad type used from update statement and delete statement.
-type Restrict = Restrictings Identity
+type Restrict = Restrictings Flat Identity
 
 -- | RestrictedStatement type synonym.
 --   Projection record type 'r' must be

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 -- |
 -- Module      : Database.Relational.Query.Monad.Trans.Restricting
@@ -34,49 +35,49 @@ import Database.Relational.Query.Monad.Class (MonadRestrict(..), MonadQuery (..)
 
 
 -- | 'StateT' type to accumulate join product context.
-newtype Restrictings m a =
-  Restrictings { queryState :: StateT RestrictContext m a }
+newtype Restrictings c m a =
+  Restrictings { queryState :: StateT (RestrictContext c) m a }
   deriving (MonadTrans, Monad, Functor, Applicative)
 
 -- | Run 'Restrictings' to expand context state.
-runRestrictings :: Restrictings m a  -- ^ RestrictContext to expand
-             -> RestrictContext        -- ^ Initial context
-             -> m (a, RestrictContext) -- ^ Expanded result
+runRestrictings :: Restrictings c m a       -- ^ RestrictContext to expand
+                -> RestrictContext c        -- ^ Initial context
+                -> m (a, RestrictContext c) -- ^ Expanded result
 runRestrictings =  runStateT . queryState
 
 -- | Run 'Restrictings' with primary empty context to expand context state.
-runRestrictingsPrime :: Restrictings m a           -- ^ RestrictContext to expand
-                 -> m (a, RestrictContext) -- ^ Expanded result
+runRestrictingsPrime :: Restrictings c m a       -- ^ RestrictContext to expand
+                     -> m (a, RestrictContext c) -- ^ Expanded result
 runRestrictingsPrime q = runRestrictings q primeRestrictContext
 
 -- | Lift to 'Restrictings'
-restrictings :: Monad m => m a -> Restrictings m a
+restrictings :: Monad m => m a -> Restrictings c m a
 restrictings =  lift
 
 -- | Unsafely update join product context.
-updateRestrictContext :: Monad m => (RestrictContext -> RestrictContext) -> Restrictings m ()
+updateRestrictContext :: Monad m => (RestrictContext c -> RestrictContext c) -> Restrictings c m ()
 updateRestrictContext =  Restrictings . modify
 
 -- | Add whole query restriction.
-updateRestriction :: Monad m => Expr Flat (Maybe Bool) -> Restrictings m ()
+updateRestriction :: Monad m => Expr c (Maybe Bool) -> Restrictings c m ()
 updateRestriction e = updateRestrictContext (addRestriction e)
 
 -- | 'MonadRestrict' instance.
-instance (Monad q, Functor q) => MonadRestrict (Restrictings q) where
+instance (Monad q, Functor q) => MonadRestrict (Restrictings Flat q) where
   restrictContext = updateRestriction
 
 -- | Restricted 'MonadQuery' instance.
-instance MonadQuery q => MonadQuery (Restrictings q) where
+instance MonadQuery q => MonadQuery (Restrictings c q) where
   restrictJoin     = restrictings . restrictJoin
   unsafeSubQuery a = restrictings . unsafeSubQuery a
 
 -- | WHERE clause prepending function.
-type WherePrepend = Prepend RestrictContext
+type WherePrepend = Prepend (RestrictContext Flat)
 
 -- | Run 'Restrictings' to get WHERE clause prepending function.
 extractWheres :: (Monad m, Functor m)
-              => Restrictings m a         -- ^ 'Restrictings' to run
-              -> m (a,  WherePrepend) -- ^ WHERE clause prepending function.
+              => Restrictings Flat m a -- ^ 'Restrictings' to run
+              -> m (a,  WherePrepend)  -- ^ WHERE clause prepending function.
 extractWheres r = second (liftToString composeWheres) <$> runRestrictingsPrime r
 
 -- | Run WHERE clause prepend.

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

@@ -32,22 +32,22 @@ import qualified Language.SQL.Keyword as SQL
 
 
 -- | Context type for Restrict.
-newtype RestrictContext = RestrictContext
-                          { restriction' :: QueryRestriction }
+newtype RestrictContext c = RestrictContext
+                            { restriction' :: QueryRestriction c }
 
 -- | Initial 'RestrictContext'.
-primeRestrictContext :: RestrictContext
+primeRestrictContext :: RestrictContext c
 primeRestrictContext =  RestrictContext Nothing
 
 -- | Add restriction of 'RestrictContext'.
-addRestriction :: Expr Flat (Maybe Bool) -> RestrictContext -> RestrictContext
+addRestriction :: Expr c (Maybe Bool) -> RestrictContext c -> RestrictContext c
 addRestriction e1 ctx =
   ctx { restriction' = Just . uf . restriction' $ ctx }
   where uf  Nothing  = fromJust e1
         uf (Just e0) = e0 `exprAnd` fromJust e1
 
 -- | Finalize context to extract accumulated restriction state.
-restriction :: RestrictContext -> QueryRestriction
+restriction :: RestrictContext c -> QueryRestriction c
 restriction =  restriction'
 
 -- | Compose SQL String from 'RestrictContext' object.
@@ -55,5 +55,5 @@ composeWheres' :: Maybe (Expr Flat Bool) -> String
 composeWheres' =  maybe [] (\e -> unwordsSQL [WHERE, SQL.word . showExpr $ e])
 
 -- | Compose SQL String from 'RestrictContext' object.
-composeWheres :: RestrictContext -> String
+composeWheres :: RestrictContext Flat -> String
 composeWheres =  composeWheres' . restriction'

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

@@ -13,10 +13,11 @@ module Database.Relational.Query.Monad.Type (
   QueryCore,
   ) where
 
+import Database.Relational.Query.Context (Flat)
 import Database.Relational.Query.Monad.Qualify (Qualify)
 import Database.Relational.Query.Monad.Trans.Join (QueryJoin)
 import Database.Relational.Query.Monad.Trans.Restricting (Restrictings)
 
 
 -- | Core query monad type used from simple query and aggregated query.
-type QueryCore = Restrictings (QueryJoin Qualify)
+type QueryCore = Restrictings Flat (QueryJoin Qualify)

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

@@ -50,7 +50,7 @@ import Data.Maybe (fromMaybe)
 import Data.Array (Array, listArray)
 import qualified Data.Array as Array
 
-import Database.Relational.Query.Context (Flat, Aggregated)
+import Database.Relational.Query.Context (Aggregated)
 import Database.Relational.Query.Expr (Expr, valueExpr)
 import Database.Relational.Query.Expr.Unsafe (showExpr)
 import Database.Relational.Query.Internal.Product
@@ -293,7 +293,7 @@ queryProductSQL =  ($ "") . showQueryProduct
 
 
 -- | Type for restriction of query.
-type QueryRestriction = Maybe (Expr Flat Bool)
+type QueryRestriction c = Maybe (Expr c Bool)
 
 
 -- | Type for group-by term