monoidal-containers (empty) → 0.1.0.0

raw patch · 5 files changed

+373/−0 lines, 5 filesdep +basedep +containersdep +deepseqsetup-changed

Dependencies added: base, containers, deepseq, hashable, lens, newtype, unordered-containers

Files

LICENSE +30/−0
Setup.hs +2/−0
monoidal-containers.cabal +35/−0
src/Data/HashMap/Monoidal.hs +150/−0
src/Data/Map/Monoidal.hs +156/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2015, Ben Gamari++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ben Gamari nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ monoidal-containers.cabal view

@@ -0,0 +1,35 @@+name:                monoidal-containers+version:             0.1.0.0+synopsis:            Containers with monoidal accumulation+description:         Containers with monoidal accumulation+homepage:            http://github.com/bgamari/monoidal-containers+license:             BSD3+license-file:        LICENSE+author:              Ben Gamari+maintainer:          ben@smart-cactus.org+copyright:           (c) 2014 Ben Gamari+category:            Data+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type:                git+  location:            git://github.com/bgamari/monoidal-containers++library+  exposed-modules:     Data.Map.Monoidal+                       Data.HashMap.Monoidal+  other-extensions:    CPP,+                       MultiParamTypeClasses,+                       GeneralizedNewtypeDeriving,+                       DeriveTraversable,+                       DeriveDataTypeable+  build-depends:       base >=4.7 && <4.9,+                       deepseq >=1.3 && <1.5,+                       containers >=0.5 && <0.6,+                       unordered-containers >= 0.2 && < 0.3,+                       hashable >= 1.2 && < 1.3,+                       lens >=4.4 && <4.8,+                       newtype >=0.2 && <0.3+  hs-source-dirs:      src+  default-language:    Haskell2010

+ src/Data/HashMap/Monoidal.hs view

@@ -0,0 +1,150 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveDataTypeable #-}++-- | This module provides a 'Data.HashMap' variant which uses the value's+-- 'Monoid' instance to accumulate conflicting entries when merging+-- 'Map's.+--+-- While some functions mirroring those of 'Data.HashMap' 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.HashMap.Monoidal+    ( MonoidalHashMap+      -- * Often-needed functions+    , singleton+    , size+    , member+    , notMember+    , lookup+    , elems+    , keys+    ) where++import Prelude hiding (lookup)+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.HashMap.Strict as M+import Data.Hashable (Hashable)+import Control.Lens+import Control.Newtype++-- | A 'HashMap' with monoidal accumulation+newtype MonoidalHashMap k a = MM (M.HashMap k a)+    deriving (Show, Read, Functor, Eq, NFData,+              Foldable, Traversable,+              Data, Typeable)++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)+    {-# 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+      where mv = M.lookup k m+    {-# INLINE at #-}++instance Each (MonoidalHashMap k a) (MonoidalHashMap k b) a b++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+    {-# INLINE itraverse #-}++instance AsEmpty (MonoidalHashMap k a) where+    _Empty = nearly (MM M.empty) (M.null . unpack)+    {-# INLINE _Empty #-}++instance Wrapped (MonoidalHashMap k a) where+    type Unwrapped (MonoidalHashMap k a) = M.HashMap k a+    _Wrapped' = iso unpack pack+    {-# INLINE _Wrapped' #-}++instance (Eq k, Hashable k, Monoid a) => Monoid (MonoidalHashMap k a) where+    mempty = MM mempty+    {-# INLINE mempty #-}+    MM a `mappend` MM b = MM $ M.unionWith mappend a b+    {-# INLINE mappend #-}++instance Newtype (MonoidalHashMap k a) (M.HashMap k a) where+    pack = MM+    {-# INLINE pack #-}+    unpack (MM a) = a+    {-# INLINE unpack #-}++#if MIN_VERSION_base(4,7,0)+instance (Eq k, Hashable k) => IsList (MonoidalHashMap k a) where+    type Item (MonoidalHashMap k a) = (k, a)+    fromList = MM . M.fromList+    {-# INLINE fromList #-}+    toList = M.toList . unpack+    {-# INLINE toList #-}+#endif++-- | /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+{-# INLINE singleton #-}++-- | /O(1)/. The number of elements in the map.+size :: MonoidalHashMap k a -> Int+size = M.size . unpack+{-# INLINE size #-}++-- | /O(log n)/. Is the key a member of the map? See also 'notMember'.+member :: (Eq k, Hashable k) => k -> MonoidalHashMap 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 :: (Eq k, Hashable k) => k -> MonoidalHashMap k a -> Bool+notMember k = not . M.member k . unpack+{-# INLINE notMember #-}++-- | /O(log n)/ Return the value to which the specified key is mapped,+-- or 'Nothing' if this map contains no mapping for the key.+lookup :: (Eq k, Hashable k) => k -> MonoidalHashMap k v -> Maybe v+lookup k = M.lookup k . unpack+{-# INLINE lookup #-}++-- | /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+{-# INLINE delete #-}++-- | /O(n)/.+-- Return all elements of the map in the ascending order of their keys.+-- Subject to list fusion.+elems :: MonoidalHashMap 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 :: MonoidalHashMap k a -> [k]+keys = M.keys . unpack+{-# INLINE keys #-}

+ src/Data/Map/Monoidal.hs view

@@ -0,0 +1,156 @@+{-# 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+    ( MonoidalMap+      -- * Often-needed functions+    , singleton+    , size+    , member+    , notMember+    , findWithDefault+    , 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 as M+import Control.Lens+import Control.Newtype++-- | A 'Map' with monoidal accumulation+newtype MonoidalMap k a = MM (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 (MM m) = case M.lookup k m of+      Just v  -> f v <&> \v' -> MM (M.insert k v' m)+      Nothing -> pure (MM 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+      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 (MM m) = fmap MM $ itraverse f m+    {-# INLINE itraverse #-}++instance Ord k => TraverseMin k (MonoidalMap k) where+    traverseMin f (MM m) = fmap MM $ traverseMin f m+    {-# INLINE traverseMin #-}+instance Ord k => TraverseMax k (MonoidalMap k) where+    traverseMax f (MM m) = fmap MM $ traverseMax f m+    {-# INLINE traverseMax #-}++instance AsEmpty (MonoidalMap k a) where+    _Empty = nearly (MM 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 = MM mempty+    {-# INLINE mempty #-}+    MM a `mappend` MM b = MM $ M.unionWith mappend a b+    {-# INLINE mappend #-}++instance Newtype (MonoidalMap k a) (M.Map k a) where+    pack = MM+    {-# INLINE pack #-}+    unpack (MM a) = a+    {-# INLINE unpack #-}++#if MIN_VERSION_base(4,7,0)+instance Ord k => IsList (MonoidalMap k a) where+    type Item (MonoidalMap k a) = (k, a)+    fromList = MM . M.fromList+    {-# 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 = MM $ 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' MM %~ M.delete k+{-# INLINE delete #-}++-- | /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 #-}