monoidmap-examples 0.0.0.4 → 0.1.0.0

raw patch · 7 files changed

+1049/−3 lines, 7 filesdep +deepseqdep +hspec-quickcheck-classesdep +quickcheck-classesdep ~monoidmapPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, hspec-quickcheck-classes, quickcheck-classes, tasty-bench, text

Dependency ranges changed: monoidmap

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• components/monoidmap-examples-benchmark/Main.hs +209/−0
• components/monoidmap-examples-test/Data/MonoidMap/Examples/RecoveredMapSpec.hs +584/−0
• components/monoidmap-examples-test/Test/Common.hs +67/−0
• components/monoidmap-examples/Data/MonoidMap/Examples/MultiSet.hs +2/−1
• components/monoidmap-examples/Data/MonoidMap/Examples/RecoveredMap.hs +130/−0
• monoidmap-examples.cabal +40/−2

@@ -1,3 +1,20 @@+# 0.1.0.0++- Changed the role of the value type parameter of `NestedMonoidMap` from+  `representational` to `nominal`. This is a consequence of the same change+  to `MonoidMap` in `monoidmap-0.1.0.0`.++  This is a breaking change: code that coerces between `NestedMonoidMap`+  types with different value types will no longer compile.++- Added the `RecoveredMap` module, which provides a re-implementation+  of `Data.Map.Strict.Map` in terms of `MonoidMap`. (This module was+  previously defined within the `monoidmap-internal` package.)++- Exported the `MultiSet` type from the `MultiSet` module.++- Revised version bounds for dependencies.+ # 0.0.0.4  - Updated links to source repository in package metadata.

@@ -0,0 +1,209 @@+-- |+-- Copyright: © 2022–2026 Jonathan Knowles+-- License: Apache-2.0+--+-- Benchmark for the 'MonoidMap' type and its functions.+--+-- When a 'MonoidMap' function has a direct counterpart in 'Map' (such as the+-- 'fromList' function), we benchmark 'Map' against 'RecoveredMap': a newtype+-- wrapper around 'MonoidMap' with functions that have the same semantics as+-- those of 'Map', so that both sides of each comparison behave identically.+--+module Main where++import Control.DeepSeq+    ( rnf )+import Control.Exception+    ( evaluate )+import Data.Eq+    ( Eq )+import Data.Function+    ( flip, ($) )+import Data.Int+    ( Int )+import Data.List+    ( filter, foldl', zip )+import Data.Maybe+    ( Maybe, fromMaybe )+import Data.Ord+    ( Ord )+import Data.Semigroup+    ( Semigroup ((<>)), stimes )+import Prelude+    ( Integer, Num, even, odd, (^), (+) )+import System.IO+    ( IO )+import Test.Tasty.Bench+    ( bench, bgroup, defaultMain, nf )++import qualified Data.Map.Strict as OMap+import qualified Data.MonoidMap.Examples.RecoveredMap as RMap++main :: IO ()+main = do++    let om_natural = fromList elems_natural :: OMap.Map Int Int+        om_even    = fromList elems_even    :: OMap.Map Int Int+        om_odd     = fromList elems_odd     :: OMap.Map Int Int++        rm_natural = fromList elems_natural :: RMap.Map Int Int+        rm_even    = fromList elems_even    :: RMap.Map Int Int+        rm_odd     = fromList elems_odd     :: RMap.Map Int Int++    evaluate $ rnf [om_natural, om_even, om_odd]+    evaluate $ rnf [rm_natural, rm_even, rm_odd]++    defaultMain+        [ bgroup "delete"+            [ bgroup "absent"+                [ bench "Data.Map.Strict" $+                    nf (deleteMany evens) om_odd+                , bench "RecoveredMap" $+                    nf (deleteMany evens) rm_odd+                ]+            , bgroup "present"+                [ bench "Data.Map.Strict" $+                    nf (deleteMany evens) om_even+                , bench "RecoveredMap" $+                    nf (deleteMany evens) rm_even+                ]+            ]+        , bgroup "insert"+            [ bgroup "absent"+                [ bench "Data.Map.Strict" $+                    nf (insertMany elems_even) om_odd+                , bench "RecoveredMap" $+                    nf (insertMany elems_even) rm_odd+                ]+            , bgroup "present"+                [ bench "Data.Map.Strict" $+                    nf (insertMany elems_even) om_even+                , bench "RecoveredMap" $+                    nf (insertMany elems_even) rm_even+                ]+            ]+        , bgroup "lookup"+            [ bgroup "absent"+                [ bench "Data.Map.Strict" $+                    nf (lookupMany evens) om_odd+                , bench "RecoveredMap" $+                    nf (lookupMany evens) rm_odd+                ]+            , bgroup "present"+                [ bench "Data.Map.Strict" $+                    nf (lookupMany evens) om_even+                , bench "RecoveredMap" $+                    nf (lookupMany evens) rm_even+                ]+            ]+        , bgroup "mappend"+            [ bgroup "disjoint"+                [ bench "Data.Map.Strict" $+                    nf (<> om_even) om_odd+                , bench "RecoveredMap" $+                    nf (<> rm_even) rm_odd+                ]+            , bgroup "identical"+                [ bench "Data.Map.Strict" $+                    nf (<> om_even) om_even+                , bench "RecoveredMap" $+                    nf (<> rm_even) rm_even+                ]+            ]+        , bgroup "stimes"+            [ bench "Data.Map.Strict" $+                nf (stimes ten_power_24) om_natural+            , 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 (mapAccumLWithKey (\s k v -> (s + k + v, v)) 0) om_natural+            , bench "RecoveredMap" $+                nf (mapAccumLWithKey (\s k v -> (s + k + 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+    minNatural :: Int+    minNatural = 1++    maxNatural :: Int+    maxNatural = 2 ^ (16 :: Int)++    elems_natural :: [(Int, Int)]+    elems_natural = zip naturals naturals++    elems_even :: [(Int, Int)]+    elems_even = zip evens evens++    elems_odd :: [(Int, Int)]+    elems_odd = zip odds odds++    naturals :: [Int]+    naturals = [minNatural .. maxNatural]++    evens :: [Int]+    evens = filter even naturals++    odds :: [Int]+    odds = filter odd naturals++    ten_power_24 :: Integer+    ten_power_24 = 1_000_000_000_000_000_000_000_000++class Ord k => Map m k v where+    fromList :: [(k, v)] -> m k v+    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++insertMany :: (Map m k v, Num v) => [(k, v)] -> m k v -> m k v+insertMany xs m = foldl' (\m' (k, v) -> insert k v m') m xs++lookupMany :: (Map m k v, Num v) => [k] -> m k v -> v+lookupMany xs m = foldl' (\n k -> fromMaybe n (lookup k m)) 0 xs

@@ -0,0 +1,584 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Use any" #-}+{-# HLINT ignore "Use null" #-}++-- |+-- Copyright: © 2022–2026 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.Examples.RecoveredMapSpec+    where++import Prelude++import Data.Function+    ( on, (&) )+import Data.List+    ( nubBy )+import Data.Monoid+    ( Sum (..) )+import Data.Proxy+    ( Proxy (..) )+import Data.Semigroup+    ( Semigroup (stimes) )+import Data.Set+    ( Set )+import Data.Text+    ( Text )+import Data.Typeable+    ( Typeable, typeRep )+import Numeric.Natural+    ( Natural )+import Test.Common+    ()+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Arbitrary (..)+    , CoArbitrary+    , Fun+    , Function+    , NonNegative (..)+    , Property+    , Testable+    , applyFun+    , applyFun2+    , applyFun3+    , checkCoverage+    , cover+    , listOf+    , shrinkMapBy+    , (===)+    )+import Test.QuickCheck.Classes+    ( eqLaws, functorLaws, monoidLaws, semigroupLaws, semigroupMonoidLaws )+import Test.Hspec.QuickCheck.Classes+    ( testLaws )++import qualified Data.Map.Strict as OMap+import qualified Data.Set as Set+import qualified Data.MonoidMap.Examples.RecoveredMap as RMap+import qualified Test.QuickCheck as QC++spec :: Spec+spec = do+    specFor (Proxy @Int) (Proxy @(Set Int))+    specFor (Proxy @Int) (Proxy @(Set Natural))+    specFor (Proxy @Int) (Proxy @(Sum Int))+    specFor (Proxy @Int) (Proxy @(Sum Natural))+    specFor (Proxy @Int) (Proxy @Text)++specFor+    :: forall k v. () =>+        ( Arbitrary k+        , Arbitrary v+        , CoArbitrary k+        , CoArbitrary v+        , Eq v+        , Function k+        , Function v+        , Monoid v+        , Ord k+        , Show k+        , Show v+        , Typeable k+        , Typeable v+        )+    => Proxy k+    -> Proxy v+    -> Spec+specFor keyType valueType = do++    let description = mconcat+            [ "RecoveredMap ("+            , show (typeRep keyType)+            , ") ("+            , show (typeRep valueType)+            , ")"+            ]++    let property :: Testable t => t -> Property+        property = checkCoverage . QC.property++    describe description $ do++        describe "Class laws" $ do+            testLaws @(RMap.Map k v)+                [ eqLaws+                , monoidLaws+                , semigroupLaws+                , semigroupMonoidLaws+                ]+            testLaws @(RMap.Map k)+                [ functorLaws+                ]++        describe "Conversion to and from lists" $ do+            it "prop_fromList_toList" $+                prop_fromList_toList+                    @k @v & property++        describe "Empty" $ do+            it "prop_empty_keysSet" $+                prop_empty_keysSet+                    @k & property+            it "prop_empty_lookup" $+                prop_empty_lookup+                    @k @v & property+            it "prop_empty_show" $+                prop_empty_show+                    @k @v & property+            it "prop_empty_toList" $+                prop_empty_toList+                    @k @v & property++        describe "Singleton" $ do+            it "prop_singleton_keysSet" $+                prop_singleton_keysSet+                    @k @v & property+            it "prop_singleton_lookup" $+                prop_singleton_lookup+                    @k @v & property+            it "prop_singleton_show" $+                prop_singleton_show+                    @k @v & property+            it "prop_singleton_toList" $+                prop_singleton_toList+                    @k @v & property++        describe "Append" $ do+            it "prop_append_toList" $+                prop_append_toList+                    @k @v & property++        describe "Times" $ do+            it "prop_stimes_toList" $+                prop_stimes_toList+                    @k @v & property++        describe "Delete" $ do+            it "prop_delete_lookup" $+                prop_delete_lookup+                    @k @v & property+            it "prop_delete_member" $+                prop_delete_member+                    @k @v & property+            it "prop_delete_toList" $+                prop_delete_toList+                    @k @v & property++        describe "Insert" $ do+            it "prop_insert_lookup" $+                prop_insert_lookup+                    @k @v & property+            it "prop_insert_member" $+                prop_insert_member+                    @k @v & property+            it "prop_insert_toList" $+                prop_insert_toList+                    @k @v & property++        describe "Map" $ do+            it "prop_map" $+                prop_map+                    @k @v @v & property+            it "prop_map_mempty" $+                prop_map_mempty+                    @k @v @v & property+            it "prop_mapWithKey" $+                prop_mapWithKey+                    @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+--------------------------------------------------------------------------------++prop_fromList_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => [(k, v)]+    -> Property+prop_fromList_toList kvs =+    (===)+        (RMap.toList (RMap.fromList kvs))+        (OMap.toList (OMap.fromList kvs))+    & cover 10+        (length kvs > 1 && length (nubBy ((==) `on` fst) kvs) /= length kvs)+        "length kvs > 1 && length (nubBy ((==) `on` fst) kvs) /= length kvs"+    & cover 10+        (length kvs > 1 && length (nubBy ((==) `on` fst) kvs) == length kvs)+        "length kvs > 1 && length (nubBy ((==) `on` fst) kvs) == length kvs"++--------------------------------------------------------------------------------+-- Empty+--------------------------------------------------------------------------------++prop_empty_keysSet+    :: forall k. (Eq k, Show k)+    => Property+prop_empty_keysSet =+    (===)+        (RMap.keysSet (RMap.empty @k))+        (OMap.keysSet (OMap.empty @k))++prop_empty_lookup+    :: forall k v. (Ord k, Eq v, Show v)+    => k+    -> Property+prop_empty_lookup k =+    (===)+        (RMap.lookup k (RMap.empty @k @v))+        (OMap.lookup k (OMap.empty @k @v))++prop_empty_show+    :: forall k v. (Show k, Show v)+    => Property+prop_empty_show =+    (===)+        (show (RMap.empty @k @v))+        (show (OMap.empty @k @v))++prop_empty_toList+    :: forall k v. (Eq k, Show k, Eq v, Show v)+    => Property+prop_empty_toList =+    (===)+        (RMap.toList (RMap.empty @k @v))+        (OMap.toList (OMap.empty @k @v))++--------------------------------------------------------------------------------+-- Singleton+--------------------------------------------------------------------------------++prop_singleton_keysSet+    :: forall k v. (Ord k, Show k)+    => k+    -> v+    -> Property+prop_singleton_keysSet k v =+    (===)+        (RMap.keysSet (RMap.singleton k v))+        (OMap.keysSet (OMap.singleton k v))++prop_singleton_lookup+    :: forall k v. (Ord k, Eq v, Show v)+    => k+    -> v+    -> Property+prop_singleton_lookup k v =+    (===)+        (RMap.lookup k (RMap.singleton k v))+        (OMap.lookup k (OMap.singleton k v))++prop_singleton_show+    :: forall k v. (Ord k, Show k, Show v)+    => k+    -> v+    -> Property+prop_singleton_show k v =+    (===)+        (show (RMap.singleton k v))+        (show (OMap.singleton k v))++prop_singleton_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => k+    -> v+    -> Property+prop_singleton_toList k v =+    (===)+        (RMap.toList (RMap.singleton k v))+        (OMap.toList (OMap.singleton k v))++--------------------------------------------------------------------------------+-- Append+--------------------------------------------------------------------------------++prop_append_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => [(k, v)]+    -> [(k, v)]+    -> Property+prop_append_toList kvs1 kvs2 =+    (===)+        (RMap.toList (RMap.fromList kvs1 <> RMap.fromList kvs2))+        (OMap.toList (OMap.fromList kvs1 <> OMap.fromList kvs2))+    & cover 10+        (ks1 `Set.disjoint` ks2)+        "ks1 `Set.disjoint` ks2"+    & cover 10+        (not (ks1 `Set.disjoint` ks2))+        "not (ks1 `Set.disjoint` ks2)"+  where+    ks1 = Set.fromList (fst <$> kvs1)+    ks2 = Set.fromList (fst <$> kvs2)++--------------------------------------------------------------------------------+-- Times+--------------------------------------------------------------------------------++prop_stimes_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => [(k, v)]+    -> NonNegative Int+    -> Property+prop_stimes_toList kvs (NonNegative n) =+    (===)+        (RMap.toList (stimes n (RMap.fromList kvs)))+        (OMap.toList (stimes n (OMap.fromList kvs)))+    & cover 1+        (n == 0)+        "n == 0"+    & cover 1+        (n == 1)+        "n == 1"+    & cover 10+        (n >= 2)+        "n >= 2"++--------------------------------------------------------------------------------+-- Delete+--------------------------------------------------------------------------------++prop_delete_lookup+    :: forall k v. (Ord k, Eq v, Show v)+    => [(k, v)]+    -> k+    -> Property+prop_delete_lookup kvs k =+    (===)+        (RMap.lookup k (RMap.delete k (RMap.fromList kvs)))+        (OMap.lookup k (OMap.delete k (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++prop_delete_member+    :: forall k v. (Ord k, Eq v)+    => [(k, v)]+    -> k+    -> Property+prop_delete_member kvs k =+    (===)+        (RMap.member k (RMap.delete k (RMap.fromList kvs)))+        (OMap.member k (OMap.delete k (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++prop_delete_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => [(k, v)]+    -> k+    -> Property+prop_delete_toList kvs k =+    (===)+        (RMap.toList (RMap.delete k (RMap.fromList kvs)))+        (OMap.toList (OMap.delete k (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++--------------------------------------------------------------------------------+-- Insert+--------------------------------------------------------------------------------++prop_insert_lookup+    :: forall k v. (Ord k, Eq v, Show v)+    => [(k, v)]+    -> k+    -> v+    -> Property+prop_insert_lookup kvs k v =+    (===)+        (RMap.lookup k (RMap.insert k v (RMap.fromList kvs)))+        (OMap.lookup k (OMap.insert k v (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++prop_insert_member+    :: forall k v. (Ord k, Eq v)+    => [(k, v)]+    -> k+    -> v+    -> Property+prop_insert_member kvs k v =+    (===)+        (RMap.member k (RMap.insert k v (RMap.fromList kvs)))+        (OMap.member k (OMap.insert k v (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++prop_insert_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => [(k, v)]+    -> k+    -> v+    -> Property+prop_insert_toList kvs k v =+    (===)+        (RMap.toList (RMap.insert k v (RMap.fromList kvs)))+        (OMap.toList (OMap.insert k v (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++--------------------------------------------------------------------------------+-- Map+--------------------------------------------------------------------------------++prop_map+    :: (Ord k, Show k, Eq v2, Show v2)+    => [(k, v1)]+    -> Fun v1 v2+    -> Property+prop_map kvs (applyFun -> f) =+    (===)+        (RMap.toList (RMap.map f (RMap.fromList kvs)))+        (OMap.toList (OMap.map f (OMap.fromList kvs)))++prop_map_mempty+    :: forall k v1 v2. (Ord k, Show k, Eq v2, Monoid v2, Show v2)+    => [(k, v1)]+    -> Property+prop_map_mempty kvs =+    (===)+        (RMap.toList (RMap.map (const (mempty @v2)) (RMap.fromList kvs)))+        (OMap.toList (OMap.map (const (mempty @v2)) (OMap.fromList kvs)))++prop_mapWithKey+    :: (Ord k, Show k, Eq v2, Show v2)+    => [(k, v1)]+    -> Fun (k, v1) v2+    -> Property+prop_mapWithKey kvs (applyFun2 -> f) =+    (===)+        (RMap.toList (RMap.mapWithKey f (RMap.fromList kvs)))+        (OMap.toList (OMap.mapWithKey f (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+--------------------------------------------------------------------------------++instance (Arbitrary k, Ord k, Arbitrary v) =>+    Arbitrary (RMap.Map k v)+  where+    arbitrary = RMap.fromList <$> listOf ((,) <$> arbitrary <*> arbitrary)+    shrink = shrinkMapBy RMap.fromList RMap.toList shrink

@@ -0,0 +1,67 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Copyright: © 2022–2026 Jonathan Knowles+-- License: Apache-2.0+--+module Test.Common+    () where++import Prelude++import Data.Text+    ( Text )+import Numeric.Natural+    ( Natural )+import Test.QuickCheck+    ( Arbitrary (..)+    , CoArbitrary (..)+    , Function (..)+    , arbitrarySizedNatural+    , coarbitraryIntegral+    , coarbitraryShow+    , frequency+    , functionIntegral+    , functionShow+    , listOf+    , shrinkIntegral+    )++import qualified Data.Text as Text++--------------------------------------------------------------------------------+-- Arbitrary instances+--------------------------------------------------------------------------------++#if !MIN_VERSION_QuickCheck(2,17,0)+instance Arbitrary Natural where+    arbitrary = arbitrarySizedNatural+    shrink = shrinkIntegral+#endif++#if !MIN_VERSION_QuickCheck(2,18,0)+instance CoArbitrary Natural where+    coarbitrary = coarbitraryIntegral+#endif++#if !MIN_VERSION_QuickCheck(2,18,0)+instance Function Natural where+    function = functionIntegral+#endif++instance Arbitrary Text where+    arbitrary = Text.pack <$> listOf genChar+      where+        genChar = frequency+            [ (64, pure 'a')+            , (16, pure 'b')+            , ( 4, pure 'c')+            , ( 1, pure 'd')+            ]++instance CoArbitrary Text where+    coarbitrary = coarbitraryShow++instance Function Text where+    function = functionShow

@@ -7,7 +7,8 @@ -- See: https://en.wikipedia.org/wiki/Multiset -- module Data.MonoidMap.Examples.MultiSet-    ( fromList+    ( MultiSet+    , fromList     , toList     , null     , member

@@ -0,0 +1,130 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Copyright: © 2022–2026 Jonathan Knowles+-- License: Apache-2.0+--+-- An ordinary left-biased map similar to 'Data.Map.Strict.Map', implemented in+-- terms of 'MonoidMap'.+--+-- Since 'MonoidMap' is itself implemented in terms of 'Data.Map.Strict.Map',+-- this module demonstrates that 'MonoidMap' and 'Data.Map.Strict.Map' are+-- equally general: each can be used to implement the other.+--+module Data.MonoidMap.Examples.RecoveredMap+    ( Map+    , empty+    , singleton+    , fromList+    , toList+    , delete+    , insert+    , keysSet+    , lookup+    , member+    , map+    , mapWithKey+    , mapAccumL+    , mapAccumLWithKey+    , mapAccumR+    , mapAccumRWithKey+    )+    where++import Prelude hiding+    ( lookup, map )++import Control.DeepSeq+    ( NFData )+import Data.Coerce+    ( coerce )+import Data.Maybe+    ( mapMaybe )+import Data.Monoid+    ( First (..) )+import Data.MonoidMap+    ( MonoidMap )+import Data.Semigroup+    ( Semigroup (stimes), stimesIdempotentMonoid )+import Data.Set+    ( Set )++import qualified Data.MonoidMap as MonoidMap++newtype Map k v = Map+    --  'First' is used to mimic the left-biased nature of+    --  'Data.Map.Strict.Map':+    {unMap :: MonoidMap k (First v)}+    deriving newtype (Eq, NFData, Monoid)++instance Ord k => Semigroup (Map k v) where+    (<>) = coerce @(MonoidMap k (First v) -> _ -> _) (<>)+    stimes = stimesIdempotentMonoid++instance (Show k, Show v) => Show (Map k v) where+    show = ("fromList " <>) . show . toList++instance Functor (Map k) where+    fmap = map++empty :: Map k v+empty = Map MonoidMap.empty++singleton :: Ord k => k -> v -> Map k v+singleton k = Map . MonoidMap.singleton k . pure++fromList :: Ord k => [(k, v)] -> Map k v+fromList = Map . MonoidMap.fromListWith (const id) . fmap (fmap pure)++toList :: Map k v -> [(k, v)]+toList = mapMaybe (getFirst . sequenceA) . MonoidMap.toList . unMap++delete :: Ord k => k -> Map k v -> Map k v+delete k = Map . MonoidMap.nullify k . unMap++insert :: Ord k => k -> v -> Map k v -> Map k v+insert k v = Map . MonoidMap.set k (pure v) . unMap++keysSet :: Map k v -> Set k+keysSet = MonoidMap.nonNullKeys . unMap++lookup :: Ord k => k -> Map k v -> Maybe v+lookup k = getFirst . MonoidMap.get k . unMap++member :: Ord k => k -> Map k v -> Bool+member k = MonoidMap.nonNullKey k . unMap++map :: (v1 -> v2) -> Map k v1 -> Map k v2+map f = Map . MonoidMap.map (fmap f) . unMap++mapWithKey :: (k -> v1 -> v2) -> Map k v1 -> Map k v2+mapWithKey f = Map . MonoidMap.mapWithKey (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)

@@ -1,6 +1,6 @@ cabal-version:  3.0 name:           monoidmap-examples-version:        0.0.0.4+version:        0.1.0.0 homepage:       https://github.com/jonathanknowles/monoidmap/tree/HEAD/packages/monoidmap-examples bug-reports:    https://github.com/jonathanknowles/monoidmap/issues license:        Apache-2.0@@ -20,14 +20,24 @@     build-depends:base                          >= 4.14.3.0   && < 4.23 common dependency-containers     build-depends:containers                    >= 0.6.5.1    && < 0.9+common dependency-deepseq+    build-depends:deepseq                       >= 1.4.4.0    && < 1.6 common dependency-hspec     build-depends:hspec                         >= 2.10.9     && < 2.12+common dependency-hspec-quickcheck-classes+    build-depends:hspec-quickcheck-classes      >= 0.0.0.0    && < 0.1 common dependency-monoid-subclasses     build-depends:monoid-subclasses             >= 1.2.3      && < 1.3 common dependency-monoidmap-    build-depends:monoidmap                     >= 0.0.4.4    && < 0.1+    build-depends:monoidmap                     >= 0.1.0.0    && < 0.2 common dependency-QuickCheck     build-depends:QuickCheck                    >= 2.14.2     && < 2.20+common dependency-quickcheck-classes+    build-depends:quickcheck-classes            >= 0.6.5.0    && < 0.7+common dependency-tasty-bench+    build-depends:tasty-bench                   >= 0.3.2      && < 0.6+common dependency-text+    build-depends:text                          >= 1.2.4.1    && < 2.2  common extensions     default-extensions:@@ -58,6 +68,7 @@     import:       , dependency-base       , dependency-containers+      , dependency-deepseq       , dependency-monoid-subclasses       , dependency-monoidmap       , extensions@@ -72,16 +83,41 @@         Data.MonoidMap.Examples.MultiMap.Instances.MultiMap4         Data.MonoidMap.Examples.MultiSet         Data.MonoidMap.Examples.NestedMonoidMap+        Data.MonoidMap.Examples.RecoveredMap         Data.MonoidMap.Examples.Set.NonEmpty     default-language:         Haskell2010 +benchmark monoidmap-examples-benchmark+    import:+      , dependency-base+      , dependency-containers+      , dependency-deepseq+      , dependency-tasty-bench+      , extensions+    build-depends:+      , monoidmap-examples+    default-language:+        Haskell2010+    type:+        exitcode-stdio-1.0+    hs-source-dirs:+        components/monoidmap-examples-benchmark+    main-is:+        Main.hs+    -- Report allocation and memory statistics for each benchmark:+    ghc-options:+        "-with-rtsopts=-T"+ test-suite monoidmap-examples-test     import:       , dependency-base       , dependency-containers       , dependency-hspec+      , dependency-hspec-quickcheck-classes       , dependency-QuickCheck+      , dependency-quickcheck-classes+      , dependency-text       , extensions     build-depends:       , monoidmap-examples@@ -93,7 +129,9 @@         components/monoidmap-examples-test     other-modules:         Data.MonoidMap.Examples.MultiMapSpec+        Data.MonoidMap.Examples.RecoveredMapSpec         SpecHook+        Test.Common     type:         exitcode-stdio-1.0     default-language: