monoidmap 0.0.1.8 → 0.0.1.9
raw patch · 8 files changed
+621/−25 lines, 8 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Examples.RecoveredMap: Map :: MonoidMap k (First v) -> Map k v
- Examples.RecoveredMap: [unMap] :: Map k v -> MonoidMap k (First v)
- Examples.RecoveredMap: newtype Map k v
+ Examples.RecoveredMap: data Map k v
+ Examples.RecoveredMap: mapAccumL :: (s -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2)
+ Examples.RecoveredMap: mapAccumLWithKey :: (s -> k -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2)
+ Examples.RecoveredMap: mapAccumR :: (s -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2)
+ Examples.RecoveredMap: mapAccumRWithKey :: (s -> k -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2)
Files
- CHANGELOG.md +10/−0
- monoidmap.cabal +2/−1
- src/benchmark/Main.hs +52/−10
- src/examples/Examples/RecoveredMap.hs +47/−2
- src/internal/Data/MonoidMap/Internal.hs +214/−6
- src/public/Data/MonoidMap.hs +12/−6
- src/test/Data/MonoidMap/TraversalSpec.hs +184/−0
- src/test/Examples/RecoveredMapSpec.hs +100/−0
CHANGELOG.md view
@@ -1,3 +1,13 @@+# 0.0.1.9++- Added the following traversal functions to `MonoidMap`:+ - `traverse`+ - `traverseWithKey`+ - `mapAccumL`+ - `mapAccumLWithKey`+ - `mapAccumR`+ - `mapAccumRWithKey`+ # 0.0.1.8 - Added strict variant of the `foldMapWithKey` function.
monoidmap.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: monoidmap-version: 0.0.1.8+version: 0.0.1.9 bug-reports: https://github.com/jonathanknowles/monoidmap/issues license: Apache-2.0 license-file: LICENSE@@ -168,6 +168,7 @@ Data.MonoidMap.MembershipSpec Data.MonoidMap.SingletonSpec Data.MonoidMap.SliceSpec+ Data.MonoidMap.TraversalSpec Data.MonoidMap.PrefixSpec Data.MonoidMap.SuffixSpec Data.MonoidMap.IntersectionSpec
src/benchmark/Main.hs view
@@ -2,6 +2,12 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NumericUnderscores #-} +-- Benchmark for the `MonoidMap` type.+--+-- Instead of benchmarking functions for the `MonoidMap` type directly, we+-- benchmark functions for the `RecoveredMap` type, a newtype wrapper around+-- the `MonoidMap` type designed to provide the same semantics as `Map`.+-- module Main where import Control.DeepSeq@@ -23,7 +29,7 @@ import Data.Semigroup ( Semigroup ((<>)), stimes ) import Prelude- ( Integer, Num, (^) )+ ( Integer, Num, (^), (+) ) import System.IO ( IO ) import Test.Tasty.Bench@@ -51,13 +57,13 @@ [ bgroup "absent" [ bench "Data.Map.Strict" $ nf (deleteMany evens) om_odd- , bench "Data.MonoidMap" $+ , bench "RecoveredMap" $ nf (deleteMany evens) rm_odd ] , bgroup "present" [ bench "Data.Map.Strict" $ nf (deleteMany evens) om_even- , bench "Data.MonoidMap" $+ , bench "RecoveredMap" $ nf (deleteMany evens) rm_even ] ]@@ -65,13 +71,13 @@ [ bgroup "absent" [ bench "Data.Map.Strict" $ nf (insertMany elems_even) om_odd- , bench "Data.MonoidMap" $+ , bench "RecoveredMap" $ nf (insertMany elems_even) rm_odd ] , bgroup "present" [ bench "Data.Map.Strict" $ nf (insertMany elems_even) om_even- , bench "Data.MonoidMap" $+ , bench "RecoveredMap" $ nf (insertMany elems_even) rm_even ] ]@@ -79,13 +85,13 @@ [ bgroup "absent" [ bench "Data.Map.Strict" $ nf (lookupMany evens) om_odd- , bench "Data.MonoidMap" $+ , bench "RecoveredMap" $ nf (lookupMany evens) rm_odd ] , bgroup "present" [ bench "Data.Map.Strict" $ nf (lookupMany evens) om_even- , bench "Data.MonoidMap" $+ , bench "RecoveredMap" $ nf (lookupMany evens) rm_even ] ]@@ -93,22 +99,46 @@ [ bgroup "disjoint" [ bench "Data.Map.Strict" $ nf (<> om_even) om_odd- , bench "Data.MonoidMap" $+ , bench "RecoveredMap" $ nf (<> rm_even) rm_odd ] , bgroup "identical" [ bench "Data.Map.Strict" $ nf (<> om_even) om_even- , bench "Data.MonoidMap" $+ , bench "RecoveredMap" $ nf (<> rm_even) rm_even ] ] , bgroup "stimes" [ bench "Data.Map.Strict" $ nf (stimes ten_power_24) om_natural- , bench "Data.MonoidMap" $+ , bench "RecoveredMap" $ nf (stimes ten_power_24) rm_natural ]+ , bgroup "mapAccumL"+ [ bench "Data.Map.Strict" $+ nf (mapAccumL (\s v -> (s + v, v)) 0) om_natural+ , bench "RecoveredMap" $+ nf (mapAccumL (\s v -> (s + v, v)) 0) rm_natural+ ]+ , bgroup "mapAccumR"+ [ bench "Data.Map.Strict" $+ nf (mapAccumR (\s v -> (s + v, v)) 0) om_natural+ , bench "RecoveredMap" $+ nf (mapAccumR (\s v -> (s + v, v)) 0) rm_natural+ ]+ , bgroup "mapAccumLWithKey"+ [ bench "Data.Map.Strict" $+ nf (mapAccumL (\s v -> (s + v, v)) 0) om_natural+ , bench "RecoveredMap" $+ nf (mapAccumL (\s v -> (s + v, v)) 0) rm_natural+ ]+ , bgroup "mapAccumRWithKey"+ [ bench "Data.Map.Strict" $+ nf (mapAccumRWithKey (\s k v -> (s + k + v, v)) 0) om_natural+ , bench "RecoveredMap" $+ nf (mapAccumRWithKey (\s k v -> (s + k + v, v)) 0) rm_natural+ ] ] where bound :: Int@@ -140,18 +170,30 @@ delete :: k -> m k v -> m k v insert :: k -> v -> m k v -> m k v lookup :: k -> m k v -> Maybe v+ mapAccumL :: (s -> v -> (s, v)) -> s -> m k v -> (s, m k v)+ mapAccumR :: (s -> v -> (s, v)) -> s -> m k v -> (s, m k v)+ mapAccumLWithKey :: (s -> k -> v -> (s, v)) -> s -> m k v -> (s, m k v)+ mapAccumRWithKey :: (s -> k -> v -> (s, v)) -> s -> m k v -> (s, m k v) instance Ord k => Map OMap.Map k v where fromList = OMap.fromList delete = OMap.delete insert = OMap.insert lookup = OMap.lookup+ mapAccumL = OMap.mapAccum+ mapAccumR f = OMap.mapAccumRWithKey (\s _ v -> f s v)+ mapAccumLWithKey = OMap.mapAccumWithKey+ mapAccumRWithKey = OMap.mapAccumRWithKey instance (Ord k, Eq v) => Map RMap.Map k v where fromList = RMap.fromList delete = RMap.delete insert = RMap.insert lookup = RMap.lookup+ mapAccumL = RMap.mapAccumL+ mapAccumR = RMap.mapAccumR+ mapAccumLWithKey = RMap.mapAccumLWithKey+ mapAccumRWithKey = RMap.mapAccumRWithKey deleteMany :: (Map m k v, Num v) => [k] -> m k v -> m k v deleteMany xs m = foldl' (flip delete) m xs
src/examples/Examples/RecoveredMap.hs view
@@ -8,10 +8,27 @@ -- An ordinary left-biased map similar to 'Map', implemented in terms of -- 'MonoidMap'. ---module Examples.RecoveredMap where+module Examples.RecoveredMap+ ( Map+ , empty+ , singleton+ , fromList+ , toList+ , delete+ , insert+ , keysSet+ , lookup+ , member+ , map+ , mapAccumL+ , mapAccumLWithKey+ , mapAccumR+ , mapAccumRWithKey+ )+ where import Prelude hiding- ( map )+ ( lookup, map ) import Control.DeepSeq ( NFData )@@ -74,3 +91,31 @@ map :: (v1 -> v2) -> Map k v1 -> Map k v2 map f = Map . MonoidMap.map (fmap f) . unMap++mapAccumL :: (s -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2)+mapAccumL f s m = Map <$> MonoidMap.mapAccumL (accum f) s (unMap m)++mapAccumR :: (s -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2)+mapAccumR f s m = Map <$> MonoidMap.mapAccumR (accum f) s (unMap m)++mapAccumLWithKey :: (s -> k -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2)+mapAccumLWithKey f s m =+ Map <$> MonoidMap.mapAccumLWithKey (accumWithKey f) s (unMap m)++mapAccumRWithKey :: (s -> k -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2)+mapAccumRWithKey f s m =+ Map <$> MonoidMap.mapAccumRWithKey (accumWithKey f) s (unMap m)++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++accum :: (s -> v1 -> (s, v2)) -> s -> First v1 -> (s, First v2)+accum f s1 (First mv1) = case mv1 of+ Just v1 -> let (s2, v2) = f s1 v1 in (s2, First (Just v2))+ Nothing -> (s1, First Nothing)++accumWithKey :: (s -> k -> v1 -> (s, v2)) -> s -> k -> First v1 -> (s, First v2)+accumWithKey f s1 k (First mv1) = case mv1 of+ Just v1 -> let (s2, v2) = f s1 k v1 in (s2, First (Just v2))+ Nothing -> (s1, First Nothing)
src/internal/Data/MonoidMap/Internal.hs view
@@ -67,18 +67,24 @@ -- ** Folding , foldl- , foldr- , foldlWithKey- , foldrWithKey- , foldMapWithKey-- -- *** Strict folding , foldl'+ , foldr , foldr'+ , foldlWithKey , foldlWithKey'+ , foldrWithKey , foldrWithKey'+ , foldMapWithKey , foldMapWithKey' + -- ** Traversal+ , traverse+ , traverseWithKey+ , mapAccumL+ , mapAccumLWithKey+ , mapAccumR+ , mapAccumRWithKey+ -- * Monoidal operations -- ** Association@@ -143,8 +149,11 @@ , splitAt , subtract , take+ , traverse ) +import Control.Applicative+ ( Applicative (..) ) import Control.DeepSeq ( NFData ) import Data.Bifoldable@@ -206,6 +215,7 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified GHC.Exts as GHC+import qualified Data.Traversable as Traversable import qualified Data.Group as C import qualified Data.Monoid.GCD as C@@ -225,6 +235,9 @@ deriving (Eq2, Show2, Bifoldable) via Map +-- Internal alias used when extra brevity is required.+type MM = MonoidMap+ -------------------------------------------------------------------------------- -- Non-null values --------------------------------------------------------------------------------@@ -1155,6 +1168,158 @@ {-# INLINE foldMapWithKey' #-} --------------------------------------------------------------------------------+-- Traversal+--------------------------------------------------------------------------------++-- | \(O(n)\). Traverses over the values of a map using the given function.+--+-- Satisfies the following property:+--+-- @+-- 'traverse' f m '=='+-- 'fmap' 'fromMap' ('Traversable'.'Traversable.traverse' f ('toMap' m))+-- @+--+-- @since 0.0.1.9+--+traverse+ :: Applicative t+ => MonoidNull v2+ => (v1 -> t v2)+ -> MonoidMap k v1+ -> t (MonoidMap k v2)+traverse f = traverseWithKey (const f)+{-# INLINE traverse #-}++-- | \(O(n)\). Traverses over the keys and values of a map using the given+-- function.+--+-- Satisfies the following property:+--+-- @+-- 'traverseWithKey' f m '=='+-- 'fmap' 'fromMap' ('Map'.'Map.traverseWithKey' f ('toMap' m))+-- @+--+-- @since 0.0.1.9+--+traverseWithKey+ :: Applicative t+ => MonoidNull v2+ => (k -> v1 -> t v2)+ -> MonoidMap k v1+ -> t (MonoidMap k v2)+traverseWithKey f (MonoidMap m) =+ MonoidMap <$>+ Map.traverseMaybeWithKey+ (\k v -> maybeNonNull <$> applyNonNull (f k) v) m+{-# INLINE traverseWithKey #-}++-- | \(O(n)\). Threads an accumulating argument through the map in ascending+-- order of keys.+--+-- Satisfies the following property:+--+-- @+-- 'mapAccumL' f s m '=='+-- 'fmap' 'fromMap' ('Traversable'.'Traversable.mapAccumL' f s ('toMap' m))+-- @+--+-- @since 0.0.1.9+--+mapAccumL+ :: MonoidNull v2+ => (s -> v1 -> (s, v2))+ -> s+ -> MonoidMap k v1+ -> (s, MonoidMap k v2)+mapAccumL f s m =+ (coerce+ :: ((v1 -> StateL s v2 ) -> MM k v1 -> StateL s (MM k v2))+ -> ((v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2))+ )+ traverse (flip f) m s+{-# INLINE mapAccumL #-}++-- | \(O(n)\). Threads an accumulating argument through the map in descending+-- order of keys.+--+-- Satisfies the following property:+--+-- @+-- 'mapAccumR' f s m '=='+-- 'fmap' 'fromMap' ('Traversable'.'Traversable.mapAccumR' f s ('toMap' m))+-- @+--+-- @since 0.0.1.9+--+mapAccumR+ :: MonoidNull v2+ => (s -> v1 -> (s, v2))+ -> s+ -> MonoidMap k v1+ -> (s, MonoidMap k v2)+mapAccumR f s m =+ (coerce+ :: ((v1 -> StateR s v2 ) -> MM k v1 -> StateR s (MM k v2))+ -> ((v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2))+ )+ traverse (flip f) m s+{-# INLINE mapAccumR #-}++-- | \(O(n)\). Threads an accumulating argument through the map in ascending+-- order of keys.+--+-- Satisfies the following property:+--+-- @+-- 'mapAccumLWithKey' f s m '=='+-- 'fmap' 'fromMap' ('Map'.'Map.mapAccumWithKey' f s ('toMap' m))+-- @+--+-- @since 0.0.1.9+--+mapAccumLWithKey+ :: MonoidNull v2+ => (s -> k -> v1 -> (s, v2))+ -> s+ -> MonoidMap k v1+ -> (s, MonoidMap k v2)+mapAccumLWithKey f s0 m =+ (coerce+ :: ((k -> v1 -> StateL s v2 ) -> MM k v1 -> StateL s (MM k v2))+ -> ((k -> v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2))+ )+ traverseWithKey (\k v1 s -> f s k v1) m s0+{-# INLINE mapAccumLWithKey #-}++-- | \(O(n)\). Threads an accumulating argument through the map in descending+-- order of keys.+--+-- Satisfies the following property:+--+-- @+-- 'mapAccumRWithKey' f s m '=='+-- 'fmap' 'fromMap' ('Map'.'Map.mapAccumRWithKey' f s ('toMap' m))+-- @+--+-- @since 0.0.1.9+--+mapAccumRWithKey+ :: MonoidNull v2+ => (s -> k -> v1 -> (s, v2))+ -> s+ -> MonoidMap k v1+ -> (s, MonoidMap k v2)+mapAccumRWithKey f s0 m =+ (coerce+ :: ((k -> v1 -> StateR s v2 ) -> MM k v1 -> StateR s (MM k v2))+ -> ((k -> v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2))+ )+ traverseWithKey (\k v1 s -> f s k v1) m s0+{-# INLINE mapAccumRWithKey #-}++-------------------------------------------------------------------------------- -- Comparison -------------------------------------------------------------------------------- @@ -3248,3 +3413,46 @@ = Map.zipWithMaybeAMatched $ \_k v1 v2 -> maybeNonNull <$> applyNonNull2 f v1 v2 {-# INLINE withBothA #-}++--------------------------------------------------------------------------------+-- State+--------------------------------------------------------------------------------++newtype StateL s a = StateL (s -> (s, a))+newtype StateR s a = StateR (s -> (s, a))++instance Functor (StateL s) where+ fmap f (StateL kx) =+ StateL $ \s -> let (s', x) = kx s in (s', f x)++instance Functor (StateR s) where+ fmap f (StateR kx) =+ StateR $ \s -> let (s', x) = kx s in (s', f x)++instance Applicative (StateL s) where+ pure a = StateL $+ \s -> (s, a)+ StateL kf <*> StateL kx = StateL $+ \s ->+ let (s' , f ) = kf s+ (s'', x) = kx s'+ in (s'', f x)+ liftA2 f (StateL kx) (StateL ky) = StateL $+ \s ->+ let (s' , x ) = kx s+ (s'', y) = ky s'+ in (s'', f x y)++instance Applicative (StateR s) where+ pure a = StateR $+ \s -> (s, a)+ StateR kf <*> StateR kx = StateR $+ \s ->+ let (s', x) = kx s+ (s'', f ) = kf s'+ in (s'', f x)+ liftA2 f (StateR kx) (StateR ky) = StateR $+ \s ->+ let (s' , y) = ky s+ (s'', x ) = kx s'+ in (s'', f x y)
src/public/Data/MonoidMap.hs view
@@ -66,17 +66,23 @@ -- ** Folding , foldl- , foldr- , foldlWithKey- , foldrWithKey- , foldMapWithKey-- -- *** Strict folding , foldl'+ , foldr , foldr'+ , foldlWithKey , foldlWithKey'+ , foldrWithKey , foldrWithKey'+ , foldMapWithKey , foldMapWithKey'++ -- ** Traversal+ , traverse+ , traverseWithKey+ , mapAccumL+ , mapAccumLWithKey+ , mapAccumR+ , mapAccumRWithKey -- * Monoidal operations
+ src/test/Data/MonoidMap/TraversalSpec.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -Wno-orphans #-}+-- |+-- Copyright: © 2022–2025 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.TraversalSpec+ ( spec+ ) where++import Prelude++import Control.Monad+ ( forM_ )+import Data.Function+ ( (&) )+import Data.Functor.Identity+ ( Identity (..) )+import Data.MonoidMap+ ( MonoidMap )+import Data.Proxy+ ( Proxy (..) )+import Test.Common+ ( Key, Test, TestType (TestType), makeSpec, property, testTypesMonoidNull )+import Test.Hspec+ ( Spec, describe, it )+import Test.QuickCheck+ ( Arbitrary (..)+ , Fun (..)+ , Property+ , applyFun+ , applyFun2+ , applyFun3+ , (===)+ )+import Data.Semigroup+ ( First (..), Last (..) )++import qualified Data.Map.Strict as Map+import qualified Data.MonoidMap as MonoidMap+import qualified Data.Traversable as Traversable++spec :: Spec+spec = describe "Traversal" $ do++ forM_ testTypesMonoidNull $ \(TestType p) -> specFor (Proxy @Key) p++specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do++ describe "traverse" $ do++ it "prop_traverse_@Identity" $+ prop_traverse @Identity+ @k @v & property+ it "prop_traverse_@Maybe" $+ prop_traverse @Maybe+ @k @v & property+ it "prop_traverse_@First" $+ prop_traverse @First+ @k @v & property+ it "prop_traverse_@Last" $+ prop_traverse @Last+ @k @v & property++ describe "traverseWithKey" $ do++ it "prop_traverseWithKey_@Identity" $+ prop_traverseWithKey @Identity+ @k @v & property+ it "prop_traverseWithKey_@Maybe" $+ prop_traverseWithKey @Maybe+ @k @v & property+ it "prop_traverseWithKey_@First" $+ prop_traverseWithKey @First+ @k @v & property+ it "prop_traverseWithKey_@Last" $+ prop_traverseWithKey @Last+ @k @v & property++ describe "mapAccumL" $ do++ it "prop_mapAccumL_@Int" $+ prop_mapAccumL @Int+ @k @v & property+ it "prop_mapAccumL_@String" $+ prop_mapAccumL @String+ @k @v & property++ describe "mapAccumR" $ do++ it "prop_mapAccumR_@Int" $+ prop_mapAccumR @Int+ @k @v & property+ it "prop_mapAccumR_@String" $+ prop_mapAccumR @String+ @k @v & property++ describe "mapAccumLWithKey" $ do++ it "prop_mapAccumLWithKey_@Int" $+ prop_mapAccumLWithKey @Int+ @k @v & property+ it "prop_mapAccumLWithKey_@String" $+ prop_mapAccumLWithKey @String+ @k @v & property++ describe "mapAccumRWithKey" $ do++ it "prop_mapAccumRWithKey_@Int" $+ prop_mapAccumRWithKey @Int+ @k @v & property+ it "prop_mapAccumRWithKey_@String" $+ prop_mapAccumRWithKey @String+ @k @v & property++prop_traverse+ :: forall t k v. Test k v+ => (Applicative t, Eq (t (MonoidMap k v)), Show (t (MonoidMap k v)))+ => Fun v (t v)+ -> MonoidMap k v+ -> Property+prop_traverse (applyFun -> f) m =+ MonoidMap.traverse f m+ ===+ fmap MonoidMap.fromMap (Traversable.traverse f (MonoidMap.toMap m))++prop_traverseWithKey+ :: forall t k v. Test k v+ => (Applicative t, Eq (t (MonoidMap k v)), Show (t (MonoidMap k v)))+ => Fun (k, v) (t v)+ -> MonoidMap k v+ -> Property+prop_traverseWithKey (applyFun2 -> f) m =+ MonoidMap.traverseWithKey f m+ ===+ fmap MonoidMap.fromMap (Map.traverseWithKey f (MonoidMap.toMap m))++prop_mapAccumL+ :: forall s k v. (Test k v, Eq s, Show s)+ => Fun (s, v) (s, v)+ -> s+ -> MonoidMap k v+ -> Property+prop_mapAccumL (applyFun2 -> f) s m =+ MonoidMap.mapAccumL f s m+ ===+ fmap MonoidMap.fromMap (Traversable.mapAccumL f s (MonoidMap.toMap m))++prop_mapAccumR+ :: forall s k v. (Test k v, Eq s, Show s)+ => Fun (s, v) (s, v)+ -> s+ -> MonoidMap k v+ -> Property+prop_mapAccumR (applyFun2 -> f) s m =+ MonoidMap.mapAccumR f s m+ ===+ fmap MonoidMap.fromMap (Traversable.mapAccumR f s (MonoidMap.toMap m))++prop_mapAccumLWithKey+ :: forall s k v. (Test k v, Eq s, Show s)+ => Fun (s, k, v) (s, v)+ -> s+ -> MonoidMap k v+ -> Property+prop_mapAccumLWithKey (applyFun3 -> f) s m =+ MonoidMap.mapAccumLWithKey f s m+ ===+ fmap MonoidMap.fromMap (Map.mapAccumWithKey f s (MonoidMap.toMap m))++prop_mapAccumRWithKey+ :: forall s k v. (Test k v, Eq s, Show s)+ => Fun (s, k, v) (s, v)+ -> s+ -> MonoidMap k v+ -> Property+prop_mapAccumRWithKey (applyFun3 -> f) s m =+ MonoidMap.mapAccumRWithKey f s m+ ===+ fmap MonoidMap.fromMap (Map.mapAccumRWithKey f s (MonoidMap.toMap m))++deriving newtype instance Arbitrary a => Arbitrary (First a)+deriving newtype instance Arbitrary a => Arbitrary (Last a)
src/test/Examples/RecoveredMapSpec.hs view
@@ -42,6 +42,8 @@ , Property , Testable , applyFun+ , applyFun2+ , applyFun3 , checkCoverage , cover , listOf@@ -74,8 +76,10 @@ :: forall k v. () => ( Arbitrary k , Arbitrary v+ , CoArbitrary k , CoArbitrary v , Eq v+ , Function k , Function v , Monoid v , Ord k@@ -186,6 +190,38 @@ prop_map_mempty @k @v @v & property + describe "MapAccumL" $ do+ it "prop_mapAccumL @Int" $+ prop_mapAccumL @Int+ @k @v @v & property+ it "prop_mapAccumL @String" $+ prop_mapAccumL @String+ @k @v @v & property++ describe "MapAccumR" $ do+ it "prop_mapAccumR @Int" $+ prop_mapAccumR @Int+ @k @v @v & property+ it "prop_mapAccumR @String" $+ prop_mapAccumR @String+ @k @v @v & property++ describe "MapAccumWithKeyL" $ do+ it "prop_mapAccumLWithKey @Int" $+ prop_mapAccumLWithKey @Int+ @k @v @v & property+ it "prop_mapAccumLWithKey @String" $+ prop_mapAccumLWithKey @String+ @k @v @v & property++ describe "MapAccumWithKeyR" $ do+ it "prop_mapAccumRWithKey @Int" $+ prop_mapAccumRWithKey @Int+ @k @v @v & property+ it "prop_mapAccumRWithKey @String" $+ prop_mapAccumRWithKey @String+ @k @v @v & property+ -------------------------------------------------------------------------------- -- Conversion to and from lists --------------------------------------------------------------------------------@@ -461,6 +497,70 @@ (===) (RMap.toList (RMap.map (const (mempty @v2)) (RMap.fromList kvs))) (OMap.toList (OMap.map (const (mempty @v2)) (OMap.fromList kvs)))++--------------------------------------------------------------------------------+-- MapAccum+--------------------------------------------------------------------------------++prop_mapAccumL+ :: forall s k v1 v2. (Eq s, Eq v2, Ord k, Show k, Show s, Show v2)+ => Fun (s, v1) (s, v2)+ -> s+ -> [(k, v1)]+ -> Property+prop_mapAccumL (applyFun2 -> f) s0 kvs =+ (===)+ (RMap.toList <$> rmapAccumL f s0 (RMap.fromList kvs))+ (OMap.toList <$> omapAccumL f s0 (OMap.fromList kvs))+ where+ rmapAccumL = RMap.mapAccumL+ omapAccumL = OMap.mapAccum++prop_mapAccumR+ :: forall s k v1 v2. (Eq s, Eq v2, Ord k, Show k, Show s, Show v2)+ => Fun (s, v1) (s, v2)+ -> s+ -> [(k, v1)]+ -> Property+prop_mapAccumR (applyFun2 -> f) s0 kvs =+ (===)+ (RMap.toList <$> rmapAccumR f s0 (RMap.fromList kvs))+ (OMap.toList <$> omapAccumR f s0 (OMap.fromList kvs))+ where+ rmapAccumR = RMap.mapAccumR+ omapAccumR g = OMap.mapAccumRWithKey (\s _ v -> g s v)++--------------------------------------------------------------------------------+-- MapAccumWithKey+--------------------------------------------------------------------------------++prop_mapAccumLWithKey+ :: forall s k v1 v2. (Eq s, Eq v2, Ord k, Show k, Show s, Show v2)+ => Fun (s, k, v1) (s, v2)+ -> s+ -> [(k, v1)]+ -> Property+prop_mapAccumLWithKey (applyFun3 -> f) s0 kvs =+ (===)+ (RMap.toList <$> rmapAccumLWithKey f s0 (RMap.fromList kvs))+ (OMap.toList <$> omapAccumLWithKey f s0 (OMap.fromList kvs))+ where+ rmapAccumLWithKey = RMap.mapAccumLWithKey+ omapAccumLWithKey = OMap.mapAccumWithKey++prop_mapAccumRWithKey+ :: forall s k v1 v2. (Eq s, Eq v2, Ord k, Show k, Show s, Show v2)+ => Fun (s, k, v1) (s, v2)+ -> s+ -> [(k, v1)]+ -> Property+prop_mapAccumRWithKey (applyFun3 -> f) s0 kvs =+ (===)+ (RMap.toList <$> rmapAccumRWithKey f s0 (RMap.fromList kvs))+ (OMap.toList <$> omapAccumRWithKey f s0 (OMap.fromList kvs))+ where+ rmapAccumRWithKey = RMap.mapAccumRWithKey+ omapAccumRWithKey = OMap.mapAccumRWithKey -------------------------------------------------------------------------------- -- Arbitrary instances