mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-12-14 22:32:07 +03:00
Remove old SQL compose codes.
This commit is contained in:
parent
91c0c285ce
commit
97441a74f6
@ -18,9 +18,7 @@ module Database.Relational.Query.Monad.Trans.Aggregating (
|
||||
Aggregatings, aggregatings,
|
||||
|
||||
-- * Result
|
||||
extractAggregateTerms,
|
||||
|
||||
GroupBysPrepend, extractGroupBys, prependGroupBys
|
||||
extractAggregateTerms
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.Class (MonadTrans (lift))
|
||||
@ -30,9 +28,8 @@ import Control.Arrow (second, (>>>))
|
||||
|
||||
import Database.Relational.Query.Context (Flat, Aggregated)
|
||||
import Database.Relational.Query.Sub (AggregateTerm, AggregateTerms)
|
||||
import Database.Relational.Query.Monad.Trans.StatePrepend (Prepend, prepend, liftToString)
|
||||
import Database.Relational.Query.Monad.Trans.AggregatingState
|
||||
(AggregatingContext, primeAggregatingContext, aggregateTerms, addGroupBy, composeGroupBys)
|
||||
(AggregatingContext, primeAggregatingContext, aggregateTerms, addGroupBy)
|
||||
import Database.Relational.Query.Projection (Projection)
|
||||
import qualified Database.Relational.Query.Projection as Projection
|
||||
|
||||
@ -92,16 +89,3 @@ instance MonadQuery m => MonadAggregate (Aggregatings m) where
|
||||
-- | Run 'Aggregatings' to get 'AggregateTerms'.
|
||||
extractAggregateTerms :: (Monad m, Functor m) => Aggregatings m a -> m (a, AggregateTerms)
|
||||
extractAggregateTerms q = second aggregateTerms <$> runAggregatingPrime q
|
||||
|
||||
-- | GROUP BY terms prepending function.
|
||||
type GroupBysPrepend = Prepend AggregatingContext
|
||||
|
||||
-- | Run 'Aggregatings' to get GROUP BY terms prepending function.
|
||||
extractGroupBys :: MonadQuery m
|
||||
=> Aggregatings m a -- ^ 'Aggregatings' to run
|
||||
-> m (a, GroupBysPrepend) -- ^ GROUP BY terms prepending function.
|
||||
extractGroupBys q = second (liftToString composeGroupBys) <$> runAggregatingPrime q
|
||||
|
||||
-- | Run GROUP BY terms prepend.
|
||||
prependGroupBys :: GroupBysPrepend -> String -> String
|
||||
prependGroupBys = prepend
|
||||
|
@ -21,10 +21,7 @@ module Database.Relational.Query.Monad.Trans.Assigning (
|
||||
assignTo, (!#), (<-#), AssignTarget,
|
||||
|
||||
-- * Result SQL set clause
|
||||
extractAssignments,
|
||||
|
||||
extractSets,
|
||||
SetPrepend, prependSet
|
||||
extractAssignments
|
||||
) where
|
||||
|
||||
import Database.Relational.Query.Context (Flat)
|
||||
@ -34,9 +31,8 @@ import Control.Applicative (Applicative, (<$>))
|
||||
import Control.Arrow ((>>>), second)
|
||||
|
||||
import Database.Relational.Query.Sub (Assignments)
|
||||
import Database.Relational.Query.Monad.Trans.StatePrepend (Prepend, prepend, liftToString)
|
||||
import Database.Relational.Query.Monad.Trans.AssigningState
|
||||
(AssigningContext, primeAssigningContext, updateAssignments, assignments, composeAssignments)
|
||||
(AssigningContext, primeAssigningContext, updateAssignments, assignments)
|
||||
import Database.Relational.Query.Pi (Pi)
|
||||
import Database.Relational.Query.Table (Table)
|
||||
import Database.Relational.Query.Projection (Projection)
|
||||
@ -98,21 +94,8 @@ assignTo vp target = updateAssigningContext . foldr (>>>) id
|
||||
infix 8 !#
|
||||
infix 4 <-#
|
||||
|
||||
-- | SET clause prepending function.
|
||||
type SetPrepend = Prepend AssigningContext
|
||||
|
||||
-- | Run 'Assignings' to get 'Assignments'
|
||||
extractAssignments :: (Monad m, Functor m)
|
||||
=> Assignings r m a
|
||||
-> m (a, Assignments)
|
||||
extractAssignments q = second assignments <$> runAssigningsPrime q
|
||||
|
||||
-- | Run 'Assignings' to get SET clause prepending function.
|
||||
extractSets :: (Monad m, Functor m)
|
||||
=> Assignings r m a
|
||||
-> m (a, SetPrepend)
|
||||
extractSets q = second (liftToString composeAssignments) <$> runAssigningsPrime q
|
||||
|
||||
-- | Run SET clause prepend.
|
||||
prependSet :: SetPrepend -> String -> String
|
||||
prependSet = prepend
|
||||
|
@ -15,9 +15,7 @@ module Database.Relational.Query.Monad.Trans.Join (
|
||||
QueryJoin, join',
|
||||
|
||||
-- * Result
|
||||
extractProduct,
|
||||
|
||||
FromPrepend, extractFrom, prependFrom
|
||||
extractProduct
|
||||
) where
|
||||
|
||||
import Prelude hiding (product)
|
||||
@ -27,14 +25,13 @@ 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, joinProduct, composeFrom)
|
||||
(JoinContext, primeJoinContext, updateProduct, joinProduct)
|
||||
import Database.Relational.Query.Internal.Product (NodeAttr, restrictProduct, growProduct)
|
||||
import Database.Relational.Query.Projection (Projection)
|
||||
import qualified Database.Relational.Query.Projection as Projection
|
||||
import Database.Relational.Query.Expr (Expr, fromJust)
|
||||
import Database.Relational.Query.Sub (SubQuery, Qualified, UnitProductSupport, JoinProduct)
|
||||
import Database.Relational.Query.Sub (SubQuery, Qualified, JoinProduct)
|
||||
|
||||
import Database.Relational.Query.Monad.Class (MonadQuery (..))
|
||||
|
||||
@ -107,16 +104,3 @@ unsafeQueryMergeWithAttr = unsafeMergeAnother
|
||||
-- | Run 'QueryJoin' to get 'JoinProduct'
|
||||
extractProduct :: (Monad m, Functor m) => QueryJoin m a -> m (a, JoinProduct)
|
||||
extractProduct q = second joinProduct <$> runQueryPrime q
|
||||
|
||||
-- | FROM clause prepending function type.
|
||||
type FromPrepend = UnitProductSupport -> Prepend JoinContext
|
||||
|
||||
-- | Run 'QueryJoin' to get FROM clause prepending function.
|
||||
extractFrom :: (Monad m, Functor m)
|
||||
=> QueryJoin m a -- ^ 'QueryJoin' to run
|
||||
-> m (a, FromPrepend) -- ^ FROM clause prepending function.
|
||||
extractFrom q = second (\jc ups -> liftToString (composeFrom ups) $ jc) <$> runQueryPrime q
|
||||
|
||||
-- | Run FROM clause prepend.
|
||||
prependFrom :: FromPrepend -> UnitProductSupport -> String -> String
|
||||
prependFrom = fmap prepend
|
||||
|
@ -22,10 +22,7 @@ module Database.Relational.Query.Monad.Trans.Ordering (
|
||||
asc, desc,
|
||||
|
||||
-- * Result
|
||||
extractOrderingTerms,
|
||||
|
||||
extractOrderBys,
|
||||
OrderByPrepend, prependOrderBy
|
||||
extractOrderingTerms
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.Class (MonadTrans (lift))
|
||||
@ -34,9 +31,8 @@ import Control.Applicative (Applicative, (<$>))
|
||||
import Control.Arrow (second, (>>>))
|
||||
|
||||
import Database.Relational.Query.Sub (Order(Asc, Desc), OrderColumn, OrderingTerms)
|
||||
import Database.Relational.Query.Monad.Trans.StatePrepend (Prepend, prepend, liftToString)
|
||||
import Database.Relational.Query.Monad.Trans.OrderingState
|
||||
(OrderingContext, primeOrderingContext, updateOrderBy, orderingTerms, composeOrderBys)
|
||||
(OrderingContext, primeOrderingContext, updateOrderBy, orderingTerms)
|
||||
import Database.Relational.Query.Projection (Projection)
|
||||
import qualified Database.Relational.Query.Projection as Projection
|
||||
|
||||
@ -137,16 +133,3 @@ desc = updateOrderBys Desc
|
||||
-- | Run 'Orderings' to get 'OrderingTerms'
|
||||
extractOrderingTerms :: (Monad m, Functor m) => Orderings p m a -> m (a, OrderingTerms)
|
||||
extractOrderingTerms q = second orderingTerms <$> runOrderingsPrime q
|
||||
|
||||
-- | ORDER BY clause prepending function.
|
||||
type OrderByPrepend = Prepend OrderingContext
|
||||
|
||||
-- | Run 'Orderings' to get ORDER BY clause prepending function.
|
||||
extractOrderBys :: (Monad m, Functor m)
|
||||
=> Orderings p m a -- ^ 'Orderings' to run
|
||||
-> m (a, OrderByPrepend) -- ^ Query result and order-by prepending function.
|
||||
extractOrderBys q = second (liftToString composeOrderBys) <$> runOrderingsPrime q
|
||||
|
||||
-- | Run ORDER BY clause prepend.
|
||||
prependOrderBy :: OrderByPrepend -> String -> String
|
||||
prependOrderBy = prepend
|
||||
|
@ -17,10 +17,7 @@ module Database.Relational.Query.Monad.Trans.Restricting (
|
||||
Restrictings, restrictings,
|
||||
|
||||
-- * Result
|
||||
extractRestrict,
|
||||
|
||||
extractWheres, WherePrepend, prependWhere,
|
||||
extractHavings, HavingPrepend, prependHaving
|
||||
extractRestrict
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.Class (MonadTrans (lift))
|
||||
@ -28,10 +25,8 @@ import Control.Monad.Trans.State (modify, StateT, runStateT)
|
||||
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.RestrictingState
|
||||
(RestrictContext, primeRestrictContext, addRestriction, restriction, composeWheres, composeHavings)
|
||||
(RestrictContext, primeRestrictContext, addRestriction, restriction)
|
||||
import Database.Relational.Query.Expr (Expr)
|
||||
import Database.Relational.Query.Sub (QueryRestriction)
|
||||
|
||||
@ -82,29 +77,3 @@ instance MonadAggregate m => MonadAggregate (Restrictings c m) where
|
||||
-- | Run 'Restrictings' to get 'QueryRestriction'
|
||||
extractRestrict :: (Monad m, Functor m) => Restrictings c m a -> m (a, QueryRestriction c)
|
||||
extractRestrict q = second restriction <$> runRestrictingsPrime q
|
||||
|
||||
-- | WHERE clause prepending function.
|
||||
type WherePrepend = Prepend (RestrictContext Flat)
|
||||
|
||||
-- | Run 'Restrictings' to get WHERE clause prepending function.
|
||||
extractWheres :: (Monad m, Functor m)
|
||||
=> 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.
|
||||
prependWhere :: WherePrepend -> String -> String
|
||||
prependWhere = prepend
|
||||
|
||||
-- | HAVING clause prepending function.
|
||||
type HavingPrepend = Prepend (RestrictContext Aggregated)
|
||||
|
||||
-- | Run 'Restrictings' to get HAVING clause prepending function.
|
||||
extractHavings :: (Monad m, Functor m)
|
||||
=> Restrictings Aggregated m a -- ^ 'Restrictings' to run
|
||||
-> m (a, HavingPrepend) -- ^ HAVING clause prepending function.
|
||||
extractHavings r = second (liftToString composeHavings) <$> runRestrictingsPrime r
|
||||
|
||||
-- | Run HAVING clause prepend.
|
||||
prependHaving :: HavingPrepend -> String -> String
|
||||
prependHaving = prepend
|
||||
|
@ -11,9 +11,6 @@
|
||||
--
|
||||
-- This module defines functions to generate simple SQL strings.
|
||||
module Database.Relational.Query.SQL (
|
||||
-- * Select SQL
|
||||
selectSeedSQL,
|
||||
|
||||
-- * Update SQL
|
||||
updateSeedSQL,
|
||||
updateSQL',
|
||||
@ -32,21 +29,9 @@ import Language.SQL.Keyword (Keyword(..), (.=.), unwordsSQL)
|
||||
import qualified Language.SQL.Keyword as SQL
|
||||
import Database.Record.ToSql (untypedUpdateValuesIndex)
|
||||
import Database.Relational.Query.Pi.Unsafe (Pi, unsafeExpandIndexes)
|
||||
import Database.Relational.Query.Sub (asColumnN)
|
||||
import Database.Relational.Query.Table (ColumnSQL, sqlWordFromColumn, Table, name, columns)
|
||||
import Database.Relational.Query.Projection (Projection)
|
||||
import qualified Database.Relational.Query.Projection as Projection
|
||||
|
||||
|
||||
-- | Generate select SQL. Seed SQL string append to this.
|
||||
selectSeedSQL :: Projection c r -> ShowS
|
||||
selectSeedSQL pj =
|
||||
(unwordsSQL [SELECT, columns' `SQL.sepBy` ", "] ++)
|
||||
where columns' = zipWith
|
||||
(\f n -> sqlWordFromColumn f `asColumnN` n)
|
||||
(Projection.columns pj)
|
||||
[(0 :: Int)..]
|
||||
|
||||
-- | Generate update SQL. Seed SQL string append to this.
|
||||
updateSeedSQL :: Table r -> ShowS
|
||||
updateSeedSQL table = (unwordsSQL [UPDATE, SQL.word $ name table] ++)
|
||||
|
Loading…
Reference in New Issue
Block a user