{-# options_haddock prune #-}
module Polysemy.Conc.Interpreter.Race where
import qualified Control.Concurrent.Async as Async
import Polysemy.Final (interpretFinal, runS)
import qualified Polysemy.Time as Time
import Polysemy.Time (MicroSeconds (MicroSeconds))
import qualified System.Timeout as System
import qualified Polysemy.Conc.Effect.Race as Race
import Polysemy.Conc.Effect.Race (Race)
biseqEither ::
Functor f =>
Either (f a) (f b) ->
f (Either a b)
biseqEither :: forall (f :: * -> *) a b.
Functor f =>
Either (f a) (f b) -> f (Either a b)
biseqEither =
(f a -> f (Either a b))
-> (f b -> f (Either a b)) -> Either (f a) (f b) -> f (Either a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> Either a b) -> f a -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left) ((b -> Either a b) -> f b -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right)
{-# inline biseqEither #-}
interpretRace ::
Member (Final IO) r =>
InterpreterFor Race r
interpretRace :: forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor Race r
interpretRace =
forall (m :: * -> *) (e :: Effect) (r :: EffectRow) a.
Member (Final m) r =>
(forall x (rInitial :: EffectRow).
e (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (e : r) a -> Sem r a
interpretFinal @IO \case
Race.Race Sem rInitial a1
left Sem rInitial b1
right ->
(IO (Either (f a1) (f b1)) -> IO (f (Either a1 b1)))
-> (IO (f b1) -> IO (Either (f a1) (f b1)))
-> IO (f b1)
-> IO (f (Either a1 b1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either (f a1) (f b1) -> f (Either a1 b1))
-> IO (Either (f a1) (f b1)) -> IO (f (Either a1 b1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (f a1) (f b1) -> f (Either a1 b1)
forall (f :: * -> *) a b.
Functor f =>
Either (f a) (f b) -> f (Either a b)
biseqEither) ((IO (f b1) -> IO (Either (f a1) (f b1)))
-> IO (f b1) -> IO (f (Either a1 b1)))
-> (IO (f a1) -> IO (f b1) -> IO (Either (f a1) (f b1)))
-> IO (f a1)
-> IO (f b1)
-> IO (f (Either a1 b1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (f a1) -> IO (f b1) -> IO (Either (f a1) (f b1))
forall a b. IO a -> IO b -> IO (Either a b)
Async.race (IO (f a1) -> IO (f b1) -> IO (f (Either a1 b1)))
-> Sem (WithStrategy IO f (Sem rInitial)) (IO (f a1))
-> Sem
(WithStrategy IO f (Sem rInitial))
(IO (f b1) -> IO (f (Either a1 b1)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem rInitial a1
-> Sem (WithStrategy IO f (Sem rInitial)) (IO (f a1))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem rInitial a1
left Sem (WithStrategy IO f (Sem rInitial)) (IO (f b1) -> IO (f x))
-> Sem (WithStrategy IO f (Sem rInitial)) (IO (f b1))
-> Sem (WithStrategy IO f (Sem rInitial)) (IO (f x))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sem rInitial b1
-> Sem (WithStrategy IO f (Sem rInitial)) (IO (f b1))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem rInitial b1
right
Race.Timeout Sem rInitial a1
ma (u -> MicroSeconds
forall a b. (TimeUnit a, TimeUnit b) => a -> b
Time.convert -> MicroSeconds Int64
timeout) Sem rInitial b1
mb -> do
IO (f a1)
maT <- Sem rInitial a1
-> Sem (WithStrategy IO f (Sem rInitial)) (IO (f a1))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem rInitial a1
ma
IO (f b1)
mbT <- Sem rInitial b1
-> Sem (WithStrategy IO f (Sem rInitial)) (IO (f b1))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem rInitial b1
mb
pure (IO (f (Either a1 b1))
-> (f b1 -> IO (f (Either a1 b1)))
-> Maybe (f b1)
-> IO (f (Either a1 b1))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((a1 -> Either a1 b1) -> f a1 -> f (Either a1 b1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a1 -> Either a1 b1
forall a b. a -> Either a b
Left (f a1 -> f (Either a1 b1)) -> IO (f a1) -> IO (f (Either a1 b1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (f a1)
maT) (f (Either a1 b1) -> IO (f (Either a1 b1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f (Either a1 b1) -> IO (f (Either a1 b1)))
-> (f b1 -> f (Either a1 b1)) -> f b1 -> IO (f (Either a1 b1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b1 -> Either a1 b1) -> f b1 -> f (Either a1 b1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b1 -> Either a1 b1
forall a b. b -> Either a b
Right) (Maybe (f b1) -> IO (f (Either a1 b1)))
-> IO (Maybe (f b1)) -> IO (f (Either a1 b1))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO (f b1) -> IO (Maybe (f b1))
forall a. Int -> IO a -> IO (Maybe a)
System.timeout (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
timeout) IO (f b1)
mbT)
{-# inline interpretRace #-}