lrucache 1.1.1.4 → 1.2.0.0
raw patch · 6 files changed
+82/−26 lines, 6 filesdep +contravariant
Dependencies added: contravariant
Files
- LICENSE +1/−1
- changes.txt +8/−1
- lrucache.cabal +6/−4
- src/Data/Cache/LRU.hs +3/−0
- src/Data/Cache/LRU/IO/Internal.hs +4/−1
- src/Data/Cache/LRU/Internal.hs +60/−19
LICENSE view
@@ -1,4 +1,4 @@-Copyright Carl Howells 2010+Copyright Carl Howells 2010-2015 All rights reserved.
changes.txt view
@@ -1,3 +1,10 @@+** 1.2.0.0+* fix build warning on GHC 7.10+* add insertInforming+* add instances for Data, Typeable, Foldable, and Traversable+* add functions for compatibility with lens++ ** 1.1.1.4 * move changelog to hackage 2 approved location @@ -6,7 +13,7 @@ * Test for containers >= 0.5, rather than GHC >= 7.6 -** 1.1.1.2 +** 1.1.1.2 * Make actually compatible with containers 0.5 - fix strictness issue
lrucache.cabal view
@@ -1,11 +1,11 @@ Name: lrucache-Version: 1.1.1.4+Version: 1.2.0.0 Synopsis: a simple, pure LRU cache License: BSD3 License-file: LICENSE Author: Carl Howells Maintainer: chowells79@gmail.com-Copyright: Carl Howells, 2010+Copyright: Carl Howells, 2010-2015 Homepage: http://github.com/chowells79/lrucache Stability: Experimental Category: Data@@ -30,7 +30,7 @@ Source-repository this type: git location: https://github.com/chowells79/lrucache.git- tag: 1.1.1.4+ tag: 1.2.0.0 Library Exposed-modules:@@ -41,7 +41,9 @@ Build-depends: base >= 4 && < 5,- containers >= 0.2 && < 0.6+ containers >= 0.2 && < 0.6,+ contravariant >= 0.5 && < 2+ GHC-options: -Wall -O2
src/Data/Cache/LRU.hs view
@@ -11,8 +11,11 @@ , newLRU , fromList , toList+ , pairs+ , keys , maxSize , insert+ , insertInforming , lookup , delete , pop
src/Data/Cache/LRU/IO/Internal.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE DeriveDataTypeable #-} -- | This module contains a mutable wrapping of an LRU in the IO -- monad, providing atomic access in a concurrent environment. All@@ -22,8 +23,10 @@ import Data.Cache.LRU ( LRU ) import qualified Data.Cache.LRU as LRU +import Data.Typeable (Typeable)+ -- | The opaque wrapper type-newtype AtomicLRU key val = C (MVar (LRU key val))+newtype AtomicLRU key val = C (MVar (LRU key val)) deriving Typeable -- | Make a new AtomicLRU that will not grow beyond the optional -- maximum size, if specified.
src/Data/Cache/LRU/Internal.hs view
@@ -1,5 +1,6 @@ {-# OPTIONS_HADDOCK not-home #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor,+ DeriveFoldable, DeriveTraversable #-} -- | This module provides access to all the internals use by the LRU -- type. This can be used to create data structures that violate the@@ -11,39 +12,51 @@ -- "Data.Cache.LRU" instead. module Data.Cache.LRU.Internal where -import Prelude hiding ( last, lookup )+import Control.Applicative (Applicative, pure, liftA2)+import Data.Traversable (Traversable(traverse), foldMapDefault)+import Data.Foldable (Foldable(foldMap), traverse_) +import Prelude hiding (last, lookup)+ import Data.Map ( Map ) import qualified Data.Map as Map #if MIN_VERSION_containers(0,5,0) import qualified Data.Map.Strict as MapStrict #endif +import Data.Data (Data)+import Data.Typeable (Typeable)++import Data.Functor.Contravariant (Contravariant((>$)))+ -- | Stores the information that makes up an LRU cache data LRU key val = LRU { first :: !(Maybe key) -- ^ the key of the most recently accessed entry , last :: !(Maybe key) -- ^ the key of the least recently accessed entry , maxSize :: !(Maybe Integer) -- ^ the maximum size of the LRU cache , content :: !(Map key (LinkedVal key val)) -- ^ the backing 'Map'- } deriving Eq+ } deriving (Eq, Data, Typeable, Functor) +instance (Ord key) => Traversable (LRU key) where+ traverse f l = fmap (fromList $ maxSize l) . go $ toList l+ where+ go [] = pure []+ go (x:xs) = liftA2 (:) (g x) (go xs)+ g (a, b) = fmap ((,) a) $ f b +instance (Ord key) => Foldable (LRU key) where+ foldMap = foldMapDefault+ instance (Ord key, Show key, Show val) => Show (LRU key val) where show lru = "fromList " ++ show (toList lru) -instance Functor (LRU key) where- fmap f lru = lru { content = fmap (fmap f) . content $ lru }- -- | The values stored in the Map of the LRU cache. They embed a -- doubly-linked list through the values of the 'Map'. data LinkedVal key val = Link { value :: val -- ^ The actual value , prev :: !(Maybe key) -- ^ the key of the value before this one , next :: !(Maybe key) -- ^ the key of the value after this one- } deriving Eq--instance Functor (LinkedVal key) where- fmap f lv = lv { value = f . value $ lv }+ } deriving (Eq, Data, Typeable, Functor, Foldable, Traversable) -- | Make an LRU. If a size limit is specified, the LRU is guaranteed -- to not grow above the specified number of entries.@@ -72,6 +85,26 @@ Nothing -> [keyval] Just nk -> keyval : listLinks m nk +-- | Traverse the (key, value) pairs of the LRU, in a read-only+-- way. This is a 'Fold' in the sense used by the+-- <https://hackage.haskell.org/package/lens lens package>. It must be+-- read-only because alterations could break the underlying 'Map'+-- structure.+pairs :: (Ord key, Applicative f, Contravariant f)+ => ((key, val) -> f (key, val))+ -> LRU key val -> f (LRU key val)+pairs f l = () >$ (traverse_ f $ toList l)++-- | Traverse the keys of the LRU, in a read-only+-- way. This is a 'Fold' in the sense used by the+-- <https://hackage.haskell.org/package/lens lens package>. It must be+-- read-only because alterations could break the underlying 'Map'+-- structure.+keys :: (Ord key, Applicative f, Contravariant f)+ => (key -> f key)+ -> LRU key val -> f (LRU key val)+keys f l = () >$ (traverse_ (f . fst) $ toList l)+ -- | Add an item to an LRU. If the key was already present in the -- LRU, the value is changed to the new value passed in. The -- item added is marked as the most recently accessed item in the@@ -80,20 +113,27 @@ -- If this would cause the LRU to exceed its maximum size, the -- least recently used item is dropped from the cache. insert :: Ord key => key -> val -> LRU key val -> LRU key val-insert key val lru = maybe emptyCase nonEmptyCase $ first lru+insert key val lru = fst (insertInforming key val lru)++-- | Same as 'insert', but also returns element which was dropped from+-- cache, if any.+insertInforming :: Ord key => key -> val -> LRU key val+ -> (LRU key val, Maybe (key, val))+insertInforming key val lru = maybe emptyCase nonEmptyCase $ first lru where contents = content lru full = maybe False (fromIntegral (Map.size contents) ==) $ maxSize lru present = key `Map.member` contents -- this is the case for adding to an empty LRU Cache- emptyCase = LRU fl fl (maxSize lru) m'+ emptyCase = (LRU fl fl (maxSize lru) m', Nothing) where fl = Just key lv = Link val Nothing Nothing m' = Map.insert key lv contents - nonEmptyCase firstKey = if present then hitSet else add firstKey+ nonEmptyCase firstKey = if present then (hitSet, Nothing)+ else add firstKey -- this updates the value stored with the key, then marks it as -- the most recently accessed@@ -103,7 +143,8 @@ -- create a new LRU with a new first item, and -- conditionally dropping the last item- add firstKey = if full then lru'' else lru'+ add firstKey = if full then (lru'', Just (key, val))+ else (lru', Nothing) where -- add a new first item firstLV' = Link val Nothing $ Just firstKey@@ -271,8 +312,8 @@ size lru == length orderedKeys && all (`Map.member` contents) orderedKeys where contents = content lru- orderedKeys = traverse next . first $ lru- traverse _ Nothing = []- traverse f (Just k) = let Just k' = Map.lookup k contents- in k : (traverse f . f $ k')- reverseKeys = traverse prev . last $ lru+ orderedKeys = walk next . first $ lru+ walk _ Nothing = []+ walk f (Just k) = let Just k' = Map.lookup k contents+ in k : (walk f . f $ k')+ reverseKeys = walk prev . last $ lru