-----------------------------------------------------------------------------
--
-- Module      :  Control.Concurrent.Network.Slave
-- Copyright   :  (C) 2010, Paul Sonkoly
-- License     :  BSD style
--
-- Maintainer  :  Paul Sonkoly
-- Stability   :  provisional
-- Portability :
--
-- | Slave processes have a single connection towards the master for simplicity.
--   Communication is done by using 'NVar' variables similar to 'MVar' in Concurrent.
--
-----------------------------------------------------------------------------

module Control.Concurrent.Network.Slave
    (
    -- * Constructors
    NCContext(..)
    -- * Functions
    , initSlave
    , slaveID
    , numSlaves
    , printMsg
) where

import Control.Concurrent
import Control.Concurrent.Network.Protocol
import System.Log.Logger
import System.IO
import Network

-- | the NC Context
data NCContext = NCC { hdl :: MVar Handle }

-- | Initialises a slave process returning the NC context.
initSlave :: HostName -> PortID -> IO NCContext
initSlave h p = do
    debugM rootLoggerName "Initialise slave"
    hdl <- connectTo h p
    hSetBuffering hdl NoBuffering
    hdl' <- newMVar hdl
    return NCC { hdl = hdl' }


-- | Returns the slave ID of the caller
slaveID :: NCContext -> IO Int
slaveID nc = do
    hdl' <- takeMVar (hdl nc)
    writeProtoId hdl' SID
    res <- readBinary hdl'
    putMVar (hdl nc) hdl'
    return res


-- | Number of slaves
numSlaves :: NCContext -> IO Int
numSlaves nc = do
    hdl' <- takeMVar (hdl nc)
    writeProtoId hdl' NSL
    res <- readBinary hdl'
    putMVar (hdl nc) hdl'
    return res


-- | Prints a message on master
printMsg :: NCContext -> String -> IO ()
printMsg nc msg = do
    hdl' <- takeMVar (hdl nc)
    writeProtoId hdl' PMS
    writeBinary hdl' msg
    putMVar (hdl nc) hdl'