module Util.HierarchicalMap where
import qualified Data.Map as M
import Data.Typeable
import Prelude hiding (lookup)
import Util.Exception
data HierarchicalMap a b =
HierarchicalMap [M.Map a b]
deriving Show
data HierarchicalMapException a =
ValueNotFoundException a
deriving (Show, Typeable)
instance (Ord a, Show a, Typeable a) => Exception (HierarchicalMapException a)
update :: Ord a => HierarchicalMap a b -> a -> b -> HierarchicalMap a b
update (HierarchicalMap (m:ms)) k v =
HierarchicalMap ((M.insert k v m):ms)
update (HierarchicalMap []) _ _ = panic "HierarchicalMap.update: invalid map"
updateMulti :: Ord a => HierarchicalMap a b -> [(a, b)] -> HierarchicalMap a b
updateMulti m bs =
foldl (\ m (a,b) -> update m a b) m bs
lookup :: (Show k, Typeable k, Ord k) => HierarchicalMap k a -> k -> a
lookup hm k = case maybeLookup hm k of
Just v -> v
Nothing -> throwException (ValueNotFoundException k)
maybeLookup :: (Show k, Typeable k, Ord k) => HierarchicalMap k a -> k -> Maybe a
maybeLookup (HierarchicalMap []) _ = Nothing
maybeLookup (HierarchicalMap (m:ms)) k =
case M.lookup k m of
Just v -> Just v
Nothing -> maybeLookup (HierarchicalMap ms) k
maybeLookupInTopLayer :: (Show k, Typeable k, Ord k) => HierarchicalMap k a -> k -> Maybe a
maybeLookupInTopLayer (HierarchicalMap []) _ = Nothing
maybeLookupInTopLayer (HierarchicalMap (m:_)) k = M.lookup k m
popLayer :: Ord a => HierarchicalMap a b -> HierarchicalMap a b
popLayer (HierarchicalMap (_:ms)) = HierarchicalMap ms
popLayer _ = panic "HierarchicalMap.popLayer: invalid map"
flatten :: Ord a => HierarchicalMap a b -> [(a, b)]
flatten (HierarchicalMap ms) = h ms []
where
h [] _ = []
h (m:ms) ks = l++(h ms ks')
where
l = [(k, v) | (k, v) <- M.toList m, not (k `elem` ks)]
ks' = Prelude.map fst l++ks
newLayer :: Ord a => HierarchicalMap a b -> HierarchicalMap a b
newLayer (HierarchicalMap ms) = HierarchicalMap (M.empty : ms)
newLayerAndBind :: Ord a => HierarchicalMap a b -> [(a, b)] -> HierarchicalMap a b
newLayerAndBind (HierarchicalMap ms) bs =
HierarchicalMap (M.fromList bs : ms)
newRecursiveLayerAndBind :: Ord a =>
HierarchicalMap a b -> [HierarchicalMap a b -> (a, b)] -> HierarchicalMap a b
newRecursiveLayerAndBind map bs = newMap
where
bs' = [f newMap | f <- bs]
newMap = newLayerAndBind map bs'
new :: Ord a => HierarchicalMap a b
new = HierarchicalMap [M.empty]
map :: Ord k => (k -> a -> b) -> HierarchicalMap k a -> HierarchicalMap k b
map func (HierarchicalMap ms) =
HierarchicalMap $ Prelude.map (M.mapWithKey func) ms