exp-cache 0.1.0.0 → 0.1.0.1

raw patch · 11 files changed

+169/−30 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +1/−0
• exp-cache.cabal +6/−1
• src/Data/Cache.hs +41/−21
• src/Data/Cache/Eviction/FIFO.hs +23/−0
• src/Data/Cache/Eviction/LFU.hs +2/−0
• src/Data/Cache/Eviction/LRU.hs +1/−1
• src/Data/Cache/Eviction/MRU.hs +1/−0
• src/Data/Cache/Eviction/RR.hs +6/−4
• test/Spec.hs +2/−0
• test/Spec/CacheTests.hs +47/−3
• test/Spec/LFUTests.hs +39/−0

@@ -1,3 +1,4 @@ # Changelog for lru-cache  ## Unreleased changes+1.0.0.1   - Introduced the FIFO strategy

@@ -1,5 +1,5 @@ name:           exp-cache-version:        0.1.0.0+version:        0.1.0.1 description:    Please see the README on Github at <https://github.com/ChrisCoffey/exp-cache#readme> homepage:       https://github.com/ChrisCoffey/exp-cache#readme bug-reports:    https://github.com/ChrisCoffey/exp-cache/issues@@ -38,6 +38,7 @@     , Data.Cache.Eviction.LFU     , Data.Cache.Eviction.MRU     , Data.Cache.Eviction.RR+    , Data.Cache.Eviction.FIFO   other-modules:     Data.Cache.Eviction   default-extensions:  DataKinds FlexibleContexts ScopedTypeVariables OverloadedStrings ViewPatterns NamedFieldPuns@@ -51,6 +52,9 @@   hs-source-dirs:       test   ghc-options: -threaded -rtsopts -with-rtsopts=-N+  default-extensions:  DataKinds FlexibleContexts ScopedTypeVariables OverloadedStrings ViewPatterns NamedFieldPuns+                       KindSignatures RecordWildCards ConstraintKinds TypeSynonymInstances FlexibleInstances MultiParamTypeClasses+                       InstanceSigs FunctionalDependencies TupleSections   build-depends:       base >=4.7 && <5     , exp-cache@@ -64,6 +68,7 @@       Spec.LRUTests,       Spec.MRUTests,       Spec.RRTests,+      Spec.LFUTests,       Spec.CacheTests   default-language: Haskell2010 

@@ -1,6 +1,7 @@ module Data.Cache (     Cache,     newCache,+    readThrough,      EvictionStrategy(..), @@ -21,7 +22,11 @@      -- | Least Frequently Used Cache     LFU,-    newLFU+    newLFU,++    -- | First in First Out Cache (a queue)+    FIFO,+    newFIFO     ) where  import Data.Cache.Eviction (EvictionStrategy(..))@@ -29,58 +34,73 @@ import Data.Cache.Eviction.MRU import Data.Cache.Eviction.RR import Data.Cache.Eviction.LFU+import Data.Cache.Eviction.FIFO  import qualified Data.HashMap.Strict as HM import Control.DeepSeq (NFData) import Data.Hashable (Hashable)+import Numeric.Natural +-- | A Cache is a bounded collection of data that supports fast random access. When the cach is full, the associated+-- 'EvictionStrategy' is used to discard an item from the cache. Library users should use 'readThrough' to read and+-- replace items in the cache. data Cache k v s =     Cache {         cacheData :: HM.HashMap k v,         evictionStrategy :: s,-        maxSize :: Int,-        currentSize :: Int+        maxSize :: !Int,+        currentSize :: !Int         } +-- | Create a new cache of the specified size using the provided 'EvictionStrategy' newCache :: (Hashable k, NFData v, EvictionStrategy s, Eq k, Ord k) =>-    Int -- ^ The maximum cache size+    Natural -- ^ The maximum cache size     -> s k -- ^ The evictionStrategy     -> Cache k v (s k)+newCache 0 _ = error "Invalid cache size" newCache maxSize evictionStrategy =     Cache {         cacheData = HM.empty,         evictionStrategy,-        maxSize,+        maxSize = fromIntegral maxSize,         currentSize = 0     } +-- | Performs a read-through operation on a given cache. readThrough :: (Hashable k, NFData v, EvictionStrategy s, Eq k, Ord k, Monad m) =>-    Cache k v (s k)-    -> k-    -> (k -> m v)+    Cache k v (s k) -- ^ The current cache state+    -> k            -- ^ The key to look up in the cache+    -> (k -> m v)   -- ^ The accessor function to evaluate if the key is not found     -> m (v , Cache k v (s k))-readThrough cache@(Cache {maxSize, evictionStrategy, cacheData, currentSize}) key onMiss =+readThrough cache@(Cache {maxSize, cacheData, currentSize}) key onMiss =     case HM.lookup key cacheData of-        -- A hit. Because the value is already in the cache, no need to evict. Update the-        -- accessed time for 'key'-        Just v -> do-            let strat' = recordLookup key evictionStrategy-            pure (v, cache {evictionStrategy = strat'} )         -- On a miss when the cache is full:         -- 1) evict the relevant key (removes from HashMap & Strategy)         -- 2) Record the newest key in the strategy         -- 3) Add key to the cache data-        Nothing | maxSize == currentSize -> do+        Nothing | maxSize <= currentSize -> do             v <- onMiss key-            let (strat', evicted) = evict evictionStrategy-                strat'' = recordLookup key strat'-                cacheData' = HM.insert key v $ maybe cacheData (`HM.delete` cacheData) evicted-            pure (v, cache {cacheData = cacheData', evictionStrategy = strat''})+            let cache' = postEviction v+            pure (v, cache' {currentSize = currentSize + 1})+        -- A hit. Because the value is already in the cache, no need to evaluate onMiss. Update the+        -- accessed time for 'key'+        Just v -> do+            let cache' = if maxSize <= currentSize+                     then postEviction v+                     else cache+                strat' = recordLookup key (evictionStrategy cache')+            pure (v, cache' {evictionStrategy = strat'} )         -- A miss when the cache is not full         -- 1) Record the new key in the data cache         -- 2) Record the new key in the strategy         Nothing -> do             v <- onMiss key-            let strat' = recordLookup key evictionStrategy+            let strat' = recordLookup key (evictionStrategy cache)                 cacheData' = HM.insert key v cacheData-            pure (v, cache {cacheData = cacheData', evictionStrategy = strat'})+            pure (v, cache {cacheData = cacheData', evictionStrategy = strat', currentSize = currentSize + 1})+        where+            postEviction v = let+                (strat', evicted) = evict (evictionStrategy cache)+                strat'' = recordLookup key strat'+                cacheData' = HM.insert key v $ maybe cacheData (`HM.delete` cacheData) evicted+                in cache {cacheData = cacheData', evictionStrategy = strat''}

@@ -0,0 +1,23 @@+module Data.Cache.Eviction.FIFO (+    FIFO,+    newFIFO+) where++import Data.Cache.Eviction+import Data.Sequence++-- | A First in First Out eviction strategy. Items are evicted based on order added, regardless of usage patterns.+newtype FIFO k = FIFO (Seq k)+    deriving (Eq, Show)++newFIFO :: FIFO k+newFIFO = FIFO empty++instance EvictionStrategy FIFO where+    recordLookup key (FIFO keys) =+        FIFO (key <| keys)++    evict (FIFO keys) =+        case viewr keys of+            EmptyR -> (FIFO keys, Nothing)+            rest :> last -> (FIFO rest, Just last)

@@ -10,6 +10,8 @@ import Data.Hashable import qualified Data.HashPSQ as PSQ +-- | Evict the least frequently used element from the cache. This means as an element is accessed, its "score" increases+-- and the element is more likely to survive eviction once the cache fills up. newtype LFU k = LFU {     queue :: PSQ.HashPSQ k Word64 ()     } deriving (Eq, Show)

@@ -37,7 +37,7 @@             EmptyR -> (SeqLRU elements, Nothing)             rest :> last -> (SeqLRU rest, Just last) --- | An optimized version of an LRU cache+-- | An optimized version of an LRU cache. The least recently used element in the cache is evicted once the cache fills up. data LRU k =     LRU {         queue :: PSQ.HashPSQ k Word64 (),

@@ -13,6 +13,7 @@ import Data.Word (Word64) import qualified Data.HashPSQ as PSQ +-- | A Most Recently Used cache. This evicts the most recently accessed item from the cache data MRU k =     MRU {         queue :: PSQ.HashPSQ k Word64 (),

@@ -12,11 +12,12 @@ import System.Random (StdGen, randomR)  -- | Random Replacement cache. The seed is fixed to an 'StdGen' since its both--- easily accessible & good enough for this purpose.+-- easily accessible & good enough for this purpose. Random replacement means exactly what it+-- sounds like: when the cache fills up a random element is selected and evicted. data RR k = RR {-    seed :: StdGen,-    writeCell :: Int,-    upperBound :: Int,+    seed :: !StdGen,+    writeCell :: !Int,+    upperBound :: !Int,     overwritten :: Maybe k, -- This is a wart used for tracking evicted nodes     contents :: StupidBiMap k     } deriving (Show)@@ -26,6 +27,7 @@              upperBound l == upperBound r &&              contents l == contents r +-- | Generate a new Random Replacement cache using the provided seed & size. newRR ::     StdGen     -> Int

@@ -2,6 +2,7 @@ import Spec.MRUTests (mruTests) import Spec.RRTests (rrSpec) import Spec.LFUTests (lfuTests)+import Spec.CacheTests (cacheTests)  import Test.Tasty  (TestTree, defaultMain, testGroup) @@ -10,6 +11,7 @@  allTests :: TestTree allTests = testGroup "Data.Cache" [+    cacheTests,     lruTests,     mruTests,     rrSpec,

@@ -4,11 +4,55 @@  import Data.Cache -import           Test.HUnit                   ((@=?))-import           Test.Tasty                   (TestTree, testGroup)-import           Test.Tasty.HUnit             (testCase)+import Control.Exception+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Test.HUnit                   ((@=?))+import Test.Tasty                   (TestTree, testGroup)+import Test.Tasty.HUnit             (testCase) +type DefaultCache = Cache Int Int (FIFO Int)  cacheTests :: TestTree cacheTests = testGroup "Cache" [+    testCase "Cannot initialize a 0 sized cache" $ do+        res <- catch ((pure $! (newCache 0 newFIFO :: DefaultCache)) *> pure False) (\(e::SomeException) -> pure True)+        res @=? True+    ,testCase "Verify that a cache size of 1 stores an element before eviction" $ do+        r <- newIORef 0+        let cache = newCache 1 newFIFO+        (v,cache') <- readThrough cache 10 (const $ pure 1 <* writeIORef r 1) :: IO (Int, DefaultCache)+        _ <- readThrough cache' 10 (const $ pure 1 <* writeIORef r 2)+        calledLookup <- readIORef r+        calledLookup @=? 1+    ,testCase "Verify that the proper eviction strategy is evaluated (FIFO vs. LRU)" $ do+        let cache = newCache 1 newFIFO+        r <- newIORef False+        (_,cache') <- readThrough cache 10 (const $ pure 1) :: IO (Int, DefaultCache)+        (_,cache'') <- readThrough cache' 11 (const $ pure 1)+        _ <- readThrough cache'' 10 (const $ pure 1 <* writeIORef r True)+        v <- readIORef r+        v @=? True+    ,testCase "Verify that eviction only fires once the cache is full" $ do+        let cache = newCache 1 newFIFO+        r <- newIORef False+        (_,cache') <- readThrough cache 10 (const $ pure 1) :: IO (Int, DefaultCache)+        (_,cache'') <- readThrough cache' 11 (const $ pure 1)+        _ <- readThrough cache'' 10 (const $ pure 1 <* writeIORef r True)+        v <- readIORef r+        v @=? True+    ,testCase "Verify that the read function evaluates only if the key is not in the cache" $ do+        let cache = newCache 100 newFIFO+        r <- newIORef True+        (_,cache') <- readThrough cache 10 (const $ pure 1) :: IO (Int, DefaultCache)+        _ <- readThrough cache' 10 (const $ pure 1 <* writeIORef r False)+        v <- readIORef r+        v @=? True+    ,testCase "Verify that the value returned by the read function is stored in the cache" $ do+        let cache = newCache 100 newFIFO+        r <- newIORef True+        (v,cache') <- readThrough cache 10 (const $ pure 1) :: IO (Int, DefaultCache)+        v @=? 1     ]++--TODO make a note that this is not the most memory efficient, but it is time efficient+

@@ -0,0 +1,39 @@+module Spec.LFUTests (+    lfuTests+) where++import Data.Cache+import Data.Cache.Eviction.LFU++import           Test.HUnit                   ((@=?))+import           Test.Tasty                   (TestTree, testGroup)+import           Test.Tasty.HUnit             (testCase)+++lfuTests :: TestTree+lfuTests = testGroup "Least Frequently Used" [+    testCase "evict empty == empty" $ do+        let strat = newLFU :: LFU Int+            (s, Nothing) = evict strat :: (LFU Int, Maybe Int)+        s @=? strat+    , testCase "evict (1:empty) == (empty, Just 1) " $ do+        let strat = newLFU :: LFU Int+            s = recordLookup (1 :: Int) strat+            (s', Just _) = evict s :: (LFU Int, Maybe Int)+        LFUContentsOnlyEq s' @=? LFUContentsOnlyEq strat+    , testCase "read a b a => evict b a" $ do+        let strat = newLFU :: LFU Int+            [x,y] = [1,2] :: [Int]+            s = recordLookup x . recordLookup y $ recordLookup x strat+            (s', Just a) = evict s+            (s'', Just b) = evict s'+            (_, Nothing) = evict s'' :: (LFU Int, Maybe Int)+        a == y @=? True+        b == x @=? True+    , testCase "read a b c c b => evict a" $ do+        let strat = newLFU :: LFU Int+            [v,w,x,y,z] = [1,2,3,3,2] :: [Int]+            s = recordLookup v . recordLookup w . recordLookup x . recordLookup y $ recordLookup z strat+            (s', Just a) = evict s:: (LFU Int, Maybe Int)+        a @=? v+    ]