summaryrefslogtreecommitdiff
path: root/src/Storage/Merge.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2022-07-17 22:29:22 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2022-07-26 21:55:07 +0200
commit97427b2f49daa9d86661ad999d4da17ac7a4acb4 (patch)
tree9e8b064932c844a4cbd44a191f74f53776889cfc /src/Storage/Merge.hs
parent479b63d8c30c0bc6e6475882d7fb573db5dad1f9 (diff)
Contacts using Set sructure
Diffstat (limited to 'src/Storage/Merge.hs')
-rw-r--r--src/Storage/Merge.hs13
1 files changed, 9 insertions, 4 deletions
diff --git a/src/Storage/Merge.hs b/src/Storage/Merge.hs
index 82737ef..c28d290 100644
--- a/src/Storage/Merge.hs
+++ b/src/Storage/Merge.hs
@@ -14,6 +14,7 @@ module Storage.Merge (
walkAncestors,
findProperty,
+ findPropertyFirst,
) where
import Control.Concurrent.MVar
@@ -141,7 +142,11 @@ walkAncestors f = helper . sortBy cmp
_ -> compare x y
findProperty :: forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> [b]
-findProperty sel = map (fromJust . sel . fromStored) . filterAncestors . (findPropHeads =<<)
- where findPropHeads :: Stored a -> [Stored a]
- findPropHeads sobj | Just _ <- sel $ fromStored sobj = [sobj]
- | otherwise = findPropHeads =<< previous sobj
+findProperty sel = map (fromJust . sel . fromStored) . filterAncestors . (findPropHeads sel =<<)
+
+findPropertyFirst :: forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> Maybe b
+findPropertyFirst sel = fmap (fromJust . sel . fromStored) . listToMaybe . filterAncestors . (findPropHeads sel =<<)
+
+findPropHeads :: forall a b. Storable a => (a -> Maybe b) -> Stored a -> [Stored a]
+findPropHeads sel sobj | Just _ <- sel $ fromStored sobj = [sobj]
+ | otherwise = findPropHeads sel =<< previous sobj