shared-resource-cache 0.2.0.4 → 0.2.0.5
raw patch · 3 files changed
+36/−6 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- shared-resource-cache.cabal +1/−1
- src/Data/SharedResourceCache/Internal/ExpiringSharedResourceCache.hs +5/−5
- test/Spec.hs +30/−0
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: shared-resource-cache-version: 0.2.0.4+version: 0.2.0.5 synopsis: A thread-safe cache for sharing resources across threads with automatic expiry description: A cache designed for guaranteeing that different threads can share the same reference to a resource. For example, it allows threads to communicate via a shared [TChan broadcast channel](https://hackage.haskell.org/package/stm-2.5.3.1/docs/Control-Concurrent-STM-TChan.html).
@@ -41,8 +41,8 @@ handleSharerJoin :: Hashable key => SharedResourceCache key value err -> CacheItem value -> key -> STM () handleSharerJoin cache cacheItem resourceId = do- void $ increaseSharersByOne cacheItem- removeScheduledCleanup (cleanUpMap cache) resourceId+ newSharerCount <- increaseSharersByOne cacheItem+ when (newSharerCount == 1) $ removeScheduledCleanup (cleanUpMap cache) resourceId handleSharerLeave :: Hashable key => SharedResourceCache key value err -> CacheItem value -> key -> IO () handleSharerLeave cache cacheItem resourceId =@@ -85,7 +85,7 @@ loadFreshlyIntoCache semaphore resourceCache resourceId = do -- We use uninterruptibleMask so that an async exception can't stop the sempahore remaining in the cache blocking any readers of the resource -- from getting the resource. We're in the context of resourcet's 'allocate' so we're otherwise 'masked' apart from on blocking operations- result <- loadIntoCache resourceCache resourceId semaphore+ result <- loadIntoCache resourceCache resourceId `onException` uninterruptibleMask_ (adjustCacheEntryOnLoadError resourceCache resourceId >> signalCacheLoaded semaphore) uninterruptibleMask_ $ do@@ -96,8 +96,8 @@ where signalCacheLoaded semaphore = putMVar semaphore () - loadIntoCache :: SharedResourceCache key value err -> key -> MVar () -> IO (Either err (CacheItem value))- loadIntoCache resourceCache@(SharedResourceCache cache _ loadResourceOp _ _ _) resourceId _ = do+ loadIntoCache :: SharedResourceCache key value err -> key -> IO (Either err (CacheItem value))+ loadIntoCache resourceCache@(SharedResourceCache cache _ loadResourceOp _ _ _) resourceId = do resourceLoadResult <- loadResourceOp resourceId case resourceLoadResult of Right resource -> putIntoCache resourceCache resourceId resource
test/Spec.hs view
@@ -136,6 +136,36 @@ removed <- liftIO $ readIORef removedItems liftIO $ removed `shouldBe` [] + it "does not evict a resurrected item after its sharer count returned to zero" $ do+ loadCount <- newIORef (0 :: Int)+ removedItems <- newIORef ([] :: [String])+ cache :: Cache <- makeGlobalSharedResourceCache+ (\key -> do+ modifyIORef' loadCount (+ 1)+ pure (Right ("value-" ++ key)))+ (Just (\val -> modifyIORef' removedItems (val :)))+ shortExpiry++ -- First acquire/release cycle: count goes 0 -> 1 -> 0, scheduling a cleanup+ runResourceT $ do+ (_, val) <- getCacheableResource cache "key1"+ liftIO $ val `shouldBe` Right "value-key1"++ -- Re-acquire before the scheduled cleanup fires: count goes 0 -> 1+ runResourceT $ do+ (_, val) <- getCacheableResource cache "key1"+ liftIO $ val `shouldBe` Right "value-key1"++ -- Hold the resource well past the originally scheduled eviction time+ liftIO $ threadDelay 2500000++ removed <- liftIO $ readIORef removedItems+ liftIO $ removed `shouldBe` []++ -- Only one actual load occurred, confirming it's the same cached item+ count <- readIORef loadCount+ count `shouldBe` 1+ it "peek returns Nothing for uncached items" $ do cache <- makeTestCache Nothing longExpiry