-- | Safer cache version that is implemented totally
-- on the user level. Using 'MVar' as a synchronization
-- primitive.
--
-- While this implementation is slower in general case it may
-- be more resilient to changes in GHC and RTS. This implementation
-- is mostly used in order to sanity check the GHC one, and in order
-- to be able to switch to this one without program recompilation.
--
-- However if you need strict guarantees that the only one action with
-- the same input is run concurrently you should prefer this implementation.
module System.Cache.Impl.MVar
  ( new
  ) where

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.HashPSQ as PSQ
import Data.Hashable
import Data.IORef
import Data.Tuple
import System.Clock.Seconds

import System.Cache.Internal.Interface

-- | Create new cache handle. Keeps priority queue from psqueues package inside.
--
-- Properties:
--
--  * if multiple threads are running an IO action with the same input
--    concurrently then only one will run, all the rest will wait for that
--    action and will either return a value, or throw an exception depending
--    on the the result of the first one
--  * storage is cleared only during access, it will remove redundant work
--    but may lead to the situation when cached values are stored in memory
--    for a longer period that it was expected
--  * psqueue structure uses both 'Hashable' and 'Ord' constraints and is
--    not vulnerable to the hash collision attacks.
--
new
  :: (Show a, Hashable a, Ord a)
  => Config
  -> IO (Handle a b)
new :: Config -> IO (Handle a b)
new cfg :: Config
cfg@Config {Seconds
Clock
configClock :: Config -> Clock
configLongestAge :: Config -> Seconds
configClock :: Clock
configLongestAge :: Seconds
..} = do
  IORef
  (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
ref <- HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
-> IO
     (IORef
        (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))))
forall a. a -> IO (IORef a)
newIORef HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
forall k p v. HashPSQ k p v
PSQ.empty
  Handle a b -> IO (Handle a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handle a b -> IO (Handle a b)) -> Handle a b -> IO (Handle a b)
forall a b. (a -> b) -> a -> b
$ Handle :: forall a b.
(Seconds -> a -> (a -> IO b) -> IO b)
-> (a -> IO ()) -> IO Seconds -> Handle a b
Handle
    { requestOrInternal :: Seconds -> a -> (a -> IO b) -> IO b
requestOrInternal = \Seconds
tm a
k a -> IO b
f -> do
        HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
queue <- IORef
  (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
-> IO
     (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
forall a. IORef a -> IO a
readIORef IORef
  (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
ref
        b
result
          <- case a
-> HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
-> Maybe (Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
forall k p v.
(Ord k, Hashable k, Ord p) =>
k -> HashPSQ k p v -> Maybe (p, v)
PSQ.lookup a
k HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
queue of
               Maybe (Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
Nothing -> Config
-> IORef
     (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
-> Seconds
-> a
-> (a -> IO b)
-> IO b
forall k z.
(Hashable k, Ord k) =>
Config
-> IORef
     (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> Seconds
-> k
-> (k -> IO z)
-> IO z
insertElement Config
cfg IORef
  (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
ref Seconds
tm a
k a -> IO b
f
               Just (Seconds
p, (IORef (Maybe b)
r, MVar (Maybe (Seconds, b))
lock)) -> do
                 IORef (Maybe b) -> IO (Maybe b)
forall a. IORef a -> IO a
readIORef IORef (Maybe b)
r IO (Maybe b) -> (Maybe b -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                   Maybe b
Nothing
                     -> Config
-> IORef
     (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
-> MVar (Maybe (Seconds, b))
-> IORef (Maybe b)
-> Seconds
-> a
-> (a -> IO b)
-> IO b
forall k z.
(Hashable k, Ord k) =>
Config
-> IORef
     (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> MVar (Maybe (Seconds, z))
-> IORef (Maybe z)
-> Seconds
-> k
-> (k -> IO z)
-> IO z
updateLock Config
cfg IORef
  (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
ref MVar (Maybe (Seconds, b))
lock IORef (Maybe b)
r Seconds
tm a
k a -> IO b
f
                   Just b
v
                     | Seconds
p Seconds -> Seconds -> Bool
forall a. Ord a => a -> a -> Bool
>= Seconds
tm Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
- Seconds
configLongestAge -> b -> IO b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v
                     | Bool
otherwise -> Config
-> IORef
     (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
-> MVar (Maybe (Seconds, b))
-> IORef (Maybe b)
-> Seconds
-> a
-> (a -> IO b)
-> IO b
forall k z.
(Hashable k, Ord k) =>
Config
-> IORef
     (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> MVar (Maybe (Seconds, z))
-> IORef (Maybe z)
-> Seconds
-> k
-> (k -> IO z)
-> IO z
updateLock Config
cfg IORef
  (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
ref MVar (Maybe (Seconds, b))
lock IORef (Maybe b)
r Seconds
tm a
k a -> IO b
f
        IORef
  (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
-> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
    -> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
        ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef
  (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
ref ((HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
  -> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
      ()))
 -> IO ())
-> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
    -> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
        ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ ((),
 HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
-> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
    ())
forall a b. (a, b) -> (b, a)
swap (((),
  HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
 -> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
     ()))
-> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
    -> ((),
        HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))))
-> HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
-> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
    ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (a, Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
 -> ((),
     Maybe (a, Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))))
-> HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
-> ((),
    HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
forall k p v b.
(Hashable k, Ord k, Ord p) =>
(Maybe (k, p, v) -> (b, Maybe (k, p, v)))
-> HashPSQ k p v -> (b, HashPSQ k p v)
PSQ.alterMin
                (\case
                  Maybe (a, Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
Nothing -> ((), Maybe (a, Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
forall a. Maybe a
Nothing)
                  Just (a
kk, Seconds
p, (IORef (Maybe b), MVar (Maybe (Seconds, b)))
v)
                    | Seconds
p Seconds -> Seconds -> Bool
forall a. Ord a => a -> a -> Bool
< Seconds
tm Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
- Seconds
configLongestAge -> ((), Maybe (a, Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
forall a. Maybe a
Nothing)
                    | Bool
otherwise -> ((), (a, Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
-> Maybe (a, Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
forall a. a -> Maybe a
Just (a
kk, Seconds
p, (IORef (Maybe b), MVar (Maybe (Seconds, b)))
v))
                )
        b -> IO b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
result
    , remove :: a -> IO ()
remove = \a
k -> do
       IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef
  (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
-> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
    -> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
        ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef
  (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
ref ((HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
  -> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
      ()))
 -> IO ())
-> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
    -> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
        ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ ((),
 HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
-> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
    ())
forall a b. (a, b) -> (b, a)
swap (((),
  HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
 -> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
     ()))
-> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
    -> ((),
        HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))))
-> HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
-> (HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))),
    ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
 -> ((),
     Maybe (Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))))
-> a
-> HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b)))
-> ((),
    HashPSQ a Seconds (IORef (Maybe b), MVar (Maybe (Seconds, b))))
forall k p v b.
(Hashable k, Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> HashPSQ k p v -> (b, HashPSQ k p v)
PSQ.alter (((), Maybe (Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b)))))
-> Maybe (Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
-> ((),
    Maybe (Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b)))))
forall a b. a -> b -> a
const ((), Maybe (Seconds, (IORef (Maybe b), MVar (Maybe (Seconds, b))))
forall a. Maybe a
Nothing)) a
k
    , getClockTime :: IO Seconds
getClockTime = Clock -> IO Seconds
getTime Clock
configClock
    }

-- | There is no value in the queue, but someone may already trying to create a lock,
-- so we need to register a lock, verifying that it was registered concurrently.
insertElement :: (Hashable k, Ord k)
  => Config
  -> IORef (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
  -> Seconds
  -> k
  -> (k -> IO z)
  -> IO z
insertElement :: Config
-> IORef
     (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> Seconds
-> k
-> (k -> IO z)
-> IO z
insertElement Config
cfg IORef
  (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
ref Seconds
tm k
k k -> IO z
f = IO (MVar (Maybe (Seconds, z)))
forall a. IO (MVar a)
newEmptyMVar IO (MVar (Maybe (Seconds, z)))
-> (MVar (Maybe (Seconds, z)) -> IO z) -> IO z
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar (Maybe (Seconds, z))
x -> MVar (Maybe (Seconds, z)) -> IO z
go MVar (Maybe (Seconds, z))
x IO z -> IO Bool -> IO z
forall a b. IO a -> IO b -> IO a
`onException` (MVar (Maybe (Seconds, z)) -> Maybe (Seconds, z) -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar (Maybe (Seconds, z))
x Maybe (Seconds, z)
forall a. Maybe a
Nothing) where
  go :: MVar (Maybe (Seconds, z)) -> IO z
go MVar (Maybe (Seconds, z))
our_lock = do
    IORef (Maybe z)
result_box <- Maybe z -> IO (IORef (Maybe z))
forall a. a -> IO (IORef a)
newIORef Maybe z
forall a. Maybe a
Nothing
    Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z)))
update_result
      <- IORef
  (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
    -> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))),
        Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z)))))
-> IO (Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z))))
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef
  (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
ref ((HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
  -> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))),
      Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z)))))
 -> IO (Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z)))))
-> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
    -> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))),
        Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z)))))
-> IO (Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z))))
forall a b. (a -> b) -> a -> b
$ (Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z))),
 HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))),
    Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z))))
forall a b. (a, b) -> (b, a)
swap ((Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z))),
  HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
 -> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))),
     Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z)))))
-> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
    -> (Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z))),
        HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))))
-> HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
-> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))),
    Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (Maybe (Seconds, (IORef (Maybe z), MVar (Maybe (Seconds, z))))
 -> (Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z))),
     Maybe (Seconds, (IORef (Maybe z), MVar (Maybe (Seconds, z))))))
-> k
-> HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
-> (Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z))),
    HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
forall k p v b.
(Hashable k, Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> HashPSQ k p v -> (b, HashPSQ k p v)
PSQ.alter
          (\case
             Just x :: (Seconds, (IORef (Maybe z), MVar (Maybe (Seconds, z))))
x@(Seconds
_, (IORef (Maybe z), MVar (Maybe (Seconds, z)))
their_lock) -> ((IORef (Maybe z), MVar (Maybe (Seconds, z)))
-> Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z)))
forall a. a -> Maybe a
Just (IORef (Maybe z), MVar (Maybe (Seconds, z)))
their_lock, (Seconds, (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> Maybe (Seconds, (IORef (Maybe z), MVar (Maybe (Seconds, z))))
forall a. a -> Maybe a
Just (Seconds, (IORef (Maybe z), MVar (Maybe (Seconds, z))))
x)
             Maybe (Seconds, (IORef (Maybe z), MVar (Maybe (Seconds, z))))
Nothing -> (Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z)))
forall a. Maybe a
Nothing, (Seconds, (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> Maybe (Seconds, (IORef (Maybe z), MVar (Maybe (Seconds, z))))
forall a. a -> Maybe a
Just (Seconds
tm, (IORef (Maybe z)
result_box, MVar (Maybe (Seconds, z))
our_lock)))
          ) k
k
    case Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z)))
update_result of
      Just (IORef (Maybe z)
r, MVar (Maybe (Seconds, z))
their_lock)
        -> Config
-> IORef
     (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> MVar (Maybe (Seconds, z))
-> IORef (Maybe z)
-> Seconds
-> k
-> (k -> IO z)
-> IO z
forall k z.
(Hashable k, Ord k) =>
Config
-> IORef
     (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> MVar (Maybe (Seconds, z))
-> IORef (Maybe z)
-> Seconds
-> k
-> (k -> IO z)
-> IO z
updateLock Config
cfg IORef
  (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
ref MVar (Maybe (Seconds, z))
their_lock IORef (Maybe z)
r Seconds
tm k
k k -> IO z
f -- Someone else managed to insert the lock, first.
      Maybe (IORef (Maybe z), MVar (Maybe (Seconds, z)))
Nothing -> do
        -- We are holding a lock, so we need to evaluate value and register it
        z
value <- k -> IO z
f k
k
        MVar (Maybe (Seconds, z)) -> Maybe (Seconds, z) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe (Seconds, z))
our_lock ((Seconds, z) -> Maybe (Seconds, z)
forall a. a -> Maybe a
Just (Seconds
tm, z
value))
        IORef (Maybe z) -> Maybe z -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe z)
result_box (z -> Maybe z
forall a. a -> Maybe a
Just z
value)
        z -> IO z
forall (f :: * -> *) a. Applicative f => a -> f a
pure z
value

updateLock :: (Hashable k, Ord k)
  => Config
  -> IORef (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
  -> MVar (Maybe (Seconds, z))
  -> IORef (Maybe z)
  -> Seconds 
  -> k
  -> (k -> IO z)
  -> IO z
updateLock :: Config
-> IORef
     (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> MVar (Maybe (Seconds, z))
-> IORef (Maybe z)
-> Seconds
-> k
-> (k -> IO z)
-> IO z
updateLock Config{Seconds
Clock
configClock :: Clock
configLongestAge :: Seconds
configClock :: Config -> Clock
configLongestAge :: Config -> Seconds
..} IORef
  (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
ref MVar (Maybe (Seconds, z))
lock IORef (Maybe z)
inner Seconds
tm k
k k -> IO z
f  = MVar (Maybe (Seconds, z))
-> (Maybe (Seconds, z) -> IO (Maybe (Seconds, z), z)) -> IO z
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Maybe (Seconds, z))
lock ((Maybe (Seconds, z) -> IO (Maybe (Seconds, z), z)) -> IO z)
-> (Maybe (Seconds, z) -> IO (Maybe (Seconds, z), z)) -> IO z
forall a b. (a -> b) -> a -> b
$ \case
  Just x :: (Seconds, z)
x@(Seconds
p, z
v) -- Result exists and is valid, we can just return it
    | Seconds
p Seconds -> Seconds -> Bool
forall a. Ord a => a -> a -> Bool
>= Seconds
tm Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
- Seconds
configLongestAge -> (Maybe (Seconds, z), z) -> IO (Maybe (Seconds, z), z)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Seconds, z) -> Maybe (Seconds, z)
forall a. a -> Maybe a
Just (Seconds, z)
x, z
v)
  Maybe (Seconds, z)
_ -> do -- There is no result or it's outdated, we can update it.
    z
value <- k -> IO z
f k
k
    IORef (Maybe z) -> Maybe z -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe z)
inner (z -> Maybe z
forall a. a -> Maybe a
Just z
value)
    IORef
  (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
-> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
    -> (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))),
        ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef
  (HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z))))
ref (\HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
queue -> (k
-> Seconds
-> (IORef (Maybe z), MVar (Maybe (Seconds, z)))
-> HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
-> HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
forall k p v.
(Ord k, Hashable k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> HashPSQ k p v
PSQ.insert k
k Seconds
tm (IORef (Maybe z)
inner,MVar (Maybe (Seconds, z))
lock) HashPSQ k Seconds (IORef (Maybe z), MVar (Maybe (Seconds, z)))
queue, ()))
    (Maybe (Seconds, z), z) -> IO (Maybe (Seconds, z), z)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Seconds, z) -> Maybe (Seconds, z)
forall a. a -> Maybe a
Just (Seconds
tm, z
value), z
value)