-----------------------------------------------------------------------------
--
-- Module      :  Control.Concurrent.Network.NVar
-- Copyright   :  (C) 2010, Paul Sonkoly
-- License     :  BSD style
--
-- Maintainer  :  Paul Sonkoly
-- Stability   :  provisional
-- Portability :
--
-- | Network variables.
--    Communication is done by using 'NVar' variables similar to 'MVar' in Concurrent.
--
--    Every read and every write results in network transaction with the master process,
--    so handle with care.
--
--    This is done with a push style implementation so 'putNVar' propagets the value to
--    the master process, but other slaves won't get automatically notified
--    about the change. The next 'takeNVar' will result in the updated value.
--
--    To save network bandwith and load on the master, it is possible to wait for an
--    'NVar' to change value using 'pollWithOp'.
-----------------------------------------------------------------------------

module Control.Concurrent.Network.NVar
    (
    -- * Functions
      newNVar
    , putNVar
    , takeNVar
    , pollWithOp
    -- * Constructors
    , Equality(..)
    ) where

import Control.Concurrent.Network.Slave
import Control.Concurrent.Network.Protocol
import Data.Binary
import Data.Maybe
import Data.Int


-- | Creates a new empty 'NVar' on the master. Doesn't block the caller.
newNVar :: NCContext -> String -> IO ()
newNVar nc name = writeProtoId (hdl nc) NNV >> writeBinary (hdl nc) name


-- | Puts a value into 'NVar' specified by the name.
--   If the 'NVar' doesn't exist this blocks the caller until it's
--    created potentially by an  other slave.
--
--   If the 'NVar' already has a value this blocks the caller until
--    an other slave calls 'takeNVar'.
--
--   If the 'NVar' is empty this returns immediately after the network
--    transactions.
putNVar :: (Binary a) => NCContext -> String -> a -> IO ()
putNVar nc name a = writeProtoId (hdl nc) PNV   >>
    writeBinary (hdl nc) name                   >>
    writeBinary (hdl nc) a                      >>
    readProtoId (hdl nc)                        >>
    return ()


-- | Takes the latest value of 'NVar' from the master.
--   If the 'NVar' doesn't exist this blocks the caller until it's
--    created potentially by an other slave.
--
--   If the 'NVar' is empty this blocks the caller until
--    an other slave calls 'putNVar'.
--
--   If the 'NVar' has a value this returns immediately after the network
--    transactions.
takeNVar :: (Binary a) =>  NCContext -> String -> IO a
takeNVar nc name = writeProtoId (hdl nc) TNV   >>
    writeBinary (hdl nc) name                  >>
    readBinary (hdl nc)


-- | Polls while the given condition is true for 'NVar' called 'name'.
--    As this call doesn't return while the condition is true, it's much
--    more efficient than busy waiting in the slave generating network
--    traffic.
pollWithOp :: (Binary a) => NCContext -> String  -> Equality -> a -> IO ()
pollWithOp nc name eq a = writeProtoId (hdl nc) PWO    >>
    writeBinary (hdl nc) name                           >>
    writeBinary (hdl nc) eq                             >>
    writeBinary (hdl nc) a                              >>
    readProtoId (hdl nc)                                >>
    return ()