{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}

{-# 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 qualified Control.Concurrent.Chan.Unagi as Unagi
import qualified Ki


-- | 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
    , 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
    , 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 :: 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)
 -> Actor msg (InChan childMsg, OutChan childMsg))
-> IO (InChan childMsg, OutChan childMsg)
-> Actor msg (InChan childMsg, OutChan childMsg)
forall a b. (a -> b) -> a -> b
$ 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


-- | 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 :: 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 :: 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 :: 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 :: 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 :: 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) -> m (InChan msg, OutChan msg))
-> IO (InChan msg, OutChan msg) -> m (InChan msg, OutChan msg)
forall a b. (a -> b) -> a -> b
$ 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


-- | 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)