{-# LANGUAGE TemplateHaskell #-}
module Calamity.Internal.RunIntoIO
( IntoIO(..)
, runIntoIOFinal
, intoIO ) where
import Control.Monad
import Data.Functor
import qualified Polysemy as P
import qualified Polysemy.Final as P
data IntoIO p m a where
IntoIO :: (p -> m ()) -> IntoIO p m (p -> IO ())
runIntoIOFinal :: forall r p a. P.Member (P.Final IO) r => P.Sem (IntoIO p ': r) a -> P.Sem r a
runIntoIOFinal :: Sem (IntoIO p : r) a -> Sem r a
runIntoIOFinal = (forall x (n :: * -> *). IntoIO p n x -> Strategic IO n x)
-> Sem (IntoIO p : r) a -> Sem r a
forall (m :: * -> *) (e :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
Member (Final m) r =>
(forall x (n :: * -> *). e n x -> Strategic m n x)
-> Sem (e : r) a -> Sem r a
P.interpretFinal ((forall x (n :: * -> *). IntoIO p n x -> Strategic IO n x)
-> Sem (IntoIO p : r) a -> Sem r a)
-> (forall x (n :: * -> *). IntoIO p n x -> Strategic IO n x)
-> Sem (IntoIO p : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
IntoIO m -> do
f ()
istate <- Sem (WithStrategy IO f n) (f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
P.getInitialStateS
f p -> IO (f ())
m' <- (p -> n ()) -> Sem (WithStrategy IO f n) (f p -> IO (f ()))
forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
P.bindS p -> n ()
m
IO (p -> IO ()) -> Sem (WithStrategy IO f n) (IO (f x))
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
P.liftS (IO (p -> IO ()) -> Sem (WithStrategy IO f n) (IO (f x)))
-> IO (p -> IO ()) -> Sem (WithStrategy IO f n) (IO (f x))
forall a b. (a -> b) -> a -> b
$ (p -> IO ()) -> IO (p -> IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\x :: p
x -> IO (f ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f p -> IO (f ())
m' (f p -> IO (f ())) -> f p -> IO (f ())
forall a b. (a -> b) -> a -> b
$ f ()
istate f () -> p -> f p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
x))
P.makeSem ''IntoIO