arbor-lru-cache 0.1.1.0 → 0.1.1.1

raw patch · 6 files changed

+106/−95 lines, 6 filesdep −generic-lensdep −lensdep ~containersdep ~hedgehogdep ~hspecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: generic-lens, lens

Dependency ranges changed: containers, hedgehog, hspec, hw-hspec-hedgehog, stm

API changes (from Hackage documentation)

Files

• arbor-lru-cache.cabal +53/−52
• src/Arbor/LruCache.hs +22/−25
• src/Arbor/LruCache/Internal/PriorityQueue.hs +22/−10
• src/Arbor/LruCache/Type.hs +3/−2
• test/Arbor/LruCache/Internal/PriorityQueueSpec.hs +4/−4
• test/Arbor/LruCache/LruCacheSpec.hs +2/−2

@@ -1,63 +1,64 @@--- This file has been generated from package.yaml by hpack version 0.18.1.------ see: https://github.com/sol/hpack+cabal-version: 2.4 -name:           arbor-lru-cache-version:        0.1.1.0-description:    Please see the README on GitHub at <https://github.com/arbor/arbor-lru-cache#readme>-homepage:       https://github.com/arbor/arbor-lru-cache#readme-bug-reports:    https://github.com/arbor/arbor-lru-cache/issues-author:         Arbor Networks-maintainer:     mayhem@arbor.net-copyright:      2018 Arbor Networks-license:        MIT-license-file:   LICENSE-build-type:     Simple-cabal-version:  >= 1.10+name:               arbor-lru-cache+version:            0.1.1.1+description:        Please see the README on GitHub at <https://github.com/arbor/arbor-lru-cache#readme>+homepage:           https://github.com/arbor/arbor-lru-cache#readme+bug-reports:        https://github.com/arbor/arbor-lru-cache/issues+author:             Arbor Networks+maintainer:         mayhem@arbor.net+copyright:          2018-2019 Arbor Networks+category:           Data, Concurrency+synopsis:           LRU cache based on STM+license:            MIT+license-file:       LICENSE+tested-with:        GHC == 8.8.1, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2+build-type:         Simple+extra-source-files: README.md+                    ChangeLog.md -extra-source-files:-    ChangeLog.md-    README.md+common base                 { build-depends: base                 >= 4.7        && < 5      } +common containers           { build-depends: containers           >= 0.5        && < 0.7    }+common hedgehog             { build-depends: hedgehog             >= 0.5        && < 1.1    }+common hspec                { build-depends: hspec                >= 2.4        && < 2.8    }+common hw-hspec-hedgehog    { build-depends: hw-hspec-hedgehog    >= 0.1        && < 0.2    }+common stm                  { build-depends: stm                  >= 2.5        && < 3      }++common arbor-lru-cache+  build-depends:      arbor-lru-cache++common config+  default-language:   Haskell2010+  ghc-options:        -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ source-repository head   type: git   location: https://github.com/arbor/arbor-lru-cache  library-  hs-source-dirs:-      src-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints-  build-depends:-      base >= 4.7 && < 5-    , containers-    , generic-lens-    , lens-    , stm-  exposed-modules:-      Arbor.LruCache-      Arbor.LruCache.Internal.PriorityQueue-      Arbor.LruCache.Type+  import:             base, config+                    , containers+                    , stm+  exposed-modules:    Arbor.LruCache+                      Arbor.LruCache.Internal.PriorityQueue+                      Arbor.LruCache.Type   other-modules:-      Paths_arbor_lru_cache-  default-language: Haskell2010+  hs-source-dirs:     src + test-suite arbor-lru-cache-test-  type: exitcode-stdio-1.0-  main-is: Spec.hs-  hs-source-dirs:-      test-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N-  build-depends:-      base >= 4.7 && < 5-    , containers-    , generic-lens-    , lens-    , stm-    , hedgehog-    , hspec-    , hw-hspec-hedgehog-    , arbor-lru-cache-  other-modules:-      Arbor.LruCache.Internal.PriorityQueueSpec-      Arbor.LruCache.LruCacheSpec-  default-language: Haskell2010+  import:             base, config+                    , arbor-lru-cache+                    , containers+                    , hedgehog+                    , hspec+                    , hw-hspec-hedgehog+                    , stm+  type:               exitcode-stdio-1.0+  main-is:            Spec.hs+  build-tool-depends: hspec-discover:hspec-discover+  other-modules:      Arbor.LruCache.Internal.PriorityQueueSpec+                      Arbor.LruCache.LruCacheSpec+  hs-source-dirs:     test+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N

@@ -1,8 +1,5 @@-{-# LANGUAGE DataKinds           #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections       #-}-{-# LANGUAGE TypeApplications    #-}- module Arbor.LruCache     ( lookup     , makeCache@@ -15,26 +12,26 @@  import Control.Concurrent import Control.Exception-import Control.Lens import Control.Monad-import Data.Generics.Product.Any+import Data.Function      ((&)) import Data.Maybe-import Prelude                   hiding (lookup)+import Prelude            hiding (lookup) +-- import qualified Arbor.LruCache.Internal.PriorityQueue as PQ import qualified Arbor.LruCache.Internal.PriorityQueue as PQ import qualified Arbor.LruCache.Type                   as Z import qualified Control.Concurrent.STM                as STM-import qualified Data.Map                              as M+import qualified Data.Map.Strict                       as M  lookup :: Ord k => k -> Z.Cache k v -> IO v lookup k cache = do   newTmv <- STM.newTVarIO Nothing-  let maxInFlight       = cache ^. the @"config" . the @"maxRequestsInFlight"-  let evict             = cache ^. the @"evict"-  let tRequestsInFlight = cache ^. the @"requestsInFlight"-  let retrieve          = cache ^. the @"retrieve"-  let tEntries          = cache ^. the @"entries"-  let tOccupancy        = cache ^. the @"occupancy"+  let maxInFlight       = cache & Z.config & Z.maxRequestsInFlight+  let evict             = cache & Z.evict+  let tRequestsInFlight = cache & Z.requestsInFlight+  let retrieve          = cache & Z.retrieve+  let tEntries          = cache & Z.entries+  let tOccupancy        = cache & Z.occupancy    join $ STM.atomically $ do     es <- STM.readTVar tEntries@@ -57,14 +54,14 @@                 STM.atomically $ do                   entries2 <- STM.readTVar tEntries                   forM_ (M.lookup k entries2) $ \tv -> STM.writeTVar tv (throw e)-                  STM.modifyTVar tRequestsInFlight pred+                  STM.modifyTVar' tRequestsInFlight pred                   STM.writeTVar tEntries (M.delete k entries2)                 throw e                kvsForEviction <- STM.atomically $ do                 STM.writeTVar newTmv (Just v)-                STM.modifyTVar tRequestsInFlight pred-                STM.modifyTVar tOccupancy succ+                STM.modifyTVar' tRequestsInFlight pred+                STM.modifyTVar' tOccupancy succ                  registerForEviction k cache                 takeEvictionsDue cache@@ -75,19 +72,19 @@  registerForEviction :: Eq k => k -> Z.Cache k v -> STM.STM () registerForEviction k cache = do-  let tEvictionQueue    = cache ^. the @"evictionQueue"-  let tEvictionPriority = cache ^. the @"evictionPriority"+  let tEvictionQueue    = cache & Z.evictionQueue+  let tEvictionPriority = cache & Z.evictionPriority -  STM.modifyTVar tEvictionPriority (+1)+  STM.modifyTVar' tEvictionPriority (+1)   evictionPriority <- STM.readTVar tEvictionPriority-  STM.modifyTVar tEvictionQueue (PQ.insert evictionPriority k)+  STM.modifyTVar' tEvictionQueue (PQ.insert evictionPriority k)  takeEvictionsDue :: Ord k => Z.Cache k v -> STM.STM [(k, v)] takeEvictionsDue cache = do-  let maxOccupancy      = cache ^. the @"config" . the @"maxOccupancy"-  let tEntries          = cache ^. the @"entries"-  let tOccupancy        = cache ^. the @"occupancy"-  let tEvictionQueue    = cache ^. the @"evictionQueue"+  let maxOccupancy      = cache & Z.config & Z.maxOccupancy+  let tEntries          = cache & Z.entries+  let tOccupancy        = cache & Z.occupancy+  let tEvictionQueue    = cache & Z.evictionQueue    evictionQueue <- STM.readTVar tEvictionQueue   occupancy <- STM.readTVar tOccupancy@@ -122,7 +119,7 @@  entries :: Ord k => Z.Cache k v -> IO (M.Map k (Maybe v)) entries cache = do-  let tEntries          = cache ^. the @"entries"+  let tEntries          = cache & Z.entries    STM.atomically $ do     m <- STM.readTVar tEntries

@@ -1,21 +1,33 @@+{-# LANGUAGE BangPatterns        #-} {-# LANGUAGE ScopedTypeVariables #-}  module Arbor.LruCache.Internal.PriorityQueue where +-- import Control.DeepSeq (seq) import Data.List (sortOn, splitAt) -newtype PriorityQueue p v = PriorityQueue [(p, v)]+newtype PQueue p v = PQueue [(p, v)]   deriving (Eq, Show) -insert :: Eq v => p -> v -> PriorityQueue p v -> PriorityQueue p v-insert p v (PriorityQueue qas) = PriorityQueue ((p, v):filter ((/= v) . snd) qas)+insert :: Eq v => p -> v -> PQueue p v -> PQueue p v+insert !p !v (PQueue qas) =+  let lst = (p, v):filter ((/= v) . snd) qas+  in PQueue (forceSpine lst) -take :: Ord p => Int -> PriorityQueue p v -> ([v], PriorityQueue p v)-take n (PriorityQueue qas) = case splitAt n (sortOn fst qas) of-  (as, bs) -> (snd <$> as, PriorityQueue bs)+take :: Ord p => Int -> PQueue p v -> ([v], PQueue p v)+take n (PQueue qas) = case splitAt n (sortOn fst qas) of+  (as, bs) -> (snd <$> as, PQueue bs) -empty :: PriorityQueue p v-empty = PriorityQueue []+empty :: PQueue p v+empty = PQueue [] -toList :: Ord p => PriorityQueue p v -> [(p, v)]-toList (PriorityQueue qas) = sortOn fst qas+toList :: Ord p => PQueue p v -> [(p, v)]+toList (PQueue qas) = sortOn fst qas++size :: PQueue p v -> Int+size (PQueue qas) = length qas++forceSpine :: [a] -> [a]+forceSpine as =+  let fc = foldr (const id) () as+  in fc `seq` as

@@ -5,9 +5,10 @@  import GHC.Generics +-- import qualified Arbor.LruCache.Internal.PriorityQueue as PQ import qualified Arbor.LruCache.Internal.PriorityQueue as PQ import qualified Control.Concurrent.STM                as STM-import qualified Data.Map                              as M+import qualified Data.Map.Strict                       as M  data CacheConfig = CacheConfig   { maxRequestsInFlight :: Int@@ -18,7 +19,7 @@   { config           :: CacheConfig   , requestsInFlight :: STM.TVar Int   , entries          :: STM.TVar (M.Map k (STM.TVar (Maybe v)))-  , evictionQueue    :: STM.TVar (PQ.PriorityQueue Int k)+  , evictionQueue    :: STM.TVar (PQ.PQueue Int k)   , evictionPriority :: STM.TVar Int   , occupancy        :: STM.TVar Int   , retrieve         :: k -> IO v

@@ -10,7 +10,7 @@ spec :: Spec spec = describe "Arbor.LruCache.Internal.PriorityQueueSpec" $ do   it "Insertion dedupes by value" $ requireTest $ do-    let actual = (PQ.empty :: PQ.PriorityQueue Int Int)+    let actual = (PQ.empty :: PQ.PQueue Int Int)           & PQ.insert 1 101           & PQ.insert 3 101           & PQ.insert 2 101@@ -19,7 +19,7 @@      PQ.toList actual === expected   it "Insert stores all non-duplicate values" $ requireTest $ do-    let actual = (PQ.empty :: PQ.PriorityQueue Int Int)+    let actual = (PQ.empty :: PQ.PQueue Int Int)           & PQ.insert 1 101           & PQ.insert 3 303           & PQ.insert 2 202@@ -28,7 +28,7 @@      PQ.toList actual === expected   it "Take removes most priority element from queue" $ requireTest $ do-    let actual = (PQ.empty :: PQ.PriorityQueue Int Int)+    let actual = (PQ.empty :: PQ.PQueue Int Int)           & PQ.insert 1 101           & PQ.insert 3 303           & PQ.insert 2 202@@ -38,7 +38,7 @@      PQ.toList actual === expected   it "Take yields most priority element from queue" $ requireTest $ do-    let actual = (PQ.empty :: PQ.PriorityQueue Int Int)+    let actual = (PQ.empty :: PQ.PQueue Int Int)           & PQ.insert 1 101           & PQ.insert 3 303           & PQ.insert 2 202

@@ -46,8 +46,8 @@ retrieve :: TVar [Event] -> Int -> IO String retrieve th mk = do   let mv = show mk-  atomically $ modifyTVar th (RetrieveEvent mk mv:)+  atomically $ modifyTVar' th (RetrieveEvent mk mv:)   return mv  evict :: TVar [Event] -> Int -> String -> IO ()-evict th mk mv = atomically $ modifyTVar th (EvictEvent mk mv:)+evict th mk mv = atomically $ modifyTVar' th (EvictEvent mk mv:)