module Data.HashMap.Monoidal
( MonoidalHashMap
, singleton
, size
, member
, notMember
, lookup
, lookupM
, elems
, keys
, delete
, mapKeys
, modify
, modifyDef
) where
import Prelude hiding (lookup)
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 GHC.Exts (IsList(..))
#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 = 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)
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
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
instance AsEmpty (MonoidalHashMap k a) where
_Empty = nearly (MM 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 = MM mempty
MM a `mappend` MM b = MM $ M.unionWith mappend a b
instance Newtype (MonoidalHashMap k a) (M.HashMap k a) where
pack = MM
unpack (MM a) = a
#if MIN_VERSION_base(4,7,0)
instance (Eq k, Hashable k, Monoid a) => IsList (MonoidalHashMap k a) where
type Item (MonoidalHashMap k a) = (k, a)
fromList = MM . M.fromListWith mappend
toList = M.toList . unpack
#endif
singleton :: (Eq k, Hashable k) => k -> a -> MonoidalHashMap k a
singleton k a = MM $ 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' MM %~ M.delete k
elems :: MonoidalHashMap k a -> [a]
elems = M.elems . unpack
keys :: MonoidalHashMap k a -> [k]
keys = M.keys . 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
. map (\(k, v) -> (f k, v))
. toList