-- |Description: Critical interpreters
module Polysemy.Conc.Interpreter.Critical where

import qualified Control.Exception as Exception
import Polysemy.Final (getInitialStateS, interpretFinal, runS)

import Polysemy.Conc.Effect.Critical (Critical (..))

-- |Interpret 'Critical' in terms of 'Final' 'IO'.
interpretCritical ::
  Member (Final IO) r =>
  InterpreterFor Critical r
interpretCritical :: forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor Critical r
interpretCritical =
  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
    Catch Sem rInitial a1
ma -> do
      f ()
s <- Sem (WithStrategy IO f (Sem rInitial)) (f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
      IO (f a1)
o <- 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
      pure (IO (f a1) -> f () -> IO (f (Either e a1))
forall {a} {f :: * -> *} {a} {b}.
(Exception a, Functor f) =>
IO (f a) -> f b -> IO (f (Either a a))
go IO (f a1)
o f ()
s)
      where
        go :: IO (f a) -> f b -> IO (f (Either a a))
go IO (f a)
ma' f b
s =
          IO (f (Either a a))
-> (a -> IO (f (Either a a))) -> IO (f (Either a a))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exception.catch ((a -> Either a a) -> f a -> f (Either a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a a
forall a b. b -> Either a b
Right (f a -> f (Either a a)) -> IO (f a) -> IO (f (Either a a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (f a)
ma') \ a
se -> f (Either a a) -> IO (f (Either a a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either a a
forall a b. a -> Either a b
Left a
se Either a a -> f b -> f (Either a a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f b
s)
{-# inline interpretCritical #-}

-- |Interpret 'Critical' by doing nothing.
interpretCriticalNull ::
  InterpreterFor Critical r
interpretCriticalNull :: forall (r :: EffectRow). InterpreterFor Critical r
interpretCriticalNull =
  (forall (rInitial :: EffectRow) x.
 Critical (Sem rInitial) x -> Tactical Critical (Sem rInitial) r x)
-> Sem (Critical : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH \case
    Catch Sem rInitial a1
ma ->
      (f a1 -> f (Either e a1))
-> Sem (WithTactics Critical f (Sem rInitial) r) (f a1)
-> Sem (WithTactics Critical f (Sem rInitial) r) (f (Either e a1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a1 -> Either e a1) -> f a1 -> f (Either e a1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a1 -> Either e a1
forall a b. b -> Either a b
Right) (Sem (WithTactics Critical f (Sem rInitial) r) (f a1)
 -> Sem (WithTactics Critical f (Sem rInitial) r) (f (Either e a1)))
-> (Sem (Critical : r) (f a1)
    -> Sem (WithTactics Critical f (Sem rInitial) r) (f a1))
-> Sem (Critical : r) (f a1)
-> Sem (WithTactics Critical f (Sem rInitial) r) (f (Either e a1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r (f a1)
-> Sem (WithTactics Critical f (Sem rInitial) r) (f a1)
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise (Sem r (f a1)
 -> Sem (WithTactics Critical f (Sem rInitial) r) (f a1))
-> (Sem (Critical : r) (f a1) -> Sem r (f a1))
-> Sem (Critical : r) (f a1)
-> Sem (WithTactics Critical f (Sem rInitial) r) (f a1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Critical : r) (f a1) -> Sem r (f a1)
forall (r :: EffectRow). InterpreterFor Critical r
interpretCriticalNull (Sem (Critical : r) (f a1)
 -> Sem (WithTactics Critical f (Sem rInitial) r) (f (Either e a1)))
-> Sem
     (WithTactics Critical f (Sem rInitial) r)
     (Sem (Critical : r) (f a1))
-> Sem (WithTactics Critical f (Sem rInitial) r) (f (Either e a1))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem rInitial a1
-> Sem
     (WithTactics Critical f (Sem rInitial) r)
     (Sem (Critical : r) (f a1))
forall (m :: * -> *) a (e :: Effect) (f :: * -> *)
       (r :: EffectRow).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT Sem rInitial a1
ma
{-# inline interpretCriticalNull #-}