monoidmap-internal 0.1.2.0 → 0.2.0.0

raw patch · 7 files changed

+188/−1031 lines, 7 filesdep −tasty-hunitPVP ok

version bump matches the API change (PVP)

Dependencies removed: tasty-hunit

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• components/monoidmap-benchmark/Main.hs +0/−314
• components/monoidmap-internal-benchmark/Main.hs +147/−0
• components/monoidmap-internal/Data/MonoidMap/Internal.hs +26/−0
• components/monoidmap-internal/Data/MonoidMap/Internal/RecoveredMap.hs +0/−125
• components/monoidmap-test/Data/MonoidMap/Internal/RecoveredMapSpec.hs +0/−584
• monoidmap-internal.cabal +3/−8

@@ -1,3 +1,15 @@+# 0.2.0.0++- Changed the role of the value type parameter of `MonoidMap` from+  `representational` to `nominal`. This prevents coercions between+  `MonoidMap` types with different value types, which could produce maps+  that contain `mempty` values.++  This is a breaking change: code that performs such coercions will no+  longer compile.++- Moved the `RecoveredMap` module to the `monoidmap-examples` package.+ # 0.1.2.0  - Improved the performance of `fromMap`, particularly for maps that

@@ -1,314 +0,0 @@--- |--- 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.------ When a 'MonoidMap' function has no direct counterpart in 'Map' (such as the--- 'fromMap' function), we benchmark the 'MonoidMap' function directly.----module Main where--import Control.DeepSeq-    ( NFData, rnf )-import Control.Exception-    ( evaluate )-import Data.Bool-    ( Bool (False, True) )-import Data.Eq-    ( Eq ((==)) )-import Data.Function-    ( const, flip, ($) )-import Data.Int-    ( Int )-import Data.List-    ( filter, foldl', zip )-import Data.Maybe-    ( Maybe, fromMaybe )-import Data.Monoid-    ( Monoid (mempty), Sum (Sum) )-import Data.Ord-    ( Ord )-import Data.Semigroup-    ( Semigroup ((<>)), stimes )-import Data.String-    ( String )-import Prelude-    ( Integer, Num, even, odd, (^), (+) )-import System.IO-    ( IO )-import Test.Tasty.Bench-    ( Benchmark, bcompare, bench, bgroup, defaultMain, nf )--import qualified Data.Map.Strict as OMap-import qualified Data.MonoidMap.Internal as MMap-import qualified Data.MonoidMap.Internal.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--        -- Maps in which different subsets of keys have 'null' values:-        om_null_none = mapWithNullIf (const False)   :: OMap.Map Int (Sum Int)-        om_null_min  = mapWithNullIf (== minNatural) :: OMap.Map Int (Sum Int)-        om_null_max  = mapWithNullIf (== maxNatural) :: OMap.Map Int (Sum Int)-        om_null_even = mapWithNullIf even            :: OMap.Map Int (Sum Int)-        om_null_odd  = mapWithNullIf odd             :: OMap.Map Int (Sum Int)-        om_null_all  = mapWithNullIf (const True)    :: OMap.Map Int (Sum Int)--    evaluate $ rnf [om_natural, om_even, om_odd]-    evaluate $ rnf [rm_natural, rm_even, rm_odd]-    evaluate $ rnf-        [ om_null_none-        , om_null_min-        , om_null_max-        , om_null_even-        , om_null_odd-        , om_null_all-        ]--    let fromMapCases =-            [ ("no nulls",           om_null_none)-            , ("one null (min key)", om_null_min)-            , ("one null (max key)", om_null_max)-            , ("even nulls",         om_null_even)-            , ("odd nulls",          om_null_odd)-            , ("all nulls",          om_null_all)-            ]--    defaultMain-        [ compareImplementations-            ("fromMap", MMap.fromMap) fromMapCases-            [ ( "fromMap_filter"-              , MMap.fromMap_filter-              )-            , ( "fromMap_filter_if_any_null"-              , MMap.fromMap_filter_if_any_null-              )-            , ( "fromMap_mapMaybe"-              , MMap.fromMap_mapMaybe-              )-            ]-        , compareImplementations-            ("fromMapWith", MMap.fromMapWith double) fromMapCases-            [ ( "fromMapWith_mapMaybe"-              , MMap.fromMapWith_mapMaybe double-              )-            , ( "fromMapWith_map_filter"-              , MMap.fromMapWith_map_filter double-              )-            , ( "fromMapWith_map_filter_if_any_null"-              , MMap.fromMapWith_map_filter_if_any_null double-              )-            ]-        , 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 (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-    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--    -- A map from keys [minNatural .. maxNatural], with a null value for each-    -- key that satisfies the given predicate, and a non-null value otherwise.-    mapWithNullIf :: (Int -> Bool) -> OMap.Map Int (Sum Int)-    mapWithNullIf hasNullValue = OMap.fromList-        [ (k, if hasNullValue k then mempty else Sum 1)-        | k <- [minNatural .. maxNatural]-        ]--    -- A simple function that replaces every value with a new value, while:-    -- - preserving existing null values; and-    -- - not introducing any new null values.-    double :: Semigroup m => m -> m-    double m = m <> m---- | Compares implementations of a public function with the public function---   itself, for each of the given cases.------ For each case, the time taken by each implementation is reported relative--- to the time taken by the public function.----compareImplementations-    :: NFData r-    => (String, i -> r)-    -- ^ The public function, with its name (also used as the group name).-    -> [(String, i)]-    -- ^ Cases (inputs) to benchmark, each with a label.-    -> [(String, i -> r)]-    -- ^ Implementations of the public function, each with a name.-    -> Benchmark-compareImplementations (publicName, public) cases implementations =-    bgroup publicName-        [ bgroup label $-            bench publicName (nf public input) :-            [ bcompare (relativeToPublic label) $ bench name $ nf f input-            | (name, f) <- implementations-            ]-        | (label, input) <- cases-        ]-  where-    -- Matches the benchmark of the public function for the given case (and-    -- nothing else):-    relativeToPublic label =-        "$NF == \"" <> publicName <> "\""-        <> " && $(NF-1) == \"" <> label <> "\""-        <> " && $(NF-2) == \"" <> publicName <> "\""--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,147 @@+-- |+-- Copyright: © 2022–2026 Jonathan Knowles+-- License: Apache-2.0+--+-- Benchmark for internal implementations of 'MonoidMap' functions.+--+-- When a 'MonoidMap' function has alternative internal implementations (such+-- as the 'fromMap' function), we benchmark each alternative implementation+-- against the public function.+--+module Main where++import Control.DeepSeq+    ( NFData, rnf )+import Control.Exception+    ( evaluate )+import Data.Bool+    ( Bool (False, True) )+import Data.Eq+    ( Eq ((==)) )+import Data.Function+    ( const, ($) )+import Data.Int+    ( Int )+import Data.Monoid+    ( Monoid (mempty), Sum (Sum) )+import Data.Semigroup+    ( Semigroup ((<>)) )+import Data.String+    ( String )+import Prelude+    ( even, odd, (^) )+import System.IO+    ( IO )+import Test.Tasty.Bench+    ( Benchmark, bcompare, bench, bgroup, defaultMain, nf )++import qualified Data.Map.Strict as OMap+import qualified Data.MonoidMap.Internal as MMap++main :: IO ()+main = do++    let -- Maps in which different subsets of keys have 'null' values:+        om_null_none = mapWithNullIf (const False)   :: OMap.Map Int (Sum Int)+        om_null_min  = mapWithNullIf (== minNatural) :: OMap.Map Int (Sum Int)+        om_null_max  = mapWithNullIf (== maxNatural) :: OMap.Map Int (Sum Int)+        om_null_even = mapWithNullIf even            :: OMap.Map Int (Sum Int)+        om_null_odd  = mapWithNullIf odd             :: OMap.Map Int (Sum Int)+        om_null_all  = mapWithNullIf (const True)    :: OMap.Map Int (Sum Int)++    evaluate $ rnf+        [ om_null_none+        , om_null_min+        , om_null_max+        , om_null_even+        , om_null_odd+        , om_null_all+        ]++    let fromMapCases =+            [ ("no nulls",           om_null_none)+            , ("one null (min key)", om_null_min)+            , ("one null (max key)", om_null_max)+            , ("even nulls",         om_null_even)+            , ("odd nulls",          om_null_odd)+            , ("all nulls",          om_null_all)+            ]++    defaultMain+        [ compareImplementations+            ("fromMap", MMap.fromMap) fromMapCases+            [ ( "fromMap_filter"+              , MMap.fromMap_filter+              )+            , ( "fromMap_filter_if_any_null"+              , MMap.fromMap_filter_if_any_null+              )+            , ( "fromMap_mapMaybe"+              , MMap.fromMap_mapMaybe+              )+            ]+        , compareImplementations+            ("fromMapWith", MMap.fromMapWith double) fromMapCases+            [ ( "fromMapWith_mapMaybe"+              , MMap.fromMapWith_mapMaybe double+              )+            , ( "fromMapWith_map_filter"+              , MMap.fromMapWith_map_filter double+              )+            , ( "fromMapWith_map_filter_if_any_null"+              , MMap.fromMapWith_map_filter_if_any_null double+              )+            ]+        ]+  where+    minNatural :: Int+    minNatural = 1++    maxNatural :: Int+    maxNatural = 2 ^ (16 :: Int)++    -- A map from keys [minNatural .. maxNatural], with a null value for each+    -- key that satisfies the given predicate, and a non-null value otherwise.+    mapWithNullIf :: (Int -> Bool) -> OMap.Map Int (Sum Int)+    mapWithNullIf hasNullValue = OMap.fromList+        [ (k, if hasNullValue k then mempty else Sum 1)+        | k <- [minNatural .. maxNatural]+        ]++    -- A simple function that replaces every value with a new value, while:+    -- - preserving existing null values; and+    -- - not introducing any new null values.+    double :: Semigroup m => m -> m+    double m = m <> m++-- | Compares implementations of a public function with the public function+--   itself, for each of the given cases.+--+-- For each case, the time taken by each implementation is reported relative+-- to the time taken by the public function.+--+compareImplementations+    :: NFData r+    => (String, i -> r)+    -- ^ The public function, with its name (also used as the group name).+    -> [(String, i)]+    -- ^ Cases (inputs) to benchmark, each with a label.+    -> [(String, i -> r)]+    -- ^ Implementations of the public function, each with a name.+    -> Benchmark+compareImplementations (publicName, public) cases implementations =+    bgroup publicName+        [ bgroup label $+            bench publicName (nf public input) :+            [ bcompare (relativeToPublic label) $ bench name $ nf f input+            | (name, f) <- implementations+            ]+        | (label, input) <- cases+        ]+  where+    -- Matches the benchmark of the public function for the given case (and+    -- nothing else):+    relativeToPublic label =+        "$NF == \"" <> publicName <> "\""+        <> " && $(NF-1) == \"" <> label <> "\""+        <> " && $(NF-2) == \"" <> publicName <> "\""

@@ -1,3 +1,4 @@+{-# LANGUAGE RoleAnnotations #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_HADDOCK not-home #-}@@ -262,6 +263,31 @@         via Map k     deriving (Eq2, Show2, Bifoldable)         via Map++-- Without an explicit type role annotation, the following roles would be+-- inferred:+--+--     type role MonoidMap nominal representational+--+-- These roles would be inherited from 'Map', which has these roles:+--+--     type role Map nominal representational+--+-- A representational role for the value type of a 'Map' is fine, because the+-- validity of a 'Map' does not depend on any property of its value type.+--+-- However, the validity of a 'MonoidMap' does depend on a property of its+-- value type: its 'mempty' value. A representational role would allow users+-- to coerce between value types with the same representation but different+-- 'mempty' values.+--+-- For example, users could coerce a 'MonoidMap' k ('Sum' 'Int') to a+-- 'MonoidMap' k ('Product' 'Int'), and thereby construct a map that contains+-- 'mempty' values.+--+-- So we must instead choose a nominal role for the value type of 'MonoidMap'.+--+type role MonoidMap nominal nominal  -- Internal alias used when extra brevity is required. type MM = MonoidMap

@@ -1,125 +0,0 @@-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- |--- Copyright: © 2022–2026 Jonathan Knowles--- License: Apache-2.0------ An ordinary left-biased map similar to 'Map', implemented in terms of--- 'MonoidMap'.----module Data.MonoidMap.Internal.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.Internal-    ( MonoidMap )-import Data.Semigroup-    ( Semigroup (stimes), stimesIdempotentMonoid )-import Data.Set-    ( Set )--import qualified Data.MonoidMap.Internal as MonoidMap--newtype Map k v = Map-    --  'First' is used to mimic the left-biased nature of 'Data.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,584 +0,0 @@-{-# 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.Internal.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.Internal.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

@@ -1,6 +1,6 @@ cabal-version:  3.0 name:           monoidmap-internal-version:        0.1.2.0+version:        0.2.0.0 homepage:       https://github.com/jonathanknowles/monoidmap/tree/HEAD/packages/monoidmap-internal bug-reports:    https://github.com/jonathanknowles/monoidmap/issues license:        Apache-2.0@@ -46,8 +46,6 @@     build-depends:quickcheck-quid               >= 0.0.1.7    && < 0.1 common dependency-tasty-bench     build-depends:tasty-bench                   >= 0.3.2      && < 0.6-common dependency-tasty-hunit-    build-depends:tasty-hunit                   >= 0.10.0.3   && < 0.11 common dependency-text     build-depends:text                          >= 1.2.4.1    && < 2.2 @@ -89,18 +87,16 @@         components/monoidmap-internal     exposed-modules:         Data.MonoidMap.Internal-        Data.MonoidMap.Internal.RecoveredMap         Data.MonoidMap.Internal.Unsafe     default-language:         Haskell2010 -benchmark monoidmap-benchmark+benchmark monoidmap-internal-benchmark     import:       , dependency-base       , dependency-containers       , dependency-deepseq       , dependency-tasty-bench-      , dependency-tasty-hunit       , extensions     build-depends:       , monoidmap-internal@@ -109,7 +105,7 @@     type:         exitcode-stdio-1.0     hs-source-dirs:-        components/monoidmap-benchmark+        components/monoidmap-internal-benchmark     main-is:         Main.hs     -- Report allocation and memory statistics for each benchmark:@@ -155,7 +151,6 @@         Data.MonoidMap.Internal.MembershipSpec         Data.MonoidMap.Internal.PartitionSpec         Data.MonoidMap.Internal.PrefixSpec-        Data.MonoidMap.Internal.RecoveredMapSpec         Data.MonoidMap.Internal.SingletonSpec         Data.MonoidMap.Internal.SliceSpec         Data.MonoidMap.Internal.SuffixSpec