module Control.Distributed.Raketka.HandleMsg where
import Data.Tagged
import Text.Printf
import Control.Distributed.Process as P hiding (Message, handleMessage)
import Control.Concurrent.STM
import Control.Distributed.Raketka.NewServerInfo
import Control.Distributed.Raketka.Process.Send
import Control.Distributed.Raketka.Type.Server as T
import Control.Distributed.Raketka.Type.Message as M
handleRemoteMessage::Content c =>
Tagged c Server -> Message c -> Process ()
handleRemoteMessage s1@(Tagged Server{..}) msg0 =
case msg0 of
Info ping1 pid1 -> newServerInfo s1 ping1 pid1
Message msg1 -> handleMessage s1 msg1
handleWhereIsReply::Content c =>
Tagged c Server -> WhereIsReply -> Process ()
handleWhereIsReply _ (P.WhereIsReply _ Nothing) = pure ()
handleWhereIsReply s1@(Tagged Server{..}) (WhereIsReply _ (Just pid0)) =
liftIO $ atomically $
sendRemote s1 pid0 $ Info Ping spid
handleMonitorNotification::Content c =>
Tagged c Server -> ProcessMonitorNotification -> Process ()
handleMonitorNotification
(Tagged Server{..}) (ProcessMonitorNotification _ pid0 _) = do
say (printf "server on %s dropped connection" (show pid0))
liftIO $ atomically $ do
old_pids1 <- readTVar servers
writeTVar servers (filter (/= pid0) old_pids1)