packages feed

monoidmap-internal 0.5.0.0 → 0.5.1.0

raw patch · 8 files changed

+370/−7 lines, 8 files

Files

CHANGELOG.md view
@@ -1,3 +1,16 @@+# 0.5.1.0++- Added the `Data.MonoidMap.Internal.NonNullMap.Merge` module, which provides+  the `merge` and `mergeA` functions for merging values of type `NonNullMap`,+  together with a set of merge strategies that can only produce `NonNull`+  values. The `monoidmap` package now uses this module to implement all of its+  merge-based functions.++- Added the `get` function to `Data.MonoidMap.Internal.NonNullMap`.++- Added the `Data.MonoidMap.Internal.NonNullMap.Get` module, which provides+  alternative implementations of `get` for benchmarking.+ # 0.5.0.0  - Removed the `NoThunks` instance for `NonNullMap`, and the dependency on
components/monoidmap-internal-benchmark/Main.hs view
@@ -22,6 +22,8 @@     ( const, ($) ) import Data.Int     ( Int )+import Data.List+    ( filter, foldl' ) import Data.Monoid     ( Monoid (mempty), Sum (Sum) ) import Data.Semigroup@@ -39,6 +41,7 @@ import qualified Data.MonoidMap.Internal.NonNullMap as MMap import qualified Data.MonoidMap.Internal.NonNullMap.FromMap as MMap import qualified Data.MonoidMap.Internal.NonNullMap.FromMapWith as MMap+import qualified Data.MonoidMap.Internal.NonNullMap.Get as MMap  main :: IO () main = do@@ -60,6 +63,23 @@         , om_null_all         ] +    let -- Map with keys that are all even:+        mm_keys_even = MMap.fromMap om_null_odd+        -- Map with keys that are all odd:+        mm_keys_odd  = MMap.fromMap om_null_even++        keys_even = filter even [minNatural .. maxNatural]+        keys_odd  = filter odd  [minNatural .. maxNatural]++    evaluate $ rnf+        [ mm_keys_even+        , mm_keys_odd+        ]+    evaluate $ rnf+        [ keys_even+        , keys_odd+        ]+     let fromMapCases =             [ ("no nulls",           om_null_none)             , ("one null (min key)", om_null_min)@@ -69,6 +89,13 @@             , ("all nulls",          om_null_all)             ] +    let getCases =+            [ ("all keys present (even)", (keys_even, mm_keys_even))+            , ("all keys present (odd)",  (keys_odd,  mm_keys_odd))+            , ("no keys present (even)",  (keys_even, mm_keys_odd))+            , ("no keys present (odd)",   (keys_odd,  mm_keys_even))+            ]+     defaultMain         [ compareImplementations             ("fromMap", MMap.fromMap) fromMapCases@@ -94,6 +121,15 @@               , MMap.fromMapWith_map_filter_if_any_null double               )             ]+        , compareImplementations+            ("get", getAll MMap.get) getCases+            [ ( "get_findWithDefault"+              , getAll MMap.get_findWithDefault+              )+            , ( "get_lookup"+              , getAll MMap.get_lookup+              )+            ]         ]   where     minNatural :: Int@@ -115,6 +151,23 @@     -- - not introducing any new null values.     double :: Semigroup m => m -> m     double m = m <> m++    -- Gets the values associated with all of the given keys, and combines them+    -- into a single value.+    --+    -- This function is marked with `NOINLINE` in order to ensure that every+    -- implementation of 'get' is called from exactly the same loop.+    --+    -- Otherwise, the compiler could compile a separate copy of the loop for+    -- each implementation, and differences between the copies could outweigh+    -- differences between the implementations themselves.+    --+    getAll+        :: (Int -> MMap.NonNullMap Int (Sum Int) -> Sum Int)+        -> ([Int], MMap.NonNullMap Int (Sum Int))+        -> Sum Int+    getAll get (ks, m) = foldl' (\v k -> v <> get k m) mempty ks+    {-# NOINLINE getAll #-}  -- | Compares implementations of a public function with the public function --   itself, for each of the given cases.
components/monoidmap-internal/Data/MonoidMap/Internal/NonNullMap.hs view
@@ -22,6 +22,9 @@      -- * Deconstruction     , toMap++    -- * Lookup+    , get     )     where @@ -38,6 +41,8 @@     ( fromMap_filter_if_any_null ) import Data.MonoidMap.Internal.NonNullMap.FromMapWith     ( fromMapWith_mapMaybe )+import Data.MonoidMap.Internal.NonNullMap.Get+    ( get_lookup ) import Data.MonoidMap.Internal.NonNullMap.Unsafe     ( NonNullMap (..), toMap ) @@ -66,3 +71,18 @@ fromMapWith :: MonoidNull v2 => (v1 -> v2) -> Map k v1 -> NonNullMap k v2 fromMapWith = fromMapWith_mapMaybe {-# INLINE fromMapWith #-}++--------------------------------------------------------------------------------+-- Lookup+--------------------------------------------------------------------------------++-- | Gets the value associated with the given key, returning 'mempty' if the+--   key is not present.+--+-- This function selects which of the implementations in+-- "Data.MonoidMap.Internal.NonNullMap.Get" is used by the public @get@+-- function of the @monoidmap@ package.+--+get :: (Ord k, Monoid v) => k -> NonNullMap k v -> v+get = get_lookup+{-# INLINE get #-}
components/monoidmap-internal/Data/MonoidMap/Internal/NonNullMap/FromMap.hs view
@@ -40,7 +40,7 @@ fromMap_filter     :: MonoidNull v => Map k v -> NonNullMap k v fromMap_filter = unsafeFromMap . Map.filter (\(!v) -> not (null v))-{-# INLINABLE fromMap_filter #-}+{-# INLINE fromMap_filter #-}  fromMap_filter_if_any_null     :: MonoidNull v => Map k v -> NonNullMap k v@@ -49,9 +49,9 @@         unsafeFromMap $ Map.filter (\(!v) -> not (null v)) m     | otherwise =         unsafeFromMap m-{-# INLINABLE fromMap_filter_if_any_null #-}+{-# INLINE fromMap_filter_if_any_null #-}  fromMap_mapMaybe     :: MonoidNull v => Map k v -> NonNullMap k v fromMap_mapMaybe = NonNullMap . Map.mapMaybe nonNull-{-# INLINABLE fromMap_mapMaybe #-}+{-# INLINE fromMap_mapMaybe #-}
components/monoidmap-internal/Data/MonoidMap/Internal/NonNullMap/FromMapWith.hs view
@@ -38,14 +38,14 @@ fromMapWith_mapMaybe     :: MonoidNull v2 => (v1 -> v2) -> Map k v1 -> NonNullMap k v2 fromMapWith_mapMaybe f = NonNullMap . Map.mapMaybe (nonNull . f)-{-# INLINABLE fromMapWith_mapMaybe #-}+{-# INLINE fromMapWith_mapMaybe #-}  fromMapWith_map_filter     :: MonoidNull v2 => (v1 -> v2) -> Map k v1 -> NonNullMap k v2 fromMapWith_map_filter f = fromMap_filter . Map.map f-{-# INLINABLE fromMapWith_map_filter #-}+{-# INLINE fromMapWith_map_filter #-}  fromMapWith_map_filter_if_any_null     :: MonoidNull v2 => (v1 -> v2) -> Map k v1 -> NonNullMap k v2 fromMapWith_map_filter_if_any_null f = fromMap_filter_if_any_null . Map.map f-{-# INLINABLE fromMapWith_map_filter_if_any_null #-}+{-# INLINE fromMapWith_map_filter_if_any_null #-}
+ components/monoidmap-internal/Data/MonoidMap/Internal/NonNullMap/Get.hs view
@@ -0,0 +1,39 @@+{- HLINT ignore "Use camelCase" -}++-- |+-- Copyright: © 2022–2026 Jonathan Knowles+-- License: Apache-2.0+--+-- Provides alternative implementations of @get@, which gets the value+-- associated with a key in a 'NonNullMap', returning 'mempty' if the key is+-- not present.+--+-- These implementations are exported so that they can be benchmarked against+-- one another.+--+module Data.MonoidMap.Internal.NonNullMap.Get+    ( get_findWithDefault+    , get_lookup+    )+    where++import Prelude++import Data.Maybe+    ( fromMaybe )+import Data.MonoidMap.Internal.NonNullMap.Unsafe+    ( NonNullMap+    , toMap+    )++import qualified Data.Map.Strict as Map++get_findWithDefault+    :: (Ord k, Monoid v) => k -> NonNullMap k v -> v+get_findWithDefault k m = Map.findWithDefault mempty k $ toMap m+{-# INLINE get_findWithDefault #-}++get_lookup+    :: (Ord k, Monoid v) => k -> NonNullMap k v -> v+get_lookup k m = fromMaybe mempty $ Map.lookup k $ toMap m+{-# INLINE get_lookup #-}
+ components/monoidmap-internal/Data/MonoidMap/Internal/NonNullMap/Merge.hs view
@@ -0,0 +1,232 @@+-- |+-- Copyright: © 2022–2026 Jonathan Knowles+-- License: Apache-2.0+--+-- Provides functions for merging maps of 'NonNull' values.+--+-- Every strategy provided by this module produces only 'NonNull' values.+--+-- This module is intended to be imported qualified:+--+-- @+-- import Data.MonoidMap.Internal.NonNullMap.Merge qualified as Merge+-- @+--+module Data.MonoidMap.Internal.NonNullMap.Merge+    (+    -- * Merging+      merge+    , mergeA++    -- * Strategies+    , Strategy (..)+    , WhenOneSideNull+    , WhenBothNonNull++    -- * Strategies for when one side is null+    , keepNull+    , keepNonNull+    , withNonNull+    , withNonNullA++    -- * Strategies for when both sides are non-null+    , withBoth+    , withBothA+    )+    where++import Prelude++import Data.Functor.Identity+    ( Identity )+import Data.Monoid.Null+    ( MonoidNull )+import Data.MonoidMap.Internal.NonNull+    ( NonNull )+import Data.MonoidMap.Internal.NonNullMap.Unsafe+    ( NonNullMap (..) )++import qualified Data.Map.Merge.Strict as Map+import qualified Data.MonoidMap.Internal.NonNull as NonNull++--------------------------------------------------------------------------------+-- Merging+--------------------------------------------------------------------------------++-- | Merges two maps with the given t'Strategy'.+--+-- For each key that has a non-null value in at least one of the maps, the+-- strategy determines the value associated with that key in the merged map.+--+-- Keys that have a null value in both maps will always have a null value in+-- the merged map.+--+merge+    :: Ord k+    => Strategy Identity k v1 v2 v3+    -> NonNullMap k v1+    -> NonNullMap k v2+    -> NonNullMap k v3+merge+    (Strategy+        (WhenOneSideNull nnl)+        (WhenOneSideNull nnr)+        (WhenBothNonNull nnp))+    (NonNullMap m1)+    (NonNullMap m2) =+        NonNullMap $ Map.merge nnl nnr nnp m1 m2+{-# INLINE merge #-}++-- | Like 'merge', but for strategies with 'Applicative' effects.+--+-- Effects are performed in increasing order of keys.+--+mergeA+    :: (Applicative f, Ord k)+    => Strategy f k v1 v2 v3+    -> NonNullMap k v1+    -> NonNullMap k v2+    -> f (NonNullMap k v3)+mergeA+    (Strategy+        (WhenOneSideNull nnl)+        (WhenOneSideNull nnr)+        (WhenBothNonNull nnp))+    (NonNullMap m1)+    (NonNullMap m2) =+        NonNullMap <$> Map.mergeA nnl nnr nnp m1 m2+{-# INLINE mergeA #-}++--------------------------------------------------------------------------------+-- Strategies+--------------------------------------------------------------------------------++-- | A strategy for keys that have a non-null value in one map, and a null+--   value in the other.+--+-- Computes a result value of type @vr@ from the non-null value of type @vx@.+--+newtype WhenOneSideNull f k vx vr = WhenOneSideNull+    (Map.WhenMissing f k (NonNull vx) (NonNull vr))++-- | A strategy for keys that have non-null values in both maps.+--+-- Computes a result value of type @vr@ from the non-null values of types @v1@+-- and @v2@.+--+newtype WhenBothNonNull f k v1 v2 vr = WhenBothNonNull+    (Map.WhenMatched f k (NonNull v1) (NonNull v2) (NonNull vr))++-- | A strategy for merging two maps.+--+-- A strategy determines how to compute each value in the merged map from the+-- values associated with the same key in the two maps being merged.+--+-- A strategy has one component for every case in which at least one of the+-- two values is non-null. There is no component for the case in which both+-- values are null: the merged value is then always null, and the merge never+-- needs to visit such keys.+--+-- Consequently, a binary operation __@f@__ can only be implemented by a+-- strategy if it satisfies:+--+-- @+-- f 'mempty' 'mempty' '==' 'mempty'+-- @+--+-- For example, the following strategy implements '(<>)':+--+-- @+-- v'Strategy'+--     { 'withNonNullL' = 'keepNonNull'      -- v '<>' 'mempty' '==' v+--     , 'withNonNullR' = 'keepNonNull'      -- 'mempty' '<>' v '==' v+--     , 'withNonNullP' = 'withBoth' '(<>)'+--     }+-- @+--+data Strategy f k v1 v2 v3 = Strategy+    { withNonNullL :: !(WhenOneSideNull f k v1    v3)+      -- ^ Applies to keys with a non-null value in the first map only.+    , withNonNullR :: !(WhenOneSideNull f k    v2 v3)+      -- ^ Applies to keys with a non-null value in the second map only.+    , withNonNullP :: !(WhenBothNonNull f k v1 v2 v3)+      -- ^ Applies to keys with non-null values in both maps.+    }++--------------------------------------------------------------------------------+-- Strategies for when one side is null+--------------------------------------------------------------------------------++-- | Produces a null value, discarding the non-null value.+--+-- Equivalent to @'withNonNull' ('const' 'mempty')@, but more efficient, as it+-- discards entire subtrees without visiting their values.+--+keepNull+    :: Applicative f+    => WhenOneSideNull f k v1 v2+keepNull = WhenOneSideNull Map.dropMissing+{-# INLINE keepNull #-}++-- | Produces the non-null value unchanged.+--+-- Equivalent to @'withNonNull' 'id'@, but more efficient, as it reuses entire+-- subtrees without testing whether their values are null.+--+keepNonNull+    :: Applicative f+    => WhenOneSideNull f k v v+keepNonNull = WhenOneSideNull Map.preserveMissing+{-# INLINE keepNonNull #-}++-- | Applies the given function to the non-null value.+--+withNonNull+    :: (Applicative f, MonoidNull v2)+    => (v1 -> v2)+    -> WhenOneSideNull f k v1 v2+withNonNull f+    = WhenOneSideNull+    $ Map.mapMaybeMissing+    $ \_k v -> NonNull.nonNull $ NonNull.apply f v+{-# INLINE withNonNull #-}++-- | Applies the given effectful function to the non-null value.+--+withNonNullA+    :: (Applicative f, MonoidNull v2)+    => (v1 -> f v2)+    -> WhenOneSideNull f k v1 v2+withNonNullA f+    = WhenOneSideNull+    $ Map.traverseMaybeMissing+    $ \_k v -> NonNull.nonNull <$> NonNull.apply f v+{-# INLINE withNonNullA #-}++--------------------------------------------------------------------------------+-- Strategies for when both sides are non-null+--------------------------------------------------------------------------------++-- | Applies the given function to both non-null values.+--+withBoth+    :: (Applicative f, MonoidNull v3)+    => (v1 -> v2 -> v3)+    -> WhenBothNonNull f k v1 v2 v3+withBoth f+    = WhenBothNonNull+    $ Map.zipWithMaybeMatched+    $ \_k v1 v2 -> NonNull.nonNull $ NonNull.apply2 f v1 v2+{-# INLINE withBoth #-}++-- | Applies the given effectful function to both non-null values.+--+withBothA+    :: (Applicative f, MonoidNull v3)+    => (v1 -> v2 -> f v3)+    -> WhenBothNonNull f k v1 v2 v3+withBothA f+    = WhenBothNonNull+    $ Map.zipWithMaybeAMatched+    $ \_k v1 v2 -> NonNull.nonNull <$> NonNull.apply2 f v1 v2+{-# INLINE withBothA #-}
monoidmap-internal.cabal view
@@ -1,6 +1,6 @@ cabal-version:  3.0 name:           monoidmap-internal-version:        0.5.0.0+version:        0.5.1.0 homepage:       https://github.com/jonathanknowles/monoidmap/tree/HEAD/packages/monoidmap-internal bug-reports:    https://github.com/jonathanknowles/monoidmap/issues license:        Apache-2.0@@ -66,6 +66,8 @@         Data.MonoidMap.Internal.NonNullMap         Data.MonoidMap.Internal.NonNullMap.FromMap         Data.MonoidMap.Internal.NonNullMap.FromMapWith+        Data.MonoidMap.Internal.NonNullMap.Get+        Data.MonoidMap.Internal.NonNullMap.Merge     other-modules:         Data.MonoidMap.Internal.NonNull.Unsafe         Data.MonoidMap.Internal.NonNullMap.Unsafe@@ -92,3 +94,7 @@     -- Report allocation and memory statistics for each benchmark:     ghc-options:         "-with-rtsopts=-T"+    -- Align functions to cache lines, so that results are not skewed by+    -- incidental changes in code alignment:+    ghc-options:+        -fproc-alignment=64