shared-resource-cache (empty) → 0.1.0.0
raw patch · 11 files changed
+470/−0 lines, 11 filesdep +basedep +list-tdep +resourcetsetup-changed
Dependencies added: base, list-t, resourcet, shared-resource-cache, stm, stm-containers, text, time
Files
- CHANGELOG.md +23/−0
- LICENSE +21/−0
- README.md +9/−0
- Setup.hs +2/−0
- shared-resource-cache.cabal +72/−0
- src/Data/SharedResourceCache.hs +137/−0
- src/Data/SharedResourceCache/Internal/Broom.hs +56/−0
- src/Data/SharedResourceCache/Internal/CacheItem.hs +14/−0
- src/Data/SharedResourceCache/Internal/ExpiringSharedResourceCache.hs +120/−0
- src/Data/SharedResourceCache/Internal/Model.hs +14/−0
- test/Spec.hs +2/−0
+ CHANGELOG.md view
@@ -0,0 +1,23 @@+# Changelog for `shared-resource-cache`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - 2026-03-22++### Added++- Initial release+- `makeGlobalResourceCache` for caches that live for the lifetime of the program+- `makeResourceCache` for caches with a scoped lifetime managed via `resourcet`+- `getCacheableResource` to retrieve (and load if necessary) a cached resource+- `withCacheableResource` as a convenience wrapper around `getCacheableResource`+- `peekCacheableResource` to retrieve a cached resource without loading it if absent+- `withPeekCacheableResource` to peek at a cached resource within an STM transaction+- Background sweep thread to periodically evict expired, unused cache entries+- Reference counting via STM to track active sharers of each cached resource
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 Gordon Martin++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,9 @@+# shared-resource-cache++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).+Using [resourcet](https://hackage.haskell.org/package/resourcet), items are only removed from the cache after no 'sharers' are holding the+resource and the item has expired (according to the expiry configuration the cache was constructed with.)++Note: an MVar is used to coordinate between threads that only one thread does the initial load of the resource with the given IO action if multiple+threads try and retrieve a resource that is not yet cached at the same time.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
@@ -0,0 +1,72 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.38.0.+--+-- see: https://github.com/sol/hpack++name: shared-resource-cache+version: 0.1.0.0+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+ <<https://hackage.haskell.org/package/stm-2.5.3.1/docs/Control-Concurrent-STM-TChan.html TChan broadcast channel>>. + Using <<https://hackage.haskell.org/package/resourcet resourcet>>, items are only removed from the cache after no 'sharers' are holding the+ resource and the item has expired (according to the expiry configuration the cache was constructed with.)+ .+ Note: an MVar is used to coordinate between threads that only one thread does the initial load of the resource with the given IO action if multiple+ threads try and retrieve a resource that is not yet cached at the same time.+category: Concurrency+homepage: https://github.com/happy0/shared-resource-cache#readme+bug-reports: https://github.com/happy0/shared-resource-cache/issues+author: Gordon Martin+maintainer: gordonhughmartin@gmail.com+copyright: 2026 Gordon Martin+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/happy0/shared-resource-cache++library+ exposed-modules:+ Data.SharedResourceCache+ other-modules:+ Data.SharedResourceCache.Internal.CacheItem+ Data.SharedResourceCache.Internal.Broom+ Data.SharedResourceCache.Internal.ExpiringSharedResourceCache+ Data.SharedResourceCache.Internal.Model+ hs-source-dirs:+ src+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ build-depends:+ base >=4.7 && <5+ , list-t ==1.0.*+ , resourcet ==1.3.*+ , stm >=2.4 && <2.6+ , stm-containers >=1.2 && <2+ , text >=2.0 && <2.2+ , time >=1.12 && <2+ default-language: Haskell2010++test-suite shared-resource-cache-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_shared_resource_cache+ hs-source-dirs:+ test+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , list-t ==1.0.*+ , resourcet ==1.3.*+ , shared-resource-cache+ , stm >=2.4 && <2.6+ , stm-containers >=1.2 && <2+ , text >=2.0 && <2.2+ , time >=1.12 && <2+ default-language: Haskell2010
@@ -0,0 +1,137 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | A cache that holds items (resources) while there are multiple threads using the +-- resource or until the item is eligible for removal with respect to the given cache+-- expiry configuration.+--+-- It is general purpose, but it is designed with the use case in mind where it is important that+-- different threads need to share the same resource instance (such as a TChan used for broadcasting messages+-- between threads)+module Data.SharedResourceCache (+ makeSharedResourceCache,+ makeGlobalSharedResourceCache,+ withCacheableResource,+ getCacheableResource,+ SharedResourceCache,+ peekCacheableResource,+ withPeekCacheableResource,+ CacheExpiryConfig(..)) where++import Control.Concurrent ( forkIO, killThread )+import Control.Concurrent.STM.TVar ()+import Control.Monad.STM ( STM, atomically )+import Data.Text ( Text )+import Data.Time ( UTCTime )+import qualified StmContainers.Map as M+import Prelude+import Control.Monad.Trans.Resource (MonadResource, ReleaseKey, runResourceT, allocate)+import Control.Monad.IO.Class (liftIO)+import Data.SharedResourceCache.Internal.CacheItem (CacheItem(..))+import Data.SharedResourceCache.Internal.ExpiringSharedResourceCache (CacheEntry(..), SharedResourceCache (..), CacheExpiryConfig, loadCacheableResource, handleSharerLeave, handlerSharerJoin, handleSharerLeaveSTM)+import Data.SharedResourceCache.Internal.Broom (startBroomLoop)+import Data.SharedResourceCache.Internal.Model (CacheExpiryConfig(..))++-- | Constructs a resource cache that is expected to be used for the lifetime of the program. Internally, it forks a thread to +-- manage periodically removing cache entries that have expired (as per the cache expiry configuration.)+makeGlobalSharedResourceCache + :: (Text -> IO (Either err a)) -- The action to load the given resource by ID+ -> Maybe (a -> IO ()) -- An action to be executed when the item is removed from the cache+ -> CacheExpiryConfig -- The configuration for when the cache item should be marked as expired and be eligible for removal from the cache+ -> IO (SharedResourceCache err a)+makeGlobalSharedResourceCache loadResourceOp onRemoval cacheExpiryConfig@(CacheExpiryConfig sweepIntervalSeconds _) = do+ resourceCache <- M.newIO+ cleanUpMap <- M.newIO+ threadId <- forkIO $ startBroomLoop resourceCache cleanUpMap onRemoval sweepIntervalSeconds+ pure $ SharedResourceCache resourceCache cleanUpMap loadResourceOp onRemoval threadId cacheExpiryConfig++-- | The same as 'makeGlobalSharedResourceCache' but intended for cases where the cache doesn't live for the lifetime of the program.+-- When the resource is freed (via MonadResource) the forked thread for cleaning the resource cache is killed.+makeSharedResourceCache :: (MonadResource m) => (Text -> IO (Either err a)) -> Maybe (a -> IO ()) -> CacheExpiryConfig -> m (ReleaseKey, SharedResourceCache err a)+makeSharedResourceCache loadResourceOp onRemoval cacheExpiryConfig = do+ allocate (allocateResource loadResourceOp onRemoval) deallocateResource+ where+ allocateResource :: (Text -> IO (Either err a)) -> Maybe (a -> IO ()) -> IO (SharedResourceCache err a)+ allocateResource loadOp removal = makeGlobalSharedResourceCache loadOp removal cacheExpiryConfig++ deallocateResource :: SharedResourceCache err a -> IO ()+ deallocateResource cache = do+ let threadId = cacheCleanupThreadId cache+ killThread threadId++-- | Executes the given action using the resource with the given ID. This function is a wrapper around the 'getCacheableResource' function,+-- where the resource is freed at the end of the supplied action+withCacheableResource :: SharedResourceCache err a -> Text -> (Either err a -> IO ()) -> IO ()+withCacheableResource cache resourceId op =+ runResourceT $ do+ (_, cachedResource) <- getCacheableResource cache resourceId+ liftIO $ op cachedResource++-- | Retrieves a cacheable resource with the given resource ID using the IO action configured+-- when the cache was constructed.+--+-- If the item is already loaded into the cache, it is returned. If it is not yet loaded, the first thread requesting this resource to+-- acquire a MVar will take ownership of loading it and signal to any other threads waiting for the resource that it has been loaded.+-- +-- This action is executed in the 'MonadResource' monad typeclass+-- context so that when the resource is freed, the cache can mark the cache item as having one less sharer.+--+-- When there are no sharers remaining, the cache item is scheduled for eviction according to the configuration that was used at cache+-- construction time+--+getCacheableResource :: (MonadResource m) => SharedResourceCache err a -> Text -> m (ReleaseKey, Either err a)+getCacheableResource resourceCache resourceId = do+ (releaseKey, cacheEntry) <- allocate (allocateResource resourceCache resourceId) (deAllocateResource resourceCache)+ return (releaseKey, cacheItem <$> cacheEntry)+ where+ allocateResource :: SharedResourceCache err a -> Text -> IO (Either err (CacheItem a))+ allocateResource = loadCacheableResource++ deAllocateResource :: SharedResourceCache err a -> Either err (CacheItem a) -> IO ()+ deAllocateResource resourceCache resource = do+ case resource of+ Left _ -> pure ()+ Right sharedResource -> handleSharerLeave resourceCache sharedResource resourceId++-- | Returns the item if it's in the cache but does not load it into the cache if it is not present.+--+-- If there are no other sharers of the resource once the resource action has been run to completion+-- or the 'release key' is used to free it early then the item is scheduled for eviction from the cache.+peekCacheableResource :: MonadResource m => SharedResourceCache err a -> Text -> m (ReleaseKey, Maybe a)+peekCacheableResource resourceCache resourceId = do+ (releaseKey, cacheEntry) <- allocate (allocateResource resourceCache resourceId) (deAllocateResource resourceCache)+ return (releaseKey, cacheItem <$> cacheEntry)+ where+ allocateResource :: SharedResourceCache err a -> Text -> IO (Maybe (CacheItem a))+ allocateResource resourceCache resourceId = atomically $ do+ item <- M.lookup resourceId (cache resourceCache)+ case item of+ Just (LoadedEntry cachedItem) -> do+ handlerSharerJoin resourceCache cachedItem resourceId+ pure (Just cachedItem)+ _ -> pure Nothing ++ deAllocateResource :: SharedResourceCache err a -> Maybe (CacheItem a) -> IO ()+ deAllocateResource resourceCache resource =+ case resource of+ Nothing -> pure ()+ Just sharedResource -> handleSharerLeave resourceCache sharedResource resourceId++-- | Executes the given action with a 'Just' if an item with the given resourceID is present in the cache,+-- otherwise executes it with Nothing+--+-- If there are no other sharers of the resource once the action is complete then the item is scheduled+-- for eviction+--+-- The 'now' parameter is used to schedule the item for eviction from the cache according to the +-- expiry config and should be the current time. It is required to be passed in as getting the current time+-- is an IO action that cannot be performed in an STM transaction.+withPeekCacheableResource :: SharedResourceCache err a -> Text -> (Maybe a -> STM b) -> UTCTime -> STM b+withPeekCacheableResource resourceCache resourceId action now = do+ resource <- M.lookup resourceId (cache resourceCache)+ case resource of+ Just (LoadedEntry item) -> do+ handlerSharerJoin resourceCache item resourceId+ result <- action (Just (cacheItem item))+ handleSharerLeaveSTM resourceCache item resourceId now+ pure result+ _ -> action Nothing
@@ -0,0 +1,56 @@+module Data.SharedResourceCache.Internal.Broom (startBroomLoop, removeIfStale, scheduleCacheCleanup, removeScheduledCleanup) where+ import qualified StmContainers.Map as M+ import Data.Text (Text)+ import Data.Time.Clock (NominalDiffTime, UTCTime)+ import Control.Concurrent.STM (STM)+ import Control.Monad (forever, when)+ import Control.Monad.STM (atomically)+ import Data.SharedResourceCache.Internal.CacheItem (numberOfSharers, CacheItem (cacheItem))+ import Control.Concurrent (threadDelay)+ import ListT (traverse_)+ import Data.Time (addUTCTime, getCurrentTime)+ import Data.SharedResourceCache.Internal.Model (CacheEntry (..), CacheExpiryConfig (..))+ + startBroomLoop :: M.Map Text (CacheEntry err a) -> M.Map Text UTCTime -> Maybe (a -> IO ()) -> Int -> IO ()+ startBroomLoop resourceCache cleanUpMap onRemove sweepIntervalSeconds = forever $ do+ now <- getCurrentTime+ -- We use 'listTNonAtomic since we do the removal itself atomically (followed by an IO action) and+ -- if we miss an entry due to a stale view on the current iteration we can remove it in a later iteration+ traverse_ (removeIfStale now resourceCache cleanUpMap onRemove) (M.listTNonAtomic cleanUpMap)+ threadDelay (sweepIntervalSeconds * 1000000)++ removeIfStale :: UTCTime -> M.Map Text (CacheEntry err a) -> M.Map Text UTCTime -> Maybe (a -> IO ()) -> (Text, UTCTime) -> IO ()+ removeIfStale now cache cleanUpMap onRemove (resourceId, cacheExpiryTime) =+ when (now >= cacheExpiryTime) $ do+ removed <- atomically $ removeIfNoSharers cache cleanUpMap resourceId+ case (removed, onRemove) of+ (Just removedItem, Just onRemovalFunction) -> onRemovalFunction removedItem+ _ -> return ()+ where+ removeIfNoSharers :: M.Map Text (CacheEntry err a) -> M.Map Text UTCTime -> Text -> STM (Maybe a)+ removeIfNoSharers cache cleanupMap resourceId = do+ resource <- M.lookup resourceId cache+ case resource of+ Just (LoadedEntry cached) -> do+ sharers <- numberOfSharers cached++ if sharers == 0+ then do+ removeFromCache cache resourceId+ removeScheduledCleanup cleanupMap resourceId+ return (Just (cacheItem cached))+ else+ return Nothing+ _ -> pure Nothing++ removeFromCache :: M.Map Text (CacheEntry err a) -> Text -> STM ()+ removeFromCache resourceCache resourceId = M.delete resourceId resourceCache++ scheduleCacheCleanup :: M.Map Text UTCTime -> CacheExpiryConfig -> UTCTime -> Text -> STM ()+ scheduleCacheCleanup cleanUpMap (CacheExpiryConfig _ itemEligibleForRemovalAfterUnusedSeconds) now resourceId = do+ let eligibleForRemovalSeconds = fromIntegral itemEligibleForRemovalAfterUnusedSeconds :: NominalDiffTime+ M.insert (addUTCTime eligibleForRemovalSeconds now) resourceId cleanUpMap++ removeScheduledCleanup :: M.Map Text UTCTime -> Text -> STM ()+ removeScheduledCleanup cleanUpMap resourceId = M.delete resourceId cleanUpMap+
@@ -0,0 +1,14 @@+module Data.SharedResourceCache.Internal.CacheItem (CacheItem(..), increaseSharersByOne, decreaseSharersByOne, numberOfSharers) where + import Control.Concurrent.STM (TVar, STM, modifyTVar')+ import Control.Concurrent.STM.TVar (readTVar)+ + data CacheItem a = CacheItem {cacheItem :: a, connections :: TVar Int}++ increaseSharersByOne :: CacheItem a -> STM Int+ increaseSharersByOne (CacheItem item connections) = modifyTVar' connections (+ 1) >> readTVar connections++ decreaseSharersByOne :: CacheItem a -> STM Int+ decreaseSharersByOne (CacheItem item connections) = modifyTVar' connections (\item -> item - 1) >> readTVar connections++ numberOfSharers :: CacheItem a -> STM Int+ numberOfSharers (CacheItem item connections) = readTVar connections
@@ -0,0 +1,120 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Data.SharedResourceCache.Internal.ExpiringSharedResourceCache (CacheEntry(..), SharedResourceCache(..), CacheExpiryConfig, loadCacheableResource, handleSharerLeave, handleSharerLeaveSTM, handlerSharerJoin) where+ import Data.SharedResourceCache.Internal.CacheItem (CacheItem (CacheItem), decreaseSharersByOne, increaseSharersByOne)+ import Control.Concurrent ( MVar, ThreadId, putMVar, readMVar )+ import qualified StmContainers.Map as M+ import Data.Text (Text)+ import Data.Time (UTCTime)+ import Control.Concurrent.STM (STM)+ import Control.Exception ( mask,+ uninterruptibleMask_, finally )+ import Control.Monad.STM (atomically)+ + import Control.Monad (void, when)+ import Data.SharedResourceCache.Internal.Broom (scheduleCacheCleanup, removeScheduledCleanup)+ import Data.SharedResourceCache.Internal.Model (CacheExpiryConfig, CacheEntry (..))+ import Data.Time.Clock (getCurrentTime)+ import Control.Concurrent.MVar (newEmptyMVar)+ import Control.Concurrent.STM.TVar (newTVar)++ -- | A cache of resources that can be shared between multiple threads (such as a TChan broadcast channel.)+ --+ data SharedResourceCache err a = SharedResourceCache {+ cache :: M.Map Text (CacheEntry err a),+ cleanUpMap :: M.Map Text UTCTime,+ loadResourceOp :: Text -> IO (Either err a),+ onRemoval :: Maybe (a -> IO ()),+ cacheCleanupThreadId :: ThreadId,+ cacheExpiryConfig :: CacheExpiryConfig+ }++ handlerSharerJoin :: SharedResourceCache err a -> CacheItem a -> Text -> STM ()+ handlerSharerJoin cache cacheItem resourceId = do+ void $ increaseSharersByOne cacheItem+ removeScheduledCleanup (cleanUpMap cache) resourceId++ handleSharerLeave :: SharedResourceCache err a -> CacheItem a -> Text -> IO ()+ handleSharerLeave cache cacheItem resourceId = do+ now <- getCurrentTime+ atomically (handleSharerLeaveSTM cache cacheItem resourceId now)++ handleSharerLeaveSTM :: SharedResourceCache err a -> CacheItem a -> Text -> UTCTime -> STM ()+ handleSharerLeaveSTM (SharedResourceCache cache cleanUpMap _ _ _ config) cacheItem resourceId now = do+ newSharerCount <- decreaseSharersByOne cacheItem+ when (newSharerCount == 0) $ void (scheduleCacheCleanup cleanUpMap config now resourceId)++ loadCacheableResource :: SharedResourceCache err a -> Text -> IO (Either err (CacheItem a))+ loadCacheableResource resourceCache@(SharedResourceCache cache _ loadResourceOp _ _ _) resourceId = do+ existingItem <- atomically $ do+ item <- M.lookup resourceId cache+ case item of+ Nothing -> pure Nothing+ Just result@(LoadingEntry loadingMVar) -> pure (Just result)+ Just result@(LoadedEntry resource) -> do+ handlerSharerJoin resourceCache resource resourceId+ pure (Just result)++ case existingItem of+ Just (LoadedEntry item) -> pure $ Right item+ Just (LoadingEntry loadedSignalMVar) -> do+ -- Wait the for the other thread that is already loading the resource to signal that it has loaded the item+ -- into the cache then recursively start again+ readMVar loadedSignalMVar+ loadCacheableResource resourceCache resourceId+ Nothing -> loadFreshlyIntoCache resourceCache resourceId++ loadFreshlyIntoCache :: SharedResourceCache err a -> Text -> IO (Either err (CacheItem a))+ loadFreshlyIntoCache resourceCache@(SharedResourceCache cache _ loadResourceOp _ _ _) resourceId =+ -- We run this operation in mask so that we aren't left with a permanent loading claim in the cache if the thread is interrupted+ mask $ (\restore -> do+ maybeSemaphore <- takeOwnershipOfLoad resourceCache resourceId++ case maybeSemaphore of+ -- Already loaded or loading in another thread, recursively start again+ Nothing -> restore $ loadCacheableResource resourceCache resourceId++ -- We've claimed ownership of loading the item into the cache+ Just semaphore ->+ restore (loadIntoCache resourceCache resourceId semaphore)+ `finally` uninterruptibleMask_ (removeLoadingClaim resourceCache resourceId >> signalCacheLoaded semaphore)+ )++ where+ signalCacheLoaded semaphore = putMVar semaphore ()++ -- Returns a Just if we took ownership and Nothing if a thread is already loading the item or it has already been fully loaded+ takeOwnershipOfLoad :: SharedResourceCache err a -> Text -> IO (Maybe (MVar ()))+ takeOwnershipOfLoad resourceCache@(SharedResourceCache cache _ loadResourceOp _ _ _) resourceId = do+ signal <- newEmptyMVar+ atomically $ do+ cachedItem <- M.lookup resourceId cache+ case cachedItem of+ Nothing -> do+ let entry = LoadingEntry signal+ M.insert entry resourceId cache+ pure (Just signal)+ _ -> pure Nothing++ loadIntoCache :: SharedResourceCache err a -> Text -> MVar () -> IO (Either err (CacheItem a))+ loadIntoCache resourceCache@(SharedResourceCache cache _ loadResourceOp _ _ _) resourceId _ = do+ resourceLoadResult <- loadResourceOp resourceId+ case resourceLoadResult of+ Right resource -> putIntoCache resourceCache resourceId resource+ Left err -> pure (Left err)++ putIntoCache :: SharedResourceCache err a -> Text -> a -> IO (Either err (CacheItem a))+ putIntoCache resourceCache@(SharedResourceCache cache _ loadResourceOp _ _ _) resourceId resource = do+ atomically $ do+ connections <- newTVar 0+ let entry = CacheItem resource connections+ handlerSharerJoin resourceCache entry resourceId+ M.insert (LoadedEntry entry) resourceId cache+ pure (Right entry)++ removeLoadingClaim :: SharedResourceCache err a -> Text -> IO ()+ removeLoadingClaim resourceCache@(SharedResourceCache cache _ _ _ _ _) resourceId = atomically $ do+ result <- M.lookup resourceId cache++ case result of+ Just (LoadingEntry _) -> void (M.delete resourceId cache)+ _ -> pure ()
@@ -0,0 +1,14 @@+module Data.SharedResourceCache.Internal.Model(CacheExpiryConfig(..), CacheEntry(..)) where++ import Control.Concurrent (MVar)+ import Data.SharedResourceCache.Internal.CacheItem (CacheItem)++ -- | Configuration for managing when items can be removed from the cache when there are no more sharers+ data CacheExpiryConfig = CacheExpiryConfig {+ sweepIntervalSeconds :: Int,+ -- ^ How often the cache's sweeper background thread should sweep the cache for expired entries with no sharers that are eligible for removal, in seconds+ itemEligibleForRemovalAfterUnusedSeconds :: Int + -- ^ How long after a cache entry has had no sharers that it is eligible for removal from the cache by the sweeper background thread+ }+ + data CacheEntry err a = LoadedEntry (CacheItem a) | LoadingEntry (MVar ())
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"