-- |
-- A newtyped version of "Data.Map.Strict" with a 'Monoid' instance providing @'mappend' = 'M.unionWith' 'mappend'@.
{-# 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

-- |A specialized version of 'M.Map'.
newtype MonoidMap k a = MonoidMap { MonoidMap k a -> Map k a
monoidMap :: M.Map k a }
  deriving (MonoidMap k a -> MonoidMap k a -> Bool
(MonoidMap k a -> MonoidMap k a -> Bool)
-> (MonoidMap k a -> MonoidMap k a -> Bool) -> Eq (MonoidMap k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. (Eq k, Eq a) => MonoidMap k a -> MonoidMap k a -> Bool
/= :: MonoidMap k a -> MonoidMap k a -> Bool
$c/= :: forall k a. (Eq k, Eq a) => MonoidMap k a -> MonoidMap k a -> Bool
== :: MonoidMap k a -> MonoidMap k a -> Bool
$c== :: forall k a. (Eq k, Eq a) => MonoidMap k a -> MonoidMap k a -> Bool
Eq, a -> MonoidMap k a -> Bool
MonoidMap k m -> m
MonoidMap k a -> [a]
MonoidMap k a -> Bool
MonoidMap k a -> Int
MonoidMap k a -> a
MonoidMap k a -> a
MonoidMap k a -> a
MonoidMap k a -> a
(a -> m) -> MonoidMap k a -> m
(a -> m) -> MonoidMap k a -> m
(a -> b -> b) -> b -> MonoidMap k a -> b
(a -> b -> b) -> b -> MonoidMap k a -> b
(b -> a -> b) -> b -> MonoidMap k a -> b
(b -> a -> b) -> b -> MonoidMap k a -> b
(a -> a -> a) -> MonoidMap k a -> a
(a -> a -> a) -> MonoidMap k a -> a
(forall m. Monoid m => MonoidMap k m -> m)
-> (forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m)
-> (forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m)
-> (forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b)
-> (forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b)
-> (forall a. (a -> a -> a) -> MonoidMap k a -> a)
-> (forall a. (a -> a -> a) -> MonoidMap k a -> a)
-> (forall a. MonoidMap k a -> [a])
-> (forall a. MonoidMap k a -> Bool)
-> (forall a. MonoidMap k a -> Int)
-> (forall a. Eq a => a -> MonoidMap k a -> Bool)
-> (forall a. Ord a => MonoidMap k a -> a)
-> (forall a. Ord a => MonoidMap k a -> a)
-> (forall a. Num a => MonoidMap k a -> a)
-> (forall a. Num a => MonoidMap k a -> a)
-> Foldable (MonoidMap k)
forall a. Eq a => a -> MonoidMap k a -> Bool
forall a. Num a => MonoidMap k a -> a
forall a. Ord a => MonoidMap k a -> a
forall m. Monoid m => MonoidMap k m -> m
forall a. MonoidMap k a -> Bool
forall a. MonoidMap k a -> Int
forall a. MonoidMap k a -> [a]
forall a. (a -> a -> a) -> MonoidMap k a -> a
forall k a. Eq a => a -> MonoidMap k a -> Bool
forall k a. Num a => MonoidMap k a -> a
forall k a. Ord a => MonoidMap k a -> a
forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m
forall k m. Monoid m => MonoidMap k m -> m
forall k a. MonoidMap k a -> Bool
forall k a. MonoidMap k a -> Int
forall k a. MonoidMap k a -> [a]
forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b
forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b
forall k a. (a -> a -> a) -> MonoidMap k a -> a
forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: MonoidMap k a -> a
$cproduct :: forall k a. Num a => MonoidMap k a -> a
sum :: MonoidMap k a -> a
$csum :: forall k a. Num a => MonoidMap k a -> a
minimum :: MonoidMap k a -> a
$cminimum :: forall k a. Ord a => MonoidMap k a -> a
maximum :: MonoidMap k a -> a
$cmaximum :: forall k a. Ord a => MonoidMap k a -> a
elem :: a -> MonoidMap k a -> Bool
$celem :: forall k a. Eq a => a -> MonoidMap k a -> Bool
length :: MonoidMap k a -> Int
$clength :: forall k a. MonoidMap k a -> Int
null :: MonoidMap k a -> Bool
$cnull :: forall k a. MonoidMap k a -> Bool
toList :: MonoidMap k a -> [a]
$ctoList :: forall k a. MonoidMap k a -> [a]
foldl1 :: (a -> a -> a) -> MonoidMap k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> MonoidMap k a -> a
foldr1 :: (a -> a -> a) -> MonoidMap k a -> a
$cfoldr1 :: forall k a. (a -> a -> a) -> MonoidMap k a -> a
foldl' :: (b -> a -> b) -> b -> MonoidMap k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
foldl :: (b -> a -> b) -> b -> MonoidMap k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
foldr' :: (a -> b -> b) -> b -> MonoidMap k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
foldr :: (a -> b -> b) -> b -> MonoidMap k a -> b
$cfoldr :: forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
foldMap' :: (a -> m) -> MonoidMap k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
foldMap :: (a -> m) -> MonoidMap k a -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
fold :: MonoidMap k m -> m
$cfold :: forall k m. Monoid m => MonoidMap k m -> m
Foldable, Int -> MonoidMap k a -> ShowS
[MonoidMap k a] -> ShowS
MonoidMap k a -> String
(Int -> MonoidMap k a -> ShowS)
-> (MonoidMap k a -> String)
-> ([MonoidMap k a] -> ShowS)
-> Show (MonoidMap k a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show k, Show a) => Int -> MonoidMap k a -> ShowS
forall k a. (Show k, Show a) => [MonoidMap k a] -> ShowS
forall k a. (Show k, Show a) => MonoidMap k a -> String
showList :: [MonoidMap k a] -> ShowS
$cshowList :: forall k a. (Show k, Show a) => [MonoidMap k a] -> ShowS
show :: MonoidMap k a -> String
$cshow :: forall k a. (Show k, Show a) => MonoidMap k a -> String
showsPrec :: Int -> MonoidMap k a -> ShowS
$cshowsPrec :: forall k a. (Show k, Show a) => Int -> MonoidMap k a -> ShowS
Show)

instance (Ord k, Semigroup a) => Semigroup (MonoidMap k a) where
  MonoidMap Map k a
a <> :: MonoidMap k a -> MonoidMap k a -> MonoidMap k a
<> MonoidMap Map k a
b = Map k a -> MonoidMap k a
forall k a. Map k a -> MonoidMap k a
MonoidMap (Map k a -> MonoidMap k a) -> Map k a -> MonoidMap k a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) Map k a
a Map k a
b

-- |'mappend' is equivalent to @'M.unionWith' 'mappend'@.
instance (Ord k, Monoid a) => Monoid (MonoidMap k a) where
  mempty :: MonoidMap k a
mempty = Map k a -> MonoidMap k a
forall k a. Map k a -> MonoidMap k a
MonoidMap Map k a
forall k a. Map k a
M.empty
  mappend :: MonoidMap k a -> MonoidMap k a -> MonoidMap k a
mappend (MonoidMap Map k a
a) (MonoidMap Map k a
b) = Map k a -> MonoidMap k a
forall k a. Map k a -> MonoidMap k a
MonoidMap (Map k a -> MonoidMap k a) -> Map k a -> MonoidMap k a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend Map k a
a Map k a
b
  mconcat :: [MonoidMap k a] -> MonoidMap k a
mconcat = Map k a -> MonoidMap k a
forall k a. Map k a -> MonoidMap k a
MonoidMap (Map k a -> MonoidMap k a)
-> ([MonoidMap k a] -> Map k a) -> [MonoidMap k a] -> MonoidMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [Map k a] -> Map k a
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend ([Map k a] -> Map k a)
-> ([MonoidMap k a] -> [Map k a]) -> [MonoidMap k a] -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MonoidMap k a -> Map k a) -> [MonoidMap k a] -> [Map k a]
forall a b. (a -> b) -> [a] -> [b]
map MonoidMap k a -> Map k a
forall k a. MonoidMap k a -> Map k a
monoidMap

instance Functor (MonoidMap k) where
  fmap :: (a -> b) -> MonoidMap k a -> MonoidMap k b
fmap a -> b
f (MonoidMap Map k a
m) = Map k b -> MonoidMap k b
forall k a. Map k a -> MonoidMap k a
MonoidMap (Map k b -> MonoidMap k b) -> Map k b -> MonoidMap k b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Map k a -> Map k b
forall a b k. (a -> b) -> Map k a -> Map k b
M.map a -> b
f Map k a
m

-- |Insert a new key and value in the map. If the key is already present in the map, the associated value is combined with the supplied value. Equivalent to @'M.insertWith' 'mappend'@.
insertMonoid :: (Ord k, Monoid a) => k -> a -> MonoidMap k a -> MonoidMap k a
insertMonoid :: k -> a -> MonoidMap k a -> MonoidMap k a
insertMonoid k
k a
a (MonoidMap Map k a
m) = Map k a -> MonoidMap k a
forall k a. Map k a -> MonoidMap k a
MonoidMap (Map k a -> MonoidMap k a) -> Map k a -> MonoidMap k a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend k
k a
a Map k a
m

-- |Build a map from a list of key/value pairs. If the list contains more than one value for the same key, the values are combined. Equivalent to @'M.fromListWith' 'mappend'@.
fromMonoidList :: (Ord k, Monoid a) => [(k, a)] -> MonoidMap k a
fromMonoidList :: [(k, a)] -> MonoidMap k a
fromMonoidList = Map k a -> MonoidMap k a
forall k a. Map k a -> MonoidMap k a
MonoidMap (Map k a -> MonoidMap k a)
-> ([(k, a)] -> Map k a) -> [(k, a)] -> MonoidMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [(k, a)] -> Map k a
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend

-- |Lookup the value at a key in the map, returning 'mempty' if the key isn't in the map.
lookupMonoid :: (Ord k, Monoid a) => k -> MonoidMap k a -> a
lookupMonoid :: k -> MonoidMap k a -> a
lookupMonoid k
k (MonoidMap Map k a
m) = Maybe a -> a
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k a
m