module Data.Map.Monoidal
( MonoidalMap
, singleton
, size
, member
, notMember
, findWithDefault
, elems
, keys
) where
import Data.Monoid
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
import Control.Applicative (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.Map as M
import Control.Lens
import Control.Newtype
newtype MonoidalMap k a = MM (M.Map k a)
deriving (Show, Read, Functor, Eq, Ord, NFData,
Foldable, Traversable,
Data, Typeable)
type instance Index (MonoidalMap k a) = k
type instance IxValue (MonoidalMap k a) = a
instance Ord k => Ixed (MonoidalMap 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 Ord k => At (MonoidalMap 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 (MonoidalMap k a) (MonoidalMap k b) a b
instance Ord k => FunctorWithIndex k (MonoidalMap k)
instance Ord k => FoldableWithIndex k (MonoidalMap k)
instance Ord k => TraversableWithIndex k (MonoidalMap k) where
itraverse f (MM m) = fmap MM $ itraverse f m
instance Ord k => TraverseMin k (MonoidalMap k) where
traverseMin f (MM m) = fmap MM $ traverseMin f m
instance Ord k => TraverseMax k (MonoidalMap k) where
traverseMax f (MM m) = fmap MM $ traverseMax f m
instance AsEmpty (MonoidalMap k a) where
_Empty = nearly (MM M.empty) (M.null . unpack)
instance Wrapped (MonoidalMap k a) where
type Unwrapped (MonoidalMap k a) = M.Map k a
_Wrapped' = iso unpack pack
instance (Ord k, Monoid a) => Monoid (MonoidalMap k a) where
mempty = MM mempty
MM a `mappend` MM b = MM $ M.unionWith mappend a b
instance Newtype (MonoidalMap k a) (M.Map k a) where
pack = MM
unpack (MM a) = a
#if MIN_VERSION_base(4,7,0)
instance Ord k => IsList (MonoidalMap k a) where
type Item (MonoidalMap k a) = (k, a)
fromList = MM . M.fromList
toList = M.toList . unpack
#endif
singleton :: Ord k => k -> a -> MonoidalMap k a
singleton k a = MM $ M.singleton k a
size :: MonoidalMap k a -> Int
size = M.size . unpack
member :: Ord k => k -> MonoidalMap k a -> Bool
member k = M.member k . unpack
notMember :: Ord k => k -> MonoidalMap k a -> Bool
notMember k = not . M.member k . unpack
findWithDefault :: Ord k => a -> k -> MonoidalMap k a -> a
findWithDefault def k = M.findWithDefault def k . unpack
delete :: Ord k => k -> MonoidalMap k a -> MonoidalMap k a
delete k = _Wrapping' MM %~ M.delete k
elems :: MonoidalMap k a -> [a]
elems = M.elems . unpack
keys :: MonoidalMap k a -> [k]
keys = M.keys . unpack