{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Web.Route.Invertible.Map.Monoid
( MonoidMap(..)
, insertMonoid
, fromMonoidList
, lookupMonoid
) where
import Prelude hiding (lookup)
import Data.Foldable (fold)
import qualified Data.Map.Strict as M
newtype MonoidMap k a = MonoidMap { monoidMap :: M.Map k a }
deriving (Eq, Foldable, Show)
instance (Ord k, Monoid a) => Monoid (MonoidMap k a) where
mempty = MonoidMap M.empty
mappend (MonoidMap a) (MonoidMap b) = MonoidMap $ M.unionWith mappend a b
mconcat = MonoidMap . M.unionsWith mappend . map monoidMap
instance Functor (MonoidMap k) where
fmap f (MonoidMap m) = MonoidMap $ M.map f m
insertMonoid :: (Ord k, Monoid a) => k -> a -> MonoidMap k a -> MonoidMap k a
insertMonoid k a (MonoidMap m) = MonoidMap $ M.insertWith mappend k a m
fromMonoidList :: (Ord k, Monoid a) => [(k, a)] -> MonoidMap k a
fromMonoidList = MonoidMap . M.fromListWith mappend
lookupMonoid :: (Ord k, Monoid a) => k -> MonoidMap k a -> a
lookupMonoid k (MonoidMap m) = fold $ M.lookup k m