packages feed

expiring-containers 0.2 → 0.2.1

raw patch · 4 files changed

+72/−60 lines, 4 files

Files

expiring-containers.cabal view
@@ -1,7 +1,7 @@ name:   expiring-containers version:-  0.2+  0.2.1 synopsis:   Expiring containers category:
library/ExpiringContainers/ExpiringMap.hs view
@@ -25,14 +25,14 @@ ) where -import qualified ExpiringContainers.ExpiringSet as A-import qualified Data.HashMap.Strict as B+import qualified ExpiringContainers.ExpiringSet as ExpiringSet+import qualified Data.HashMap.Strict as HashMap import Data.Time import Data.Maybe import Prelude hiding (lookup, null, map) import Data.Hashable-import qualified Data.Foldable as D-import qualified Data.List as C+import qualified Data.Foldable as Foldable+import qualified Data.List as List import qualified GHC.Exts as G  {-|@@ -40,8 +40,8 @@ -} data ExpiringMap key value =   ExpiringMap-    (A.ExpiringSet key)-    (B.HashMap key value)+    (ExpiringSet.ExpiringSet key)+    (HashMap.HashMap key value)     deriving (Eq, Foldable, Show)  {--------------------------------------------------------------------@@ -53,7 +53,7 @@  mapWithKey :: (k -> v1 -> v2) -> ExpiringMap k v1 -> ExpiringMap k v2 mapWithKey f (ExpiringMap expiringSet hashMap) =-  ExpiringMap expiringSet $ B.mapWithKey f hashMap+  ExpiringMap expiringSet $ HashMap.mapWithKey f hashMap  {--------------------------------------------------------------------   Lists@@ -65,54 +65,54 @@  toList :: (Eq k, Hashable k) => ExpiringMap k v -> [(UTCTime, k, v)] toList (ExpiringMap expiringSet hashMap) =-  fmap (\(time, key) -> (time, key, hashMap B.! key)) $ A.toList expiringSet+  fmap (\(time, key) -> (time, key, hashMap HashMap.! key)) $ ExpiringSet.toList expiringSet  fromList :: (Eq k, Hashable k) =>      [(UTCTime, k, v)] -> ExpiringMap k v fromList list = ExpiringMap expSet hashMap   where-    (expSetList, hashMapList) = D.foldl' (\(xs, ys) (t,k,v) -> ((t,k) : xs, (k,v) : ys)) ([], []) list-    expSet = A.fromList expSetList-    hashMap = B.fromList hashMapList+    (expSetList, hashMapList) = Foldable.foldl' (\(xs, ys) (t,k,v) -> ((t,k) : xs, (k,v) : ys)) ([], []) list+    expSet = ExpiringSet.fromList expSetList+    hashMap = HashMap.fromList hashMapList  {--------------------------------------------------------------------   Construction --------------------------------------------------------------------} empty :: (Eq k, Hashable k) => ExpiringMap k v-empty = ExpiringMap A.empty B.empty+empty = ExpiringMap ExpiringSet.empty HashMap.empty  singleton :: (Eq k, Hashable k) => UTCTime -> k -> v -> ExpiringMap k v-singleton time k v = ExpiringMap (A.singleton time k) (B.singleton k v)+singleton time k v = ExpiringMap (ExpiringSet.singleton time k) (HashMap.singleton k v) {-# INLINABLE singleton #-}  {--------------------------------------------------------------------   Basic interface --------------------------------------------------------------------} null :: ExpiringMap k v -> Bool-null (ExpiringMap _ hashMap) = B.null hashMap+null (ExpiringMap _ hashMap) = HashMap.null hashMap {-# INLINE null #-}  size :: ExpiringMap k v -> Int-size (ExpiringMap _ hashMap) = B.size hashMap+size (ExpiringMap _ hashMap) = HashMap.size hashMap  member :: (Eq k, Hashable k) => k -> ExpiringMap k v -> Bool-member key (ExpiringMap _ hashMap) = B.member key hashMap+member key (ExpiringMap _ hashMap) = HashMap.member key hashMap  insert :: (Eq k,  Hashable k) => UTCTime {-^ Expiry time -} -> k -> v -> ExpiringMap k v -> ExpiringMap k v insert time key value (ExpiringMap expSet hashMap) =-  ExpiringMap (A.insert time key expSet) (B.insert key value hashMap)+  ExpiringMap (ExpiringSet.insert time key expSet) (HashMap.insert key value hashMap)  delete :: (Eq k, Hashable k) => k -> ExpiringMap k v -> ExpiringMap k v delete key (ExpiringMap expSet hashMap) =-  ExpiringMap (A.delete key expSet) (B.delete key hashMap)+  ExpiringMap (ExpiringSet.delete key expSet) (HashMap.delete key hashMap)  lookup :: (Eq k, Hashable k) => k -> ExpiringMap k v -> Maybe v lookup key (ExpiringMap expSet hashMap) =-  B.lookup key hashMap+  HashMap.lookup key hashMap  setCurrentTime :: (Eq k, Hashable k) => UTCTime -> ExpiringMap k v -> ExpiringMap k v setCurrentTime time (ExpiringMap expSet hashMap) =   ExpiringMap newExpSet newHashMap     where-      (keys, newExpSet) = A.clean time expSet-      newHashMap = C.foldl' (flip B.delete) hashMap keys+      (keys, newExpSet) = ExpiringSet.clean time expSet+      newHashMap = List.foldl' (flip HashMap.delete) hashMap keys
library/ExpiringContainers/ExpiringSet.hs view
@@ -20,20 +20,20 @@   member,   memberTime,   size,+  lookup,    -- * Filter   clean, ) where -import qualified Data.HashMap.Strict as A-import qualified IntMultimap as B-import qualified Data.HashSet as C-import qualified Data.Foldable as D+import qualified Data.HashMap.Strict as HashMap+import qualified IntMultimap as IntMap+import qualified Data.Foldable as Foldable import qualified GHC.Exts as G import Data.Time import Data.Int-import Prelude hiding(map, null)+import Prelude hiding(map, null, lookup) import GHC.Generics import Timestamp import Data.Hashable@@ -45,9 +45,9 @@ data ExpiringSet element =   ExpiringSet     {-| Elements indexed by timestamps -}-    (B.IntMultimap element)+    (IntMap.IntMultimap element)     {-| Timestamps indexed by elements -}-    (A.HashMap element Int)+    (HashMap.HashMap element Int)     deriving(Eq, Show, Generic)  @@ -56,24 +56,24 @@   Transformations --------------------------------------------------------------------} map :: (Eq b, Hashable b) => (a -> b) -> ExpiringSet a -> ExpiringSet b-map f (ExpiringSet intMultimap hashMap) = uncurry ExpiringSet $ B.foldlWithKey' step (B.empty, A.empty) intMultimap where+map f (ExpiringSet intMultimap hashMap) = uncurry ExpiringSet $ IntMap.foldlWithKey' step (IntMap.empty, HashMap.empty) intMultimap where   step stamp (!intMultimap', !hashMap') x-    | Just v <- A.lookup y hashMap' = (B.insert stamp y $ B.delete v y intMultimap', A.insert y stamp hashMap')-    | otherwise = (B.insert stamp y intMultimap', A.insert y stamp hashMap')+    | Just v <- HashMap.lookup y hashMap' = (IntMap.insert stamp y $ IntMap.delete v y intMultimap', HashMap.insert y stamp hashMap')+    | otherwise = (IntMap.insert stamp y intMultimap', HashMap.insert y stamp hashMap')     where y = f x {-# INLINE map #-} -construct :: (Eq k, Hashable k) => A.HashMap k Int -> ExpiringSet k+construct :: (Eq k, Hashable k) => HashMap.HashMap k Int -> ExpiringSet k construct hashMap = ExpiringSet intMultimap hashMap   where     intMultimap = hashToMap hashMap -hashToMap :: (Eq a, Hashable a) => A.HashMap a Int -> B.IntMultimap a+hashToMap :: (Eq a, Hashable a) => HashMap.HashMap a Int -> IntMap.IntMultimap a hashToMap hashMap =-  A.foldlWithKey' (\intMultiMap key value -> B.insert value key intMultiMap) B.empty hashMap+  HashMap.foldlWithKey' (\intMultiMap key value -> IntMap.insert value key intMultiMap) IntMap.empty hashMap -mapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> A.HashMap k1 a -> A.HashMap k2 a-mapKeys f hashMap = A.fromList $ fmap (first f) $ (A.toList hashMap)+mapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> HashMap.HashMap k1 a -> HashMap.HashMap k2 a+mapKeys f hashMap = HashMap.fromList $ fmap (first f) $ (HashMap.toList hashMap)   {--------------------------------------------------------------------@@ -85,20 +85,20 @@   fromList = fromList  toList :: ExpiringSet a -> [(UTCTime, a)]-toList (ExpiringSet intMultiMap _) = fmap (\(k, a) -> (,) (timestampUtcTime $ Timestamp $ fromIntegral k) a) $ B.toList intMultiMap+toList (ExpiringSet intMultiMap _) = fmap (\(k, a) -> (,) (timestampUtcTime $ Timestamp $ fromIntegral k) a) $ IntMap.toList intMultiMap  fromList :: (Eq a, Hashable a) =>      [(UTCTime, a)] -> ExpiringSet a-fromList = construct . A.fromList . fmap (\(t, a) -> (,) a (fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) t))+fromList = construct . HashMap.fromList . fmap (\(t, a) -> (,) a (fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) t))  {--------------------------------------------------------------------   Construction --------------------------------------------------------------------} empty :: (Eq a, Hashable a) => ExpiringSet a-empty = ExpiringSet B.empty A.empty+empty = ExpiringSet IntMap.empty HashMap.empty  singleton :: (Eq a, Hashable a) => UTCTime -> a -> ExpiringSet a-singleton time v = construct $ A.singleton v key+singleton time v = construct $ HashMap.singleton v key   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time {-# INLINABLE singleton #-}@@ -115,67 +115,73 @@   (listElem, ExpiringSet newMultiMap newHash)   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time-    newHash = A.filterWithKey (\_ k -> k >= key) hashMap-    (oldMultiMap, maybeElem, newMultiMap) = (B.splitLookup key intMultiMap)+    newHash = HashMap.filterWithKey (\_ k -> k >= key) hashMap+    (oldMultiMap, maybeElem, newMultiMap) = (IntMap.splitLookup key intMultiMap)     element = case maybeElem of-      Just a -> D.toList a+      Just a -> Foldable.toList a       Nothing -> []-    listElem = (D.toList oldMultiMap) ++ element+    listElem = (Foldable.toList oldMultiMap) ++ element  {--------------------------------------------------------------------   Basic interface --------------------------------------------------------------------} null :: ExpiringSet a -> Bool-null (ExpiringSet _ hashMap) = A.null hashMap+null (ExpiringSet _ hashMap) = HashMap.null hashMap {-# INLINE null #-}  size :: ExpiringSet a -> Int-size (ExpiringSet _ hashMap) = A.size hashMap+size (ExpiringSet _ hashMap) = HashMap.size hashMap  member :: (Eq a, Hashable a) => a -> ExpiringSet a -> Bool-member a (ExpiringSet _ hashMap) = A.member a hashMap+member a (ExpiringSet _ hashMap) = HashMap.member a hashMap  memberTime :: UTCTime -> ExpiringSet a -> Bool-memberTime time (ExpiringSet intMultiMap _) = B.member key intMultiMap+memberTime time (ExpiringSet intMultiMap _) = IntMap.member key intMultiMap   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time  insertForce :: (Hashable element, Eq element) => UTCTime {-^ Expiry time -} -> element -> ExpiringSet element -> ExpiringSet element insertForce time value (ExpiringSet intMultiMap hashMap) =-  ExpiringSet newMultiMap (A.insert value key hashMap)+  ExpiringSet newMultiMap (HashMap.insert value key hashMap)   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time-    maybeTimestamp = A.lookup value hashMap+    maybeTimestamp = HashMap.lookup value hashMap     newMultiMap = case maybeTimestamp of-      Nothing -> B.insert key value intMultiMap-      Just k -> B.insert key value $ B.delete k value intMultiMap+      Nothing -> IntMap.insert key value intMultiMap+      Just k -> IntMap.insert key value $ IntMap.delete k value intMultiMap  {-|+Check whether the set contains the element, and if it does+return the element's associated time.+-}+lookup :: (Eq a, Hashable a) => a -> ExpiringSet a -> Maybe UTCTime+lookup a (ExpiringSet _ hashMap) = timestampUtcTime . Timestamp . fromIntegral <$> HashMap.lookup a hashMap +{-| -} insert :: (Hashable element, Eq element) => UTCTime {-^ Expiry time -} -> element -> ExpiringSet element -> ExpiringSet element insert time value (ExpiringSet intMultiMap hashMap) =   ExpiringSet newMultiMap newHash   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time-    maybeTimestamp = A.lookup value hashMap+    maybeTimestamp = HashMap.lookup value hashMap     (newMultiMap, newHash) = case maybeTimestamp of-      Nothing -> (B.insert key value intMultiMap, A.insert value key hashMap)+      Nothing -> (IntMap.insert key value intMultiMap, HashMap.insert value key hashMap)       Just k -> if key >= k-        then (B.insert key value $ B.delete k value intMultiMap, A.insert value key hashMap)+        then (IntMap.insert key value $ IntMap.delete k value intMultiMap, HashMap.insert value key hashMap)         else (intMultiMap, hashMap)  deleteByTime :: (Hashable element, Eq element) => UTCTime {-^ Expiry time -} -> element -> ExpiringSet element -> ExpiringSet element deleteByTime time element (ExpiringSet _ hashMap) =-  construct $ A.delete element hashMap+  construct $ HashMap.delete element hashMap   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time  delete :: (Hashable element, Eq element) => element -> ExpiringSet element -> ExpiringSet element delete value (ExpiringSet intMultiMap hashMap) =-  ExpiringSet newMultiMap (A.delete value hashMap)+  ExpiringSet newMultiMap (HashMap.delete value hashMap)   where-    maybeKey = A.lookup value hashMap+    maybeKey = HashMap.lookup value hashMap     newMultiMap = case maybeKey of       Nothing -> intMultiMap-      Just key -> B.delete key value intMultiMap+      Just key -> IntMap.delete key value intMultiMap
test/Main.hs view
@@ -88,6 +88,12 @@     -- ,     testProperty "member" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value :: Int) ->     (A.member value $ A.delete value $ A.insert key value $ A.fromList list) === False+    ,+    testProperty "lookup not found" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value :: Int) ->+        (A.lookup value $ A.delete value $ A.insert key value $ A.fromList list) === Nothing+    ,+    testProperty "lookup found" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value :: Int) ->+        (A.lookup value $ A.insertForce key value $ A.fromList list) === (Just $ timestampUtcTime $ utcTimeTimestamp key)   ]  expiringMap =