{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- For `HasMsg msg`
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

{-# OPTIONS_HADDOCK not-home #-}
{-# OPTIONS_HADDOCK prune #-}

-- |
-- Module:     Drama.Process.Internal
-- Stability:  experimental
-- License:    BSD-3-Clause
-- Copyright:  © 2021 Evan Relf
-- Maintainer: evan@evanrelf.com

module Drama.Process.Internal where

import Control.Applicative (Alternative)
import Control.Monad (MonadPlus)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Reader (ReaderT (..), asks)
import Data.Kind (Constraint)
import Data.Void (Void)
import GHC.TypeLits (ErrorMessage (..), TypeError)

import qualified Control.Concurrent.Chan.Unagi as Unagi
import qualified Ki

-- Support `MonadFail` on GHC 8.6.5
#if MIN_VERSION_base(4,9,0)
import Control.Monad.Fail (MonadFail)
#endif
#if MIN_VERSION_base(4,13,0)
import Prelude hiding (MonadFail)
#endif


-- | Monad supporting actor operations. Inspired by Elixir and Erlang's
-- processes.
--
-- @since 0.3.0.0
newtype Process msg a = Process (ReaderT (ProcessEnv msg) IO a)
  deriving newtype
    ( a -> Process msg b -> Process msg a
(a -> b) -> Process msg a -> Process msg b
(forall a b. (a -> b) -> Process msg a -> Process msg b)
-> (forall a b. a -> Process msg b -> Process msg a)
-> Functor (Process msg)
forall a b. a -> Process msg b -> Process msg a
forall a b. (a -> b) -> Process msg a -> Process msg b
forall msg a b. a -> Process msg b -> Process msg a
forall msg a b. (a -> b) -> Process msg a -> Process msg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Process msg b -> Process msg a
$c<$ :: forall msg a b. a -> Process msg b -> Process msg a
fmap :: (a -> b) -> Process msg a -> Process msg b
$cfmap :: forall msg a b. (a -> b) -> Process msg a -> Process msg b
Functor
    , Functor (Process msg)
a -> Process msg a
Functor (Process msg)
-> (forall a. a -> Process msg a)
-> (forall a b.
    Process msg (a -> b) -> Process msg a -> Process msg b)
-> (forall a b c.
    (a -> b -> c) -> Process msg a -> Process msg b -> Process msg c)
-> (forall a b. Process msg a -> Process msg b -> Process msg b)
-> (forall a b. Process msg a -> Process msg b -> Process msg a)
-> Applicative (Process msg)
Process msg a -> Process msg b -> Process msg b
Process msg a -> Process msg b -> Process msg a
Process msg (a -> b) -> Process msg a -> Process msg b
(a -> b -> c) -> Process msg a -> Process msg b -> Process msg c
forall msg. Functor (Process msg)
forall a. a -> Process msg a
forall msg a. a -> Process msg a
forall a b. Process msg a -> Process msg b -> Process msg a
forall a b. Process msg a -> Process msg b -> Process msg b
forall a b. Process msg (a -> b) -> Process msg a -> Process msg b
forall msg a b. Process msg a -> Process msg b -> Process msg a
forall msg a b. Process msg a -> Process msg b -> Process msg b
forall msg a b.
Process msg (a -> b) -> Process msg a -> Process msg b
forall a b c.
(a -> b -> c) -> Process msg a -> Process msg b -> Process msg c
forall msg a b c.
(a -> b -> c) -> Process msg a -> Process msg b -> Process msg c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Process msg a -> Process msg b -> Process msg a
$c<* :: forall msg a b. Process msg a -> Process msg b -> Process msg a
*> :: Process msg a -> Process msg b -> Process msg b
$c*> :: forall msg a b. Process msg a -> Process msg b -> Process msg b
liftA2 :: (a -> b -> c) -> Process msg a -> Process msg b -> Process msg c
$cliftA2 :: forall msg a b c.
(a -> b -> c) -> Process msg a -> Process msg b -> Process msg c
<*> :: Process msg (a -> b) -> Process msg a -> Process msg b
$c<*> :: forall msg a b.
Process msg (a -> b) -> Process msg a -> Process msg b
pure :: a -> Process msg a
$cpure :: forall msg a. a -> Process msg a
$cp1Applicative :: forall msg. Functor (Process msg)
Applicative
    , Applicative (Process msg)
a -> Process msg a
Applicative (Process msg)
-> (forall a b.
    Process msg a -> (a -> Process msg b) -> Process msg b)
-> (forall a b. Process msg a -> Process msg b -> Process msg b)
-> (forall a. a -> Process msg a)
-> Monad (Process msg)
Process msg a -> (a -> Process msg b) -> Process msg b
Process msg a -> Process msg b -> Process msg b
forall msg. Applicative (Process msg)
forall a. a -> Process msg a
forall msg a. a -> Process msg a
forall a b. Process msg a -> Process msg b -> Process msg b
forall a b. Process msg a -> (a -> Process msg b) -> Process msg b
forall msg a b. Process msg a -> Process msg b -> Process msg b
forall msg a b.
Process msg a -> (a -> Process msg b) -> Process msg b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Process msg a
$creturn :: forall msg a. a -> Process msg a
>> :: Process msg a -> Process msg b -> Process msg b
$c>> :: forall msg a b. Process msg a -> Process msg b -> Process msg b
>>= :: Process msg a -> (a -> Process msg b) -> Process msg b
$c>>= :: forall msg a b.
Process msg a -> (a -> Process msg b) -> Process msg b
$cp1Monad :: forall msg. Applicative (Process msg)
Monad
    , Monad (Process msg)
Monad (Process msg)
-> (forall a. IO a -> Process msg a) -> MonadIO (Process msg)
IO a -> Process msg a
forall msg. Monad (Process msg)
forall a. IO a -> Process msg a
forall msg a. IO a -> Process msg a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Process msg a
$cliftIO :: forall msg a. IO a -> Process msg a
$cp1MonadIO :: forall msg. Monad (Process msg)
MonadIO
    , Applicative (Process msg)
Process msg a
Applicative (Process msg)
-> (forall a. Process msg a)
-> (forall a. Process msg a -> Process msg a -> Process msg a)
-> (forall a. Process msg a -> Process msg [a])
-> (forall a. Process msg a -> Process msg [a])
-> Alternative (Process msg)
Process msg a -> Process msg a -> Process msg a
Process msg a -> Process msg [a]
Process msg a -> Process msg [a]
forall msg. Applicative (Process msg)
forall a. Process msg a
forall a. Process msg a -> Process msg [a]
forall a. Process msg a -> Process msg a -> Process msg a
forall msg a. Process msg a
forall msg a. Process msg a -> Process msg [a]
forall msg a. Process msg a -> Process msg a -> Process msg a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: Process msg a -> Process msg [a]
$cmany :: forall msg a. Process msg a -> Process msg [a]
some :: Process msg a -> Process msg [a]
$csome :: forall msg a. Process msg a -> Process msg [a]
<|> :: Process msg a -> Process msg a -> Process msg a
$c<|> :: forall msg a. Process msg a -> Process msg a -> Process msg a
empty :: Process msg a
$cempty :: forall msg a. Process msg a
$cp1Alternative :: forall msg. Applicative (Process msg)
Alternative
    , Monad (Process msg)
Alternative (Process msg)
Process msg a
Alternative (Process msg)
-> Monad (Process msg)
-> (forall a. Process msg a)
-> (forall a. Process msg a -> Process msg a -> Process msg a)
-> MonadPlus (Process msg)
Process msg a -> Process msg a -> Process msg a
forall msg. Monad (Process msg)
forall msg. Alternative (Process msg)
forall a. Process msg a
forall a. Process msg a -> Process msg a -> Process msg a
forall msg a. Process msg a
forall msg a. Process msg a -> Process msg a -> Process msg a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: Process msg a -> Process msg a -> Process msg a
$cmplus :: forall msg a. Process msg a -> Process msg a -> Process msg a
mzero :: Process msg a
$cmzero :: forall msg a. Process msg a
$cp2MonadPlus :: forall msg. Monad (Process msg)
$cp1MonadPlus :: forall msg. Alternative (Process msg)
MonadPlus
#if MIN_VERSION_base(4,9,0)
    , Monad (Process msg)
Monad (Process msg)
-> (forall a. String -> Process msg a) -> MonadFail (Process msg)
String -> Process msg a
forall msg. Monad (Process msg)
forall a. String -> Process msg a
forall msg a. String -> Process msg a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Process msg a
$cfail :: forall msg a. String -> Process msg a
$cp1MonadFail :: forall msg. Monad (Process msg)
MonadFail
#endif
    , Monad (Process msg)
Monad (Process msg)
-> (forall a. (a -> Process msg a) -> Process msg a)
-> MonadFix (Process msg)
(a -> Process msg a) -> Process msg a
forall msg. Monad (Process msg)
forall a. (a -> Process msg a) -> Process msg a
forall msg a. (a -> Process msg a) -> Process msg a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> Process msg a) -> Process msg a
$cmfix :: forall msg a. (a -> Process msg a) -> Process msg a
$cp1MonadFix :: forall msg. Monad (Process msg)
MonadFix
    )


-- | Provided some `ProcessEnv`, convert a `Process` action into an `IO`
-- action.
--
-- @since 0.3.0.0
runProcess :: MonadIO m => ProcessEnv msg -> Process msg a -> m a
runProcess :: ProcessEnv msg -> Process msg a -> m a
runProcess ProcessEnv msg
processEnv (Process ReaderT (ProcessEnv msg) IO a
reader) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ ReaderT (ProcessEnv msg) IO a -> ProcessEnv msg -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (ProcessEnv msg) IO a
reader ProcessEnv msg
processEnv


-- | Ambient context provided by the `Process` monad.
--
-- Values in `ProcessEnv` are scoped to the current process and cannot be safely
-- shared. Functions like `spawn`, `receive`, and `here` use these values as
-- implicit parameters to avoid leaking internals (and for convenience).
--
-- @since 0.3.0.0
data ProcessEnv msg = ProcessEnv
  { ProcessEnv msg -> Address msg
address :: Address msg
    -- ^ Current process' address.
  , ProcessEnv msg -> Mailbox msg
mailbox :: Mailbox msg
    -- ^ Current process' mailbox.
  , ProcessEnv msg -> Scope
scope :: Scope
    -- ^ Current process' token used for spawning threads.
  }


-- | Address for sending messages to a process. Obtained by running `spawn`,
-- `here`, or `receive` (if another process sends you an address).
--
-- @since 0.3.0.0
newtype Address msg = Address (Unagi.InChan msg)


-- | Mailbox where a process receives messages. Cannot be shared with other
-- processes; used implicitly by `receive` and `tryReceive`.
--
-- @since 0.3.0.0
newtype Mailbox msg = Mailbox (Unagi.OutChan msg)


-- | Token delimiting the lifetime of child processes (threads) created by a
-- process.
--
-- @since 0.3.0.0
newtype Scope = Scope Ki.Scope


-- | Constraint which prevents setting `msg ~ Void`, and provides helpful type
-- errors.
--
-- @since 0.3.0.0
type family HasMsg msg :: Constraint where
  HasMsg NoMsg = TypeError ('Text "Processes with 'msg ~ NoMsg' cannot receive messages")
  HasMsg Void = TypeError ('Text "Use 'msg ~ NoMsg' instead of 'msg ~ Void' for processes which do not receive messages")
  HasMsg () = TypeError ('Text "Use 'msg ~ NoMsg' instead of 'msg ~ ()' for processes which do not receive messages")
  HasMsg msg = ()


-- | Message type used by processes which do not receive messages.
--
-- @since 0.3.0.0
data NoMsg


-- | Spawn a child process and return its address.
--
-- @since 0.3.0.0
spawn
  :: HasMsg msg
  => Process msg ()
  -- ^ Process to spawn
  -> Process _msg (Address msg)
  -- ^ Spawned process' address
spawn :: Process msg () -> Process _msg (Address msg)
spawn Process msg ()
process = do
  (InChan msg
inChan, OutChan msg
outChan) <- IO (InChan msg, OutChan msg)
-> Process _msg (InChan msg, OutChan msg)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (InChan msg, OutChan msg)
forall a. IO (InChan a, OutChan a)
Unagi.newChan
  let address :: Address msg
address = InChan msg -> Address msg
forall msg. InChan msg -> Address msg
Address InChan msg
inChan
  let mailbox :: Mailbox msg
mailbox = OutChan msg -> Mailbox msg
forall msg. OutChan msg -> Mailbox msg
Mailbox OutChan msg
outChan
  Address msg -> Mailbox msg -> Process msg () -> Process _msg ()
forall msg _msg.
Address msg -> Mailbox msg -> Process msg () -> Process _msg ()
spawnImpl Address msg
address Mailbox msg
mailbox Process msg ()
process
  Address msg -> Process _msg (Address msg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Address msg
address


-- | More efficient version of `spawn`, for processes which receive no messages
-- (@msg ~ `NoMsg`@). See docs for `spawn` for more information.
--
-- @since 0.3.0.0
spawn_ :: Process NoMsg () -> Process msg ()
spawn_ :: Process NoMsg () -> Process msg ()
spawn_ Process NoMsg ()
process = do
  let address :: Address msg
address = InChan msg -> Address msg
forall msg. InChan msg -> Address msg
Address (String -> InChan msg
forall a. HasCallStack => String -> a
error String
voidMsgError)
  let mailbox :: Mailbox msg
mailbox = OutChan msg -> Mailbox msg
forall msg. OutChan msg -> Mailbox msg
Mailbox (String -> OutChan msg
forall a. HasCallStack => String -> a
error String
voidMsgError)
  Address NoMsg
-> Mailbox NoMsg -> Process NoMsg () -> Process msg ()
forall msg _msg.
Address msg -> Mailbox msg -> Process msg () -> Process _msg ()
spawnImpl Address NoMsg
forall msg. Address msg
address Mailbox NoMsg
forall msg. Mailbox msg
mailbox Process NoMsg ()
process


spawnImpl
  :: Address msg
  -> Mailbox msg
  -> Process msg ()
  -> Process _msg ()
spawnImpl :: Address msg -> Mailbox msg -> Process msg () -> Process _msg ()
spawnImpl Address msg
address Mailbox msg
mailbox Process msg ()
process = do
  Scope Scope
kiScope <- ReaderT (ProcessEnv _msg) IO Scope -> Process _msg Scope
forall msg a. ReaderT (ProcessEnv msg) IO a -> Process msg a
Process (ReaderT (ProcessEnv _msg) IO Scope -> Process _msg Scope)
-> ReaderT (ProcessEnv _msg) IO Scope -> Process _msg Scope
forall a b. (a -> b) -> a -> b
$ (ProcessEnv _msg -> Scope) -> ReaderT (ProcessEnv _msg) IO Scope
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ProcessEnv _msg -> Scope
forall msg. ProcessEnv msg -> Scope
scope
  IO () -> Process _msg ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process _msg ()) -> IO () -> Process _msg ()
forall a b. (a -> b) -> a -> b
$ Scope -> IO () -> IO ()
Ki.fork_ Scope
kiScope (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Address msg -> Mailbox msg -> Process msg () -> IO ()
forall (m :: * -> *) msg a.
MonadIO m =>
Address msg -> Mailbox msg -> Process msg a -> m a
runImpl Address msg
address Mailbox msg
mailbox Process msg ()
process


-- | Block until all child processes have terminated.
--
-- @since 0.3.0.0
wait :: Process msg ()
wait :: Process msg ()
wait = do
  Scope Scope
kiScope <- ReaderT (ProcessEnv msg) IO Scope -> Process msg Scope
forall msg a. ReaderT (ProcessEnv msg) IO a -> Process msg a
Process (ReaderT (ProcessEnv msg) IO Scope -> Process msg Scope)
-> ReaderT (ProcessEnv msg) IO Scope -> Process msg Scope
forall a b. (a -> b) -> a -> b
$ (ProcessEnv msg -> Scope) -> ReaderT (ProcessEnv msg) IO Scope
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ProcessEnv msg -> Scope
forall msg. ProcessEnv msg -> Scope
scope
  IO () -> Process msg ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process msg ()) -> IO () -> Process msg ()
forall a b. (a -> b) -> a -> b
$ Scope -> IO ()
Ki.wait Scope
kiScope


-- | Return the current process' address.
--
-- @since 0.3.0.0
here :: HasMsg msg => Process msg (Address msg)
here :: Process msg (Address msg)
here = ReaderT (ProcessEnv msg) IO (Address msg)
-> Process msg (Address msg)
forall msg a. ReaderT (ProcessEnv msg) IO a -> Process msg a
Process (ReaderT (ProcessEnv msg) IO (Address msg)
 -> Process msg (Address msg))
-> ReaderT (ProcessEnv msg) IO (Address msg)
-> Process msg (Address msg)
forall a b. (a -> b) -> a -> b
$ (ProcessEnv msg -> Address msg)
-> ReaderT (ProcessEnv msg) IO (Address msg)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ProcessEnv msg -> Address msg
forall msg. ProcessEnv msg -> Address msg
address


-- | Send a message to another process.
--
-- @since 0.3.0.0
send
  :: HasMsg msg
  => Address msg
  -- ^ Other process' address
  -> msg
  -- ^ Message to send
  -> Process _msg ()
send :: Address msg -> msg -> Process _msg ()
send (Address InChan msg
inChan) msg
msg = IO () -> Process _msg ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process _msg ()) -> IO () -> Process _msg ()
forall a b. (a -> b) -> a -> b
$ InChan msg -> msg -> IO ()
forall a. InChan a -> a -> IO ()
Unagi.writeChan InChan msg
inChan msg
msg


-- | Receive a message. When the mailbox is empty, blocks until a message
-- arrives.
--
-- @since 0.3.0.0
receive :: HasMsg msg => Process msg msg
receive :: Process msg msg
receive = do
  Mailbox OutChan msg
outChan <- ReaderT (ProcessEnv msg) IO (Mailbox msg)
-> Process msg (Mailbox msg)
forall msg a. ReaderT (ProcessEnv msg) IO a -> Process msg a
Process (ReaderT (ProcessEnv msg) IO (Mailbox msg)
 -> Process msg (Mailbox msg))
-> ReaderT (ProcessEnv msg) IO (Mailbox msg)
-> Process msg (Mailbox msg)
forall a b. (a -> b) -> a -> b
$ (ProcessEnv msg -> Mailbox msg)
-> ReaderT (ProcessEnv msg) IO (Mailbox msg)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ProcessEnv msg -> Mailbox msg
forall msg. ProcessEnv msg -> Mailbox msg
mailbox
  IO msg -> Process msg msg
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO msg -> Process msg msg) -> IO msg -> Process msg msg
forall a b. (a -> b) -> a -> b
$ OutChan msg -> IO msg
forall a. OutChan a -> IO a
Unagi.readChan OutChan msg
outChan


-- | Try to receive a message. When the mailbox is empty, returns `Nothing`.
--
-- @since 0.3.0.0
tryReceive :: HasMsg msg => Process msg (Maybe msg)
tryReceive :: Process msg (Maybe msg)
tryReceive = do
  Mailbox OutChan msg
outChan <- ReaderT (ProcessEnv msg) IO (Mailbox msg)
-> Process msg (Mailbox msg)
forall msg a. ReaderT (ProcessEnv msg) IO a -> Process msg a
Process (ReaderT (ProcessEnv msg) IO (Mailbox msg)
 -> Process msg (Mailbox msg))
-> ReaderT (ProcessEnv msg) IO (Mailbox msg)
-> Process msg (Mailbox msg)
forall a b. (a -> b) -> a -> b
$ (ProcessEnv msg -> Mailbox msg)
-> ReaderT (ProcessEnv msg) IO (Mailbox msg)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ProcessEnv msg -> Mailbox msg
forall msg. ProcessEnv msg -> Mailbox msg
mailbox
  (Element msg
element, IO msg
_) <- IO (Element msg, IO msg) -> Process msg (Element msg, IO msg)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Element msg, IO msg) -> Process msg (Element msg, IO msg))
-> IO (Element msg, IO msg) -> Process msg (Element msg, IO msg)
forall a b. (a -> b) -> a -> b
$ OutChan msg -> IO (Element msg, IO msg)
forall a. OutChan a -> IO (Element a, IO a)
Unagi.tryReadChan OutChan msg
outChan
  IO (Maybe msg) -> Process msg (Maybe msg)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe msg) -> Process msg (Maybe msg))
-> IO (Maybe msg) -> Process msg (Maybe msg)
forall a b. (a -> b) -> a -> b
$ Element msg -> IO (Maybe msg)
forall a. Element a -> IO (Maybe a)
Unagi.tryRead Element msg
element


-- | Run a top-level process. Intended to be used at the entry point of your
-- program.
--
-- If your program is designed with processes in mind, you can use `Process` as
-- your program's base monad:
--
-- > main :: IO ()
-- > main = run do
-- >   ...
--
-- Otherwise, use `run` like you would with @run@ functions from libraries like
-- @transformers@ or @mtl@.
--
-- @since 0.3.0.0
run :: (HasMsg msg, MonadIO m) => Process msg a -> m a
run :: Process msg a -> m a
run Process msg a
process = do
  (InChan msg
inChan, OutChan msg
outChan) <- IO (InChan msg, OutChan msg) -> m (InChan msg, OutChan msg)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (InChan msg, OutChan msg)
forall a. IO (InChan a, OutChan a)
Unagi.newChan
  let address :: Address msg
address = InChan msg -> Address msg
forall msg. InChan msg -> Address msg
Address InChan msg
inChan
  let mailbox :: Mailbox msg
mailbox = OutChan msg -> Mailbox msg
forall msg. OutChan msg -> Mailbox msg
Mailbox OutChan msg
outChan
  Address msg -> Mailbox msg -> Process msg a -> m a
forall (m :: * -> *) msg a.
MonadIO m =>
Address msg -> Mailbox msg -> Process msg a -> m a
runImpl Address msg
address Mailbox msg
mailbox Process msg a
process


-- | More efficient version of `run`, for processes which receive no messages
-- (@msg ~ `NoMsg`@). See docs for `run` for more information.
--
-- @since 0.3.0.0
run_ :: MonadIO m => Process NoMsg a -> m a
run_ :: Process NoMsg a -> m a
run_ Process NoMsg a
process = do
  let address :: Address msg
address = InChan msg -> Address msg
forall msg. InChan msg -> Address msg
Address (String -> InChan msg
forall a. HasCallStack => String -> a
error String
voidMsgError)
  let mailbox :: Mailbox msg
mailbox = OutChan msg -> Mailbox msg
forall msg. OutChan msg -> Mailbox msg
Mailbox (String -> OutChan msg
forall a. HasCallStack => String -> a
error String
voidMsgError)
  Address NoMsg -> Mailbox NoMsg -> Process NoMsg a -> m a
forall (m :: * -> *) msg a.
MonadIO m =>
Address msg -> Mailbox msg -> Process msg a -> m a
runImpl Address NoMsg
forall msg. Address msg
address Mailbox NoMsg
forall msg. Mailbox msg
mailbox Process NoMsg a
process


runImpl :: MonadIO m => Address msg -> Mailbox msg -> Process msg a -> m a
runImpl :: Address msg -> Mailbox msg -> Process msg a -> m a
runImpl Address msg
address Mailbox msg
mailbox Process msg a
process = do
  IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ (Scope -> IO a) -> IO a
forall a. (Scope -> IO a) -> IO a
Ki.scoped \Scope
kiScope -> do
    let scope :: Scope
scope = Scope -> Scope
Scope Scope
kiScope
    ProcessEnv msg -> Process msg a -> IO a
forall (m :: * -> *) msg a.
MonadIO m =>
ProcessEnv msg -> Process msg a -> m a
runProcess ProcessEnv :: forall msg. Address msg -> Mailbox msg -> Scope -> ProcessEnv msg
ProcessEnv{Address msg
address :: Address msg
address :: Address msg
address, Mailbox msg
mailbox :: Mailbox msg
mailbox :: Mailbox msg
mailbox, Scope
scope :: Scope
scope :: Scope
scope} Process msg a
process


voidMsgError :: String
voidMsgError :: String
voidMsgError = [String] -> String
unlines ([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
unwords ([[String]] -> String) -> [[String]] -> String
forall a b. (a -> b) -> a -> b
$
  [ [String
"[!] drama internal error"]
  , []
  , [ String
"Attempted to use the address or mailbox of a process which cannot send"
    , String
"or receive messages (msg ~ NoMsg)."
    ]
  , [ String
"This should be impossible using non-internal modules!" ]
  , []
  , [ String
"Please report this issue at https://github.com/evanrelf/drama/issues"
    ]
  ]