Add any & anyWithKey

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:
 

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)

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)

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)