HandleMsg.hs

module Control.Distributed.Raketka.HandleMsg where

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

{- | both 'Info' with 'Ping' and ordinary 'Messages' 

calls 

    * 'newServerInfo'
    * 'handleMessage'
    
    depending on message type
-} 
handleRemoteMessage :: Content tag ps s c =>
    tag (Server ps s) -> Message c -> Process ()
handleRemoteMessage server0 msg0 =
  case msg0 of
    Info ping1 pid1 -> newServerInfo server0 ping1 pid1
    Message msg1 -> handleMessage server0 msg1


{- | handles replies to 'whereisRemoteAsync', run on init 
in "Control.Distributed.Raketka.Master" -}
handleWhereIsReply :: Content tag ps s c =>
    tag (Server ps s)
    -> WhereIsReply
    -> Process ()
handleWhereIsReply _ (P.WhereIsReply _ Nothing) = pure ()
handleWhereIsReply
         server0
         (WhereIsReply _ (Just pid0)) =
  la $ sendRemote server0 pid0 $
         Info Ping $
         spid $ untag server0


{- | 'ProcessMonitorNotification' e.g. connection lost  -} 
handleMonitorNotification :: Content tag ps s c =>
    tag (Server ps s)
    -> ProcessMonitorNotification
    -> Process ()
handleMonitorNotification
       server0
       (ProcessMonitorNotification _ pid0 reason0) = do
  say (printf "server on %s dropped connection. reason: %s" pid0 (show reason0))
  la $ do
    old_pids1 <- readTVar servers1
    writeTVar servers1 $ onPeerDisConnected' old_pids1 pid0
  onPeerDisConnected server0 pid0
  where servers1 = servers $ untag server0