-- |Description: Timeout Helper
module Polysemy.Conc.Queue.Timeout where

import Control.Concurrent.STM (STM, atomically)
import Polysemy.Time (TimeUnit)

import qualified Polysemy.Conc.Data.QueueResult as QueueResult
import Polysemy.Conc.Data.QueueResult (QueueResult)
import Polysemy.Conc.Effect.Race (Race)
import qualified Polysemy.Conc.Race as Race

-- |Run an 'STM' action atomically with a time limit
withTimeout ::
  TimeUnit t =>
  Members [Race, Embed IO] r =>
  t ->
  STM (Maybe d) ->
  Sem r (QueueResult d)
withTimeout :: forall t (r :: EffectRow) d.
(TimeUnit t, Members '[Race, Embed IO] r) =>
t -> STM (Maybe d) -> Sem r (QueueResult d)
withTimeout t
timeout STM (Maybe d)
readQ =
  QueueResult d
-> t -> Sem r (QueueResult d) -> Sem r (QueueResult d)
forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r a -> Sem r a
Race.timeoutAs_ QueueResult d
forall d. QueueResult d
QueueResult.NotAvailable t
timeout Sem r (QueueResult d)
reader'
  where
    reader' :: Sem r (QueueResult d)
reader' =
      QueueResult d -> (d -> QueueResult d) -> Maybe d -> QueueResult d
forall b a. b -> (a -> b) -> Maybe a -> b
maybe QueueResult d
forall d. QueueResult d
QueueResult.Closed d -> QueueResult d
forall d. d -> QueueResult d
QueueResult.Success (Maybe d -> QueueResult d)
-> Sem r (Maybe d) -> Sem r (QueueResult d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe d) -> Sem r (Maybe d)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (STM (Maybe d) -> IO (Maybe d)
forall a. STM a -> IO a
atomically STM (Maybe d)
readQ)