ttl-hashtables 1.4.0.0 → 1.4.1.0

raw patch · 3 files changed

+44/−31 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Data/TTLHashTable.hs +36/−22
• test/Spec.hs +6/−7
• ttl-hashtables.cabal +2/−2

@@ -1,4 +1,4 @@-{-# LANGUAGE GADTs, RecordWildCards #-}+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, RecordWildCards #-} {- | Module: Data.TTLHashTable Description: Adds TTL entry expiration to the excellent mutable hash tables from the hashtables package@@ -34,6 +34,7 @@ -- hash tables in the ST monad aren't as well. If concurrent threads need to operate on the same -- table, you need to provide external means of synchronization to guarantee exclusive access -- to the table+                          TimeStamp,                           TTLHashTable,                           TTLHashTableError(..),                           Settings(..),@@ -93,10 +94,13 @@                         gcMaxEntriesRef_  :: IORef Int }                     -> TTLHashTable h k v -data Value v = Value { expiresAt :: Int,+data Value v = Value { expiresAt :: TimeStamp,                        ttl       :: Int,                        value     :: v } +-- | A representation of a point in time, used to track entry lifetime.+newtype TimeStamp = TimeStamp Int deriving (Num, Integral, Real, Enum, Eq, Ord)+ -- | The 'Settings' type allows for specifying how the hash table should behave. data Settings = Settings {                            -- | Maximum size of the hash table. Once reached, insertion of keys@@ -198,7 +202,7 @@ insertWithTTL ht@TTLHashTable {..} ttl k v = do   numEntries <- liftIO $ readIORef numEntriesRef_   now        <- getTimeStamp-  let expiresAt = now + ttl * 1000000 -- to nanoseconds+  let expiresAt = now + fromIntegral (ttl * 1000000) -- to nanoseconds   maxSize <- liftIO $ readIORef maxSizeRef_   if numEntries < maxSize     then insert' expiresAt@@ -210,7 +214,7 @@                   liftIO $ do                     H.insert hashTable_ k value                     modifyIORef' numEntriesRef_ (+1)-                    modifyIORef' timeStampsRef_ $ M.insert expiresAt k+                    modifyIORef' timeStampsRef_ $ M.insert (fromIntegral expiresAt) k  -- | like 'insertWithTTL' but ignores insertion failure insertWithTTL_ :: (Eq k, Hashable k, C.HashTable h, MonadIO m)@@ -222,17 +226,17 @@ insertWithTTL_ h ttl k = void . runMaybeT . insertWithTTL h ttl k  -checkOldest :: (Eq k, Hashable k, MonadIO m) => TTLHashTable h k v -> Int -> m (Maybe ())+checkOldest :: (Eq k, Hashable k, MonadIO m) => TTLHashTable h k v -> TimeStamp -> m (Maybe ()) checkOldest ht@TTLHashTable {..} now =     liftIO . runMaybeT $ do       (timeStamp, k) <- MaybeT . atomicModifyIORef' timeStampsRef_ $ \timeStamps ->                          case M.minViewWithKey timeStamps of                            Nothing -> (timeStamps, Nothing)                            Just ((timeStamp, k), timeStamps') ->-                             if timeStamp <= now+                             if (fromIntegral timeStamp) <= now                                then (timeStamps', Just (timeStamp, k))                                else (timeStamps, Nothing)-      MaybeT $ mutateWith (deleteExpired timeStamp) ht k+      MaybeT $ mutateWith (deleteExpired $ fromIntegral timeStamp) ht k  -- | Lookup a key in the hash table. If called straight in the IO monad it would throw a -- 'NotFound' exception, but if called under @MaybeT IO@ or @ExceptT SomeException IO@ it would@@ -246,7 +250,13 @@ lookupAndRenew :: (Eq k, Hashable k, MonadIO m, Failable m) => TTLHashTable h k v -> k -> m v lookupAndRenew = lookup' True -lookupMaybeExpired :: (Eq k, Hashable k, MonadIO m, Failable m) => TTLHashTable h k v -> k -> m (v, Int)+-- | Perform a lookup without doing any actual checks to see if the entry is still alive or+-- if it has expired. Instead, the entry expiration timestamp is returned together with the+-- value (if found). The purpose of this function is to provide a manual way to check expiration,+-- for example when performing batch lookups or sacrificing lifetime resolution for the sake+-- of performance (and thus avoiding an expensive timestamp retrieval every time a lookup is+-- performed)+lookupMaybeExpired :: (Eq k, Hashable k, MonadIO m, Failable m) => TTLHashTable h k v -> k -> m (v, TimeStamp) lookupMaybeExpired TTLHashTable {..} k =   maybe (failure NotFound) returnValue =<< liftIO (H.lookup hashTable_ k)     where returnValue Value {..} = return (value, expiresAt)@@ -262,13 +272,13 @@         (mExpire, mValue) <- mutateWith (refreshEntry now) ht k         removeTimeStamp mExpire         Value {..}        <- checkLookedUp mValue now-        liftIO $ modifyIORef' timeStampsRef_ $ M.insert expiresAt k+        liftIO $ modifyIORef' timeStampsRef_ $ M.insert (fromIntegral expiresAt) k         return value     where refreshEntry _ Nothing =               (Nothing, (Nothing, Nothing))           refreshEntry now (Just v@Value{..}) =               if expiresAt > now then-                  let v' = Value { expiresAt = now + ttl * 1000000, -- nanoseconds+                  let v' = Value { expiresAt = now + (fromIntegral ttl * 1000000), -- nanoseconds                                    ttl = ttl,                                    value = value }                   in (Just v', (Just expiresAt, Just v'))@@ -277,11 +287,11 @@           removeTimeStamp Nothing =               return ()           removeTimeStamp (Just timeStamp) =-              liftIO . modifyIORef' timeStampsRef_ $ M.delete timeStamp+              liftIO . modifyIORef' timeStampsRef_ $ M.delete (fromIntegral timeStamp)  checkLookedUp :: (MonadIO m, Failable m)                  => Maybe (Value v)-                 -> Int+                 -> TimeStamp                  -> m (Value v) checkLookedUp Nothing _               = failure NotFound checkLookedUp (Just v@Value {..}) now =@@ -301,10 +311,10 @@ delete ht@TTLHashTable {..} k = do     timeStamp <- deleteWith $ \v ->       (Nothing, v >>= return . expiresAt)-    forM_ timeStamp $ liftIO . modifyIORef' timeStampsRef_ . M.delete+    forM_ timeStamp $ liftIO . modifyIORef' timeStampsRef_ . M.delete . fromIntegral       where deleteWith fun = mutateWith fun ht k -deleteExpired :: Int -> Maybe (Value v) -> (Maybe (Value v), Maybe ())+deleteExpired :: TimeStamp -> Maybe (Value v) -> (Maybe (Value v), Maybe ()) deleteExpired _ Nothing =   (Nothing, Nothing) deleteExpired timeStamp (Just v@Value {..}) =@@ -357,10 +367,10 @@ removeExpired' ht@TTLHashTable {..} gcMaxEntries =   liftIO $ do     now          <- getTimeStamp-    (n, expired) <- atomicModifyIORef' timeStampsRef_ $ selectedEntries now+    (n, expired) <- atomicModifyIORef' timeStampsRef_ $ selectedEntries (fromIntegral now)     Prelude.mapM_ remove expired     return n-        where remove (timeStamp, k) = mutateWith (deleteExpired timeStamp) ht k+        where remove (timeStamp, k) = mutateWith (deleteExpired $ fromIntegral timeStamp) ht k               selectedEntries now m =                   let (old, active)      = M.split now m                       (selected, notYet) = splitAt gcMaxEntries $ M.toList old@@ -368,11 +378,13 @@                   in (M.union active toReinsert, (n, selected))               countFromList (n, acc) (k, v) = (n + 1, M.insert k v acc) --- | Returns a timestamp value in nanoseconds-getTimeStamp :: (MonadIO m) => m Int+-- | Returns a timestamp for the current moment (__now__). This value can be used when+-- | comparing expiration times manually as returned by 'lookupMaybeExpired' for example,+-- | when it makes sense to do so in the name of performance.+getTimeStamp :: (MonadIO m) => m TimeStamp getTimeStamp = do   (TimeSpec secs ns) <- liftIO $ getTime Monotonic-  return . fromIntegral $ (secs * 1000000000 + ns)+  return . fromIntegral $ secs * 1000000000 + ns  -- | A strict fold in IO over the @(key, value)@ records in a hash table foldM :: (MonadIO m) => (a -> (k, v) -> IO a) -> a -> TTLHashTable h k v -> m a@@ -418,12 +430,14 @@   defaultTTL <- liftIO $ readIORef defaultTTLRef_   mutateWith (mutate' now defaultTTL f) ht k -mutate' :: Int -> Int -> (Maybe v -> (Maybe v, a)) -> Maybe (Value v) -> (Maybe (Value v), a)+mutate' :: TimeStamp -> Int -> (Maybe v -> (Maybe v, a)) -> Maybe (Value v) -> (Maybe (Value v), a) mutate' now defaultTTL f mV =     let (expiresAt, ttl, mValue) = metaFrom mV         vFrom mValue' = do           value <- mValue'           return Value {expiresAt = expiresAt, ttl = ttl, value = value }     in first vFrom $ f mValue-        where metaFrom Nothing            = (now + defaultTTL * 1000000, defaultTTL, Nothing)-              metaFrom (Just Value {..})  = (now + ttl * 1000000, ttl, Just value)+        where metaFrom Nothing =+                (now + fromIntegral (defaultTTL * 1000000), defaultTTL, Nothing)+              metaFrom (Just Value {..})  =+                (now + fromIntegral (ttl * 1000000), ttl, Just value)

@@ -16,7 +16,6 @@  withSizedRenewableTTLHashTable :: IO (TTLHashTable Cuckoo.HashTable Int String) withSizedRenewableTTLHashTable = newWithSettings def { maxSize = 2,-                                                       renewUponRead = True,                                                        defaultTTL = 100,                                                        gcMaxEntries = 1 } @@ -50,7 +49,7 @@             threadDelay 200000 -- wait 200 mS             s' <- size ht             s' `shouldBe` 2-            _ <- find ht 1+            _ <- runExceptT $ lookupAndRenew ht 1             s'' <- size ht             s'' `shouldBe` 1             delete ht 2@@ -107,14 +106,14 @@           \ht -> do             insert ht 1 "foo"             threadDelay 50000 -- wait 50 mS-            _ <- find ht 1+            _ <- lookupAndRenew ht 1             threadDelay 50000 -- wait 50 mS-            _ <- find ht 1+            _ <- lookupAndRenew ht 1             threadDelay 50000 -- wait 50 mS-            _ <- find ht 1+            _ <- lookupAndRenew ht 1             threadDelay 50000 -- wait 50 mS-            v <- find ht 1-            v `shouldBe` Just "foo"+            v <- lookupAndRenew ht 1+            v `shouldBe` "foo"         it "Checks that lookup doesn't renew expired entry" $           \ht -> do             insert ht 1 "foo"

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3388338e9a83ada9651f2f035614cb640965e9628df50285184ab9166923e93a+-- hash: 4659935f4d42287b429b71c7213283dcc3e3c103e8d0527509ad3d1d73a4f6a1  name:           ttl-hashtables-version:        1.4.0.0+version:        1.4.1.0 synopsis:       Extends hashtables so that entries added can be expired after a TTL description:    This library extends fast mutable hashtables so that entries added can be expired after a given TTL (time to live). This TTL can be specified as a default property of the table or on a per entry basis. category:       Data