module Control.Wire.TimedMap
(
TimedMap(..),
tmEmpty,
tmFindWithDefault,
tmLookup,
tmInsert,
tmLimitAge,
tmLimitSize
)
where
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Map (Map)
import Data.Set (Set)
data TimedMap t k a =
TimedMap {
tmMap :: Map k (a, t),
tmTimes :: Map t (Set k)
}
deriving Show
tmFindWithDefault ::
Ord k
=> a
-> k
-> TimedMap t k a
-> a
tmFindWithDefault x0 k = M.findWithDefault x0 k . fmap fst . tmMap
tmEmpty :: TimedMap t k a
tmEmpty = TimedMap M.empty M.empty
tmInsert ::
(Ord k, Ord t)
=> t
-> k
-> a
-> TimedMap t k a
-> TimedMap t k a
tmInsert t k x (TimedMap xs' ts'') =
TimedMap xs ts
where
xs = M.insert k (x, t) xs'
ts = M.insertWith S.union t (S.singleton k) ts'
ts' =
case M.lookup k xs' of
Nothing -> ts''
Just (_, t') ->
M.update (\s' -> let s = S.delete k s' in
if S.null s then Nothing else Just s)
t' ts''
tmLimitAge :: (Ord t, Ord k) => t -> TimedMap t k a -> TimedMap t k a
tmLimitAge minT (TimedMap xs' ts') = TimedMap xs ts
where
xs = xs' M.\\ delMap
ts = maybe id (M.insert minT) tsCur tsYounger
(tsOlder, tsCur, tsYounger) = M.splitLookup minT ts'
delMap =
M.fromDistinctAscList . map (, ()) .
S.toAscList . S.unions . M.elems $ tsOlder
tmLimitSize :: Ord k => Int -> TimedMap t k a -> TimedMap t k a
tmLimitSize n tm@(TimedMap xs ts') =
if n >= 0 && M.size xs > n
then tmLimitSize n $ TimedMap (xs M.\\ delMap) ts
else tm
where
delMap = M.fromDistinctAscList . map (, ()) . S.toAscList $ delKeys
((_, delKeys), ts) = M.deleteFindMin ts'
tmLookup :: Ord k => k -> TimedMap t k a -> Maybe a
tmLookup k (TimedMap xs _) = fmap fst (M.lookup k xs)