Strict.hs

module Core.Data.Map.Strict
  ( lookupMon
  , insertMon
  , unionMon
  , intersectionMon
  , filterKeys
  , adjustF
  ) where

import Data.Monoid
import Data.Foldable
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

-- | Looks up a value, returns @mempty@ if it isn't found.
lookupMon :: (Ord k, Monoid a) => k -> Map k a -> a
lookupMon key = fold . Map.lookup key

-- | Inserts a value at the given key.
-- If an old value is already present at the key,
-- appends it to the old value.
insertMon :: (Ord k, Monoid a) => k -> a -> Map k a -> Map k a
insertMon = Map.insertWith (<>)

-- | Combines the two maps, appending values which share keys.
unionMon :: (Ord k, Monoid a) => Map k a -> Map k a -> Map k a
unionMon = Map.unionWith (<>)

-- | Intersects the two maps by combining values.
-- Returns a map with all keys both maps share,
-- and the values of each key is the value of the left map
-- appended to the value of the second.
intersectionMon :: (Ord k, Monoid a) => Map k a -> Map k a -> Map k a
intersectionMon = Map.intersectionWith (<>)

-- | Filters a map by its keys --
-- removes key-value pairs whose keys
-- don't satisfy the predicate.
filterKeys :: (k -> Bool) -> Map k a -> Map k a
filterKeys f = Map.filterWithKey $ const . f

-- | Transforms the value with the key if it exists, otherwise does nothing.
adjustF :: (Ord k, Applicative w) => (v -> w v) -> k -> Map k v -> w (Map k v)
adjustF f = Map.alterF $ traverse f