module Data.LruCache.Haxl
( LruHandle (..)
, newLruHandle
, cached'
, cached
, remove
, updateLruHandle
) where
import Data.Hashable (Hashable (..))
import Haxl.Core (GenHaxl, env, userEnv)
import Haxl.Core.Monad (unsafeLiftIO)
import Data.HashPSQ (delete, member)
import Data.IORef (atomicModifyIORef')
import Data.LruCache (empty, insert, lookup)
import Data.LruCache.Internal (LruCache (..))
import Data.LruCache.IO (LruHandle (..), newLruHandle)
import Prelude hiding (lookup)
doLookup :: (Hashable k, Ord k) => k -> LruCache k v -> (LruCache k v, Maybe v)
doLookup :: k -> LruCache k v -> (LruCache k v, Maybe v)
doLookup k :: k
k c :: LruCache k v
c = case k -> LruCache k v -> Maybe (v, LruCache k v)
forall k v.
(Hashable k, Ord k) =>
k -> LruCache k v -> Maybe (v, LruCache k v)
lookup k
k LruCache k v
c of
Nothing -> (LruCache k v
c, Maybe v
forall a. Maybe a
Nothing)
Just (v :: v
v, c' :: LruCache k v
c') -> (LruCache k v
c', v -> Maybe v
forall a. a -> Maybe a
Just v
v)
doInsert :: (Hashable k, Ord k) => k -> v -> a -> LruCache k v -> (LruCache k v, a)
doInsert :: k -> v -> a -> LruCache k v -> (LruCache k v, a)
doInsert k :: k
k v :: v
v v0 :: a
v0 c :: LruCache k v
c = (k -> v -> LruCache k v -> LruCache k v
forall k v.
(Hashable k, Ord k) =>
k -> v -> LruCache k v -> LruCache k v
insert k
k v
v LruCache k v
c, a
v0)
cached :: (Hashable k, Ord k) => (u -> Maybe (LruHandle k v)) -> k -> GenHaxl u w (Maybe v) -> GenHaxl u w (Maybe v)
cached :: (u -> Maybe (LruHandle k v))
-> k -> GenHaxl u w (Maybe v) -> GenHaxl u w (Maybe v)
cached lru :: u -> Maybe (LruHandle k v)
lru k :: k
k io :: GenHaxl u w (Maybe v)
io = do
Maybe (LruHandle k v)
h <- u -> Maybe (LruHandle k v)
lru (u -> Maybe (LruHandle k v))
-> GenHaxl u w u -> GenHaxl u w (Maybe (LruHandle k v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env u w -> u) -> GenHaxl u w u
forall u w a. (Env u w -> a) -> GenHaxl u w a
env Env u w -> u
forall u w. Env u w -> u
userEnv
Maybe (LruHandle k v)
-> k -> GenHaxl u w (Maybe v) -> GenHaxl u w (Maybe v)
forall k v u w.
(Hashable k, Ord k) =>
Maybe (LruHandle k v)
-> k -> GenHaxl u w (Maybe v) -> GenHaxl u w (Maybe v)
go Maybe (LruHandle k v)
h k
k GenHaxl u w (Maybe v)
io
where go :: (Hashable k, Ord k) => Maybe (LruHandle k v) -> k -> GenHaxl u w (Maybe v) -> GenHaxl u w (Maybe v)
go :: Maybe (LruHandle k v)
-> k -> GenHaxl u w (Maybe v) -> GenHaxl u w (Maybe v)
go Nothing _ io0 :: GenHaxl u w (Maybe v)
io0 = GenHaxl u w (Maybe v)
io0
go (Just (LruHandle ref :: IORef (LruCache k v)
ref)) k0 :: k
k0 io0 :: GenHaxl u w (Maybe v)
io0 = do
Maybe v
res <- IO (Maybe v) -> GenHaxl u w (Maybe v)
forall a u w. IO a -> GenHaxl u w a
unsafeLiftIO (IO (Maybe v) -> GenHaxl u w (Maybe v))
-> IO (Maybe v) -> GenHaxl u w (Maybe v)
forall a b. (a -> b) -> a -> b
$ IORef (LruCache k v)
-> (LruCache k v -> (LruCache k v, Maybe v)) -> IO (Maybe v)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (LruCache k v)
ref ((LruCache k v -> (LruCache k v, Maybe v)) -> IO (Maybe v))
-> (LruCache k v -> (LruCache k v, Maybe v)) -> IO (Maybe v)
forall a b. (a -> b) -> a -> b
$ k -> LruCache k v -> (LruCache k v, Maybe v)
forall k v.
(Hashable k, Ord k) =>
k -> LruCache k v -> (LruCache k v, Maybe v)
doLookup k
k0
case Maybe v
res of
Just v :: v
v -> Maybe v -> GenHaxl u w (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return (v -> Maybe v
forall a. a -> Maybe a
Just v
v)
Nothing -> do
Maybe v
v <- GenHaxl u w (Maybe v)
io0
case Maybe v
v of
Nothing -> Maybe v -> GenHaxl u w (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
Just v0 :: v
v0 -> IO (Maybe v) -> GenHaxl u w (Maybe v)
forall a u w. IO a -> GenHaxl u w a
unsafeLiftIO (IO (Maybe v) -> GenHaxl u w (Maybe v))
-> IO (Maybe v) -> GenHaxl u w (Maybe v)
forall a b. (a -> b) -> a -> b
$ IORef (LruCache k v)
-> (LruCache k v -> (LruCache k v, Maybe v)) -> IO (Maybe v)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (LruCache k v)
ref ((LruCache k v -> (LruCache k v, Maybe v)) -> IO (Maybe v))
-> (LruCache k v -> (LruCache k v, Maybe v)) -> IO (Maybe v)
forall a b. (a -> b) -> a -> b
$ k -> v -> Maybe v -> LruCache k v -> (LruCache k v, Maybe v)
forall k v a.
(Hashable k, Ord k) =>
k -> v -> a -> LruCache k v -> (LruCache k v, a)
doInsert k
k0 v
v0 Maybe v
v
cached' :: (Hashable k, Ord k) => (u -> Maybe (LruHandle k v)) -> k -> GenHaxl u w v -> GenHaxl u w v
cached' :: (u -> Maybe (LruHandle k v)) -> k -> GenHaxl u w v -> GenHaxl u w v
cached' lru :: u -> Maybe (LruHandle k v)
lru k :: k
k io :: GenHaxl u w v
io = do
Maybe (LruHandle k v)
h <- u -> Maybe (LruHandle k v)
lru (u -> Maybe (LruHandle k v))
-> GenHaxl u w u -> GenHaxl u w (Maybe (LruHandle k v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env u w -> u) -> GenHaxl u w u
forall u w a. (Env u w -> a) -> GenHaxl u w a
env Env u w -> u
forall u w. Env u w -> u
userEnv
Maybe (LruHandle k v) -> k -> GenHaxl u w v -> GenHaxl u w v
forall k v u w.
(Hashable k, Ord k) =>
Maybe (LruHandle k v) -> k -> GenHaxl u w v -> GenHaxl u w v
go Maybe (LruHandle k v)
h k
k GenHaxl u w v
io
where go :: (Hashable k, Ord k) => Maybe (LruHandle k v) -> k -> GenHaxl u w v -> GenHaxl u w v
go :: Maybe (LruHandle k v) -> k -> GenHaxl u w v -> GenHaxl u w v
go Nothing _ io0 :: GenHaxl u w v
io0 = GenHaxl u w v
io0
go (Just (LruHandle ref :: IORef (LruCache k v)
ref)) k0 :: k
k0 io0 :: GenHaxl u w v
io0 = do
Maybe v
res <- IO (Maybe v) -> GenHaxl u w (Maybe v)
forall a u w. IO a -> GenHaxl u w a
unsafeLiftIO (IO (Maybe v) -> GenHaxl u w (Maybe v))
-> IO (Maybe v) -> GenHaxl u w (Maybe v)
forall a b. (a -> b) -> a -> b
$ IORef (LruCache k v)
-> (LruCache k v -> (LruCache k v, Maybe v)) -> IO (Maybe v)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (LruCache k v)
ref ((LruCache k v -> (LruCache k v, Maybe v)) -> IO (Maybe v))
-> (LruCache k v -> (LruCache k v, Maybe v)) -> IO (Maybe v)
forall a b. (a -> b) -> a -> b
$ k -> LruCache k v -> (LruCache k v, Maybe v)
forall k v.
(Hashable k, Ord k) =>
k -> LruCache k v -> (LruCache k v, Maybe v)
doLookup k
k0
case Maybe v
res of
Just v :: v
v -> v -> GenHaxl u w v
forall (m :: * -> *) a. Monad m => a -> m a
return v
v
Nothing -> do
v
v <- GenHaxl u w v
io0
IO v -> GenHaxl u w v
forall a u w. IO a -> GenHaxl u w a
unsafeLiftIO (IO v -> GenHaxl u w v) -> IO v -> GenHaxl u w v
forall a b. (a -> b) -> a -> b
$ IORef (LruCache k v) -> (LruCache k v -> (LruCache k v, v)) -> IO v
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (LruCache k v)
ref ((LruCache k v -> (LruCache k v, v)) -> IO v)
-> (LruCache k v -> (LruCache k v, v)) -> IO v
forall a b. (a -> b) -> a -> b
$ k -> v -> v -> LruCache k v -> (LruCache k v, v)
forall k v a.
(Hashable k, Ord k) =>
k -> v -> a -> LruCache k v -> (LruCache k v, a)
doInsert k
k0 v
v v
v
remove :: (Hashable k, Ord k) => (u -> Maybe (LruHandle k v)) -> k -> GenHaxl u w ()
remove :: (u -> Maybe (LruHandle k v)) -> k -> GenHaxl u w ()
remove lru :: u -> Maybe (LruHandle k v)
lru k :: k
k = do
Maybe (LruHandle k v)
h <- u -> Maybe (LruHandle k v)
lru (u -> Maybe (LruHandle k v))
-> GenHaxl u w u -> GenHaxl u w (Maybe (LruHandle k v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env u w -> u) -> GenHaxl u w u
forall u w a. (Env u w -> a) -> GenHaxl u w a
env Env u w -> u
forall u w. Env u w -> u
userEnv
case Maybe (LruHandle k v)
h of
Nothing -> () -> GenHaxl u w ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (LruHandle ref :: IORef (LruCache k v)
ref) ->
IO () -> GenHaxl u w ()
forall a u w. IO a -> GenHaxl u w a
unsafeLiftIO (IO () -> GenHaxl u w ()) -> IO () -> GenHaxl u w ()
forall a b. (a -> b) -> a -> b
$ IORef (LruCache k v)
-> (LruCache k v -> (LruCache k v, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (LruCache k v)
ref ((LruCache k v -> (LruCache k v, ())) -> IO ())
-> (LruCache k v -> (LruCache k v, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \c :: LruCache k v
c -> do
let queue :: HashPSQ k Priority v
queue = LruCache k v -> HashPSQ k Priority v
forall k v. LruCache k v -> HashPSQ k Priority v
lruQueue LruCache k v
c
size :: Int
size = LruCache k v -> Int
forall k v. LruCache k v -> Int
lruSize LruCache k v
c
if k -> HashPSQ k Priority v -> Bool
forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> HashPSQ k p v -> Bool
member k
k HashPSQ k Priority v
queue then (LruCache k v
c { lruSize :: Int
lruSize = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1, lruQueue :: HashPSQ k Priority v
lruQueue = k -> HashPSQ k Priority v -> HashPSQ k Priority v
forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> HashPSQ k p v -> HashPSQ k p v
delete k
k HashPSQ k Priority v
queue }, ())
else (LruCache k v
c, ())
updateLruHandle :: (Hashable k, Ord k) => LruHandle k v -> Int -> IO ()
updateLruHandle :: LruHandle k v -> Int -> IO ()
updateLruHandle (LruHandle ref :: IORef (LruCache k v)
ref) size :: Int
size =
IORef (LruCache k v)
-> (LruCache k v -> (LruCache k v, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (LruCache k v)
ref ((LruCache k v -> (LruCache k v, ())) -> IO ())
-> (LruCache k v -> (LruCache k v, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ (LruCache k v, ()) -> LruCache k v -> (LruCache k v, ())
forall a b. a -> b -> a
const (Int -> LruCache k v
forall k v. Int -> LruCache k v
empty Int
size, ())