packages feed

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