monoidal-containers 0.2.0.0 → 0.3.0.0
raw patch · 4 files changed
+207/−45 lines, 4 filesdep ~containers
Dependency ranges changed: containers
Files
- monoidal-containers.cabal +4/−3
- src/Data/HashMap/Monoidal.hs +24/−24
- src/Data/Map/Monoidal.hs +18/−18
- src/Data/Map/Monoidal/Strict.hs +161/−0
monoidal-containers.cabal view
@@ -1,5 +1,5 @@ name: monoidal-containers-version: 0.2.0.0+version: 0.3.0.0 synopsis: Containers with monoidal accumulation description: Containers with monoidal accumulation homepage: http://github.com/bgamari/monoidal-containers@@ -11,7 +11,7 @@ category: Data build-type: Simple cabal-version: >=1.10-tested-with: GHC ==7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==8.0.1+tested-with: GHC ==7.6.3, GHC ==7.8.4, GHC ==8.0.1 source-repository head type: git@@ -20,14 +20,15 @@ library exposed-modules: Data.Map.Monoidal Data.HashMap.Monoidal+ Data.Map.Monoidal.Strict other-extensions: CPP, MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveTraversable, DeriveDataTypeable build-depends: base >=4.5 && <4.10,+ containers >=0.5 && <0.6, deepseq >=1.3 && <1.5,- containers >=0.4 && <0.6, unordered-containers >= 0.2 && < 0.3, hashable >= 1.2 && < 1.3, lens >=4.4 && <5,
src/Data/HashMap/Monoidal.hs view
@@ -55,7 +55,7 @@ import Control.Newtype -- | A 'HashMap' with monoidal accumulation-newtype MonoidalHashMap k a = MM (M.HashMap k a)+newtype MonoidalHashMap k a = MonoidalHashMap { getMonoidalHashMap :: M.HashMap k a } deriving (Show, Read, Functor, Eq, NFData, Foldable, Traversable, Data, Typeable)@@ -63,15 +63,15 @@ type instance Index (MonoidalHashMap k a) = k type instance IxValue (MonoidalHashMap k a) = a instance (Eq k, Hashable k) => Ixed (MonoidalHashMap k a) where- ix k f (MM m) = case M.lookup k m of- Just v -> f v <&> \v' -> MM (M.insert k v' m)- Nothing -> pure (MM m)+ ix k f (MonoidalHashMap m) = case M.lookup k m of+ Just v -> f v <&> \v' -> MonoidalHashMap (M.insert k v' m)+ Nothing -> pure (MonoidalHashMap m) {-# INLINE ix #-} instance (Eq k, Hashable k) => At (MonoidalHashMap k a) where- at k f (MM m) = f mv <&> \r -> case r of- Nothing -> maybe (MM m) (const (MM $ M.delete k m)) mv- Just v' -> MM $ M.insert k v' m+ at k f (MonoidalHashMap m) = f mv <&> \r -> case r of+ Nothing -> maybe (MonoidalHashMap m) (const (MonoidalHashMap $ M.delete k m)) mv+ Just v' -> MonoidalHashMap $ M.insert k v' m where mv = M.lookup k m {-# INLINE at #-} @@ -80,11 +80,11 @@ instance (Eq k, Hashable k) => FunctorWithIndex k (MonoidalHashMap k) instance (Eq k, Hashable k) => FoldableWithIndex k (MonoidalHashMap k) instance (Eq k, Hashable k) => TraversableWithIndex k (MonoidalHashMap k) where- itraverse f (MM m) = fmap MM $ itraverse f m+ itraverse f (MonoidalHashMap m) = fmap MonoidalHashMap $ itraverse f m {-# INLINE itraverse #-} instance AsEmpty (MonoidalHashMap k a) where- _Empty = nearly (MM M.empty) (M.null . unpack)+ _Empty = nearly (MonoidalHashMap M.empty) (M.null . unpack) {-# INLINE _Empty #-} instance Wrapped (MonoidalHashMap k a) where@@ -93,21 +93,21 @@ {-# INLINE _Wrapped' #-} instance (Eq k, Hashable k, Monoid a) => Monoid (MonoidalHashMap k a) where- mempty = MM mempty+ mempty = MonoidalHashMap mempty {-# INLINE mempty #-}- MM a `mappend` MM b = MM $ M.unionWith mappend a b+ MonoidalHashMap a `mappend` MonoidalHashMap b = MonoidalHashMap $ M.unionWith mappend a b {-# INLINE mappend #-} instance Newtype (MonoidalHashMap k a) (M.HashMap k a) where- pack = MM+ pack = MonoidalHashMap {-# INLINE pack #-}- unpack (MM a) = a+ unpack (MonoidalHashMap a) = a {-# INLINE unpack #-} #if MIN_VERSION_base(4,7,0) instance (Eq k, Hashable k, Monoid a) => Exts.IsList (MonoidalHashMap k a) where type Item (MonoidalHashMap k a) = (k, a)- fromList = MM . M.fromListWith mappend+ fromList = MonoidalHashMap . M.fromListWith mappend {-# INLINE fromList #-} toList = M.toList . unpack {-# INLINE toList #-}@@ -115,7 +115,7 @@ -- | /O(1)/. A map with a single element. singleton :: (Eq k, Hashable k) => k -> a -> MonoidalHashMap k a-singleton k a = MM $ M.singleton k a+singleton k a = MonoidalHashMap $ M.singleton k a {-# INLINE singleton #-} -- | /O(1)/. The number of elements in the map.@@ -148,12 +148,11 @@ -- | /O(log n)/. Delete a key and its value from the map. When the key is not -- a member of the map, the original map is returned. delete :: (Eq k, Hashable k) => k -> MonoidalHashMap k a -> MonoidalHashMap k a-delete k = _Wrapping' MM %~ M.delete k+delete k = _Wrapping' MonoidalHashMap %~ M.delete k {-# INLINE delete #-} -- | /O(n)/.--- Return all elements of the map in the ascending order of their keys.--- Subject to list fusion.+-- Return a list of this map's values. The list is produced lazily. elems :: MonoidalHashMap k a -> [a] elems = M.elems . unpack {-# INLINE elems #-}@@ -165,13 +164,13 @@ {-# INLINE keys #-} -- | /O(n*log n)/. Construct a map with the supplied mappings. If the list--- contains duplicate mappings, the later mappings take precedence.-fromList :: (Eq k, Hashable k) => [(k,a)] -> MonoidalHashMap k a-fromList = pack . M.fromList+-- contains duplicate mappings, values will be merged using (mappend newVal oldVal).+fromList :: (Eq k, Hashable k, Monoid a) => [(k,a)] -> MonoidalHashMap k a+fromList = pack . M.fromListWith mappend {-# INLINE fromList #-} --- | /O(n*log n)/. Construct a map with the supplied mappings. If the list--- contains duplicate mappings, the later mappings take precedence.+-- | /O(n*log n)/. Return a list of this map's elements. The list is produced+-- lazily. The order of its elements is unspecified. toList :: MonoidalHashMap k a -> [(k,a)] toList = M.toList . unpack {-# INLINE toList #-}@@ -198,7 +197,8 @@ . unpack {-# INLINE modifyDef #-} --- | /O(n)/. Map a function to each key of a map+-- | /O(n)/. Map a function to each key of a map, if it will result+-- in duplicated mappings, their values will be merged in unspecified order mapKeys :: (Monoid a, Hashable k, Eq k, Hashable k', Eq k') => (k -> k') -> MonoidalHashMap k a -> MonoidalHashMap k' a mapKeys f = fromList
src/Data/Map/Monoidal.hs view
@@ -45,7 +45,7 @@ import Control.Newtype -- | A 'Map' with monoidal accumulation-newtype MonoidalMap k a = MM (M.Map k a)+newtype MonoidalMap k a = MonoidalMap { getMonoidalMap :: M.Map k a } deriving (Show, Read, Functor, Eq, Ord, NFData, Foldable, Traversable, Data, Typeable)@@ -53,15 +53,15 @@ type instance Index (MonoidalMap k a) = k type instance IxValue (MonoidalMap k a) = a instance Ord k => Ixed (MonoidalMap k a) where- ix k f (MM m) = case M.lookup k m of- Just v -> f v <&> \v' -> MM (M.insert k v' m)- Nothing -> pure (MM m)+ ix k f (MonoidalMap m) = case M.lookup k m of+ Just v -> f v <&> \v' -> MonoidalMap (M.insert k v' m)+ Nothing -> pure (MonoidalMap m) {-# INLINE ix #-} instance Ord k => At (MonoidalMap k a) where- at k f (MM m) = f mv <&> \r -> case r of- Nothing -> maybe (MM m) (const (MM $ M.delete k m)) mv- Just v' -> MM $ M.insert k v' m+ at k f (MonoidalMap m) = f mv <&> \r -> case r of+ Nothing -> maybe (MonoidalMap m) (const (MonoidalMap $ M.delete k m)) mv+ Just v' -> MonoidalMap $ M.insert k v' m where mv = M.lookup k m {-# INLINE at #-} @@ -70,18 +70,18 @@ instance Ord k => FunctorWithIndex k (MonoidalMap k) instance Ord k => FoldableWithIndex k (MonoidalMap k) instance Ord k => TraversableWithIndex k (MonoidalMap k) where- itraverse f (MM m) = fmap MM $ itraverse f m+ itraverse f (MonoidalMap m) = fmap MonoidalMap $ itraverse f m {-# INLINE itraverse #-} instance Ord k => TraverseMin k (MonoidalMap k) where- traverseMin f (MM m) = fmap MM $ traverseMin f m+ traverseMin f (MonoidalMap m) = fmap MonoidalMap $ traverseMin f m {-# INLINE traverseMin #-} instance Ord k => TraverseMax k (MonoidalMap k) where- traverseMax f (MM m) = fmap MM $ traverseMax f m+ traverseMax f (MonoidalMap m) = fmap MonoidalMap $ traverseMax f m {-# INLINE traverseMax #-} instance AsEmpty (MonoidalMap k a) where- _Empty = nearly (MM M.empty) (M.null . unpack)+ _Empty = nearly (MonoidalMap M.empty) (M.null . unpack) {-# INLINE _Empty #-} instance Wrapped (MonoidalMap k a) where@@ -90,21 +90,21 @@ {-# INLINE _Wrapped' #-} instance (Ord k, Monoid a) => Monoid (MonoidalMap k a) where- mempty = MM mempty+ mempty = MonoidalMap mempty {-# INLINE mempty #-}- MM a `mappend` MM b = MM $ M.unionWith mappend a b+ MonoidalMap a `mappend` MonoidalMap b = MonoidalMap $ M.unionWith mappend a b {-# INLINE mappend #-} instance Newtype (MonoidalMap k a) (M.Map k a) where- pack = MM+ pack = MonoidalMap {-# INLINE pack #-}- unpack (MM a) = a+ unpack (MonoidalMap a) = a {-# INLINE unpack #-} #if MIN_VERSION_base(4,7,0) instance (Ord k, Monoid a) => IsList (MonoidalMap k a) where type Item (MonoidalMap k a) = (k, a)- fromList = MM . M.fromListWith mappend+ fromList = MonoidalMap . M.fromListWith mappend {-# INLINE fromList #-} toList = M.toList . unpack {-# INLINE toList #-}@@ -112,7 +112,7 @@ -- | /O(1)/. A map with a single element. singleton :: Ord k => k -> a -> MonoidalMap k a-singleton k a = MM $ M.singleton k a+singleton k a = MonoidalMap $ M.singleton k a {-# INLINE singleton #-} -- | /O(1)/. The number of elements in the map.@@ -140,7 +140,7 @@ -- | /O(log n)/. Delete a key and its value from the map. When the key is not -- a member of the map, the original map is returned. delete :: Ord k => k -> MonoidalMap k a -> MonoidalMap k a-delete k = _Wrapping' MM %~ M.delete k+delete k = _Wrapping' MonoidalMap %~ M.delete k {-# INLINE delete #-} -- | /O(n)/. Return all elements of the map and their keys
+ src/Data/Map/Monoidal/Strict.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveDataTypeable #-}++-- | This module provides a 'Data.Map' variant which uses the value's+-- 'Monoid' instance to accumulate conflicting entries when merging+-- 'Map's.+--+-- While some functions mirroring those of 'Data.Map' are provided+-- here for convenience, more specialized needs will likely want to use+-- either the 'Newtype' or 'Wrapped' instances to manipulate the+-- underlying 'Map'.++module Data.Map.Monoidal.Strict+ ( MonoidalMap+ -- * Often-needed functions+ , singleton+ , size+ , member+ , notMember+ , findWithDefault+ , assocs+ , elems+ , keys+ ) where++import Data.Monoid+import Data.Foldable (Foldable)+import Data.Traversable (Traversable)+import Control.Applicative (Applicative, pure)+import Data.Data (Data)+import Data.Typeable (Typeable)++#if MIN_VERSION_base(4,7,0)+import GHC.Exts (IsList(..))+#endif++import Control.DeepSeq+import qualified Data.Map.Strict as M+import Control.Lens+import Control.Newtype++-- | A 'Map' with monoidal accumulation+newtype MonoidalMap k a = MonoidalMap { getMonoidalMap :: M.Map k a }+ deriving (Show, Read, Functor, Eq, Ord, NFData,+ Foldable, Traversable,+ Data, Typeable)++type instance Index (MonoidalMap k a) = k+type instance IxValue (MonoidalMap k a) = a+instance Ord k => Ixed (MonoidalMap k a) where+ ix k f (MonoidalMap m) = case M.lookup k m of+ Just v -> f v <&> \v' -> MonoidalMap (M.insert k v' m)+ Nothing -> pure (MonoidalMap m)+ {-# INLINE ix #-}++instance Ord k => At (MonoidalMap k a) where+ at k f (MonoidalMap m) = f mv <&> \r -> case r of+ Nothing -> maybe (MonoidalMap m) (const (MonoidalMap $ M.delete k m)) mv+ Just v' -> MonoidalMap $ M.insert k v' m+ where mv = M.lookup k m+ {-# INLINE at #-}++instance Each (MonoidalMap k a) (MonoidalMap k b) a b++instance Ord k => FunctorWithIndex k (MonoidalMap k)+instance Ord k => FoldableWithIndex k (MonoidalMap k)+instance Ord k => TraversableWithIndex k (MonoidalMap k) where+ itraverse f (MonoidalMap m) = fmap MonoidalMap $ itraverse f m+ {-# INLINE itraverse #-}++instance Ord k => TraverseMin k (MonoidalMap k) where+ traverseMin f (MonoidalMap m) = fmap MonoidalMap $ traverseMin f m+ {-# INLINE traverseMin #-}+instance Ord k => TraverseMax k (MonoidalMap k) where+ traverseMax f (MonoidalMap m) = fmap MonoidalMap $ traverseMax f m+ {-# INLINE traverseMax #-}++instance AsEmpty (MonoidalMap k a) where+ _Empty = nearly (MonoidalMap M.empty) (M.null . unpack)+ {-# INLINE _Empty #-}++instance Wrapped (MonoidalMap k a) where+ type Unwrapped (MonoidalMap k a) = M.Map k a+ _Wrapped' = iso unpack pack+ {-# INLINE _Wrapped' #-}++instance (Ord k, Monoid a) => Monoid (MonoidalMap k a) where+ mempty = MonoidalMap mempty+ {-# INLINE mempty #-}+ MonoidalMap a `mappend` MonoidalMap b = MonoidalMap $ M.unionWith mappend a b+ {-# INLINE mappend #-}++instance Newtype (MonoidalMap k a) (M.Map k a) where+ pack = MonoidalMap+ {-# INLINE pack #-}+ unpack (MonoidalMap a) = a+ {-# INLINE unpack #-}++#if MIN_VERSION_base(4,7,0)+instance (Ord k, Monoid a) => IsList (MonoidalMap k a) where+ type Item (MonoidalMap k a) = (k, a)+ fromList = MonoidalMap . M.fromListWith mappend+ {-# INLINE fromList #-}+ toList = M.toList . unpack+ {-# INLINE toList #-}+#endif++-- | /O(1)/. A map with a single element.+singleton :: Ord k => k -> a -> MonoidalMap k a+singleton k a = MonoidalMap $ M.singleton k a+{-# INLINE singleton #-}++-- | /O(1)/. The number of elements in the map.+size :: MonoidalMap k a -> Int+size = M.size . unpack+{-# INLINE size #-}++-- | /O(log n)/. Is the key a member of the map? See also 'notMember'.+member :: Ord k => k -> MonoidalMap k a -> Bool+member k = M.member k . unpack+{-# INLINE member #-}++-- | /O(log n)/. Is the key not a member of the map? See also 'member'.+notMember :: Ord k => k -> MonoidalMap k a -> Bool+notMember k = not . M.member k . unpack+{-# INLINE notMember #-}++-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- the value at key @k@ or returns default value @def@+-- when the key is not in the map.+findWithDefault :: Ord k => a -> k -> MonoidalMap k a -> a+findWithDefault def k = M.findWithDefault def k . unpack+{-# INLINE findWithDefault #-}++-- | /O(log n)/. Delete a key and its value from the map. When the key is not+-- a member of the map, the original map is returned.+delete :: Ord k => k -> MonoidalMap k a -> MonoidalMap k a+delete k = _Wrapping' MonoidalMap %~ M.delete k+{-# INLINE delete #-}++-- | /O(n)/. Return all elements of the map and their keys+assocs :: MonoidalMap k a -> [(k,a)]+assocs = M.assocs . unpack+{-# INLINE assocs #-}++-- | /O(n)/. Return all elements of the map in the ascending order of their+-- keys. Subject to list fusion.+elems :: MonoidalMap k a -> [a]+elems = M.elems . unpack+{-# INLINE elems #-}++-- | /O(n)/. Return all keys of the map in ascending order. Subject to list+-- fusion.+keys :: MonoidalMap k a -> [k]+keys = M.keys . unpack+{-# INLINE keys #-}