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

import qualified Control.Exception as Exception
import Polysemy (runT)
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 :: InterpreterFor Critical r
interpretCritical =
  (forall x (rInitial :: EffectRow).
 Critical (Sem rInitial) x -> Strategic IO (Sem rInitial) x)
-> Sem (Critical : r) a -> Sem r a
forall (m :: * -> *) (e :: (* -> *) -> * -> *) (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 ma -> do
      f ()
s <- Sem (WithStrategy IO f (Sem rInitial)) (f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
      IO (f a)
o <- Sem rInitial a -> Sem (WithStrategy IO f (Sem rInitial)) (IO (f a))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem rInitial a
ma
      pure (IO (f a) -> f () -> IO (f (Either e a))
forall a (f :: * -> *) b b.
(Exception a, Functor f) =>
IO (f b) -> f b -> IO (f (Either a b))
run IO (f a)
o f ()
s)
      where
        run :: IO (f b) -> f b -> IO (f (Either a b))
run IO (f b)
ma' f b
s =
          IO (f (Either a b))
-> (a -> IO (f (Either a b))) -> IO (f (Either a b))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exception.catch ((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 (f b -> f (Either a b)) -> IO (f b) -> IO (f (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (f b)
ma') \ a
se -> f (Either a b) -> IO (f (Either a b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either a b
forall a b. a -> Either a b
Left a
se Either a b -> f b -> f (Either a b)
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 :: Sem (Critical : r) a -> Sem r a
interpretCriticalNull =
  (forall (rInitial :: EffectRow) x.
 Critical (Sem rInitial) x -> Tactical Critical (Sem rInitial) r x)
-> Sem (Critical : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (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 ma ->
      (f a -> f (Either e a))
-> Sem (WithTactics Critical f (Sem rInitial) r) (f a)
-> Sem (WithTactics Critical f (Sem rInitial) r) (f (Either e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Either e a) -> f a -> f (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either e a
forall a b. b -> Either a b
Right) (Sem (WithTactics Critical f (Sem rInitial) r) (f a)
 -> Sem (WithTactics Critical f (Sem rInitial) r) (f (Either e a)))
-> (Sem (Critical : r) (f a)
    -> Sem (WithTactics Critical f (Sem rInitial) r) (f a))
-> Sem (Critical : r) (f a)
-> Sem (WithTactics Critical f (Sem rInitial) r) (f (Either e a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r (f a) -> Sem (WithTactics Critical f (Sem rInitial) r) (f a)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem r (f a)
 -> Sem (WithTactics Critical f (Sem rInitial) r) (f a))
-> (Sem (Critical : r) (f a) -> Sem r (f a))
-> Sem (Critical : r) (f a)
-> Sem (WithTactics Critical f (Sem rInitial) r) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Critical : r) (f a) -> Sem r (f a)
forall (r :: EffectRow). InterpreterFor Critical r
interpretCriticalNull (Sem (Critical : r) (f a)
 -> Sem (WithTactics Critical f (Sem rInitial) r) (f (Either e a)))
-> Sem
     (WithTactics Critical f (Sem rInitial) r)
     (Sem (Critical : r) (f a))
-> Sem (WithTactics Critical f (Sem rInitial) r) (f (Either e a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem rInitial a
-> Sem
     (WithTactics Critical f (Sem rInitial) r)
     (Sem (Critical : r) (f a))
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (f :: * -> *)
       (r :: EffectRow).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT Sem rInitial a
ma
{-# inline interpretCriticalNull #-}