{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Dep.Value.Cached
(
Ref,
allocateRef,
cache,
)
where
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Cont
import Dep.Has
import Dep.Value
import Data.ByteString
import Data.Typeable
import Data.Proxy
type Ref v = MVar (Maybe v)
allocateRef :: MonadIO m => ContT () m (Ref v)
allocateRef :: ContT () m (Ref v)
allocateRef = ((Ref v -> m ()) -> m ()) -> ContT () m (Ref v)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT \Ref v -> m ()
f -> do
Ref v
ref <- IO (Ref v) -> m (Ref v)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref v) -> m (Ref v)) -> IO (Ref v) -> m (Ref v)
forall a b. (a -> b) -> a -> b
$ Maybe v -> IO (Ref v)
forall a. a -> IO (MVar a)
newMVar Maybe v
forall a. Maybe a
Nothing
Ref v -> m ()
f Ref v
ref
cache :: MonadUnliftIO m => Ref v -> Value v m -> Value v m
cache :: Ref v -> Value v m -> Value v m
cache Ref v
ref Value {m v
value :: forall v (m :: * -> *). Value v m -> m v
value :: m v
value} = m v -> Value v m
forall v (m :: * -> *). m v -> Value v m
Value do
m v -> IO v
run <- m (m v -> IO v)
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
IO v -> m v
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO v -> m v) -> IO v -> m v
forall a b. (a -> b) -> a -> b
$ Ref v -> (Maybe v -> IO (Maybe v, v)) -> IO v
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar Ref v
ref \case
Just v
v -> do
(Maybe v, v) -> IO (Maybe v, v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> Maybe v
forall a. a -> Maybe a
Just v
v, v
v)
Maybe v
Nothing -> do
v
v <- m v -> IO v
run m v
value
(Maybe v, v) -> IO (Maybe v, v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> Maybe v
forall a. a -> Maybe a
Just v
v, v
v)