ttl-hashtables 1.2.0.0 → 1.2.1.0

raw patch · 3 files changed

+50/−15 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 +37/−13
• test/Spec.hs +11/−0
• ttl-hashtables.cabal +2/−2

@@ -43,6 +43,8 @@                           insertWithTTL_,                           delete,                           find,+                          foldM,+                          Data.TTLHashTable.mapM_,                           lookup,                           new,                           newWithSettings,@@ -51,10 +53,11 @@  import Prelude                 hiding (lookup) import Control.Exception              (Exception)-import Control.Monad                  (void)+import Control.Monad                  (void, when) import Control.Monad.Failable         (Failable, failure) import Control.Monad.IO.Class         (MonadIO, liftIO) import Control.Monad.Trans.Maybe      (MaybeT(..), runMaybeT)+import Data.Bits                      (finiteBitSize) import Data.Default                   (Default, def) import Data.Hashable                  (Hashable) import Data.IntMap.Strict             (IntMap)@@ -64,7 +67,7 @@                                        newIORef,                                        readIORef) import Data.Typeable                  (Typeable)-import System.Clock                   (Clock(Monotonic), TimeSpec(..), getTime)+import System.Clock                   (Clock(..), TimeSpec(..), getTime)  import qualified Data.HashTable.Class as C import qualified Data.HashTable.IO    as H@@ -94,8 +97,8 @@                            -- | Whether a succesful lookup of an entry means the TTL of the entry                            -- should be restarted. Default is 'False'                            renewUponRead :: Bool,-                           -- | Default TTL value to be used for an entry if none is specified-                           -- at insertion time+                           -- | Default TTL value in milliseconds to be used for an entry if none+                           -- is specified at insertion time                            defaultTTL    :: Int,                            -- | Maximum number of entries that can be garbage collected in one                            -- single call to removeExpired. This setting is provided so that@@ -107,6 +110,7 @@ data TTLHashTableError = NotFound      -- ^ The entry was not found in the table                        | ExpiredEntry  -- ^ The entry did exist but is no longer valid                        | HashTableFull -- ^ The maximum size for the table has been reached+                       | UnsupportedPlatform String -- ^ The platform is not supported                          deriving (Eq, Typeable, Show)  instance Exception TTLHashTableError@@ -118,8 +122,15 @@                      gcMaxEntries  = maxBound                    } +assertIntSize :: (Failable m) => m ()+assertIntSize =+    when (finiteBitSize maxInt < 64) $+      failure $ UnsupportedPlatform "Int size on this platform is < 64 bits"+          where maxInt   = maxBound :: Int++ -- | Creates a new hash table with default settings-new :: (C.HashTable h, MonadIO m) => m (TTLHashTable h k v)+new :: (C.HashTable h, MonadIO m, Failable m) => m (TTLHashTable h k v) new = newWithSettings def  -- | Creates a new hash table with the specified settings. Use the 'Default' instance of 'Settings'@@ -127,8 +138,9 @@ -- @ -- newWithSettings def { maxSize = 64 } -- @-newWithSettings :: (C.HashTable h, MonadIO m) => Settings -> m (TTLHashTable h k v)-newWithSettings Settings {..} =+newWithSettings :: (C.HashTable h, MonadIO m, Failable m) => Settings -> m (TTLHashTable h k v)+newWithSettings Settings {..} = do+    assertIntSize     liftIO $ do       table <- newHT       sRef  <- newIORef 0@@ -166,7 +178,7 @@           -> m () insert_ h k = void . runMaybeT . insert h k --- | like 'insert' but an entry specific TTL can be provided+-- | like 'insert' but an entry specific TTL in milliseconds can be provided. insertWithTTL :: (Eq k, Hashable k, C.HashTable h, MonadIO m, Failable m)           => TTLHashTable h k v           -> Int@@ -176,7 +188,7 @@ insertWithTTL ht@TTLHashTable {..} ttl k v = do   numEntries <- liftIO $ readIORef numEntriesRef_   now        <- getTimeStamp-  let expiresAt = now + ttl+  let expiresAt = now + ttl * 1000000 -- to nanoseconds   if numEntries < maxSize_     then insert' expiresAt     else do@@ -233,7 +245,9 @@               ((Nothing, 0), (Nothing, Nothing))           refreshEntry now (Just v@Value{..}) =               if expiresAt > now then-                  let v' = Value { expiresAt = now + ttl, ttl = ttl, value = value }+                  let v' = Value { expiresAt = now + ttl * 1000000, -- nanoseconds+                                   ttl = ttl,+                                   value = value }                   in ((Just v', 0), (Just expiresAt, Just v'))               else                   ((Nothing, 1), (Nothing, Just v))@@ -306,7 +320,7 @@   liftIO $ do     now          <- getTimeStamp     (n, expired) <- atomicModifyIORef' timeStampsRef_ $ selectedEntries now-    mapM_ remove expired+    Prelude.mapM_ remove expired     return n         where remove (timeStamp, k) = mutateWith (deleteExpired timeStamp) ht k               selectedEntries now m =@@ -316,8 +330,18 @@                   in (M.union active toReinsert, (n, selected))               countFromList (n, acc) (k, v) = (n + 1, M.insert k v acc) --- | Returns a timestamp value in milliseconds+-- | Returns a timestamp value in nanoseconds getTimeStamp :: (MonadIO m) => m Int getTimeStamp = do   (TimeSpec secs ns) <- liftIO $ getTime Monotonic-  return . fromIntegral $ (secs * 1000000000 + ns) `div` 1000000+  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+foldM f x TTLHashTable {..} = liftIO . H.foldM f' x $ hashTable_+    where f' acc (k, Value {..}) = f acc (k, value)++-- | A side-effecting map over the @(key, value)@ records in a hash table+mapM_ :: (MonadIO m) => ((k, v) -> IO a) -> TTLHashTable h k v -> m ()+mapM_ f TTLHashTable {..} = liftIO $ H.mapM_ f' hashTable_+    where f' (k, Value {..}) = f (k, value)

@@ -20,6 +20,9 @@                                                        defaultTTL = 100,                                                        gcMaxEntries = 1 } +withIntHashTable :: IO (TTLHashTable Basic.HashTable Int Int)+withIntHashTable = new+ main :: IO () main = do   hspec $ do@@ -120,6 +123,14 @@              s' <- size ht              s' `shouldBe` 0              left' `shouldBe` 0+    before withIntHashTable $+      describe "A hash table with integer values" $ do+        it "Checks folding" $+           \ht -> do+             insert ht 1 2+             insert ht 2 3+             r <- foldM (\a -> return . (a +) . snd) 0 ht+             r `shouldBe` 5  hashTableError :: TTLHashTableError -> Either SomeException a -> Bool hashTableError e (Left e') =

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3fc54c5635761c9454d4730b7ce9c2b5e4bcdc1e8e96c1ea77312c7c0e0c54ea+-- hash: 65615fa7b0bf5fdbc5d34448bd6b00132bfecbbdb8d68e7e67cd0c7e727b0464  name:           ttl-hashtables-version:        1.2.0.0+version:        1.2.1.0 synopsis:       Extends hashtables so that entries added can be expired after a TTL description:    Please see the README on Gitlab at <https://gitlab.com/codemonkeylabs/ttl-hashtables#readme> category:       Data