{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Web.Route.Invertible.Map.MonoidHash
( MonoidHashMap(..)
, insertMonoidHash
, fromMonoidHashList
, lookupMonoidHash
) where
import Prelude hiding (lookup)
import Data.Foldable (fold)
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as M
newtype MonoidHashMap k a = MonoidHashMap { monoidHashMap :: M.HashMap k a }
deriving (Eq, Foldable, Show)
instance (Eq k, Hashable k, Monoid a) => Monoid (MonoidHashMap k a) where
mempty = MonoidHashMap M.empty
mappend (MonoidHashMap a) (MonoidHashMap b) = MonoidHashMap $ M.unionWith mappend a b
instance Functor (MonoidHashMap k) where
fmap f (MonoidHashMap m) = MonoidHashMap $ M.map f m
insertMonoidHash :: (Eq k, Hashable k, Monoid a) => k -> a -> MonoidHashMap k a -> MonoidHashMap k a
insertMonoidHash k a (MonoidHashMap m) = MonoidHashMap $ M.insertWith mappend k a m
fromMonoidHashList :: (Eq k, Hashable k, Monoid a) => [(k, a)] -> MonoidHashMap k a
fromMonoidHashList = MonoidHashMap . M.fromListWith mappend
lookupMonoidHash :: (Eq k, Hashable k, Monoid a) => k -> MonoidHashMap k a -> a
lookupMonoidHash k (MonoidHashMap m) = fold $ M.lookup k m