{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
-- | Cache 'Value's to avoid repeated calls to the underlying value-obtaining action, which migh be expensive.

--

-- Typically, this module only needs to be imported when creating the global application environment.

module Dep.Value.Cached
  ( 
    -- * caching 'Value's

    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)