module Data.HashMap.Monoidal
( MonoidalHashMap
, toList
, fromList
, singleton
, size
, member
, notMember
, lookup
, lookupM
, elems
, keys
, delete
, mapKeys
, modify
, modifyDef
, map
, filterWithKey
) where
import Prelude hiding (lookup, map)
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Foldable (Foldable)
import Control.Applicative (pure)
import Data.Data (Data)
import Data.Typeable (Typeable)
#if MIN_VERSION_base(4,7,0)
import qualified GHC.Exts as Exts
#endif
import Control.DeepSeq
import qualified Data.HashMap.Strict as M
import Data.Hashable (Hashable)
import Control.Lens
import Control.Newtype
newtype MonoidalHashMap k a = MonoidalHashMap { getMonoidalHashMap :: 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 (MonoidalHashMap m) = case M.lookup k m of
Just v -> f v <&> \v' -> MonoidalHashMap (M.insert k v' m)
Nothing -> pure (MonoidalHashMap m)
instance (Eq k, Hashable k) => At (MonoidalHashMap k a) where
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
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 (MonoidalHashMap m) = fmap MonoidalHashMap $ itraverse f m
instance AsEmpty (MonoidalHashMap k a) where
_Empty = nearly (MonoidalHashMap M.empty) (M.null . unpack)
instance Wrapped (MonoidalHashMap k a) where
type Unwrapped (MonoidalHashMap k a) = M.HashMap k a
_Wrapped' = iso unpack pack
instance (Eq k, Hashable k, Monoid a) => Monoid (MonoidalHashMap k a) where
mempty = MonoidalHashMap mempty
MonoidalHashMap a `mappend` MonoidalHashMap b = MonoidalHashMap $ M.unionWith mappend a b
instance Newtype (MonoidalHashMap k a) (M.HashMap k a) where
pack = MonoidalHashMap
unpack (MonoidalHashMap a) = a
#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 = MonoidalHashMap . M.fromListWith mappend
toList = M.toList . unpack
#endif
singleton :: (Eq k, Hashable k) => k -> a -> MonoidalHashMap k a
singleton k a = MonoidalHashMap $ M.singleton k a
size :: MonoidalHashMap k a -> Int
size = M.size . unpack
member :: (Eq k, Hashable k) => k -> MonoidalHashMap k a -> Bool
member k = M.member k . unpack
notMember :: (Eq k, Hashable k) => k -> MonoidalHashMap k a -> Bool
notMember k = not . M.member k . unpack
lookup :: (Eq k, Hashable k) => k -> MonoidalHashMap k v -> Maybe v
lookup k = M.lookup k . unpack
lookupM :: (Eq k, Hashable k, Monoid v) => k -> MonoidalHashMap k v -> v
lookupM k = fromMaybe mempty . M.lookup k . unpack
delete :: (Eq k, Hashable k) => k -> MonoidalHashMap k a -> MonoidalHashMap k a
delete k = _Wrapping' MonoidalHashMap %~ M.delete k
elems :: MonoidalHashMap k a -> [a]
elems = M.elems . unpack
keys :: MonoidalHashMap k a -> [k]
keys = M.keys . unpack
fromList :: (Eq k, Hashable k, Monoid a) => [(k,a)] -> MonoidalHashMap k a
fromList = pack . M.fromListWith mappend
toList :: MonoidalHashMap k a -> [(k,a)]
toList = M.toList . unpack
modify :: (Monoid a, Hashable k, Eq k)
=> (a -> a)
-> k -> MonoidalHashMap k a
-> MonoidalHashMap k a
modify f k = pack
. M.insertWith (\_ old -> f old) k (f mempty)
. unpack
modifyDef :: (Monoid a, Hashable k, Eq k)
=> a -> (a -> a)
-> k -> MonoidalHashMap k a
-> MonoidalHashMap k a
modifyDef d f k = pack
. M.insertWith (\_ old -> f old) k d
. unpack
mapKeys :: (Monoid a, Hashable k, Eq k, Hashable k', Eq k')
=> (k -> k') -> MonoidalHashMap k a -> MonoidalHashMap k' a
mapKeys f = fromList
. fmap (\(k, v) -> (f k, v))
. toList
filterWithKey :: (k -> v -> Bool) -> MonoidalHashMap k v -> MonoidalHashMap k v
filterWithKey pred = pack . M.filterWithKey pred . unpack
map :: (v1 -> v2) -> MonoidalHashMap k v1 -> MonoidalHashMap k v2
map f = pack . M.map f . unpack