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

Update interfaces of Product module.

Browse Source
This commit is contained in:
Kei Hibino 2013-05-20 17:25:17 +09:00
parent 17d94d6455
commit 7b41128a0a
2 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
relational-join/src/Database/Relational/Query/Join.hs
View File

@ -171,7 +171,7 @@ unsafeMergeAnother attr q1 =
QueryJoin QueryJoin
$ \st0 -> let p0 = product st0 $ \st0 -> let p0 = product st0
(pj, st1) = runQueryJoin q1 (st0 { product = Nothing}) (pj, st1) = runQueryJoin q1 (st0 { product = Nothing})
p1 = Product.unsafeUpdateNodeAttr attr p1 = Product.node attr
. mayEmptyProduct "unsafeMergeAnother" $ product st1 . mayEmptyProduct "unsafeMergeAnother" $ product st1
in (pj, updateProduct' (const $ mergeProduct p0 p1) st1) in (pj, updateProduct' (const $ mergeProduct p0 p1) st1)

14
relational-join/src/Database/Relational/Query/Product.hs
View File

@ -1,7 +1,7 @@
module Database.Relational.Query.Product ( module Database.Relational.Query.Product (
NodeAttr (Just', Maybe), unsafeUpdateNodeAttr, NodeAttr (Just', Maybe), -- unsafeUpdateNodeAttr,
ProductTree, Node, QueryProduct, QueryProductNode, ProductTree, Node, QueryProduct, QueryProductNode,
growProductRight, growProductLeft, node, growRight, growLeft,
growProduct, product, restrictProduct, growProduct, product, restrictProduct,
Product, Product,
tree, tree,
@ -55,19 +55,19 @@ node a q = unsafeUpdateNodeAttr a q
leaf :: NodeAttr -> q -> Node q leaf :: NodeAttr -> q -> Node q
leaf a q = node a (Leaf a q) leaf a q = node a (Leaf a q)
growProductRight :: Maybe (ProductTree q) -> (NodeAttr, ProductTree q) -> ProductTree q growRight :: Maybe (ProductTree q) -> (NodeAttr, ProductTree q) -> ProductTree q
growProductRight = d where growRight = d where
d Nothing (na, q) = node na q d Nothing (na, q) = node na q
d (Just l) (na, q) = Join Just' l (node na q) Nothing d (Just l) (na, q) = Join Just' l (node na q) Nothing
growProductLeft :: (NodeAttr, ProductTree q) -> Maybe (ProductTree q) -> ProductTree q growLeft :: (NodeAttr, ProductTree q) -> Maybe (ProductTree q) -> ProductTree q
growProductLeft = d where growLeft = d where
d (na, q) Nothing = node na q d (na, q) Nothing = node na q
d (na, q) (Just r) = Join Just' (node na q) r Nothing d (na, q) (Just r) = Join Just' (node na q) r Nothing
growProduct :: Maybe (ProductTree q) -> (NodeAttr, q) -> ProductTree q growProduct :: Maybe (ProductTree q) -> (NodeAttr, q) -> ProductTree q
growProduct = match where growProduct = match where
match t (na, q) = growProductRight t (na, leaf na q) match t (na, q) = growRight t (na, leaf na q)
product :: NodeAttr -> ProductTree q -> ProductTree q -> Maybe (Expr Bool) -> ProductTree q product :: NodeAttr -> ProductTree q -> ProductTree q -> Maybe (Expr Bool) -> ProductTree q