module Data.Map.Monoidal.Strict
( MonoidalMap(..)
, singleton
, size
, member
, notMember
, findWithDefault
, assocs
, 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.Strict as M
import Control.Lens
import Control.Newtype
newtype MonoidalMap k a = MonoidalMap { getMonoidalMap :: 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 (MonoidalMap m) = case M.lookup k m of
Just v -> f v <&> \v' -> MonoidalMap (M.insert k v' m)
Nothing -> pure (MonoidalMap m)
instance Ord k => At (MonoidalMap k a) where
at k f (MonoidalMap m) = f mv <&> \r -> case r of
Nothing -> maybe (MonoidalMap m) (const (MonoidalMap $ M.delete k m)) mv
Just v' -> MonoidalMap $ 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 (MonoidalMap m) = fmap MonoidalMap $ itraverse f m
instance Ord k => TraverseMin k (MonoidalMap k) where
traverseMin f (MonoidalMap m) = fmap MonoidalMap $ traverseMin f m
instance Ord k => TraverseMax k (MonoidalMap k) where
traverseMax f (MonoidalMap m) = fmap MonoidalMap $ traverseMax f m
instance AsEmpty (MonoidalMap k a) where
_Empty = nearly (MonoidalMap 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 = MonoidalMap mempty
MonoidalMap a `mappend` MonoidalMap b = MonoidalMap $ M.unionWith mappend a b
instance Newtype (MonoidalMap k a) (M.Map k a) where
pack = MonoidalMap
unpack (MonoidalMap a) = a
#if MIN_VERSION_base(4,7,0)
instance (Ord k, Monoid a) => IsList (MonoidalMap k a) where
type Item (MonoidalMap k a) = (k, a)
fromList = MonoidalMap . M.fromListWith mappend
toList = M.toList . unpack
#endif
singleton :: Ord k => k -> a -> MonoidalMap k a
singleton k a = MonoidalMap $ 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' MonoidalMap %~ M.delete k
assocs :: MonoidalMap k a -> [(k,a)]
assocs = M.assocs . unpack
elems :: MonoidalMap k a -> [a]
elems = M.elems . unpack
keys :: MonoidalMap k a -> [k]
keys = M.keys . unpack