From fe6dcc98eaa5545f98ff6ab8d38b3969517a3de0 Mon Sep 17 00:00:00 2001 From: vlatkoB Date: Tue, 23 Jun 2020 16:33:41 +0200 Subject: [PATCH 1/2] add deleteView, cachedMaybe and stripedCachedMaybe --- lrucaching.cabal | 2 +- src/Data/LruCache.hs | 12 ++++++++++++ src/Data/LruCache/IO.hs | 33 ++++++++++++++++++++++++++++++++- 3 files changed, 45 insertions(+), 2 deletions(-) diff --git a/lrucaching.cabal b/lrucaching.cabal index 627fa8b..47282ac 100644 --- a/lrucaching.cabal +++ b/lrucaching.cabal @@ -1,5 +1,5 @@ name: lrucaching -version: 0.3.3 +version: 0.3.4 synopsis: LRU cache description: Please see README.md homepage: https://github.com/cocreature/lrucaching#readme diff --git a/src/Data/LruCache.hs b/src/Data/LruCache.hs index efe87aa..5d0b2e7 100644 --- a/src/Data/LruCache.hs +++ b/src/Data/LruCache.hs @@ -15,6 +15,7 @@ module Data.LruCache , empty , insert , insertView + , deleteView , lookup ) where @@ -87,6 +88,17 @@ insert key val c = , lruQueue = queue } +-- | Delete an element from the 'LruCache'. +deleteView :: (Hashable k, Ord k) => k -> LruCache k v -> Maybe (v, LruCache k v) +deleteView key c = + case HashPSQ.deleteView key (lruQueue c) of + Nothing -> Nothing + Just (p,mbOldVal,queue) -> Just ( mbOldVal + , c { lruSize = lruSize c - 1 + , lruQueue = queue + } + ) + -- | Insert an element into the 'LruCache' returning the evicted -- element if any. -- diff --git a/src/Data/LruCache/IO.hs b/src/Data/LruCache/IO.hs index a988b6a..40c9482 100644 --- a/src/Data/LruCache/IO.hs +++ b/src/Data/LruCache/IO.hs @@ -11,9 +11,11 @@ automatically when cache entries are evicted module Data.LruCache.IO ( LruHandle(..) , cached + , cachedMaybe , newLruHandle , StripedLruHandle(..) , stripedCached + , stripedCachedMaybe , newStripedLruHandle ) where @@ -48,6 +50,23 @@ cached (LruHandle ref) k io = atomicModifyIORef' ref $ \c -> (insert k v c, ()) return v +-- | Maybe form of `cached` +cachedMaybe :: (Hashable k, Ord k) => LruHandle k v -> k -> IO (Maybe v) -> IO (Maybe v) +cachedMaybe (LruHandle ref) k io = + do lookupRes <- atomicModifyIORef' ref $ \c -> + case lookup k c of + Nothing -> (c, Nothing) + Just (v, c') -> (c', Just v) + case lookupRes of + Just v -> return $ Just v + Nothing -> + do v <- io + case v of + Nothing -> return Nothing + Just v' -> do + atomicModifyIORef' ref $ \c -> (insert k v' c, ()) + return v + -- | Using a stripe of multiple handles can improve the performance in -- the case of concurrent accesses since several handles can be -- accessed in parallel. @@ -69,4 +88,16 @@ stripedCached :: stripedCached (StripedLruHandle v) k = cached (v Vector.! idx) k where - idx = hash k `mod` Vector.length v \ No newline at end of file + idx = hash k `mod` Vector.length v + +-- | Maybe form of `stripedCached` +stripedCachedMaybe :: + (Hashable k, Ord k) => + StripedLruHandle k v -> + k -> + IO (Maybe v) -> + IO (Maybe v) +stripedCachedMaybe (StripedLruHandle v) k = + cachedMaybe (v Vector.! idx) k + where + idx = hash k `mod` Vector.length v From f5537ee021f5864734723b0256844940ee411169 Mon Sep 17 00:00:00 2001 From: vlatkoB Date: Tue, 23 Jun 2020 16:51:53 +0200 Subject: [PATCH 2/2] deleteView for IO and striped --- src/Data/LruCache.hs | 14 +++++++------- src/Data/LruCache/IO.hs | 23 +++++++++++++++++++++++ 2 files changed, 30 insertions(+), 7 deletions(-) diff --git a/src/Data/LruCache.hs b/src/Data/LruCache.hs index 5d0b2e7..7401b34 100644 --- a/src/Data/LruCache.hs +++ b/src/Data/LruCache.hs @@ -89,15 +89,15 @@ insert key val c = } -- | Delete an element from the 'LruCache'. -deleteView :: (Hashable k, Ord k) => k -> LruCache k v -> Maybe (v, LruCache k v) +deleteView :: (Hashable k, Ord k) => k -> LruCache k v -> (Maybe v, LruCache k v) deleteView key c = case HashPSQ.deleteView key (lruQueue c) of - Nothing -> Nothing - Just (p,mbOldVal,queue) -> Just ( mbOldVal - , c { lruSize = lruSize c - 1 - , lruQueue = queue - } - ) + Nothing -> (Nothing, c) + Just (p,mbOldVal,queue) -> ( Just mbOldVal + , c { lruSize = lruSize c - 1 + , lruQueue = queue + } + ) -- | Insert an element into the 'LruCache' returning the evicted -- element if any. diff --git a/src/Data/LruCache/IO.hs b/src/Data/LruCache/IO.hs index 40c9482..11aa3e0 100644 --- a/src/Data/LruCache/IO.hs +++ b/src/Data/LruCache/IO.hs @@ -17,6 +17,8 @@ module Data.LruCache.IO , stripedCached , stripedCachedMaybe , newStripedLruHandle + , deleteViewIO + , stripedDeleteViewIO ) where import Control.Applicative ((<$>)) @@ -67,6 +69,14 @@ cachedMaybe (LruHandle ref) k io = atomicModifyIORef' ref $ \c -> (insert k v' c, ()) return v +-- | Delete an item from the cache and return value of that item. +deleteViewIO :: (Hashable k, Ord k) => LruHandle k v -> k -> IO (Maybe v) +deleteViewIO (LruHandle ref) k = + atomicModifyIORef' ref $ \c -> + case deleteView k c of + (Nothing, c') -> (c', Nothing) + (Just v, c') -> (c', Just v) + -- | Using a stripe of multiple handles can improve the performance in -- the case of concurrent accesses since several handles can be -- accessed in parallel. @@ -101,3 +111,16 @@ stripedCachedMaybe (StripedLruHandle v) k = cachedMaybe (v Vector.! idx) k where idx = hash k `mod` Vector.length v + + + +-- | Striped version of `deleteViewIO` +stripedDeleteViewIO :: + (Hashable k, Ord k) => + StripedLruHandle k v -> + k -> + IO (Maybe v) +stripedDeleteViewIO (StripedLruHandle v) k = + deleteViewIO (v Vector.! idx) k + where + idx = hash k `mod` Vector.length v