{-# LANGUAGE RankNTypes #-}
module Control.Distributed.Raketka.Type.Server where

import Control.Concurrent.STM
import Control.Distributed.Process.Serializable
import Control.Distributed.Process hiding (Message)
import Control.Distributed.Raketka.Type.Arg
import Data.Tagged


{- | constraint type

    __c__ is Message content type, implementation-specific      -}
type Content c = (Specific c, Serializable c, Show c)

{- | methods in this instance are called in library, defined in the program (this or another program that consumes this library)
    
    see example implementation in "Control.Distributed.Raketka.Impl.Inst"

    "Control.Distributed.Raketka.Impl.Inst" is part of the package, is not displayed in docs because it is part of a program, not the library.
    
    see also Main.hs there is important code there
    
    __c__ is Message content type, implementation-specific  
-}
class Specific c where
    handleMessage::Tagged c Server -> c -> Process ()
    startServer::Tagged c ServerId -> Process ()


-- | pass tag between different types 
passTag::Tagged a b -> c -> Tagged a c
passTag _ = Tagged


data Server = Server
      { proxychan::TChan (Process ())  -- ^ pipeline for sending messages 
        , servers::TVar [ProcessId]    -- ^ to broadcast to entire cluster 
        , spid::ProcessId              -- ^ this node's pid   
        }