khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2024-12-12 12:09:08 +03:00
Code Issues Projects Releases Wiki Activity

Fixed along with disabling unsafeMergeAnotherQuery.

Browse Source
This commit is contained in:
Kei Hibino 2013-05-26 13:11:14 +09:00
parent d5a9b9ed58
commit ce5218af72
2 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
relational-join/src/Database/Relational/Query/Monad/Ordering.hs
View File

@ -12,12 +12,12 @@ module Database.Relational.Query.Monad.Ordering (
import Control.Monad (liftM, ap) import Control.Monad (liftM, ap)
import Control.Monad.Trans.Class (MonadTrans (lift)) 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.Applicative (Applicative (pure, (<*>)), (<$>))
import Control.Arrow (second) import Control.Arrow (second)
import Database.Relational.Query.Internal.Context 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 qualified Database.Relational.Query.Internal.Context as Context
-- import Database.Relational.Query.Internal.Product (NodeAttr) -- 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 updateOrderBys order p = updateOrderingContext (\c -> foldl update c (orderTerms p)) where
update = flip (Context.updateOrderBy order) update = flip (Context.updateOrderBy order)
{-
takeOrderBys :: Monad m => Orderings p m OrderBys takeOrderBys :: Monad m => Orderings p m OrderBys
takeOrderBys = Orderings $ state Context.takeOrderBys takeOrderBys = Orderings $ state Context.takeOrderBys
restoreLowOrderBys :: Monad m => Context.OrderBys -> Orderings p m () restoreLowOrderBys :: Monad m => Context.OrderBys -> Orderings p m ()
restoreLowOrderBys ros = updateOrderingContext $ Context.restoreLowOrderBys ros restoreLowOrderBys ros = updateOrderingContext $ Context.restoreLowOrderBys ros
{-
unsafeMergeAnotherOrderBys :: UnsafeMonadQuery m unsafeMergeAnotherOrderBys :: UnsafeMonadQuery m
=> NodeAttr => NodeAttr
-> Orderings p m (Projection r) -> Orderings p m (Projection r)
-> Orderings p m (Projection r) -> Orderings p m (Projection r)
unsafeMergeAnotherOrderBys naR qR = do unsafeMergeAnotherOrderBys naR qR = do
ros <- takeOrderBys ros <- takeOrderBys
let qR' = fst <$> runOrderingsPrime qR let qR' = fst <$> runOrderingsPrime qR

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

@ -11,7 +11,7 @@ module Database.Relational.Query.Monad.Simple (
toSubQuery toSubQuery
) where ) where
import Database.Relational.Query.Internal.Product (NodeAttr) -- import Database.Relational.Query.Internal.Product (NodeAttr)
import Database.Relational.Query.Projection (Projection) import Database.Relational.Query.Projection (Projection)
import qualified Database.Relational.Query.Projection as Projection import qualified Database.Relational.Query.Projection as Projection
@ -33,10 +33,13 @@ simple = orderings
-- unsafeMergeAnotherOrderBys :: NodeAttr -> QuerySimple (Projection r) -> QuerySimple (Projection r) -- unsafeMergeAnotherOrderBys :: NodeAttr -> QuerySimple (Projection r) -> QuerySimple (Projection r)
-- unsafeMergeAnotherOrderBys = Ordering.unsafeMergeAnotherOrderBys -- unsafeMergeAnotherOrderBys = Ordering.unsafeMergeAnotherOrderBys
expandSQL :: SimpleQuery r -> ((String, Projection r), String -> String)
expandSQL = Core.expandSQL . Ordering.appendOrderBys
toSQL :: SimpleQuery r -> String toSQL :: SimpleQuery r -> String
toSQL q = append sql where toSQL q = append sql where
((sql, _), append) = Core.expandSQL . Ordering.appendOrderBys $ q ((sql, _), append) = expandSQL q
toSubQuery :: SimpleQuery r -> SubQuery toSubQuery :: SimpleQuery r -> SubQuery
toSubQuery q = subQuery (append sql) (Projection.width pj) where toSubQuery q = subQuery (append sql) (Projection.width pj) where
((sql, pj), append) = Core.expandSQL . Ordering.appendOrderBys $ q ((sql, pj), append) = expandSQL q