diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# 0.0.1.0 + +- Added support for GHC 9.8. +- Optimised performance of `Semigroup.stimes` operation for `MonoidMap`. + # 0.0.0.1 Revised `MultiMap` examples and documentation. diff --git a/monoidmap.cabal b/monoidmap.cabal --- a/monoidmap.cabal +++ b/monoidmap.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: monoidmap -version: 0.0.0.1 +version: 0.0.1.0 bug-reports: https://github.com/jonathanknowles/monoidmap/issues license: Apache-2.0 license-file: LICENSE @@ -17,15 +17,15 @@ README.md common dependency-base - build-depends:base >= 4.14.3.0 && < 4.19 + build-depends:base >= 4.14.3.0 && < 4.20 common dependency-containers build-depends:containers >= 0.6.5.1 && < 0.7 common dependency-deepseq - build-depends:deepseq >= 1.4.4.0 && < 1.5 + build-depends:deepseq >= 1.4.4.0 && < 1.6 common dependency-groups build-depends:groups >= 0.5.3 && < 0.6 common dependency-hspec - build-depends:hspec >= 2.10.9 && < 2.11 + build-depends:hspec >= 2.10.9 && < 2.12 common dependency-monoid-subclasses build-depends:monoid-subclasses >= 1.2.3 && < 1.3 common dependency-nonempty-containers @@ -33,7 +33,7 @@ common dependency-nothunks build-depends:nothunks >= 0.1.3 && < 0.2 common dependency-pretty-show - build-depends:pretty-show >= 1.10 && < 1.11 + build-depends:pretty-show >= 1.10 && < 1.20 common dependency-QuickCheck build-depends:QuickCheck >= 2.14.2 && < 2.15 common dependency-quickcheck-classes @@ -49,7 +49,7 @@ 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.1 + build-depends:text >= 1.2.4.1 && < 2.2 common extensions default-extensions: diff --git a/src/benchmark/Main.hs b/src/benchmark/Main.hs --- a/src/benchmark/Main.hs +++ b/src/benchmark/Main.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NumericUnderscores #-} module Main where @@ -14,6 +15,8 @@ ( foldl' ) import Data.Maybe ( fromMaybe ) +import Data.Semigroup + ( stimes ) import Test.Tasty.Bench ( bench, bgroup, defaultMain, nf ) @@ -23,14 +26,16 @@ main :: IO () main = do - let om_even = fromList elems_even :: OMap.Map Int Int - om_odd = fromList elems_odd :: OMap.Map Int Int + 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_even = fromList elems_even :: RMap.Map Int Int - rm_odd = fromList elems_odd :: RMap.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_even, om_odd] - evaluate $ rnf [rm_even, rm_odd] + evaluate $ rnf [om_natural, om_even, om_odd] + evaluate $ rnf [rm_natural, rm_even, rm_odd] defaultMain [ bgroup "delete" @@ -89,22 +94,37 @@ nf (<> rm_even) rm_even ] ] + , bgroup "stimes" + [ bench "Data.Map.Strict" $ + nf (stimes ten_power_24) om_natural + , bench "Data.MonoidMap" $ + nf (stimes ten_power_24) rm_natural + ] ] where bound :: Int bound = 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 = [1 .. bound] + evens :: [Int] evens = [2, 4 .. bound] odds :: [Int] odds = [1, 3 .. bound] + + 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 diff --git a/src/examples/Examples/RecoveredMap.hs b/src/examples/Examples/RecoveredMap.hs --- a/src/examples/Examples/RecoveredMap.hs +++ b/src/examples/Examples/RecoveredMap.hs @@ -15,12 +15,16 @@ 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 ) @@ -29,7 +33,11 @@ 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, Semigroup, Monoid) + 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 diff --git a/src/internal/Data/MonoidMap/Internal.hs b/src/internal/Data/MonoidMap/Internal.hs --- a/src/internal/Data/MonoidMap/Internal.hs +++ b/src/internal/Data/MonoidMap/Internal.hs @@ -153,6 +153,8 @@ ( Monus (..) ) import Data.Monoid.Null ( MonoidNull, PositiveMonoid ) +import Data.Semigroup + ( stimes ) import Data.Semigroup.Cancellative ( Cancellative , Commutative @@ -242,6 +244,9 @@ Semigroup (MonoidMap k v) where (<>) = append + stimes 0 = const mempty + stimes 1 = id + stimes n = map (stimes n) instance (Ord k, MonoidNull v, Commutative v) => Commutative (MonoidMap k v) diff --git a/src/test/Examples/RecoveredMapSpec.hs b/src/test/Examples/RecoveredMapSpec.hs --- a/src/test/Examples/RecoveredMapSpec.hs +++ b/src/test/Examples/RecoveredMapSpec.hs @@ -21,6 +21,8 @@ ( Sum (..) ) import Data.Proxy ( Proxy (..) ) +import Data.Semigroup + ( Semigroup (stimes) ) import Data.Set ( Set ) import Data.Text @@ -36,6 +38,7 @@ , CoArbitrary , Fun , Function + , NonNegative (..) , Property , Testable , applyFun @@ -148,6 +151,11 @@ 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 @@ -300,6 +308,29 @@ 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