mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-12-04 03:53:03 +03:00
Fixed along with disabling unsafeMergeAnotherQuery.
This commit is contained in:
parent
d5a9b9ed58
commit
ce5218af72
@ -12,12 +12,12 @@ module Database.Relational.Query.Monad.Ordering (
|
||||
|
||||
import Control.Monad (liftM, ap)
|
||||
import Control.Monad.Trans.Class (MonadTrans (lift))
|
||||
import Control.Monad.Trans.State (StateT, runStateT, modify, state)
|
||||
import Control.Monad.Trans.State (StateT, runStateT, modify)
|
||||
import Control.Applicative (Applicative (pure, (<*>)), (<$>))
|
||||
import Control.Arrow (second)
|
||||
|
||||
import Database.Relational.Query.Internal.Context
|
||||
(Order(Asc, Desc), OrderBys, OrderingContext, primeOrderingContext)
|
||||
(Order(Asc, Desc), OrderingContext, primeOrderingContext)
|
||||
import qualified Database.Relational.Query.Internal.Context as Context
|
||||
-- import Database.Relational.Query.Internal.Product (NodeAttr)
|
||||
|
||||
@ -72,17 +72,17 @@ updateOrderBys :: (Monad m, OrderingTerms p) => Order -> p t -> Orderings p m ()
|
||||
updateOrderBys order p = updateOrderingContext (\c -> foldl update c (orderTerms p)) where
|
||||
update = flip (Context.updateOrderBy order)
|
||||
|
||||
{-
|
||||
takeOrderBys :: Monad m => Orderings p m OrderBys
|
||||
takeOrderBys = Orderings $ state Context.takeOrderBys
|
||||
|
||||
restoreLowOrderBys :: Monad m => Context.OrderBys -> Orderings p m ()
|
||||
restoreLowOrderBys ros = updateOrderingContext $ Context.restoreLowOrderBys ros
|
||||
|
||||
{-
|
||||
unsafeMergeAnotherOrderBys :: UnsafeMonadQuery m
|
||||
=> NodeAttr
|
||||
-> Orderings p m (Projection r)
|
||||
-> Orderings p m (Projection r)
|
||||
|
||||
unsafeMergeAnotherOrderBys naR qR = do
|
||||
ros <- takeOrderBys
|
||||
let qR' = fst <$> runOrderingsPrime qR
|
||||
|
@ -11,7 +11,7 @@ module Database.Relational.Query.Monad.Simple (
|
||||
toSubQuery
|
||||
) where
|
||||
|
||||
import Database.Relational.Query.Internal.Product (NodeAttr)
|
||||
-- import Database.Relational.Query.Internal.Product (NodeAttr)
|
||||
|
||||
import Database.Relational.Query.Projection (Projection)
|
||||
import qualified Database.Relational.Query.Projection as Projection
|
||||
@ -33,10 +33,13 @@ simple = orderings
|
||||
-- unsafeMergeAnotherOrderBys :: NodeAttr -> QuerySimple (Projection r) -> QuerySimple (Projection r)
|
||||
-- unsafeMergeAnotherOrderBys = Ordering.unsafeMergeAnotherOrderBys
|
||||
|
||||
expandSQL :: SimpleQuery r -> ((String, Projection r), String -> String)
|
||||
expandSQL = Core.expandSQL . Ordering.appendOrderBys
|
||||
|
||||
toSQL :: SimpleQuery r -> String
|
||||
toSQL q = append sql where
|
||||
((sql, _), append) = Core.expandSQL . Ordering.appendOrderBys $ q
|
||||
((sql, _), append) = expandSQL q
|
||||
|
||||
toSubQuery :: SimpleQuery r -> SubQuery
|
||||
toSubQuery q = subQuery (append sql) (Projection.width pj) where
|
||||
((sql, pj), append) = Core.expandSQL . Ordering.appendOrderBys $ q
|
||||
((sql, pj), append) = expandSQL q
|
||||
|
Loading…
Reference in New Issue
Block a user