-- | Something for converting polysemy actions into IO actions
module Calamity.Internal.RunIntoIO (
  runSemToIO,
  bindSemToIO,
) where

import Data.Functor

import Polysemy qualified as P
import Polysemy.Final qualified as P

runSemToIO :: forall r a. P.Member (P.Final IO) r => P.Sem r a -> P.Sem r (IO (Maybe a))
runSemToIO :: forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem r a -> Sem r (IO (Maybe a))
runSemToIO Sem r a
m = Strategic IO (Sem r) (IO (Maybe a)) -> Sem r (IO (Maybe a))
forall (m :: * -> *) (r :: EffectRow) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
P.withStrategicToFinal (Strategic IO (Sem r) (IO (Maybe a)) -> Sem r (IO (Maybe a)))
-> Strategic IO (Sem r) (IO (Maybe a)) -> Sem r (IO (Maybe a))
forall a b. (a -> b) -> a -> b
$ do
  IO (f a)
m' <- Sem r a -> Sem (WithStrategy IO f (Sem r)) (IO (f a))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
P.runS Sem r a
m
  Inspector f
ins <- Sem (WithStrategy IO f (Sem r)) (Inspector f)
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (Inspector f)
P.getInspectorS
  IO (IO (Maybe a)) -> Strategic IO (Sem r) (IO (Maybe a))
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
P.liftS (IO (IO (Maybe a)) -> Strategic IO (Sem r) (IO (Maybe a)))
-> IO (IO (Maybe a)) -> Strategic IO (Sem r) (IO (Maybe a))
forall a b. (a -> b) -> a -> b
$ IO (Maybe a) -> IO (IO (Maybe a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inspector f -> forall x. f x -> Maybe x
forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
P.inspect Inspector f
ins (f a -> Maybe a) -> IO (f a) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (f a)
m')

bindSemToIO :: forall r p a. P.Member (P.Final IO) r => (p -> P.Sem r a) -> P.Sem r (p -> IO (Maybe a))
bindSemToIO :: forall (r :: EffectRow) p a.
Member (Final IO) r =>
(p -> Sem r a) -> Sem r (p -> IO (Maybe a))
bindSemToIO p -> Sem r a
m = Strategic IO (Sem r) (p -> IO (Maybe a))
-> Sem r (p -> IO (Maybe a))
forall (m :: * -> *) (r :: EffectRow) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
P.withStrategicToFinal (Strategic IO (Sem r) (p -> IO (Maybe a))
 -> Sem r (p -> IO (Maybe a)))
-> Strategic IO (Sem r) (p -> IO (Maybe a))
-> Sem r (p -> IO (Maybe a))
forall a b. (a -> b) -> a -> b
$ do
  f ()
istate <- Sem (WithStrategy IO f (Sem r)) (f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
P.getInitialStateS
  f p -> IO (f a)
m' <- (p -> Sem r a) -> Sem (WithStrategy IO f (Sem r)) (f p -> IO (f a))
forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
P.bindS p -> Sem r a
m
  Inspector f
ins <- Sem (WithStrategy IO f (Sem r)) (Inspector f)
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (Inspector f)
P.getInspectorS
  IO (p -> IO (Maybe a)) -> Strategic IO (Sem r) (p -> IO (Maybe a))
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
P.liftS (IO (p -> IO (Maybe a))
 -> Strategic IO (Sem r) (p -> IO (Maybe a)))
-> IO (p -> IO (Maybe a))
-> Strategic IO (Sem r) (p -> IO (Maybe a))
forall a b. (a -> b) -> a -> b
$ (p -> IO (Maybe a)) -> IO (p -> IO (Maybe a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\p
x -> Inspector f -> forall x. f x -> Maybe x
forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
P.inspect Inspector f
ins (f a -> Maybe a) -> IO (f a) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f p -> IO (f a)
m' (f ()
istate f () -> p -> f p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
x))