{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Data.Cache.LRU.IO.Internal where
import Prelude hiding ( lookup, mod, take )
import Control.Applicative ( (<$>) )
import Control.Concurrent.MVar ( MVar )
import qualified Control.Concurrent.MVar as MV
import Control.Exception ( bracketOnError )
import Data.Cache.LRU ( LRU )
import qualified Data.Cache.LRU as LRU
import Data.Typeable (Typeable)
newtype AtomicLRU key val = C (MVar (LRU key val)) deriving Typeable
newAtomicLRU :: Ord key => Maybe Integer
-> IO (AtomicLRU key val)
newAtomicLRU :: Maybe Integer -> IO (AtomicLRU key val)
newAtomicLRU = (MVar (LRU key val) -> AtomicLRU key val)
-> IO (MVar (LRU key val)) -> IO (AtomicLRU key val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVar (LRU key val) -> AtomicLRU key val
forall key val. MVar (LRU key val) -> AtomicLRU key val
C (IO (MVar (LRU key val)) -> IO (AtomicLRU key val))
-> (Maybe Integer -> IO (MVar (LRU key val)))
-> Maybe Integer
-> IO (AtomicLRU key val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRU key val -> IO (MVar (LRU key val))
forall a. a -> IO (MVar a)
MV.newMVar (LRU key val -> IO (MVar (LRU key val)))
-> (Maybe Integer -> LRU key val)
-> Maybe Integer
-> IO (MVar (LRU key val))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Integer -> LRU key val
forall key val. Ord key => Maybe Integer -> LRU key val
LRU.newLRU
fromList :: Ord key => Maybe Integer
-> [(key, val)] -> IO (AtomicLRU key val)
fromList :: Maybe Integer -> [(key, val)] -> IO (AtomicLRU key val)
fromList Maybe Integer
s [(key, val)]
l = (MVar (LRU key val) -> AtomicLRU key val)
-> IO (MVar (LRU key val)) -> IO (AtomicLRU key val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVar (LRU key val) -> AtomicLRU key val
forall key val. MVar (LRU key val) -> AtomicLRU key val
C (IO (MVar (LRU key val)) -> IO (AtomicLRU key val))
-> (LRU key val -> IO (MVar (LRU key val)))
-> LRU key val
-> IO (AtomicLRU key val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRU key val -> IO (MVar (LRU key val))
forall a. a -> IO (MVar a)
MV.newMVar (LRU key val -> IO (AtomicLRU key val))
-> LRU key val -> IO (AtomicLRU key val)
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> [(key, val)] -> LRU key val
forall key val.
Ord key =>
Maybe Integer -> [(key, val)] -> LRU key val
LRU.fromList Maybe Integer
s [(key, val)]
l
toList :: Ord key => AtomicLRU key val -> IO [(key, val)]
toList :: AtomicLRU key val -> IO [(key, val)]
toList (C MVar (LRU key val)
mvar) = LRU key val -> [(key, val)]
forall key val. Ord key => LRU key val -> [(key, val)]
LRU.toList (LRU key val -> [(key, val)])
-> IO (LRU key val) -> IO [(key, val)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar (LRU key val) -> IO (LRU key val)
forall a. MVar a -> IO a
MV.readMVar MVar (LRU key val)
mvar
maxSize :: AtomicLRU key val -> IO (Maybe Integer)
maxSize :: AtomicLRU key val -> IO (Maybe Integer)
maxSize (C MVar (LRU key val)
mvar) = LRU key val -> Maybe Integer
forall key val. LRU key val -> Maybe Integer
LRU.maxSize (LRU key val -> Maybe Integer)
-> IO (LRU key val) -> IO (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar (LRU key val) -> IO (LRU key val)
forall a. MVar a -> IO a
MV.readMVar MVar (LRU key val)
mvar
insert :: Ord key => key -> val -> AtomicLRU key val -> IO ()
insert :: key -> val -> AtomicLRU key val -> IO ()
insert key
key val
val (C MVar (LRU key val)
mvar) = MVar (LRU key val) -> (LRU key val -> IO (LRU key val)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_' MVar (LRU key val)
mvar ((LRU key val -> IO (LRU key val)) -> IO ())
-> (LRU key val -> IO (LRU key val)) -> IO ()
forall a b. (a -> b) -> a -> b
$ LRU key val -> IO (LRU key val)
forall (m :: * -> *) a. Monad m => a -> m a
return (LRU key val -> IO (LRU key val))
-> (LRU key val -> LRU key val) -> LRU key val -> IO (LRU key val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. key -> val -> LRU key val -> LRU key val
forall key val. Ord key => key -> val -> LRU key val -> LRU key val
LRU.insert key
key val
val
lookup :: Ord key => key -> AtomicLRU key val -> IO (Maybe val)
lookup :: key -> AtomicLRU key val -> IO (Maybe val)
lookup key
key (C MVar (LRU key val)
mvar) = MVar (LRU key val)
-> (LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar' MVar (LRU key val)
mvar ((LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val))
-> (LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val)
forall a b. (a -> b) -> a -> b
$ (LRU key val, Maybe val) -> IO (LRU key val, Maybe val)
forall (m :: * -> *) a. Monad m => a -> m a
return ((LRU key val, Maybe val) -> IO (LRU key val, Maybe val))
-> (LRU key val -> (LRU key val, Maybe val))
-> LRU key val
-> IO (LRU key val, Maybe val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. key -> LRU key val -> (LRU key val, Maybe val)
forall key val.
Ord key =>
key -> LRU key val -> (LRU key val, Maybe val)
LRU.lookup key
key
delete :: Ord key => key -> AtomicLRU key val -> IO (Maybe val)
delete :: key -> AtomicLRU key val -> IO (Maybe val)
delete key
key (C MVar (LRU key val)
mvar) = MVar (LRU key val)
-> (LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar' MVar (LRU key val)
mvar ((LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val))
-> (LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val)
forall a b. (a -> b) -> a -> b
$ (LRU key val, Maybe val) -> IO (LRU key val, Maybe val)
forall (m :: * -> *) a. Monad m => a -> m a
return ((LRU key val, Maybe val) -> IO (LRU key val, Maybe val))
-> (LRU key val -> (LRU key val, Maybe val))
-> LRU key val
-> IO (LRU key val, Maybe val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. key -> LRU key val -> (LRU key val, Maybe val)
forall key val.
Ord key =>
key -> LRU key val -> (LRU key val, Maybe val)
LRU.delete key
key
pop :: Ord key => AtomicLRU key val -> IO (Maybe (key, val))
pop :: AtomicLRU key val -> IO (Maybe (key, val))
pop (C MVar (LRU key val)
mvar) = MVar (LRU key val)
-> (LRU key val -> IO (LRU key val, Maybe (key, val)))
-> IO (Maybe (key, val))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar' MVar (LRU key val)
mvar ((LRU key val -> IO (LRU key val, Maybe (key, val)))
-> IO (Maybe (key, val)))
-> (LRU key val -> IO (LRU key val, Maybe (key, val)))
-> IO (Maybe (key, val))
forall a b. (a -> b) -> a -> b
$ (LRU key val, Maybe (key, val))
-> IO (LRU key val, Maybe (key, val))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LRU key val, Maybe (key, val))
-> IO (LRU key val, Maybe (key, val)))
-> (LRU key val -> (LRU key val, Maybe (key, val)))
-> LRU key val
-> IO (LRU key val, Maybe (key, val))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRU key val -> (LRU key val, Maybe (key, val))
forall key val.
Ord key =>
LRU key val -> (LRU key val, Maybe (key, val))
LRU.pop
size :: AtomicLRU key val -> IO Int
size :: AtomicLRU key val -> IO Int
size (C MVar (LRU key val)
mvar) = LRU key val -> Int
forall key val. LRU key val -> Int
LRU.size (LRU key val -> Int) -> IO (LRU key val) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar (LRU key val) -> IO (LRU key val)
forall a. MVar a -> IO a
MV.readMVar MVar (LRU key val)
mvar
modifyAtomicLRU :: (LRU.LRU key val -> LRU.LRU key val)
-> AtomicLRU key val
-> IO ()
modifyAtomicLRU :: (LRU key val -> LRU key val) -> AtomicLRU key val -> IO ()
modifyAtomicLRU LRU key val -> LRU key val
f = (LRU key val -> IO (LRU key val)) -> AtomicLRU key val -> IO ()
forall key val.
(LRU key val -> IO (LRU key val)) -> AtomicLRU key val -> IO ()
modifyAtomicLRU' ((LRU key val -> IO (LRU key val)) -> AtomicLRU key val -> IO ())
-> (LRU key val -> IO (LRU key val)) -> AtomicLRU key val -> IO ()
forall a b. (a -> b) -> a -> b
$ LRU key val -> IO (LRU key val)
forall (m :: * -> *) a. Monad m => a -> m a
return (LRU key val -> IO (LRU key val))
-> (LRU key val -> LRU key val) -> LRU key val -> IO (LRU key val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRU key val -> LRU key val
f
modifyAtomicLRU' :: (LRU.LRU key val -> IO (LRU.LRU key val))
-> AtomicLRU key val
-> IO ()
modifyAtomicLRU' :: (LRU key val -> IO (LRU key val)) -> AtomicLRU key val -> IO ()
modifyAtomicLRU' LRU key val -> IO (LRU key val)
f (C MVar (LRU key val)
mvar) = MVar (LRU key val) -> (LRU key val -> IO (LRU key val)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_' MVar (LRU key val)
mvar LRU key val -> IO (LRU key val)
f
modifyMVar_' :: MVar a -> (a -> IO a) -> IO ()
modifyMVar_' :: MVar a -> (a -> IO a) -> IO ()
modifyMVar_' MVar a
mvar a -> IO a
f = do
let take :: IO a
take = MVar a -> IO a
forall a. MVar a -> IO a
MV.takeMVar MVar a
mvar
replace :: a -> IO ()
replace = MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
MV.putMVar MVar a
mvar
mod :: a -> IO ()
mod a
x = do
a
x' <- a -> IO a
f a
x
MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
MV.putMVar MVar a
mvar (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$! a
x'
IO a -> (a -> IO ()) -> (a -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError IO a
take a -> IO ()
replace a -> IO ()
mod
modifyMVar' :: MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar' :: MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar' MVar a
mvar a -> IO (a, b)
f = do
let take :: IO a
take = MVar a -> IO a
forall a. MVar a -> IO a
MV.takeMVar MVar a
mvar
replace :: a -> IO ()
replace = MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
MV.putMVar MVar a
mvar
mod :: a -> IO b
mod a
x = do
(a
x', b
result) <- a -> IO (a, b)
f a
x
MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
MV.putMVar MVar a
mvar (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$! a
x'
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
result
IO a -> (a -> IO ()) -> (a -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError IO a
take a -> IO ()
replace a -> IO b
mod