{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
module Relude.Extra.Map
( StaticMap (..)
, DynamicMap (..)
, (!?)
, notMember
, lookupDefault
, toPairs
, keys
, elems
) where
import GHC.Exts (IsList (Item, toList))
import Relude.Base (Eq, Ord, Type)
import Relude.Bool (Bool, guard, not)
import Relude.Container.Reexport (HashMap, HashSet, Hashable, IntMap, IntSet, Map, Set, fst, snd)
import Relude.Function ((.))
import Relude.Functor.Reexport (($>))
import Relude.List (map)
import Relude.Monad.Reexport (Maybe (..), fromMaybe)
import Relude.Numeric (Int)
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import qualified Data.Set as S
class StaticMap t where
type Key t :: Type
type Val t :: Type
size :: t -> Int
lookup :: Key t -> t -> Maybe (Val t)
member :: Key t -> t -> Bool
instance Ord k => StaticMap (Map k v) where
type Key (Map k v) = k
type Val (Map k v) = v
size = M.size
{-# INLINE size #-}
lookup = M.lookup
{-# INLINE lookup #-}
member = M.member
{-# INLINE member #-}
instance (Eq k, Hashable k) => StaticMap (HashMap k v) where
type Key (HashMap k v) = k
type Val (HashMap k v) = v
size = HM.size
{-# INLINE size #-}
lookup = HM.lookup
{-# INLINE lookup #-}
member = HM.member
{-# INLINE member #-}
instance StaticMap (IntMap v) where
type Key (IntMap v) = Int
type Val (IntMap v) = v
size = IM.size
{-# INLINE size #-}
lookup = IM.lookup
{-# INLINE lookup #-}
member = IM.member
{-# INLINE member #-}
instance Ord a => StaticMap (Set a) where
type Key (Set a) = a
type Val (Set a) = a
size = S.size
{-# INLINE size #-}
member = S.member
{-# INLINE member #-}
lookup k m = guard (member k m) $> k
{-# INLINE lookup #-}
instance (Eq a, Hashable a) => StaticMap (HashSet a) where
type Key (HashSet a) = a
type Val (HashSet a) = a
size = HS.size
{-# INLINE size #-}
member = HS.member
{-# INLINE member #-}
lookup k m = guard (member k m) $> k
{-# INLINE lookup #-}
instance StaticMap IntSet where
type Key IntSet = Int
type Val IntSet = Int
size = IS.size
{-# INLINE size #-}
member = IS.member
{-# INLINE member #-}
lookup k m = guard (member k m) $> k
{-# INLINE lookup #-}
infixl 9 !?
(!?) :: StaticMap t => t -> Key t -> Maybe (Val t)
(!?) m k = lookup k m
{-# INLINE (!?) #-}
notMember :: StaticMap t => Key t -> t -> Bool
notMember k = not . member k
{-# INLINE notMember #-}
lookupDefault :: StaticMap t
=> Val t
-> Key t
-> t
-> Val t
lookupDefault def k = fromMaybe def . lookup k
{-# INLINE lookupDefault #-}
class StaticMap t => DynamicMap t where
insert :: Key t -> Val t -> t -> t
insertWith :: (Val t -> Val t -> Val t) -> Key t -> Val t -> t -> t
delete :: Key t -> t -> t
alter :: (Maybe (Val t) -> Maybe (Val t)) -> Key t -> t -> t
instance Ord k => DynamicMap (Map k v) where
insert = M.insert
{-# INLINE insert #-}
insertWith = M.insertWith
{-# INLINE insertWith #-}
delete = M.delete
{-# INLINE delete #-}
alter = M.alter
{-# INLINE alter #-}
instance (Eq k, Hashable k) => DynamicMap (HashMap k v) where
insert = HM.insert
{-# INLINE insert #-}
insertWith = HM.insertWith
{-# INLINE insertWith #-}
delete = HM.delete
{-# INLINE delete #-}
alter = HM.alter
{-# INLINE alter #-}
instance DynamicMap (IntMap v) where
insert = IM.insert
{-# INLINE insert #-}
insertWith = IM.insertWith
{-# INLINE insertWith #-}
delete = IM.delete
{-# INLINE delete #-}
alter = IM.alter
{-# INLINE alter #-}
toPairs :: (IsList t, Item t ~ (a, b)) => t -> [(a, b)]
toPairs = toList
keys :: (IsList t, Item t ~ (a, b)) => t -> [a]
keys = map fst . toList
elems :: (IsList t, Item t ~ (a, b)) => t -> [b]
elems = map snd . toList