-- |Description: Race Combinators
module Polysemy.Conc.Race where

import Polysemy.Time (TimeUnit)

import qualified Polysemy.Conc.Effect.Race as Race
import Polysemy.Conc.Effect.Race (Race)
import Polysemy.Resume (Stop, stop)

-- |Specialization of 'Race.race' for the case where both actions return the same type, obviating the need for 'Either'.
race_ ::
  Member Race r =>
  Sem r a ->
  Sem r a ->
  Sem r a
race_ :: forall (r :: EffectRow) a.
Member Race r =>
Sem r a -> Sem r a -> Sem r a
race_ Sem r a
ml Sem r a
mr =
  Either a a -> a
forall a. Either a a -> a
unify (Either a a -> a) -> Sem r (Either a a) -> Sem r a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r a -> Sem r a -> Sem r (Either a a)
forall a b (r :: EffectRow).
Member Race r =>
Sem r a -> Sem r b -> Sem r (Either a b)
Race.race Sem r a
ml Sem r a
mr
{-# inline race_ #-}

-- |Specialization of 'Race.timeout' for the case where the main action returns the same type as the fallback, obviating
-- the need for 'Either'.
timeout_ ::
  TimeUnit u =>
  Member Race r =>
  Sem r a ->
  u ->
  Sem r a ->
  Sem r a
timeout_ :: forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
Sem r a -> u -> Sem r a -> Sem r a
timeout_ Sem r a
err u
interval Sem r a
ma =
  Either a a -> a
forall a. Either a a -> a
unify (Either a a -> a) -> Sem r (Either a a) -> Sem r a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r a -> u -> Sem r a -> Sem r (Either a a)
forall a b u (r :: EffectRow).
(TimeUnit u, Member Race r) =>
Sem r a -> u -> Sem r b -> Sem r (Either a b)
Race.timeout Sem r a
err u
interval Sem r a
ma
{-# inline timeout_ #-}

-- |Version of `Race.timeout` that takes a pure fallback value.
timeoutAs ::
  TimeUnit u =>
  Member Race r =>
  a ->
  u ->
  Sem r b ->
  Sem r (Either a b)
timeoutAs :: forall u (r :: EffectRow) a b.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r b -> Sem r (Either a b)
timeoutAs a
err =
  Sem r a -> u -> Sem r b -> Sem r (Either a b)
forall a b u (r :: EffectRow).
(TimeUnit u, Member Race r) =>
Sem r a -> u -> Sem r b -> Sem r (Either a b)
Race.timeout (a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
err)
{-# inline timeoutAs #-}

-- |Specialization of 'timeoutAs' for the case where the main action return the same type as the fallback, obviating the
-- need for 'Either'.
timeoutAs_ ::
  TimeUnit u =>
  Member Race r =>
  a ->
  u ->
  Sem r a ->
  Sem r a
timeoutAs_ :: forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r a -> Sem r a
timeoutAs_ a
err =
  Sem r a -> u -> Sem r a -> Sem r a
forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
Sem r a -> u -> Sem r a -> Sem r a
timeout_ (a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
err)
{-# inline timeoutAs_ #-}

-- |Specialization of 'Race.timeout' for unit actions.
timeoutU ::
  TimeUnit u =>
  Member Race r =>
  u ->
  Sem r () ->
  Sem r ()
timeoutU :: forall u (r :: EffectRow).
(TimeUnit u, Member Race r) =>
u -> Sem r () -> Sem r ()
timeoutU =
  Sem r () -> u -> Sem r () -> Sem r ()
forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
Sem r a -> u -> Sem r a -> Sem r a
timeout_ Sem r ()
forall (f :: * -> *). Applicative f => f ()
unit
{-# inline timeoutU #-}

-- |Variant of 'Race.timeout' that returns 'Maybe'.
timeoutMaybe ::
  TimeUnit u =>
  Member Race r =>
  u ->
  Sem r a ->
  Sem r (Maybe a)
timeoutMaybe :: forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
u -> Sem r a -> Sem r (Maybe a)
timeoutMaybe u
u Sem r a
ma =
  Maybe a -> u -> Sem r (Maybe a) -> Sem r (Maybe a)
forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r a -> Sem r a
timeoutAs_ Maybe a
forall a. Maybe a
Nothing u
u (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Sem r a -> Sem r (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r a
ma)
{-# inline timeoutMaybe #-}

-- |Variant of 'Race.timeout' that calls 'Stop' with the supplied error when the action times out.
timeoutStop ::
  TimeUnit u =>
  Members [Race, Stop err] r =>
  err ->
  u ->
  Sem r a ->
  Sem r a
timeoutStop :: forall u err (r :: EffectRow) a.
(TimeUnit u, Members '[Race, Stop err] r) =>
err -> u -> Sem r a -> Sem r a
timeoutStop err
err =
  Sem r a -> u -> Sem r a -> Sem r a
forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
Sem r a -> u -> Sem r a -> Sem r a
timeout_ (err -> Sem r a
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop err
err)
{-# inline timeoutStop #-}