{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskell #-}

module Polysemy.Cache where

import qualified Data.Cache as C
import Data.Function ((&))
import Data.Hashable
import Data.IORef
import Polysemy
import Polysemy.AtomicState
import System.Clock

data Cache k v (m :: * -> *) a where
  Insert :: (Eq k, Hashable k) => k -> v -> Cache k v m ()
  Insert' :: (Eq k, Hashable k) => Maybe TimeSpec -> k -> v -> Cache k v m ()
  Lookup :: (Eq k, Hashable k) => k -> Cache k v m (Maybe v)
  Lookup' :: (Eq k, Hashable k) => k -> Cache k v m (Maybe v)
  Keys :: (Eq k, Hashable k) => Cache k v m [k]
  Delete :: (Eq k, Hashable k) => k -> Cache k v m ()
  FilterWithKey :: (Eq k, Hashable k) => (k -> v -> Bool) -> Cache k v m ()
  Purge :: (Eq k, Hashable k) => Cache k v m ()
  PurgeExpired :: (Eq k, Hashable k) => Cache k v m ()
  Size :: (Eq k, Hashable k) => Cache k v m Int
  DefaultExipration :: (Eq k, Hashable k) => Cache k v m (Maybe TimeSpec)
  SetDefaultExpiration :: (Eq k, Hashable k) => Maybe TimeSpec -> Cache k v m ()

makeSem_ ''Cache

-- | Insert an item into the cache, using the default expiration value of the cache.
insert :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => k -> v -> Sem r ()

-- | Insert an item in the cache, with an explicit expiration value.
insert' :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Maybe TimeSpec -> k -> v -> Sem r ()

-- | Lookup an item with the given key, and delete it if it is expired.
--
-- The function will only return a value if it is present in the cache and if the item is not expired.
--
-- The function will eagerly delete the item from the cache if it is expired.
lookup :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => k -> Sem r (Maybe v)

-- | Lookup an item with the given key, but don't delete it if it is expired.
--
-- The function will only return a value if it is present in the cache and if the item is not expired.
--
-- The function will not delete the item from the cache.
lookup' :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => k -> Sem r (Maybe v)

-- | Return all keys present in the cache.
keys :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Sem r [k]

-- | Delete an item from the cache. Won't do anything if the item is not present.
delete :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => k -> Sem r ()

-- | Keeps elements that satify a predicate (used for cache invalidation). Note that the predicate might be called for expired items.
filterWithKey :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => (k -> v -> Bool) -> Sem r ()

-- | Delete all elements (cache invalidation).
purge :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Sem r ()

-- | Delete all items that are expired.
--
-- This is one big atomic operation.
purgeExpired :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Sem r ()

-- | Return the size of the cache, including expired items.
size :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Sem r Int

-- | Get the default expiration value of newly added cache items.
defaultExipration :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Sem r (Maybe TimeSpec)

-- | Change the default expiration value of newly added cache items.
setDefaultExpiration :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Maybe TimeSpec -> Sem r ()

-- | Run a 'Cache' using 'AtomicState'
runCacheAtomicState ::
  forall k v r a.
  Members '[Embed IO, AtomicState (C.Cache k v)] r =>
  Sem (Cache k v ': r) a ->
  Sem r a
runCacheAtomicState :: Sem (Cache k v : r) a -> Sem r a
runCacheAtomicState = (forall x (m :: * -> *). Cache k v m x -> Sem r x)
-> Sem (Cache k v : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall x (m :: * -> *). Cache k v m x -> Sem r x)
 -> Sem (Cache k v : r) a -> Sem r a)
-> (forall x (m :: * -> *). Cache k v m x -> Sem r x)
-> Sem (Cache k v : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Insert k v -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> k -> v -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> k -> v -> IO ()
C.insert Cache k v
cache k
k v
v
  Insert' ts k v -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> Maybe TimeSpec -> k -> v -> IO ()
forall k v.
(Eq k, Hashable k) =>
Cache k v -> Maybe TimeSpec -> k -> v -> IO ()
C.insert' Cache k v
cache Maybe TimeSpec
ts k
k v
v
  Lookup k -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO (Maybe v) -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Maybe v) -> Sem r x) -> IO (Maybe v) -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> k -> IO (Maybe v)
forall k v. (Eq k, Hashable k) => Cache k v -> k -> IO (Maybe v)
C.lookup Cache k v
cache k
k
  Lookup' k -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO (Maybe v) -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Maybe v) -> Sem r x) -> IO (Maybe v) -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> k -> IO (Maybe v)
forall k v. (Eq k, Hashable k) => Cache k v -> k -> IO (Maybe v)
C.lookup Cache k v
cache k
k
  Keys -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO [k] -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO [k] -> Sem r x) -> IO [k] -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> IO [k]
forall k v. Cache k v -> IO [k]
C.keys Cache k v
cache
  Delete k -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> k -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> k -> IO ()
C.delete Cache k v
cache k
k
  FilterWithKey pred -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ (k -> v -> Bool) -> Cache k v -> IO ()
forall k v.
(Eq k, Hashable k) =>
(k -> v -> Bool) -> Cache k v -> IO ()
C.filterWithKey k -> v -> Bool
pred Cache k v
cache
  Purge -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> IO ()
C.purge Cache k v
cache
  PurgeExpired -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> IO ()
C.purgeExpired Cache k v
cache
  Size -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO Int -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO Int -> Sem r x) -> IO Int -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> IO Int
forall k v. Cache k v -> IO Int
C.size Cache k v
cache
  DefaultExipration -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    Maybe TimeSpec -> Sem r x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TimeSpec -> Sem r x) -> Maybe TimeSpec -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> Maybe TimeSpec
forall k v. Cache k v -> Maybe TimeSpec
C.defaultExpiration Cache k v
cache
  SetDefaultExpiration ts -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    Cache k v -> Sem r x
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
s -> Sem r ()
atomicPut (Cache k v -> Sem r x) -> Cache k v -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> Maybe TimeSpec -> Cache k v
forall k v. Cache k v -> Maybe TimeSpec -> Cache k v
C.setDefaultExpiration Cache k v
cache Maybe TimeSpec
ts

-- | Alternative version of 'runCacheAtomicState' that uses 'Final' instead of 'Embed'
runCacheAtomicState' ::
  forall k v r a.
  Members '[Final IO, AtomicState (C.Cache k v)] r =>
  Sem (Cache k v ': r) a ->
  Sem r a
runCacheAtomicState' :: Sem (Cache k v : r) a -> Sem r a
runCacheAtomicState' = (forall x (m :: * -> *). Cache k v m x -> Sem r x)
-> Sem (Cache k v : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall x (m :: * -> *). Cache k v m x -> Sem r x)
 -> Sem (Cache k v : r) a -> Sem r a)
-> (forall x (m :: * -> *). Cache k v m x -> Sem r x)
-> Sem (Cache k v : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Insert k v -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> k -> v -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> k -> v -> IO ()
C.insert Cache k v
cache k
k v
v
  Insert' ts k v -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> Maybe TimeSpec -> k -> v -> IO ()
forall k v.
(Eq k, Hashable k) =>
Cache k v -> Maybe TimeSpec -> k -> v -> IO ()
C.insert' Cache k v
cache Maybe TimeSpec
ts k
k v
v
  Lookup k -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO (Maybe v) -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO (Maybe v) -> Sem r x) -> IO (Maybe v) -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> k -> IO (Maybe v)
forall k v. (Eq k, Hashable k) => Cache k v -> k -> IO (Maybe v)
C.lookup Cache k v
cache k
k
  Lookup' k -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO (Maybe v) -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO (Maybe v) -> Sem r x) -> IO (Maybe v) -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> k -> IO (Maybe v)
forall k v. (Eq k, Hashable k) => Cache k v -> k -> IO (Maybe v)
C.lookup Cache k v
cache k
k
  Keys -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO [k] -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO [k] -> Sem r x) -> IO [k] -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> IO [k]
forall k v. Cache k v -> IO [k]
C.keys Cache k v
cache
  Delete k -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> k -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> k -> IO ()
C.delete Cache k v
cache k
k
  FilterWithKey pred -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ (k -> v -> Bool) -> Cache k v -> IO ()
forall k v.
(Eq k, Hashable k) =>
(k -> v -> Bool) -> Cache k v -> IO ()
C.filterWithKey k -> v -> Bool
pred Cache k v
cache
  Purge -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> IO ()
C.purge Cache k v
cache
  PurgeExpired -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO () -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO () -> Sem r x) -> IO () -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> IO ()
C.purgeExpired Cache k v
cache
  Size -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    IO Int -> Sem r x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO Int -> Sem r x) -> IO Int -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> IO Int
forall k v. Cache k v -> IO Int
C.size Cache k v
cache
  DefaultExipration -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    Maybe TimeSpec -> Sem r x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TimeSpec -> Sem r x) -> Maybe TimeSpec -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> Maybe TimeSpec
forall k v. Cache k v -> Maybe TimeSpec
C.defaultExpiration Cache k v
cache
  SetDefaultExpiration ts -> do
    Cache k v
cache <- Sem r (Cache k v)
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
Sem r s
atomicGet
    Cache k v -> Sem r x
forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
s -> Sem r ()
atomicPut (Cache k v -> Sem r x) -> Cache k v -> Sem r x
forall a b. (a -> b) -> a -> b
$ Cache k v -> Maybe TimeSpec -> Cache k v
forall k v. Cache k v -> Maybe TimeSpec -> Cache k v
C.setDefaultExpiration Cache k v
cache Maybe TimeSpec
ts

-- | Run a 'Cache', given a default expiration time.
runCache ::
  forall k v r a.
  Members '[Embed IO] r =>
  Maybe TimeSpec ->
  Sem (Cache k v ': AtomicState (C.Cache k v) ': r) a ->
  Sem r a
runCache :: Maybe TimeSpec
-> Sem (Cache k v : AtomicState (Cache k v) : r) a -> Sem r a
runCache ts :: Maybe TimeSpec
ts eff :: Sem (Cache k v : AtomicState (Cache k v) : r) a
eff = do
  Cache k v
cache <- IO (Cache k v) -> Sem r (Cache k v)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Cache k v) -> Sem r (Cache k v))
-> IO (Cache k v) -> Sem r (Cache k v)
forall a b. (a -> b) -> a -> b
$ Maybe TimeSpec -> IO (Cache k v)
forall k v. Maybe TimeSpec -> IO (Cache k v)
C.newCache Maybe TimeSpec
ts
  IORef (Cache k v)
ref <- IO (IORef (Cache k v)) -> Sem r (IORef (Cache k v))
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (IORef (Cache k v)) -> Sem r (IORef (Cache k v)))
-> IO (IORef (Cache k v)) -> Sem r (IORef (Cache k v))
forall a b. (a -> b) -> a -> b
$ Cache k v -> IO (IORef (Cache k v))
forall a. a -> IO (IORef a)
newIORef Cache k v
cache
  Sem (Cache k v : AtomicState (Cache k v) : r) a
eff
    Sem (Cache k v : AtomicState (Cache k v) : r) a
-> (Sem (Cache k v : AtomicState (Cache k v) : r) a
    -> Sem (AtomicState (Cache k v) : r) a)
-> Sem (AtomicState (Cache k v) : r) a
forall a b. a -> (a -> b) -> b
& Sem (Cache k v : AtomicState (Cache k v) : r) a
-> Sem (AtomicState (Cache k v) : r) a
forall k v (r :: [(* -> *) -> * -> *]) a.
Members '[Embed IO, AtomicState (Cache k v)] r =>
Sem (Cache k v : r) a -> Sem r a
runCacheAtomicState
    Sem (AtomicState (Cache k v) : r) a
-> (Sem (AtomicState (Cache k v) : r) a -> Sem r a) -> Sem r a
forall a b. a -> (a -> b) -> b
& IORef (Cache k v) -> Sem (AtomicState (Cache k v) : r) a -> Sem r a
forall s (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IORef s -> Sem (AtomicState s : r) a -> Sem r a
runAtomicStateIORef IORef (Cache k v)
ref

-- | Alternative version of 'runCache' that uses 'Final' instead of 'Embed'
runCache' ::
  forall k v r a.
  Members '[Final IO] r =>
  Maybe TimeSpec ->
  Sem (Cache k v ': AtomicState (C.Cache k v) ': Embed IO ': r) a ->
  Sem r a
runCache' :: Maybe TimeSpec
-> Sem (Cache k v : AtomicState (Cache k v) : Embed IO : r) a
-> Sem r a
runCache' ts :: Maybe TimeSpec
ts eff :: Sem (Cache k v : AtomicState (Cache k v) : Embed IO : r) a
eff = do
  Cache k v
cache <- IO (Cache k v) -> Sem r (Cache k v)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO (Cache k v) -> Sem r (Cache k v))
-> IO (Cache k v) -> Sem r (Cache k v)
forall a b. (a -> b) -> a -> b
$ Maybe TimeSpec -> IO (Cache k v)
forall k v. Maybe TimeSpec -> IO (Cache k v)
C.newCache Maybe TimeSpec
ts
  IORef (Cache k v)
ref <- IO (IORef (Cache k v)) -> Sem r (IORef (Cache k v))
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO (IORef (Cache k v)) -> Sem r (IORef (Cache k v)))
-> IO (IORef (Cache k v)) -> Sem r (IORef (Cache k v))
forall a b. (a -> b) -> a -> b
$ Cache k v -> IO (IORef (Cache k v))
forall a. a -> IO (IORef a)
newIORef Cache k v
cache
  Sem (Cache k v : AtomicState (Cache k v) : Embed IO : r) a
eff
    Sem (Cache k v : AtomicState (Cache k v) : Embed IO : r) a
-> (Sem (Cache k v : AtomicState (Cache k v) : Embed IO : r) a
    -> Sem (AtomicState (Cache k v) : Embed IO : r) a)
-> Sem (AtomicState (Cache k v) : Embed IO : r) a
forall a b. a -> (a -> b) -> b
& Sem (Cache k v : AtomicState (Cache k v) : Embed IO : r) a
-> Sem (AtomicState (Cache k v) : Embed IO : r) a
forall k v (r :: [(* -> *) -> * -> *]) a.
Members '[Embed IO, AtomicState (Cache k v)] r =>
Sem (Cache k v : r) a -> Sem r a
runCacheAtomicState
    Sem (AtomicState (Cache k v) : Embed IO : r) a
-> (Sem (AtomicState (Cache k v) : Embed IO : r) a
    -> Sem (Embed IO : r) a)
-> Sem (Embed IO : r) a
forall a b. a -> (a -> b) -> b
& IORef (Cache k v)
-> Sem (AtomicState (Cache k v) : Embed IO : r) a
-> Sem (Embed IO : r) a
forall s (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IORef s -> Sem (AtomicState s : r) a -> Sem r a
runAtomicStateIORef IORef (Cache k v)
ref
    Sem (Embed IO : r) a
-> (Sem (Embed IO : r) a -> Sem r a) -> Sem r a
forall a b. a -> (a -> b) -> b
& Sem (Embed IO : r) a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
embedToFinal