refactor(runtime): more on handle receive

src/runtime-prototype/src/StuntDouble/EventLoop.hs

@@ -52,8 +52,9 @@ handleCommand :: Command -> LoopState -> IO ()
 handleCommand (Spawn actor respVar) ls = do
   undefined
 handleCommand (Invoke lr m respVar) ls = do
-  -- actor <- findActor ls lr
-  undefined
+  Just actor <- lookupActor lr (loopStateActors ls)
+  Now reply <- runActor ls (actor m)
+  atomically (putTMVar respVar reply)
 handleCommand (Send rr m) ls = do
   -- a <- async (makeHttpRequest (translateToUrl rr) (seralise m))
   -- atomically (modifyTVar (loopStateAsyncs ls) (a :))
@@ -62,12 +63,21 @@ handleCommand Quit ls = do
   a <- atomically (takeTMVar (loopStateAsync ls))
   cancel a
 
-handleReceive :: Receive -> LoopState -> IO ()
-handleReceive (Request e) ls = do
-  actor <- undefined -- findActor ls (envelopeReceiver e)
-  runActor ls (actor (envelopeMessage e))
+data ActorNotFound = ActorNotFound RemoteRef
+  deriving Show
 
-runActor :: LoopState -> Actor -> IO ()
+instance Exception ActorNotFound where
+
+handleReceive :: Request -> LoopState -> IO ()
+handleReceive (Request e) ls = do
+  mActor <- lookupActor (remoteToLocalRef (envelopeReceiver e)) (loopStateActors ls)
+  case mActor of
+    Nothing -> throwIO (ActorNotFound (envelopeReceiver e)) -- XXX: Throw here or just log and continue?
+    Just actor -> do
+      _ <- runActor ls (actor (envelopeMessage e))
+      return ()
+
+runActor :: LoopState -> Free ActorF a -> IO a
 runActor ls = undefined -- iterM go
   where
     go :: ActorF (IO a) -> IO a

src/runtime-prototype/src/StuntDouble/EventLoop/State.hs

@@ -1,6 +1,7 @@
 module StuntDouble.EventLoop.State where
 
 import Data.Map (Map)
+import qualified Data.Map as Map
 import Control.Concurrent.STM
 import Control.Concurrent.Async
 
@@ -16,9 +17,14 @@ import StuntDouble.Message
 data LoopState = LoopState
   { loopStateAsync :: TMVar (Async ()) -- | Hold the `Async` of the event loop itself.
   , loopStateQueue :: TBQueue Event
-  , loopStateActors :: TVar (Map InternalActorRef (Message -> Actor))
+  , loopStateActors :: TVar (Map LocalRef (Message -> Actor))
   -- , loopStateHandlers :: TVar (Map (Async Message) (Message -> Actor))
-  , loopStateIOHandlers :: TVar (Map (Async IOResult) (InternalActorRef, IOResult -> Actor))
+  , loopStateIOHandlers :: TVar (Map (Async IOResult) (LocalRef, IOResult -> Actor))
   , loopStateIOAsyncs :: TVar [Async IOResult]
   , loopStateTransport :: Transport IO -- Will not change once created, so doesn't need STM?
   }
+
+
+lookupActor :: LocalRef -> TVar (Map LocalRef (Message -> Actor)) 
+            -> IO (Maybe (Message -> Actor))
+lookupActor key var = Map.lookup key <$> atomically (readTVar var)

src/runtime-prototype/src/StuntDouble/Reference.hs

@@ -1,6 +1,7 @@
 module StuntDouble.Reference where
 
 data LocalRef = LocalRef Int
+  deriving (Eq, Ord)
 
 data RemoteRef = RemoteRef
   { address :: String
@@ -11,4 +12,5 @@ data RemoteRef = RemoteRef
 localToRemoteRef :: String -> LocalRef -> RemoteRef
 localToRemoteRef address (LocalRef i) = RemoteRef address i
 
-type InternalActorRef = Int
+remoteToLocalRef :: RemoteRef -> LocalRef
+remoteToLocalRef = LocalRef . index