raketka-1.2.0: src/Control/Distributed/Raketka/Impl/Inst.hs
module Control.Distributed.Raketka.Impl.Inst where
import Data.ByteString
import Data.Set as S
import Control.Distributed.Process
import Control.Distributed.Raketka.Type.Arg
import Control.Distributed.Raketka.Type.Server
import qualified Control.Distributed.Raketka.Process.Server as S
import Debug.Trace
import Text.Printf
data Slb a = Slb a -- ^ Stateless ByteString
type Server_slb = Server (Set ProcessId) ()
instance Specific Slb (Set ProcessId) () ByteString where
handleMessage :: Slb Server_slb -> ByteString -> Process ()
handleMessage (Slb serv0) msg0 =
trace "handleMessage" $
pure () -- todo
startServer :: Slb ServerId -> () -> Process ()
startServer (Slb id0) _ = server id0
onPeerConnected :: Slb Server_slb -> ProcessId -> Process ()
onPeerConnected (Slb s0) = tracePid "connected to %s"
onPeerDisConnected :: Slb Server_slb -> ProcessId -> Process ()
onPeerDisConnected (Slb s0) = tracePid "disconnected %s"
tag = Slb
untag (Slb a) = a
tracePid :: String -- ^ formattable string with a placeholder for pid
-> ProcessId
-> Process ()
tracePid msg0 pid0 =
trace msg1 $
pure ()
where msg1 = printf msg0 pid0
server :: ServerId -> Process ()
server id0 = newServer' >>= flip S.server id0
newServer' :: Process (Slb Server_slb)
newServer' = S.newServer () S.empty