{-# OPTIONS_HADDOCK not-home #-}
{-# 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
-- invariants the public interface maintains.  Be careful when using
-- this module.  The 'valid' function can be used to check if an LRU
-- structure satisfies the invariants the public interface maintains.
--
-- If this degree of control isn't needed, consider using
-- "Data.Cache.LRU" instead.
module Data.Cache.LRU.Internal where

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 {
      LRU key val -> Maybe key
first :: !(Maybe key) -- ^ the key of the most recently accessed entry
    , LRU key val -> Maybe key
last :: !(Maybe key) -- ^ the key of the least recently accessed entry
    , LRU key val -> Maybe Integer
maxSize :: !(Maybe Integer) -- ^ the maximum size of the LRU cache
    , LRU key val -> Map key (LinkedVal key val)
content :: !(Map key (LinkedVal key val)) -- ^ the backing 'Map'
    } deriving (LRU key val -> LRU key val -> Bool
(LRU key val -> LRU key val -> Bool)
-> (LRU key val -> LRU key val -> Bool) -> Eq (LRU key val)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall key val.
(Eq key, Eq val) =>
LRU key val -> LRU key val -> Bool
/= :: LRU key val -> LRU key val -> Bool
$c/= :: forall key val.
(Eq key, Eq val) =>
LRU key val -> LRU key val -> Bool
== :: LRU key val -> LRU key val -> Bool
$c== :: forall key val.
(Eq key, Eq val) =>
LRU key val -> LRU key val -> Bool
Eq, Typeable (LRU key val)
Constr
DataType
Typeable (LRU key val)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LRU key val -> c (LRU key val))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (LRU key val))
-> (LRU key val -> Constr)
-> (LRU key val -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (LRU key val)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (LRU key val)))
-> ((forall b. Data b => b -> b) -> LRU key val -> LRU key val)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LRU key val -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LRU key val -> r)
-> (forall u. (forall d. Data d => d -> u) -> LRU key val -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LRU key val -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val))
-> Data (LRU key val)
LRU key val -> Constr
LRU key val -> DataType
(forall b. Data b => b -> b) -> LRU key val -> LRU key val
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LRU key val -> c (LRU key val)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LRU key val)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LRU key val))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LRU key val -> u
forall u. (forall d. Data d => d -> u) -> LRU key val -> [u]
forall key val.
(Data key, Data val, Ord key) =>
Typeable (LRU key val)
forall key val.
(Data key, Data val, Ord key) =>
LRU key val -> Constr
forall key val.
(Data key, Data val, Ord key) =>
LRU key val -> DataType
forall key val.
(Data key, Data val, Ord key) =>
(forall b. Data b => b -> b) -> LRU key val -> LRU key val
forall key val u.
(Data key, Data val, Ord key) =>
Int -> (forall d. Data d => d -> u) -> LRU key val -> u
forall key val u.
(Data key, Data val, Ord key) =>
(forall d. Data d => d -> u) -> LRU key val -> [u]
forall key val r r'.
(Data key, Data val, Ord key) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LRU key val -> r
forall key val r r'.
(Data key, Data val, Ord key) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LRU key val -> r
forall key val (m :: * -> *).
(Data key, Data val, Ord key, Monad m) =>
(forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val)
forall key val (m :: * -> *).
(Data key, Data val, Ord key, MonadPlus m) =>
(forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val)
forall key val (c :: * -> *).
(Data key, Data val, Ord key) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LRU key val)
forall key val (c :: * -> *).
(Data key, Data val, Ord key) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LRU key val -> c (LRU key val)
forall key val (t :: * -> *) (c :: * -> *).
(Data key, Data val, Ord key, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (LRU key val))
forall key val (t :: * -> * -> *) (c :: * -> *).
(Data key, Data val, Ord key, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LRU key val))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LRU key val -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LRU key val -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LRU key val)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LRU key val -> c (LRU key val)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (LRU key val))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LRU key val))
$cLRU :: Constr
$tLRU :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val)
$cgmapMo :: forall key val (m :: * -> *).
(Data key, Data val, Ord key, MonadPlus m) =>
(forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val)
gmapMp :: (forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val)
$cgmapMp :: forall key val (m :: * -> *).
(Data key, Data val, Ord key, MonadPlus m) =>
(forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val)
gmapM :: (forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val)
$cgmapM :: forall key val (m :: * -> *).
(Data key, Data val, Ord key, Monad m) =>
(forall d. Data d => d -> m d) -> LRU key val -> m (LRU key val)
gmapQi :: Int -> (forall d. Data d => d -> u) -> LRU key val -> u
$cgmapQi :: forall key val u.
(Data key, Data val, Ord key) =>
Int -> (forall d. Data d => d -> u) -> LRU key val -> u
gmapQ :: (forall d. Data d => d -> u) -> LRU key val -> [u]
$cgmapQ :: forall key val u.
(Data key, Data val, Ord key) =>
(forall d. Data d => d -> u) -> LRU key val -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LRU key val -> r
$cgmapQr :: forall key val r r'.
(Data key, Data val, Ord key) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LRU key val -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LRU key val -> r
$cgmapQl :: forall key val r r'.
(Data key, Data val, Ord key) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LRU key val -> r
gmapT :: (forall b. Data b => b -> b) -> LRU key val -> LRU key val
$cgmapT :: forall key val.
(Data key, Data val, Ord key) =>
(forall b. Data b => b -> b) -> LRU key val -> LRU key val
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LRU key val))
$cdataCast2 :: forall key val (t :: * -> * -> *) (c :: * -> *).
(Data key, Data val, Ord key, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LRU key val))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (LRU key val))
$cdataCast1 :: forall key val (t :: * -> *) (c :: * -> *).
(Data key, Data val, Ord key, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (LRU key val))
dataTypeOf :: LRU key val -> DataType
$cdataTypeOf :: forall key val.
(Data key, Data val, Ord key) =>
LRU key val -> DataType
toConstr :: LRU key val -> Constr
$ctoConstr :: forall key val.
(Data key, Data val, Ord key) =>
LRU key val -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LRU key val)
$cgunfold :: forall key val (c :: * -> *).
(Data key, Data val, Ord key) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LRU key val)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LRU key val -> c (LRU key val)
$cgfoldl :: forall key val (c :: * -> *).
(Data key, Data val, Ord key) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LRU key val -> c (LRU key val)
$cp1Data :: forall key val.
(Data key, Data val, Ord key) =>
Typeable (LRU key val)
Data, Typeable, a -> LRU key b -> LRU key a
(a -> b) -> LRU key a -> LRU key b
(forall a b. (a -> b) -> LRU key a -> LRU key b)
-> (forall a b. a -> LRU key b -> LRU key a) -> Functor (LRU key)
forall a b. a -> LRU key b -> LRU key a
forall a b. (a -> b) -> LRU key a -> LRU key b
forall key a b. a -> LRU key b -> LRU key a
forall key a b. (a -> b) -> LRU key a -> LRU key b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LRU key b -> LRU key a
$c<$ :: forall key a b. a -> LRU key b -> LRU key a
fmap :: (a -> b) -> LRU key a -> LRU key b
$cfmap :: forall key a b. (a -> b) -> LRU key a -> LRU key b
Functor)

instance (Ord key) => Traversable (LRU key) where
    traverse :: (a -> f b) -> LRU key a -> f (LRU key b)
traverse a -> f b
f LRU key a
l = ([(key, b)] -> LRU key b) -> f [(key, b)] -> f (LRU key b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Integer -> [(key, b)] -> LRU key b
forall key val.
Ord key =>
Maybe Integer -> [(key, val)] -> LRU key val
fromList (Maybe Integer -> [(key, b)] -> LRU key b)
-> Maybe Integer -> [(key, b)] -> LRU key b
forall a b. (a -> b) -> a -> b
$ LRU key a -> Maybe Integer
forall key val. LRU key val -> Maybe Integer
maxSize LRU key a
l) (f [(key, b)] -> f (LRU key b))
-> ([(key, a)] -> f [(key, b)]) -> [(key, a)] -> f (LRU key b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(key, a)] -> f [(key, b)]
forall a. [(a, a)] -> f [(a, b)]
go ([(key, a)] -> f (LRU key b)) -> [(key, a)] -> f (LRU key b)
forall a b. (a -> b) -> a -> b
$ LRU key a -> [(key, a)]
forall key val. Ord key => LRU key val -> [(key, val)]
toList LRU key a
l
      where
        go :: [(a, a)] -> f [(a, b)]
go [] = [(a, b)] -> f [(a, b)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        go ((a, a)
x:[(a, a)]
xs) = ((a, b) -> [(a, b)] -> [(a, b)])
-> f (a, b) -> f [(a, b)] -> f [(a, b)]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) ((a, a) -> f (a, b)
forall a. (a, a) -> f (a, b)
g (a, a)
x) ([(a, a)] -> f [(a, b)]
go [(a, a)]
xs)
        g :: (a, a) -> f (a, b)
g (a
a, a
b) = (b -> (a, b)) -> f b -> f (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) a
a) (f b -> f (a, b)) -> f b -> f (a, b)
forall a b. (a -> b) -> a -> b
$ a -> f b
f a
b

instance (Ord key) => Foldable (LRU key) where
    foldMap :: (a -> m) -> LRU key a -> m
foldMap = (a -> m) -> LRU key a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance (Ord key, Show key, Show val) => Show (LRU key val) where
    show :: LRU key val -> String
show LRU key val
lru = String
"fromList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(key, val)] -> String
forall a. Show a => a -> String
show (LRU key val -> [(key, val)]
forall key val. Ord key => LRU key val -> [(key, val)]
toList LRU key val
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 {
      LinkedVal key val -> val
value :: val -- ^ The actual value
    , LinkedVal key val -> Maybe key
prev :: !(Maybe key) -- ^ the key of the value before this one
    , LinkedVal key val -> Maybe key
next :: !(Maybe key) -- ^ the key of the value after this one
    } deriving (LinkedVal key val -> LinkedVal key val -> Bool
(LinkedVal key val -> LinkedVal key val -> Bool)
-> (LinkedVal key val -> LinkedVal key val -> Bool)
-> Eq (LinkedVal key val)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall key val.
(Eq val, Eq key) =>
LinkedVal key val -> LinkedVal key val -> Bool
/= :: LinkedVal key val -> LinkedVal key val -> Bool
$c/= :: forall key val.
(Eq val, Eq key) =>
LinkedVal key val -> LinkedVal key val -> Bool
== :: LinkedVal key val -> LinkedVal key val -> Bool
$c== :: forall key val.
(Eq val, Eq key) =>
LinkedVal key val -> LinkedVal key val -> Bool
Eq, Typeable (LinkedVal key val)
Constr
DataType
Typeable (LinkedVal key val)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> LinkedVal key val
    -> c (LinkedVal key val))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (LinkedVal key val))
-> (LinkedVal key val -> Constr)
-> (LinkedVal key val -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (LinkedVal key val)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (LinkedVal key val)))
-> ((forall b. Data b => b -> b)
    -> LinkedVal key val -> LinkedVal key val)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LinkedVal key val -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LinkedVal key val -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LinkedVal key val -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LinkedVal key val -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LinkedVal key val -> m (LinkedVal key val))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LinkedVal key val -> m (LinkedVal key val))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LinkedVal key val -> m (LinkedVal key val))
-> Data (LinkedVal key val)
LinkedVal key val -> Constr
LinkedVal key val -> DataType
(forall b. Data b => b -> b)
-> LinkedVal key val -> LinkedVal key val
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LinkedVal key val
-> c (LinkedVal key val)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LinkedVal key val)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LinkedVal key val))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> LinkedVal key val -> u
forall u. (forall d. Data d => d -> u) -> LinkedVal key val -> [u]
forall key val.
(Data key, Data val) =>
Typeable (LinkedVal key val)
forall key val. (Data key, Data val) => LinkedVal key val -> Constr
forall key val.
(Data key, Data val) =>
LinkedVal key val -> DataType
forall key val.
(Data key, Data val) =>
(forall b. Data b => b -> b)
-> LinkedVal key val -> LinkedVal key val
forall key val u.
(Data key, Data val) =>
Int -> (forall d. Data d => d -> u) -> LinkedVal key val -> u
forall key val u.
(Data key, Data val) =>
(forall d. Data d => d -> u) -> LinkedVal key val -> [u]
forall key val r r'.
(Data key, Data val) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LinkedVal key val -> r
forall key val r r'.
(Data key, Data val) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LinkedVal key val -> r
forall key val (m :: * -> *).
(Data key, Data val, Monad m) =>
(forall d. Data d => d -> m d)
-> LinkedVal key val -> m (LinkedVal key val)
forall key val (m :: * -> *).
(Data key, Data val, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> LinkedVal key val -> m (LinkedVal key val)
forall key val (c :: * -> *).
(Data key, Data val) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LinkedVal key val)
forall key val (c :: * -> *).
(Data key, Data val) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LinkedVal key val
-> c (LinkedVal key val)
forall key val (t :: * -> *) (c :: * -> *).
(Data key, Data val, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (LinkedVal key val))
forall key val (t :: * -> * -> *) (c :: * -> *).
(Data key, Data val, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LinkedVal key val))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LinkedVal key val -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LinkedVal key val -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LinkedVal key val -> m (LinkedVal key val)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LinkedVal key val -> m (LinkedVal key val)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LinkedVal key val)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LinkedVal key val
-> c (LinkedVal key val)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (LinkedVal key val))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LinkedVal key val))
$cLink :: Constr
$tLinkedVal :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> LinkedVal key val -> m (LinkedVal key val)
$cgmapMo :: forall key val (m :: * -> *).
(Data key, Data val, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> LinkedVal key val -> m (LinkedVal key val)
gmapMp :: (forall d. Data d => d -> m d)
-> LinkedVal key val -> m (LinkedVal key val)
$cgmapMp :: forall key val (m :: * -> *).
(Data key, Data val, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> LinkedVal key val -> m (LinkedVal key val)
gmapM :: (forall d. Data d => d -> m d)
-> LinkedVal key val -> m (LinkedVal key val)
$cgmapM :: forall key val (m :: * -> *).
(Data key, Data val, Monad m) =>
(forall d. Data d => d -> m d)
-> LinkedVal key val -> m (LinkedVal key val)
gmapQi :: Int -> (forall d. Data d => d -> u) -> LinkedVal key val -> u
$cgmapQi :: forall key val u.
(Data key, Data val) =>
Int -> (forall d. Data d => d -> u) -> LinkedVal key val -> u
gmapQ :: (forall d. Data d => d -> u) -> LinkedVal key val -> [u]
$cgmapQ :: forall key val u.
(Data key, Data val) =>
(forall d. Data d => d -> u) -> LinkedVal key val -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LinkedVal key val -> r
$cgmapQr :: forall key val r r'.
(Data key, Data val) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LinkedVal key val -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LinkedVal key val -> r
$cgmapQl :: forall key val r r'.
(Data key, Data val) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LinkedVal key val -> r
gmapT :: (forall b. Data b => b -> b)
-> LinkedVal key val -> LinkedVal key val
$cgmapT :: forall key val.
(Data key, Data val) =>
(forall b. Data b => b -> b)
-> LinkedVal key val -> LinkedVal key val
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LinkedVal key val))
$cdataCast2 :: forall key val (t :: * -> * -> *) (c :: * -> *).
(Data key, Data val, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LinkedVal key val))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (LinkedVal key val))
$cdataCast1 :: forall key val (t :: * -> *) (c :: * -> *).
(Data key, Data val, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (LinkedVal key val))
dataTypeOf :: LinkedVal key val -> DataType
$cdataTypeOf :: forall key val.
(Data key, Data val) =>
LinkedVal key val -> DataType
toConstr :: LinkedVal key val -> Constr
$ctoConstr :: forall key val. (Data key, Data val) => LinkedVal key val -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LinkedVal key val)
$cgunfold :: forall key val (c :: * -> *).
(Data key, Data val) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LinkedVal key val)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LinkedVal key val
-> c (LinkedVal key val)
$cgfoldl :: forall key val (c :: * -> *).
(Data key, Data val) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LinkedVal key val
-> c (LinkedVal key val)
$cp1Data :: forall key val.
(Data key, Data val) =>
Typeable (LinkedVal key val)
Data, Typeable, a -> LinkedVal key b -> LinkedVal key a
(a -> b) -> LinkedVal key a -> LinkedVal key b
(forall a b. (a -> b) -> LinkedVal key a -> LinkedVal key b)
-> (forall a b. a -> LinkedVal key b -> LinkedVal key a)
-> Functor (LinkedVal key)
forall a b. a -> LinkedVal key b -> LinkedVal key a
forall a b. (a -> b) -> LinkedVal key a -> LinkedVal key b
forall key a b. a -> LinkedVal key b -> LinkedVal key a
forall key a b. (a -> b) -> LinkedVal key a -> LinkedVal key b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LinkedVal key b -> LinkedVal key a
$c<$ :: forall key a b. a -> LinkedVal key b -> LinkedVal key a
fmap :: (a -> b) -> LinkedVal key a -> LinkedVal key b
$cfmap :: forall key a b. (a -> b) -> LinkedVal key a -> LinkedVal key b
Functor, LinkedVal key a -> Bool
(a -> m) -> LinkedVal key a -> m
(a -> b -> b) -> b -> LinkedVal key a -> b
(forall m. Monoid m => LinkedVal key m -> m)
-> (forall m a. Monoid m => (a -> m) -> LinkedVal key a -> m)
-> (forall m a. Monoid m => (a -> m) -> LinkedVal key a -> m)
-> (forall a b. (a -> b -> b) -> b -> LinkedVal key a -> b)
-> (forall a b. (a -> b -> b) -> b -> LinkedVal key a -> b)
-> (forall b a. (b -> a -> b) -> b -> LinkedVal key a -> b)
-> (forall b a. (b -> a -> b) -> b -> LinkedVal key a -> b)
-> (forall a. (a -> a -> a) -> LinkedVal key a -> a)
-> (forall a. (a -> a -> a) -> LinkedVal key a -> a)
-> (forall a. LinkedVal key a -> [a])
-> (forall a. LinkedVal key a -> Bool)
-> (forall a. LinkedVal key a -> Int)
-> (forall a. Eq a => a -> LinkedVal key a -> Bool)
-> (forall a. Ord a => LinkedVal key a -> a)
-> (forall a. Ord a => LinkedVal key a -> a)
-> (forall a. Num a => LinkedVal key a -> a)
-> (forall a. Num a => LinkedVal key a -> a)
-> Foldable (LinkedVal key)
forall a. Eq a => a -> LinkedVal key a -> Bool
forall a. Num a => LinkedVal key a -> a
forall a. Ord a => LinkedVal key a -> a
forall m. Monoid m => LinkedVal key m -> m
forall a. LinkedVal key a -> Bool
forall a. LinkedVal key a -> Int
forall a. LinkedVal key a -> [a]
forall a. (a -> a -> a) -> LinkedVal key a -> a
forall key a. Eq a => a -> LinkedVal key a -> Bool
forall key a. Num a => LinkedVal key a -> a
forall key a. Ord a => LinkedVal key a -> a
forall m a. Monoid m => (a -> m) -> LinkedVal key a -> m
forall key m. Monoid m => LinkedVal key m -> m
forall key a. LinkedVal key a -> Bool
forall key a. LinkedVal key a -> Int
forall key a. LinkedVal key a -> [a]
forall b a. (b -> a -> b) -> b -> LinkedVal key a -> b
forall a b. (a -> b -> b) -> b -> LinkedVal key a -> b
forall key a. (a -> a -> a) -> LinkedVal key a -> a
forall key m a. Monoid m => (a -> m) -> LinkedVal key a -> m
forall key b a. (b -> a -> b) -> b -> LinkedVal key a -> b
forall key a b. (a -> b -> b) -> b -> LinkedVal key a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: LinkedVal key a -> a
$cproduct :: forall key a. Num a => LinkedVal key a -> a
sum :: LinkedVal key a -> a
$csum :: forall key a. Num a => LinkedVal key a -> a
minimum :: LinkedVal key a -> a
$cminimum :: forall key a. Ord a => LinkedVal key a -> a
maximum :: LinkedVal key a -> a
$cmaximum :: forall key a. Ord a => LinkedVal key a -> a
elem :: a -> LinkedVal key a -> Bool
$celem :: forall key a. Eq a => a -> LinkedVal key a -> Bool
length :: LinkedVal key a -> Int
$clength :: forall key a. LinkedVal key a -> Int
null :: LinkedVal key a -> Bool
$cnull :: forall key a. LinkedVal key a -> Bool
toList :: LinkedVal key a -> [a]
$ctoList :: forall key a. LinkedVal key a -> [a]
foldl1 :: (a -> a -> a) -> LinkedVal key a -> a
$cfoldl1 :: forall key a. (a -> a -> a) -> LinkedVal key a -> a
foldr1 :: (a -> a -> a) -> LinkedVal key a -> a
$cfoldr1 :: forall key a. (a -> a -> a) -> LinkedVal key a -> a
foldl' :: (b -> a -> b) -> b -> LinkedVal key a -> b
$cfoldl' :: forall key b a. (b -> a -> b) -> b -> LinkedVal key a -> b
foldl :: (b -> a -> b) -> b -> LinkedVal key a -> b
$cfoldl :: forall key b a. (b -> a -> b) -> b -> LinkedVal key a -> b
foldr' :: (a -> b -> b) -> b -> LinkedVal key a -> b
$cfoldr' :: forall key a b. (a -> b -> b) -> b -> LinkedVal key a -> b
foldr :: (a -> b -> b) -> b -> LinkedVal key a -> b
$cfoldr :: forall key a b. (a -> b -> b) -> b -> LinkedVal key a -> b
foldMap' :: (a -> m) -> LinkedVal key a -> m
$cfoldMap' :: forall key m a. Monoid m => (a -> m) -> LinkedVal key a -> m
foldMap :: (a -> m) -> LinkedVal key a -> m
$cfoldMap :: forall key m a. Monoid m => (a -> m) -> LinkedVal key a -> m
fold :: LinkedVal key m -> m
$cfold :: forall key m. Monoid m => LinkedVal key m -> m
Foldable, Functor (LinkedVal key)
Foldable (LinkedVal key)
Functor (LinkedVal key)
-> Foldable (LinkedVal key)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> LinkedVal key a -> f (LinkedVal key b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LinkedVal key (f a) -> f (LinkedVal key a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LinkedVal key a -> m (LinkedVal key b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LinkedVal key (m a) -> m (LinkedVal key a))
-> Traversable (LinkedVal key)
(a -> f b) -> LinkedVal key a -> f (LinkedVal key b)
forall key. Functor (LinkedVal key)
forall key. Foldable (LinkedVal key)
forall key (m :: * -> *) a.
Monad m =>
LinkedVal key (m a) -> m (LinkedVal key a)
forall key (f :: * -> *) a.
Applicative f =>
LinkedVal key (f a) -> f (LinkedVal key a)
forall key (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LinkedVal key a -> m (LinkedVal key b)
forall key (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LinkedVal key a -> f (LinkedVal key b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
LinkedVal key (m a) -> m (LinkedVal key a)
forall (f :: * -> *) a.
Applicative f =>
LinkedVal key (f a) -> f (LinkedVal key a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LinkedVal key a -> m (LinkedVal key b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LinkedVal key a -> f (LinkedVal key b)
sequence :: LinkedVal key (m a) -> m (LinkedVal key a)
$csequence :: forall key (m :: * -> *) a.
Monad m =>
LinkedVal key (m a) -> m (LinkedVal key a)
mapM :: (a -> m b) -> LinkedVal key a -> m (LinkedVal key b)
$cmapM :: forall key (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LinkedVal key a -> m (LinkedVal key b)
sequenceA :: LinkedVal key (f a) -> f (LinkedVal key a)
$csequenceA :: forall key (f :: * -> *) a.
Applicative f =>
LinkedVal key (f a) -> f (LinkedVal key a)
traverse :: (a -> f b) -> LinkedVal key a -> f (LinkedVal key b)
$ctraverse :: forall key (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LinkedVal key a -> f (LinkedVal key b)
$cp2Traversable :: forall key. Foldable (LinkedVal key)
$cp1Traversable :: forall key. Functor (LinkedVal key)
Traversable)

-- | Make an LRU.  If a size limit is specified, the LRU is guaranteed
-- to not grow above the specified number of entries.
newLRU :: (Ord key) => Maybe Integer -- ^ the optional maximum size of the LRU
       -> LRU key val
newLRU :: Maybe Integer -> LRU key val
newLRU (Just Integer
s) | Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = String -> LRU key val
forall a. HasCallStack => String -> a
error String
"non-positive size LRU"
newLRU Maybe Integer
s  = Maybe key
-> Maybe key
-> Maybe Integer
-> Map key (LinkedVal key val)
-> LRU key val
forall key val.
Maybe key
-> Maybe key
-> Maybe Integer
-> Map key (LinkedVal key val)
-> LRU key val
LRU Maybe key
forall a. Maybe a
Nothing Maybe key
forall a. Maybe a
Nothing Maybe Integer
s Map key (LinkedVal key val)
forall k a. Map k a
Map.empty

-- | Build a new LRU from the given maximum size and list of contents,
-- in order from most recently accessed to least recently accessed.
fromList :: Ord key => Maybe Integer -- ^ the optional maximum size of the LRU
         -> [(key, val)] -> LRU key val
fromList :: Maybe Integer -> [(key, val)] -> LRU key val
fromList Maybe Integer
s [(key, val)]
l = LRU key val -> LRU key val
appendAll (LRU key val -> LRU key val) -> LRU key val -> LRU key val
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> LRU key val
forall key val. Ord key => Maybe Integer -> LRU key val
newLRU Maybe Integer
s
    where appendAll :: LRU key val -> LRU key val
appendAll = ((key, val)
 -> (LRU key val -> LRU key val) -> LRU key val -> LRU key val)
-> (LRU key val -> LRU key val)
-> [(key, val)]
-> LRU key val
-> LRU key val
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (key, val)
-> (LRU key val -> LRU key val) -> LRU key val -> LRU key val
forall key val a.
Ord key =>
(key, val) -> (a -> LRU key val) -> a -> LRU key val
ins LRU key val -> LRU key val
forall a. a -> a
id [(key, val)]
l
          ins :: (key, val) -> (a -> LRU key val) -> a -> LRU key val
ins (key
k, val
v) = (key -> val -> LRU key val -> LRU key val
forall key val. Ord key => key -> val -> LRU key val -> LRU key val
insert key
k val
v (LRU key val -> LRU key val)
-> (a -> LRU key val) -> a -> LRU key val
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- | Retrieve a list view of an LRU.  The items are returned in
-- order from most recently accessed to least recently accessed.
toList :: Ord key => LRU key val -> [(key, val)]
toList :: LRU key val -> [(key, val)]
toList LRU key val
lru = [(key, val)] -> (key -> [(key, val)]) -> Maybe key -> [(key, val)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Map key (LinkedVal key val) -> key -> [(key, val)]
forall key b.
Ord key =>
Map key (LinkedVal key b) -> key -> [(key, b)]
listLinks (Map key (LinkedVal key val) -> key -> [(key, val)])
-> (LRU key val -> Map key (LinkedVal key val))
-> LRU key val
-> key
-> [(key, val)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRU key val -> Map key (LinkedVal key val)
forall key val. LRU key val -> Map key (LinkedVal key val)
content (LRU key val -> key -> [(key, val)])
-> LRU key val -> key -> [(key, val)]
forall a b. (a -> b) -> a -> b
$ LRU key val
lru) (Maybe key -> [(key, val)]) -> Maybe key -> [(key, val)]
forall a b. (a -> b) -> a -> b
$ LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
first LRU key val
lru
    where
      listLinks :: Map key (LinkedVal key b) -> key -> [(key, b)]
listLinks Map key (LinkedVal key b)
m key
key =
          let Just LinkedVal key b
lv = key -> Map key (LinkedVal key b) -> Maybe (LinkedVal key b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key (LinkedVal key b)
m
              keyval :: (key, b)
keyval = (key
key, LinkedVal key b -> b
forall key val. LinkedVal key val -> val
value LinkedVal key b
lv)
          in case LinkedVal key b -> Maybe key
forall key val. LinkedVal key val -> Maybe key
next LinkedVal key b
lv of
               Maybe key
Nothing -> [(key, b)
keyval]
               Just key
nk -> (key, b)
keyval (key, b) -> [(key, b)] -> [(key, b)]
forall a. a -> [a] -> [a]
: Map key (LinkedVal key b) -> key -> [(key, b)]
listLinks Map key (LinkedVal key b)
m key
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 :: ((key, val) -> f (key, val)) -> LRU key val -> f (LRU key val)
pairs (key, val) -> f (key, val)
f LRU key val
l = () () -> f () -> f (LRU key val)
forall (f :: * -> *) b a. Contravariant f => b -> f b -> f a
>$ (((key, val) -> f (key, val)) -> [(key, val)] -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (key, val) -> f (key, val)
f ([(key, val)] -> f ()) -> [(key, val)] -> f ()
forall a b. (a -> b) -> a -> b
$ LRU key val -> [(key, val)]
forall key val. Ord key => LRU key val -> [(key, val)]
toList LRU key val
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 :: (key -> f key) -> LRU key val -> f (LRU key val)
keys key -> f key
f LRU key val
l = () () -> f () -> f (LRU key val)
forall (f :: * -> *) b a. Contravariant f => b -> f b -> f a
>$ (((key, val) -> f key) -> [(key, val)] -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (key -> f key
f (key -> f key) -> ((key, val) -> key) -> (key, val) -> f key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (key, val) -> key
forall a b. (a, b) -> a
fst) ([(key, val)] -> f ()) -> [(key, val)] -> f ()
forall a b. (a -> b) -> a -> b
$ LRU key val -> [(key, val)]
forall key val. Ord key => LRU key val -> [(key, val)]
toList LRU key val
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
-- LRU returned.
--
-- 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 key val -> LRU key val
insert key
key val
val LRU key val
lru = (LRU key val, Maybe (key, val)) -> LRU key val
forall a b. (a, b) -> a
fst (key -> val -> LRU key val -> (LRU key val, Maybe (key, val))
forall key val.
Ord key =>
key -> val -> LRU key val -> (LRU key val, Maybe (key, val))
insertInforming key
key val
val LRU 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 key val -> (LRU key val, Maybe (key, val))
insertInforming key
key val
val LRU key val
lru = (LRU key val, Maybe (key, val))
-> (key -> (LRU key val, Maybe (key, val)))
-> Maybe key
-> (LRU key val, Maybe (key, val))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LRU key val, Maybe (key, val))
forall a. (LRU key val, Maybe a)
emptyCase key -> (LRU key val, Maybe (key, val))
nonEmptyCase (Maybe key -> (LRU key val, Maybe (key, val)))
-> Maybe key -> (LRU key val, Maybe (key, val))
forall a b. (a -> b) -> a -> b
$ LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
first LRU key val
lru
    where
      contents :: Map key (LinkedVal key val)
contents = LRU key val -> Map key (LinkedVal key val)
forall key val. LRU key val -> Map key (LinkedVal key val)
content LRU key val
lru
      full :: Bool
full = Bool -> (Integer -> Bool) -> Maybe Integer -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map key (LinkedVal key val) -> Int
forall k a. Map k a -> Int
Map.size Map key (LinkedVal key val)
contents) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe Integer -> Bool) -> Maybe Integer -> Bool
forall a b. (a -> b) -> a -> b
$ LRU key val -> Maybe Integer
forall key val. LRU key val -> Maybe Integer
maxSize LRU key val
lru
      present :: Bool
present = key
key key -> Map key (LinkedVal key val) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map key (LinkedVal key val)
contents

      -- this is the case for adding to an empty LRU Cache
      emptyCase :: (LRU key val, Maybe a)
emptyCase = (Maybe key
-> Maybe key
-> Maybe Integer
-> Map key (LinkedVal key val)
-> LRU key val
forall key val.
Maybe key
-> Maybe key
-> Maybe Integer
-> Map key (LinkedVal key val)
-> LRU key val
LRU Maybe key
fl Maybe key
fl (LRU key val -> Maybe Integer
forall key val. LRU key val -> Maybe Integer
maxSize LRU key val
lru) Map key (LinkedVal key val)
m', Maybe a
forall a. Maybe a
Nothing)
          where
            fl :: Maybe key
fl = key -> Maybe key
forall a. a -> Maybe a
Just key
key
            lv :: LinkedVal key val
lv = val -> Maybe key -> Maybe key -> LinkedVal key val
forall key val. val -> Maybe key -> Maybe key -> LinkedVal key val
Link val
val Maybe key
forall a. Maybe a
Nothing Maybe key
forall a. Maybe a
Nothing
            m' :: Map key (LinkedVal key val)
m' = key
-> LinkedVal key val
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
key LinkedVal key val
forall key. LinkedVal key val
lv Map key (LinkedVal key val)
contents

      nonEmptyCase :: key -> (LRU key val, Maybe (key, val))
nonEmptyCase key
firstKey = if Bool
present then (LRU key val
hitSet, Maybe (key, val)
forall a. Maybe a
Nothing)
                              else key -> (LRU key val, Maybe (key, val))
add key
firstKey

      -- this updates the value stored with the key, then marks it as
      -- the most recently accessed
      hitSet :: LRU key val
hitSet = key -> LRU key val -> LRU key val
forall key val. Ord key => key -> LRU key val -> LRU key val
hit' key
key LRU key val
lru'
          where lru' :: LRU key val
lru' = LRU key val
lru { content :: Map key (LinkedVal key val)
content = Map key (LinkedVal key val)
contents' }
                contents' :: Map key (LinkedVal key val)
contents' = (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v {value :: val
value = val
val}) key
key Map key (LinkedVal key val)
contents

      -- create a new LRU with a new first item, and
      -- conditionally dropping the last item
      add :: key -> (LRU key val, Maybe (key, val))
add key
firstKey = if Bool
full then (LRU key val
lru'', (key, val) -> Maybe (key, val)
forall a. a -> Maybe a
Just (key
lastKey, LinkedVal key val -> val
forall key val. LinkedVal key val -> val
value LinkedVal key val
lastLV))
                     else (LRU key val
lru', Maybe (key, val)
forall a. Maybe a
Nothing)
          where
            -- add a new first item
            firstLV' :: LinkedVal key val
firstLV' = val -> Maybe key -> Maybe key -> LinkedVal key val
forall key val. val -> Maybe key -> Maybe key -> LinkedVal key val
Link val
val Maybe key
forall a. Maybe a
Nothing (Maybe key -> LinkedVal key val) -> Maybe key -> LinkedVal key val
forall a b. (a -> b) -> a -> b
$ key -> Maybe key
forall a. a -> Maybe a
Just key
firstKey
            contents' :: Map key (LinkedVal key val)
contents' = key
-> LinkedVal key val
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
key LinkedVal key val
firstLV' (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v { prev :: Maybe key
prev = key -> Maybe key
forall a. a -> Maybe a
Just key
key }) key
firstKey (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> Map key (LinkedVal key val) -> Map key (LinkedVal key val)
forall a b. (a -> b) -> a -> b
$
                        Map key (LinkedVal key val)
contents
            lru' :: LRU key val
lru' = LRU key val
lru { first :: Maybe key
first = key -> Maybe key
forall a. a -> Maybe a
Just key
key, content :: Map key (LinkedVal key val)
content = Map key (LinkedVal key val)
contents' }

            -- remove the last item
            Just key
lastKey = LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
last LRU key val
lru'
            Just LinkedVal key val
lastLV = key -> Map key (LinkedVal key val) -> Maybe (LinkedVal key val)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
lastKey Map key (LinkedVal key val)
contents'
            contents'' :: Map key (LinkedVal key val)
contents'' = key -> Map key (LinkedVal key val) -> Map key (LinkedVal key val)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete key
lastKey Map key (LinkedVal key val)
contents'
            lru'' :: LRU key val
lru'' = key
-> LRU key val
-> Map key (LinkedVal key val)
-> LinkedVal key val
-> LRU key val
forall key val.
Ord key =>
key
-> LRU key val
-> Map key (LinkedVal key val)
-> LinkedVal key val
-> LRU key val
delete' key
lastKey LRU key val
lru' Map key (LinkedVal key val)
contents'' LinkedVal key val
lastLV

-- | Look up an item in an LRU.  If it was present, it is marked as
-- the most recently accesed in the returned LRU.
lookup :: Ord key => key -> LRU key val -> (LRU key val, Maybe val)
lookup :: key -> LRU key val -> (LRU key val, Maybe val)
lookup key
key LRU key val
lru = case key -> Map key (LinkedVal key val) -> Maybe (LinkedVal key val)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key (Map key (LinkedVal key val) -> Maybe (LinkedVal key val))
-> Map key (LinkedVal key val) -> Maybe (LinkedVal key val)
forall a b. (a -> b) -> a -> b
$ LRU key val -> Map key (LinkedVal key val)
forall key val. LRU key val -> Map key (LinkedVal key val)
content LRU key val
lru of
                           Maybe (LinkedVal key val)
Nothing -> (LRU key val
lru, Maybe val
forall a. Maybe a
Nothing)
                           Just LinkedVal key val
lv -> (key -> LRU key val -> LRU key val
forall key val. Ord key => key -> LRU key val -> LRU key val
hit' key
key LRU key val
lru, val -> Maybe val
forall a. a -> Maybe a
Just (val -> Maybe val)
-> (LinkedVal key val -> val) -> LinkedVal key val -> Maybe val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkedVal key val -> val
forall key val. LinkedVal key val -> val
value (LinkedVal key val -> Maybe val) -> LinkedVal key val -> Maybe val
forall a b. (a -> b) -> a -> b
$ LinkedVal key val
lv)

-- | Remove an item from an LRU.  Returns the new LRU, and the value
-- removed if the key was present.
delete :: Ord key => key -> LRU key val -> (LRU key val, Maybe val)
delete :: key -> LRU key val -> (LRU key val, Maybe val)
delete key
key LRU key val
lru = (LRU key val, Maybe val)
-> (LinkedVal key val -> (LRU key val, Maybe val))
-> Maybe (LinkedVal key val)
-> (LRU key val, Maybe val)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LRU key val
lru, Maybe val
forall a. Maybe a
Nothing) LinkedVal key val -> (LRU key val, Maybe val)
delete'' Maybe (LinkedVal key val)
mLV
    where
      delete'' :: LinkedVal key val -> (LRU key val, Maybe val)
delete'' LinkedVal key val
lv = (key
-> LRU key val
-> Map key (LinkedVal key val)
-> LinkedVal key val
-> LRU key val
forall key val.
Ord key =>
key
-> LRU key val
-> Map key (LinkedVal key val)
-> LinkedVal key val
-> LRU key val
delete' key
key LRU key val
lru Map key (LinkedVal key val)
cont' LinkedVal key val
lv, val -> Maybe val
forall a. a -> Maybe a
Just (val -> Maybe val) -> val -> Maybe val
forall a b. (a -> b) -> a -> b
$ LinkedVal key val -> val
forall key val. LinkedVal key val -> val
value LinkedVal key val
lv)
      (Maybe (LinkedVal key val)
mLV, Map key (LinkedVal key val)
cont') = (key -> LinkedVal key val -> Maybe (LinkedVal key val))
-> key
-> Map key (LinkedVal key val)
-> (Maybe (LinkedVal key val), Map key (LinkedVal key val))
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\key
_ LinkedVal key val
_ -> Maybe (LinkedVal key val)
forall a. Maybe a
Nothing) key
key (Map key (LinkedVal key val)
 -> (Maybe (LinkedVal key val), Map key (LinkedVal key val)))
-> Map key (LinkedVal key val)
-> (Maybe (LinkedVal key val), Map key (LinkedVal key val))
forall a b. (a -> b) -> a -> b
$ LRU key val -> Map key (LinkedVal key val)
forall key val. LRU key val -> Map key (LinkedVal key val)
content LRU key val
lru

-- | Removes the least-recently accessed element from the LRU.
-- Returns the new LRU, and the key and value from the least-recently
-- used element, if there was one.
pop :: Ord key => LRU key val -> (LRU key val, Maybe (key, val))
pop :: LRU key val -> (LRU key val, Maybe (key, val))
pop LRU key val
lru = if LRU key val -> Int
forall key val. LRU key val -> Int
size LRU key val
lru Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then (LRU key val
lru, Maybe (key, val)
forall a. Maybe a
Nothing) else (LRU key val
lru', (key, val) -> Maybe (key, val)
forall a. a -> Maybe a
Just (key, val)
pair)
    where
      Just key
lastKey = LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
last LRU key val
lru
      (LRU key val
lru', Just val
lastVal) = key -> LRU key val -> (LRU key val, Maybe val)
forall key val.
Ord key =>
key -> LRU key val -> (LRU key val, Maybe val)
delete key
lastKey LRU key val
lru
      pair :: (key, val)
pair = (key
lastKey, val
lastVal)

-- | Returns the number of elements the LRU currently contains.
size :: LRU key val -> Int
size :: LRU key val -> Int
size = Map key (LinkedVal key val) -> Int
forall k a. Map k a -> Int
Map.size (Map key (LinkedVal key val) -> Int)
-> (LRU key val -> Map key (LinkedVal key val))
-> LRU key val
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRU key val -> Map key (LinkedVal key val)
forall key val. LRU key val -> Map key (LinkedVal key val)
content

-- | Internal function.  The key passed in must be present in the
-- LRU.  Moves the item associated with that key to the most
-- recently accessed position.
hit' :: Ord key => key -> LRU key val -> LRU key val
hit' :: key -> LRU key val -> LRU key val
hit' key
key LRU key val
lru = if key
key key -> key -> Bool
forall a. Eq a => a -> a -> Bool
== key
firstKey then LRU key val
lru else LRU key val
notFirst
    where Just key
firstKey = LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
first LRU key val
lru
          Just key
lastKey = LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
last LRU key val
lru
          Just LinkedVal key val
lastLV = key -> Map key (LinkedVal key val) -> Maybe (LinkedVal key val)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
lastKey Map key (LinkedVal key val)
conts
          conts :: Map key (LinkedVal key val)
conts = LRU key val -> Map key (LinkedVal key val)
forall key val. LRU key val -> Map key (LinkedVal key val)
content LRU key val
lru

          -- key wasn't already the head of the list.  Some alteration
          -- will be needed
          notFirst :: LRU key val
notFirst = if key
key key -> key -> Bool
forall a. Eq a => a -> a -> Bool
== key
lastKey then LRU key val
replaceLast else LRU key val
replaceMiddle

          adjFront :: Map key (LinkedVal key val) -> Map key (LinkedVal key val)
adjFront = (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v { prev :: Maybe key
prev = key -> Maybe key
forall a. a -> Maybe a
Just key
key}) key
firstKey (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                     (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v { prev :: Maybe key
prev = Maybe key
forall a. Maybe a
Nothing
                                      , next :: Maybe key
next = LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
first LRU key val
lru }) key
key

          -- key was the last entry in the list
          replaceLast :: LRU key val
replaceLast = LRU key val
lru { first :: Maybe key
first = key -> Maybe key
forall a. a -> Maybe a
Just key
key
                            , last :: Maybe key
last = LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
prev LinkedVal key val
lastLV
                            , content :: Map key (LinkedVal key val)
content = Map key (LinkedVal key val)
cLast
                            }
          Just key
pKey = LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
prev LinkedVal key val
lastLV
          cLast :: Map key (LinkedVal key val)
cLast = (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v { next :: Maybe key
next = Maybe key
forall a. Maybe a
Nothing }) key
pKey (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map key (LinkedVal key val) -> Map key (LinkedVal key val)
forall val.
Map key (LinkedVal key val) -> Map key (LinkedVal key val)
adjFront (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> Map key (LinkedVal key val) -> Map key (LinkedVal key val)
forall a b. (a -> b) -> a -> b
$ Map key (LinkedVal key val)
conts

          -- the key wasn't the first or last key
          replaceMiddle :: LRU key val
replaceMiddle = LRU key val
lru { first :: Maybe key
first = key -> Maybe key
forall a. a -> Maybe a
Just key
key
                              , content :: Map key (LinkedVal key val)
content = Map key (LinkedVal key val)
cMid
                              }
          Just LinkedVal key val
keyLV = key -> Map key (LinkedVal key val) -> Maybe (LinkedVal key val)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key (LinkedVal key val)
conts
          Just key
prevKey = LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
prev LinkedVal key val
keyLV
          Just key
nextKey = LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
next LinkedVal key val
keyLV
          cMid :: Map key (LinkedVal key val)
cMid = (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v { next :: Maybe key
next = key -> Maybe key
forall a. a -> Maybe a
Just key
nextKey }) key
prevKey (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v { prev :: Maybe key
prev = key -> Maybe key
forall a. a -> Maybe a
Just key
prevKey }) key
nextKey (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 Map key (LinkedVal key val) -> Map key (LinkedVal key val)
forall val.
Map key (LinkedVal key val) -> Map key (LinkedVal key val)
adjFront (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> Map key (LinkedVal key val) -> Map key (LinkedVal key val)
forall a b. (a -> b) -> a -> b
$ Map key (LinkedVal key val)
conts

-- | An internal function used by 'insert' (when the cache is full)
-- and 'delete'.  This function has strict requirements on its
-- arguments in order to work properly.
--
-- As this is intended to be an internal function, the arguments were
-- chosen to avoid repeated computation, rather than for simplicity of
-- calling this function.
delete' :: Ord key => key -- ^ The key must be present in the provided 'LRU'
        -> LRU key val -- ^ This is the 'LRU' to modify
        -> Map key (LinkedVal key val) -- ^ this is the 'Map' from the
                                       -- previous argument, but with
                                       -- the key already removed from
                                       -- it.  This isn't consistent
                                       -- yet, as it still might
                                       -- contain LinkedVals with
                                       -- pointers to the removed key.
        -> LinkedVal key val -- ^ This is the 'LinkedVal' that
                             -- corresponds to the key in the passed
                             -- in LRU. It is absent from the passed
                             -- in map.
        -> LRU key val
delete' :: key
-> LRU key val
-> Map key (LinkedVal key val)
-> LinkedVal key val
-> LRU key val
delete' key
key LRU key val
lru Map key (LinkedVal key val)
cont' LinkedVal key val
lv = if Map key (LinkedVal key val) -> Bool
forall k a. Map k a -> Bool
Map.null Map key (LinkedVal key val)
cont' then LRU key val
deleteOnly else LRU key val
deleteOne
    where
      -- delete the only item in the cache
      deleteOnly :: LRU key val
deleteOnly = LRU key val
lru { first :: Maybe key
first = Maybe key
forall a. Maybe a
Nothing
                       , last :: Maybe key
last = Maybe key
forall a. Maybe a
Nothing
                       , content :: Map key (LinkedVal key val)
content = Map key (LinkedVal key val)
cont'
                       }

      -- delete an item that isn't the only item
      Just key
firstKey = LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
first LRU key val
lru
      deleteOne :: LRU key val
deleteOne = if key
firstKey key -> key -> Bool
forall a. Eq a => a -> a -> Bool
== key
key then LRU key val
deleteFirst else LRU key val
deleteNotFirst

      -- delete the first item
      deleteFirst :: LRU key val
deleteFirst = LRU key val
lru { first :: Maybe key
first = LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
next LinkedVal key val
lv
                        , content :: Map key (LinkedVal key val)
content = Map key (LinkedVal key val)
contFirst
                        }
      Just key
nKey = LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
next LinkedVal key val
lv
      contFirst :: Map key (LinkedVal key val)
contFirst = (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v { prev :: Maybe key
prev = Maybe key
forall a. Maybe a
Nothing }) key
nKey Map key (LinkedVal key val)
cont'

      -- delete an item other than the first
      Just key
lastKey = LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
last LRU key val
lru
      deleteNotFirst :: LRU key val
deleteNotFirst = if key
lastKey key -> key -> Bool
forall a. Eq a => a -> a -> Bool
== key
key then LRU key val
deleteLast else LRU key val
deleteMid

      -- delete the last item
      deleteLast :: LRU key val
deleteLast = LRU key val
lru { last :: Maybe key
last = LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
prev LinkedVal key val
lv
                       , content :: Map key (LinkedVal key val)
content = Map key (LinkedVal key val)
contLast
                       }
      Just key
pKey = LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
prev LinkedVal key val
lv
      contLast :: Map key (LinkedVal key val)
contLast = (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v { next :: Maybe key
next = Maybe key
forall a. Maybe a
Nothing}) key
pKey Map key (LinkedVal key val)
cont'

      -- delete an item in the middle
      deleteMid :: LRU key val
deleteMid = LRU key val
lru { content :: Map key (LinkedVal key val)
content = Map key (LinkedVal key val)
contMid }
      contMid :: Map key (LinkedVal key val)
contMid = (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v { next :: Maybe key
next = LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
next LinkedVal key val
lv }) key
pKey (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (LinkedVal key val -> LinkedVal key val)
-> key
-> Map key (LinkedVal key val)
-> Map key (LinkedVal key val)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' (\LinkedVal key val
v -> LinkedVal key val
v { prev :: Maybe key
prev = LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
prev LinkedVal key val
lv }) key
nKey (Map key (LinkedVal key val) -> Map key (LinkedVal key val))
-> Map key (LinkedVal key val) -> Map key (LinkedVal key val)
forall a b. (a -> b) -> a -> b
$
                Map key (LinkedVal key val)
cont'

-- | Internal function.  This is very similar to 'Map.adjust', with
-- two major differences.  First, it's strict in the application of
-- the function, which is a huge win when working with this structure.
--
-- Second, it requires that the key be present in order to work.  If
-- the key isn't present, 'undefined' will be inserted into the 'Map',
-- which will cause problems later.
adjust' :: Ord k => (a -> a) -> k -> Map k a -> Map k a
#if MIN_VERSION_containers(0,5,0)
adjust' :: (a -> a) -> k -> Map k a -> Map k a
adjust' = (a -> a) -> k -> Map k a -> Map k a
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
MapStrict.adjust
#else
adjust' f k m = Map.insertWith' (\_ o -> f o) k (error "adjust' used wrongly") m
#endif

-- | Internal function.  This checks the four structural invariants
-- of the LRU cache structure:
--
-- 1. The cache's size does not exceed the specified max size.
--
-- 2. The linked list through the nodes is consistent in both directions.
--
-- 3. The linked list contains the same number of nodes as the cache.
--
-- 4. Every key in the linked list is in the 'Map'.
valid :: Ord key => LRU key val -> Bool
valid :: LRU key val -> Bool
valid LRU key val
lru = Bool -> (Integer -> Bool) -> Maybe Integer -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LRU key val -> Int
forall key val. LRU key val -> Int
size LRU key val
lru) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=) (LRU key val -> Maybe Integer
forall key val. LRU key val -> Maybe Integer
maxSize LRU key val
lru) Bool -> Bool -> Bool
&&
            [key] -> [key]
forall a. [a] -> [a]
reverse [key]
orderedKeys [key] -> [key] -> Bool
forall a. Eq a => a -> a -> Bool
== [key]
reverseKeys Bool -> Bool -> Bool
&&
            LRU key val -> Int
forall key val. LRU key val -> Int
size LRU key val
lru Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [key] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [key]
orderedKeys Bool -> Bool -> Bool
&&
            (key -> Bool) -> [key] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (key -> Map key (LinkedVal key val) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map key (LinkedVal key val)
contents) [key]
orderedKeys
    where contents :: Map key (LinkedVal key val)
contents = LRU key val -> Map key (LinkedVal key val)
forall key val. LRU key val -> Map key (LinkedVal key val)
content LRU key val
lru
          orderedKeys :: [key]
orderedKeys = (LinkedVal key val -> Maybe key) -> Maybe key -> [key]
walk LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
next (Maybe key -> [key])
-> (LRU key val -> Maybe key) -> LRU key val -> [key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
first (LRU key val -> [key]) -> LRU key val -> [key]
forall a b. (a -> b) -> a -> b
$ LRU key val
lru
          walk :: (LinkedVal key val -> Maybe key) -> Maybe key -> [key]
walk LinkedVal key val -> Maybe key
_ Maybe key
Nothing = []
          walk LinkedVal key val -> Maybe key
f (Just key
k) = let Just LinkedVal key val
k' = key -> Map key (LinkedVal key val) -> Maybe (LinkedVal key val)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
k Map key (LinkedVal key val)
contents
                                in key
k key -> [key] -> [key]
forall a. a -> [a] -> [a]
: ((LinkedVal key val -> Maybe key) -> Maybe key -> [key]
walk LinkedVal key val -> Maybe key
f (Maybe key -> [key])
-> (LinkedVal key val -> Maybe key) -> LinkedVal key val -> [key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkedVal key val -> Maybe key
f (LinkedVal key val -> [key]) -> LinkedVal key val -> [key]
forall a b. (a -> b) -> a -> b
$ LinkedVal key val
k')
          reverseKeys :: [key]
reverseKeys = (LinkedVal key val -> Maybe key) -> Maybe key -> [key]
walk LinkedVal key val -> Maybe key
forall key val. LinkedVal key val -> Maybe key
prev (Maybe key -> [key])
-> (LRU key val -> Maybe key) -> LRU key val -> [key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRU key val -> Maybe key
forall key val. LRU key val -> Maybe key
last (LRU key val -> [key]) -> LRU key val -> [key]
forall a b. (a -> b) -> a -> b
$ LRU key val
lru