{-# LANGUAGE TemplateHaskell #-}

-- | Something for converting polysemy actions into IO actions
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