diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2022-07-17 22:29:22 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2022-07-26 21:55:07 +0200 |
| commit | 97427b2f49daa9d86661ad999d4da17ac7a4acb4 (patch) | |
| tree | 9e8b064932c844a4cbd44a191f74f53776889cfc /src/Storage/Merge.hs | |
| parent | 479b63d8c30c0bc6e6475882d7fb573db5dad1f9 (diff) | |
Contacts using Set sructure
Diffstat (limited to 'src/Storage/Merge.hs')
| -rw-r--r-- | src/Storage/Merge.hs | 13 |
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 |