From 3907933c4a83914a486f73819ef00c849c8b992e Mon Sep 17 00:00:00 2001 From: flip111 Date: Tue, 12 Mar 2024 16:16:36 +0100 Subject: [PATCH] Add any & anyWithKey (#73) --- CHANGELOG.md | 2 ++ src/Data/Map.purs | 2 +- src/Data/Map/Internal.purs | 22 ++++++++++++++++++++++ test/Test/Data/Map.purs | 30 ++++++++++++++++++++++++++++-- 4 files changed, 53 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 81683e0..7ed77a5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,8 @@ Notable changes to this project are documented in this file. The format is based Breaking changes: New features: +* Add `Data.Map.any` (#73 by @flip111) +* Add `Data.Map.anyWithKey` (#73 by @flip111) Bugfixes: diff --git a/src/Data/Map.purs b/src/Data/Map.purs index bda8bd1..4aac96f 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -12,7 +12,7 @@ import Data.Eq (class Eq1) import Data.Foldable (class Foldable) import Data.FoldableWithIndex (class FoldableWithIndex) import Data.FunctorWithIndex (class FunctorWithIndex) -import Data.Map.Internal (Map, alter, catMaybes, checkValid, delete, empty, filter, filterKeys, filterWithKey, findMax, findMin, foldSubmap, fromFoldable, fromFoldableWith, fromFoldableWithIndex, insert, insertWith, isEmpty, isSubmap, lookup, lookupGE, lookupGT, lookupLE, lookupLT, member, pop, showTree, singleton, size, submap, toUnfoldable, toUnfoldableUnordered, union, unionWith, unions, intersection, intersectionWith, difference, update, values, mapMaybeWithKey, mapMaybe) +import Data.Map.Internal (Map, alter, catMaybes, checkValid, delete, empty, filter, filterKeys, filterWithKey, findMax, findMin, foldSubmap, fromFoldable, fromFoldableWith, fromFoldableWithIndex, insert, insertWith, isEmpty, isSubmap, lookup, lookupGE, lookupGT, lookupLE, lookupLT, member, pop, showTree, singleton, size, submap, toUnfoldable, toUnfoldableUnordered, union, unionWith, unions, intersection, intersectionWith, difference, update, values, mapMaybeWithKey, mapMaybe, any, anyWithKey) import Data.Newtype (class Newtype) import Data.Ord (class Ord1) import Data.Traversable (class Traversable) diff --git a/src/Data/Map/Internal.purs b/src/Data/Map/Internal.purs index e65f5af..81cc398 100644 --- a/src/Data/Map/Internal.purs +++ b/src/Data/Map/Internal.purs @@ -46,6 +46,8 @@ module Data.Map.Internal , mapMaybeWithKey , mapMaybe , catMaybes + , any + , anyWithKey , MapIter , MapIterStep(..) , toMapIter @@ -672,6 +674,26 @@ mapMaybe = mapMaybeWithKey <<< const catMaybes :: forall k v. Ord k => Map k (Maybe v) -> Map k v catMaybes = mapMaybe identity +-- | Returns true if at least one map element satisfies the given predicateon the value, +-- | iterating the map only as necessary and stopping as soon as the predicate +-- | yields true. +any :: forall k v. (v -> Boolean) -> Map k v -> Boolean +any predicate = go + where + go = case _ of + Leaf -> false + Node _ _ _ mv ml mr -> predicate mv || go ml || go mr + +-- | Returns true if at least one map element satisfies the given predicate, +-- | iterating the map only as necessary and stopping as soon as the predicate +-- | yields true. +anyWithKey :: forall k v. (k -> v -> Boolean) -> Map k v -> Boolean +anyWithKey predicate = go + where + go = case _ of + Leaf -> false + Node _ _ mk mv ml mr -> predicate mk mv || go ml || go mr + -- | Low-level Node constructor which maintains the height and size invariants -- | This is unsafe because it assumes the child Maps are ordered and balanced. unsafeNode :: forall k v. Fn4 k v (Map k v) (Map k v) (Map k v) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 1e9575b..c1bb1ef 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -9,16 +9,17 @@ import Data.Foldable (foldl, for_, all, and) import Data.FoldableWithIndex (foldrWithIndex) import Data.Function (on) import Data.FunctorWithIndex (mapWithIndex) -import Data.List (List(..), groupBy, length, nubBy, singleton, sort, sortBy, (:)) +import Data.List (List(..), groupBy, length, nubBy, singleton, sort, sortBy, (:), head, last) import Data.List.NonEmpty as NEL import Data.Map as M import Data.Map.Gen (genMap) import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Semigroup.First (First(..)) import Data.Semigroup.Last (Last(..)) -import Data.Tuple (Tuple(..), fst, uncurry) +import Data.Tuple (Tuple(..), fst, snd, uncurry) import Effect (Effect) import Effect.Console (log) +import Effect.Exception (throwException, error) import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((), (<=?), (===), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) @@ -448,5 +449,30 @@ mapTests = do let result = left <> right result == right + log "any" + quickCheck $ \(TestMap m :: TestMap SmallKey Int) -> + let list = M.toUnfoldable m + in case head list of + Nothing -> true + Just h -> case last list of + Nothing -> true + Just l -> M.any (\x -> x == snd h) m && M.any (\x -> x == snd l) m + + log "any with empty map" + when (M.any (\_ -> true) (M.empty :: M.Map SmallKey Int)) $ throwException $ error "Test any with empty map failed" + + log "anyWithKey" + quickCheck $ \(TestMap m :: TestMap SmallKey Int) -> + let list = M.toUnfoldable m + in case head list of + Nothing -> true + Just h -> case last list of + Nothing -> true + Just l -> M.anyWithKey (\k v -> k == fst h && v == snd h) m && M.anyWithKey (\k v -> k == fst l && v == snd l) m + + log "anyWithKey with empty map" + when (M.anyWithKey (\_ _ -> true) (M.empty :: M.Map SmallKey Int)) $ throwException $ error "Test anyWithKey with empty map failed" + + smSingleton :: forall key value. key -> value -> M.SemigroupMap key value smSingleton k v = M.SemigroupMap (M.singleton k v)