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

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

{-# OPTIONS_HADDOCK not-home #-}

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

module Drama.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


-- | Forbid use of functions which use the underlying `Unagi.Chan` when an
-- actor's message type is `()` or `Void`.
--
-- Forces users to use the more efficient `spawn_` and `run_` functions, and
-- prevents runtime exceptions.
--
-- @since 0.2.0.0
type family Message msg :: Constraint where
  Message Void = TypeError ('Text "Actors with 'msg ~ Void' cannot receive messages")
  Message () = TypeError ('Text "Use 'msg ~ Void' instead of 'msg ~ ()' for actors which do not receive messages")
  Message msg = ()


-- | The `Actor` monad, where you can `spawn` other actors, and `send` and
-- `receive` messages.
--
-- @since 0.1.0.0
newtype Actor msg a = Actor (ReaderT (ActorEnv msg) IO a)
  deriving newtype
    ( a -> Actor msg b -> Actor msg a
(a -> b) -> Actor msg a -> Actor msg b
(forall a b. (a -> b) -> Actor msg a -> Actor msg b)
-> (forall a b. a -> Actor msg b -> Actor msg a)
-> Functor (Actor msg)
forall a b. a -> Actor msg b -> Actor msg a
forall a b. (a -> b) -> Actor msg a -> Actor msg b
forall msg a b. a -> Actor msg b -> Actor msg a
forall msg a b. (a -> b) -> Actor msg a -> Actor msg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Actor msg b -> Actor msg a
$c<$ :: forall msg a b. a -> Actor msg b -> Actor msg a
fmap :: (a -> b) -> Actor msg a -> Actor msg b
$cfmap :: forall msg a b. (a -> b) -> Actor msg a -> Actor msg b
Functor
    , Functor (Actor msg)
a -> Actor msg a
Functor (Actor msg)
-> (forall a. a -> Actor msg a)
-> (forall a b. Actor msg (a -> b) -> Actor msg a -> Actor msg b)
-> (forall a b c.
    (a -> b -> c) -> Actor msg a -> Actor msg b -> Actor msg c)
-> (forall a b. Actor msg a -> Actor msg b -> Actor msg b)
-> (forall a b. Actor msg a -> Actor msg b -> Actor msg a)
-> Applicative (Actor msg)
Actor msg a -> Actor msg b -> Actor msg b
Actor msg a -> Actor msg b -> Actor msg a
Actor msg (a -> b) -> Actor msg a -> Actor msg b
(a -> b -> c) -> Actor msg a -> Actor msg b -> Actor msg c
forall msg. Functor (Actor msg)
forall a. a -> Actor msg a
forall msg a. a -> Actor msg a
forall a b. Actor msg a -> Actor msg b -> Actor msg a
forall a b. Actor msg a -> Actor msg b -> Actor msg b
forall a b. Actor msg (a -> b) -> Actor msg a -> Actor msg b
forall msg a b. Actor msg a -> Actor msg b -> Actor msg a
forall msg a b. Actor msg a -> Actor msg b -> Actor msg b
forall msg a b. Actor msg (a -> b) -> Actor msg a -> Actor msg b
forall a b c.
(a -> b -> c) -> Actor msg a -> Actor msg b -> Actor msg c
forall msg a b c.
(a -> b -> c) -> Actor msg a -> Actor msg b -> Actor 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
<* :: Actor msg a -> Actor msg b -> Actor msg a
$c<* :: forall msg a b. Actor msg a -> Actor msg b -> Actor msg a
*> :: Actor msg a -> Actor msg b -> Actor msg b
$c*> :: forall msg a b. Actor msg a -> Actor msg b -> Actor msg b
liftA2 :: (a -> b -> c) -> Actor msg a -> Actor msg b -> Actor msg c
$cliftA2 :: forall msg a b c.
(a -> b -> c) -> Actor msg a -> Actor msg b -> Actor msg c
<*> :: Actor msg (a -> b) -> Actor msg a -> Actor msg b
$c<*> :: forall msg a b. Actor msg (a -> b) -> Actor msg a -> Actor msg b
pure :: a -> Actor msg a
$cpure :: forall msg a. a -> Actor msg a
$cp1Applicative :: forall msg. Functor (Actor msg)
Applicative
    , Applicative (Actor msg)
a -> Actor msg a
Applicative (Actor msg)
-> (forall a b. Actor msg a -> (a -> Actor msg b) -> Actor msg b)
-> (forall a b. Actor msg a -> Actor msg b -> Actor msg b)
-> (forall a. a -> Actor msg a)
-> Monad (Actor msg)
Actor msg a -> (a -> Actor msg b) -> Actor msg b
Actor msg a -> Actor msg b -> Actor msg b
forall msg. Applicative (Actor msg)
forall a. a -> Actor msg a
forall msg a. a -> Actor msg a
forall a b. Actor msg a -> Actor msg b -> Actor msg b
forall a b. Actor msg a -> (a -> Actor msg b) -> Actor msg b
forall msg a b. Actor msg a -> Actor msg b -> Actor msg b
forall msg a b. Actor msg a -> (a -> Actor msg b) -> Actor 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 -> Actor msg a
$creturn :: forall msg a. a -> Actor msg a
>> :: Actor msg a -> Actor msg b -> Actor msg b
$c>> :: forall msg a b. Actor msg a -> Actor msg b -> Actor msg b
>>= :: Actor msg a -> (a -> Actor msg b) -> Actor msg b
$c>>= :: forall msg a b. Actor msg a -> (a -> Actor msg b) -> Actor msg b
$cp1Monad :: forall msg. Applicative (Actor msg)
Monad
    , Monad (Actor msg)
Monad (Actor msg)
-> (forall a. IO a -> Actor msg a) -> MonadIO (Actor msg)
IO a -> Actor msg a
forall msg. Monad (Actor msg)
forall a. IO a -> Actor msg a
forall msg a. IO a -> Actor msg a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Actor msg a
$cliftIO :: forall msg a. IO a -> Actor msg a
$cp1MonadIO :: forall msg. Monad (Actor msg)
MonadIO
    , Applicative (Actor msg)
Actor msg a
Applicative (Actor msg)
-> (forall a. Actor msg a)
-> (forall a. Actor msg a -> Actor msg a -> Actor msg a)
-> (forall a. Actor msg a -> Actor msg [a])
-> (forall a. Actor msg a -> Actor msg [a])
-> Alternative (Actor msg)
Actor msg a -> Actor msg a -> Actor msg a
Actor msg a -> Actor msg [a]
Actor msg a -> Actor msg [a]
forall msg. Applicative (Actor msg)
forall a. Actor msg a
forall a. Actor msg a -> Actor msg [a]
forall a. Actor msg a -> Actor msg a -> Actor msg a
forall msg a. Actor msg a
forall msg a. Actor msg a -> Actor msg [a]
forall msg a. Actor msg a -> Actor msg a -> Actor 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 :: Actor msg a -> Actor msg [a]
$cmany :: forall msg a. Actor msg a -> Actor msg [a]
some :: Actor msg a -> Actor msg [a]
$csome :: forall msg a. Actor msg a -> Actor msg [a]
<|> :: Actor msg a -> Actor msg a -> Actor msg a
$c<|> :: forall msg a. Actor msg a -> Actor msg a -> Actor msg a
empty :: Actor msg a
$cempty :: forall msg a. Actor msg a
$cp1Alternative :: forall msg. Applicative (Actor msg)
Alternative
#if MIN_VERSION_base(4,9,0)
    , Monad (Actor msg)
Alternative (Actor msg)
Actor msg a
Alternative (Actor msg)
-> Monad (Actor msg)
-> (forall a. Actor msg a)
-> (forall a. Actor msg a -> Actor msg a -> Actor msg a)
-> MonadPlus (Actor msg)
Actor msg a -> Actor msg a -> Actor msg a
forall msg. Monad (Actor msg)
forall msg. Alternative (Actor msg)
forall a. Actor msg a
forall a. Actor msg a -> Actor msg a -> Actor msg a
forall msg a. Actor msg a
forall msg a. Actor msg a -> Actor msg a -> Actor msg a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: Actor msg a -> Actor msg a -> Actor msg a
$cmplus :: forall msg a. Actor msg a -> Actor msg a -> Actor msg a
mzero :: Actor msg a
$cmzero :: forall msg a. Actor msg a
$cp2MonadPlus :: forall msg. Monad (Actor msg)
$cp1MonadPlus :: forall msg. Alternative (Actor msg)
MonadPlus
#endif
    , Monad (Actor msg)
Monad (Actor msg)
-> (forall a. String -> Actor msg a) -> MonadFail (Actor msg)
String -> Actor msg a
forall msg. Monad (Actor msg)
forall a. String -> Actor msg a
forall msg a. String -> Actor msg a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Actor msg a
$cfail :: forall msg a. String -> Actor msg a
$cp1MonadFail :: forall msg. Monad (Actor msg)
MonadFail
    , Monad (Actor msg)
Monad (Actor msg)
-> (forall a. (a -> Actor msg a) -> Actor msg a)
-> MonadFix (Actor msg)
(a -> Actor msg a) -> Actor msg a
forall msg. Monad (Actor msg)
forall a. (a -> Actor msg a) -> Actor msg a
forall msg a. (a -> Actor msg a) -> Actor msg a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> Actor msg a) -> Actor msg a
$cmfix :: forall msg a. (a -> Actor msg a) -> Actor msg a
$cp1MonadFix :: forall msg. Monad (Actor msg)
MonadFix
    )


-- | @since 0.1.0.0
runActor :: MonadIO m => ActorEnv msg -> Actor msg a -> m a
runActor :: ActorEnv msg -> Actor msg a -> m a
runActor ActorEnv msg
actorEnv (Actor ReaderT (ActorEnv msg) IO a
m) = 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 (ActorEnv msg) IO a -> ActorEnv msg -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (ActorEnv msg) IO a
m ActorEnv msg
actorEnv


-- | Environment for the `Actor` monad.
--
-- @since 0.1.0.0
data ActorEnv msg = ActorEnv
  { ActorEnv msg -> Address msg
address :: Address msg
  , ActorEnv msg -> Mailbox msg
mailbox :: Mailbox msg
  , ActorEnv msg -> Scope
scope :: Scope
  }


-- | The address for an actor. Returned after `spawn`ing an actor or asking for
-- the current actor's address with `here`. Used to `send` messages to specific
-- actors.
--
-- @since 0.1.0.0
newtype Address msg = Address (Unagi.InChan msg)


-- | Where messages are delivered. Implicitly provided to `receive` and
-- `tryReceive` by the `Actor` monad.
--
-- @since 0.1.0.0
newtype Mailbox msg = Mailbox (Unagi.OutChan msg)


-- | @since 0.1.0.0
newtype Scope = Scope Ki.Scope


-- | Spawn a new actor. Returns the spawned actor's address.
--
-- Example:
--
-- > printerAddress <- spawn printer
--
-- @since 0.1.0.0
spawn :: Message childMsg => Actor childMsg () -> Actor msg (Address childMsg)
spawn :: Actor childMsg () -> Actor msg (Address childMsg)
spawn Actor childMsg ()
actor = do
  (InChan childMsg
inChan, OutChan childMsg
outChan) <- IO (InChan childMsg, OutChan childMsg)
-> Actor msg (InChan childMsg, OutChan childMsg)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (InChan childMsg, OutChan childMsg)
forall a. IO (InChan a, OutChan a)
Unagi.newChan
  let address :: Address childMsg
address = InChan childMsg -> Address childMsg
forall msg. InChan msg -> Address msg
Address InChan childMsg
inChan
  let mailbox :: Mailbox childMsg
mailbox = OutChan childMsg -> Mailbox childMsg
forall msg. OutChan msg -> Mailbox msg
Mailbox OutChan childMsg
outChan

  Scope Scope
kiScope <- ReaderT (ActorEnv msg) IO Scope -> Actor msg Scope
forall msg a. ReaderT (ActorEnv msg) IO a -> Actor msg a
Actor (ReaderT (ActorEnv msg) IO Scope -> Actor msg Scope)
-> ReaderT (ActorEnv msg) IO Scope -> Actor msg Scope
forall a b. (a -> b) -> a -> b
$ (ActorEnv msg -> Scope) -> ReaderT (ActorEnv msg) IO Scope
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ActorEnv msg -> Scope
forall msg. ActorEnv msg -> Scope
scope
  IO () -> Actor msg ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Actor msg ()) -> IO () -> Actor 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
$ (Scope -> IO ()) -> IO ()
forall a. (Scope -> IO a) -> IO a
Ki.scoped \Scope
childKiScope ->
    let childScope :: Scope
childScope = Scope -> Scope
Scope Scope
childKiScope
        childEnv :: ActorEnv childMsg
childEnv = ActorEnv :: forall msg. Address msg -> Mailbox msg -> Scope -> ActorEnv msg
ActorEnv{Address childMsg
address :: Address childMsg
address :: Address childMsg
address, Mailbox childMsg
mailbox :: Mailbox childMsg
mailbox :: Mailbox childMsg
mailbox, scope :: Scope
scope = Scope
childScope}
     in ActorEnv childMsg -> Actor childMsg () -> IO ()
forall (m :: * -> *) msg a.
MonadIO m =>
ActorEnv msg -> Actor msg a -> m a
runActor ActorEnv childMsg
childEnv Actor childMsg ()
actor

  Address childMsg -> Actor msg (Address childMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Address childMsg
address


-- | More efficient version of `spawn`, for actors which receive no messages
-- (`msg ~ Void`). See docs for `spawn` for more information.
--
-- @since 0.2.0.0
spawn_ :: Actor Void () -> Actor msg ()
spawn_ :: Actor Void () -> Actor msg ()
spawn_ Actor Void ()
actor = 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
"unreachable")
  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
"unreachable")

  Scope Scope
kiScope <- ReaderT (ActorEnv msg) IO Scope -> Actor msg Scope
forall msg a. ReaderT (ActorEnv msg) IO a -> Actor msg a
Actor (ReaderT (ActorEnv msg) IO Scope -> Actor msg Scope)
-> ReaderT (ActorEnv msg) IO Scope -> Actor msg Scope
forall a b. (a -> b) -> a -> b
$ (ActorEnv msg -> Scope) -> ReaderT (ActorEnv msg) IO Scope
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ActorEnv msg -> Scope
forall msg. ActorEnv msg -> Scope
scope
  IO () -> Actor msg ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Actor msg ()) -> IO () -> Actor 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
$ (Scope -> IO ()) -> IO ()
forall a. (Scope -> IO a) -> IO a
Ki.scoped \Scope
childKiScope ->
    let childScope :: Scope
childScope = Scope -> Scope
Scope Scope
childKiScope
        childEnv :: ActorEnv Void
childEnv = ActorEnv :: forall msg. Address msg -> Mailbox msg -> Scope -> ActorEnv msg
ActorEnv{Address Void
forall msg. Address msg
address :: forall msg. Address msg
address :: Address Void
address, Mailbox Void
forall msg. Mailbox msg
mailbox :: forall msg. Mailbox msg
mailbox :: Mailbox Void
mailbox, scope :: Scope
scope = Scope
childScope}
     in ActorEnv Void -> Actor Void () -> IO ()
forall (m :: * -> *) msg a.
MonadIO m =>
ActorEnv msg -> Actor msg a -> m a
runActor ActorEnv Void
childEnv Actor Void ()
actor


-- | Wait for all actors spawned by the current actor to terminate.
--
-- Example:
--
-- > fooAddress <- spawn foo
-- > barAddress <- spawn bar
-- > wait
--
-- @since 0.1.0.0
wait :: Actor msg ()
wait :: Actor msg ()
wait = do
  Scope Scope
kiScope <- ReaderT (ActorEnv msg) IO Scope -> Actor msg Scope
forall msg a. ReaderT (ActorEnv msg) IO a -> Actor msg a
Actor (ReaderT (ActorEnv msg) IO Scope -> Actor msg Scope)
-> ReaderT (ActorEnv msg) IO Scope -> Actor msg Scope
forall a b. (a -> b) -> a -> b
$ (ActorEnv msg -> Scope) -> ReaderT (ActorEnv msg) IO Scope
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ActorEnv msg -> Scope
forall msg. ActorEnv msg -> Scope
scope
  IO () -> Actor msg ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Actor msg ()) -> IO () -> Actor msg ()
forall a b. (a -> b) -> a -> b
$ Scope -> IO ()
Ki.wait Scope
kiScope


-- | Return the current actor's own address. Useful for sending your address to
-- other actors, or for sending yourself a message.
--
-- @since 0.1.0.0
here :: Message msg => Actor msg (Address msg)
here :: Actor msg (Address msg)
here = ReaderT (ActorEnv msg) IO (Address msg) -> Actor msg (Address msg)
forall msg a. ReaderT (ActorEnv msg) IO a -> Actor msg a
Actor (ReaderT (ActorEnv msg) IO (Address msg)
 -> Actor msg (Address msg))
-> ReaderT (ActorEnv msg) IO (Address msg)
-> Actor msg (Address msg)
forall a b. (a -> b) -> a -> b
$ (ActorEnv msg -> Address msg)
-> ReaderT (ActorEnv msg) IO (Address msg)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ActorEnv msg -> Address msg
forall msg. ActorEnv msg -> Address msg
address


-- | Given an actor's address, send it a message.
--
-- Example:
--
-- > send printerAddress "Hello, world!"
--
-- @since 0.1.0.0
send
  :: Message recipientMsg
  => Address recipientMsg
  -> recipientMsg
  -> Actor msg ()
send :: Address recipientMsg -> recipientMsg -> Actor msg ()
send (Address InChan recipientMsg
inChan) recipientMsg
msg = IO () -> Actor msg ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Actor msg ()) -> IO () -> Actor msg ()
forall a b. (a -> b) -> a -> b
$ InChan recipientMsg -> recipientMsg -> IO ()
forall a. InChan a -> a -> IO ()
Unagi.writeChan InChan recipientMsg
inChan recipientMsg
msg


-- | Receive a message sent to the actor's mailbox. This function blocks until
-- a message is received.
--
-- Example:
--
-- > printer :: Actor String ()
-- > printer = forever do
-- >   string <- receive
-- >   liftIO $ putStrLn string
--
-- @since 0.1.0.0
receive :: Message msg => Actor msg msg
receive :: Actor msg msg
receive = do
  Mailbox OutChan msg
outChan <- ReaderT (ActorEnv msg) IO (Mailbox msg) -> Actor msg (Mailbox msg)
forall msg a. ReaderT (ActorEnv msg) IO a -> Actor msg a
Actor (ReaderT (ActorEnv msg) IO (Mailbox msg)
 -> Actor msg (Mailbox msg))
-> ReaderT (ActorEnv msg) IO (Mailbox msg)
-> Actor msg (Mailbox msg)
forall a b. (a -> b) -> a -> b
$ (ActorEnv msg -> Mailbox msg)
-> ReaderT (ActorEnv msg) IO (Mailbox msg)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ActorEnv msg -> Mailbox msg
forall msg. ActorEnv msg -> Mailbox msg
mailbox
  IO msg -> Actor msg msg
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO msg -> Actor msg msg) -> IO msg -> Actor msg msg
forall a b. (a -> b) -> a -> b
$ OutChan msg -> IO msg
forall a. OutChan a -> IO a
Unagi.readChan OutChan msg
outChan


-- | Receive a message sent to the actor's mailbox. This function blocks until
-- a message is received.
--
-- Example:
--
-- > printer :: Actor String ()
-- > printer = forever do
-- >   tryReceive >>= \case
-- >     Just string -> liftIO $ putStrLn string
-- >     Nothing -> ...
--
-- @since 0.1.0.0
tryReceive :: Message msg => Actor msg (Maybe msg)
tryReceive :: Actor msg (Maybe msg)
tryReceive = do
  Mailbox OutChan msg
outChan <- ReaderT (ActorEnv msg) IO (Mailbox msg) -> Actor msg (Mailbox msg)
forall msg a. ReaderT (ActorEnv msg) IO a -> Actor msg a
Actor (ReaderT (ActorEnv msg) IO (Mailbox msg)
 -> Actor msg (Mailbox msg))
-> ReaderT (ActorEnv msg) IO (Mailbox msg)
-> Actor msg (Mailbox msg)
forall a b. (a -> b) -> a -> b
$ (ActorEnv msg -> Mailbox msg)
-> ReaderT (ActorEnv msg) IO (Mailbox msg)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ActorEnv msg -> Mailbox msg
forall msg. ActorEnv msg -> Mailbox msg
mailbox
  (Element msg
element, IO msg
_) <- IO (Element msg, IO msg) -> Actor msg (Element msg, IO msg)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Element msg, IO msg) -> Actor msg (Element msg, IO msg))
-> IO (Element msg, IO msg) -> Actor 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) -> Actor msg (Maybe msg)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe msg) -> Actor msg (Maybe msg))
-> IO (Maybe msg) -> Actor 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 actor. Intended to be used at the entry point of your
-- program.
--
-- @since 0.1.0.0
run :: (Message msg, MonadIO m) => Actor msg a -> m a
run :: Actor msg a -> m a
run Actor msg a
actor = 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

  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
    ActorEnv msg -> Actor msg a -> IO a
forall (m :: * -> *) msg a.
MonadIO m =>
ActorEnv msg -> Actor msg a -> m a
runActor ActorEnv :: forall msg. Address msg -> Mailbox msg -> Scope -> ActorEnv msg
ActorEnv{Address msg
address :: Address msg
address :: Address msg
address, Mailbox msg
mailbox :: Mailbox msg
mailbox :: Mailbox msg
mailbox, Scope
scope :: Scope
scope :: Scope
scope} Actor msg a
actor


-- | More efficient version of `run`, for actors which receive no messages
-- (`msg ~ Void`). See docs for `run` for more information.
--
-- @since 0.2.0.0
run_ :: MonadIO m => Actor Void a -> m a
run_ :: Actor Void a -> m a
run_ Actor Void a
actor = 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
"unreachable")
  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
"unreachable")

  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
    ActorEnv Void -> Actor Void a -> IO a
forall (m :: * -> *) msg a.
MonadIO m =>
ActorEnv msg -> Actor msg a -> m a
runActor ActorEnv :: forall msg. Address msg -> Mailbox msg -> Scope -> ActorEnv msg
ActorEnv{Address Void
forall msg. Address msg
address :: forall msg. Address msg
address :: Address Void
address, Mailbox Void
forall msg. Mailbox msg
mailbox :: forall msg. Mailbox msg
mailbox :: Mailbox Void
mailbox, Scope
scope :: Scope
scope :: Scope
scope} Actor Void a
actor


-- | Loop indefinitely with state. Use `Control.Monad.forever` for stateless
-- infinite loops.
--
-- Example:
--
-- > counter :: Actor () Int
-- > counter = loop 10 \count -> do
-- >   liftIO $ print count
-- >   if count > 0
-- >     then continue (count - 1)
-- >     else exit count
--
-- @since 0.1.0.0
loop
  :: s
  -- ^ Initial state
  -> (s -> Actor msg (Either s a))
  -- ^ Action to perform, either returning a new state to continue looping, or
  -- a final value to stop looping.
  -> Actor msg a
loop :: s -> (s -> Actor msg (Either s a)) -> Actor msg a
loop s
s0 s -> Actor msg (Either s a)
k =
  s -> Actor msg (Either s a)
k s
s0 Actor msg (Either s a)
-> (Either s a -> Actor msg a) -> Actor msg a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left s
s -> s -> (s -> Actor msg (Either s a)) -> Actor msg a
forall s msg a. s -> (s -> Actor msg (Either s a)) -> Actor msg a
loop s
s s -> Actor msg (Either s a)
k
    Right a
x -> a -> Actor msg a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x


-- | Continue looping with state.
--
-- prop> continue s = pure (Left s)
--
-- @since 0.1.0.0
continue :: s -> Actor msg (Either s a)
continue :: s -> Actor msg (Either s a)
continue s
s = Either s a -> Actor msg (Either s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s -> Either s a
forall a b. a -> Either a b
Left s
s)


-- | Exit loop with value.
--
-- prop> exit x = pure (Right x)
--
-- @since 0.1.0.0
exit :: a -> Actor msg (Either s a)
exit :: a -> Actor msg (Either s a)
exit a
x = Either s a -> Actor msg (Either s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either s a
forall a b. b -> Either a b
Right a
x)