-- Locations
--   includes API for error and debug messages
--
  Author :   ,  
-----------------------------------------------------------------------------

module Control.Parallel.HdpH.Internal.Location
  ( -- * node IDs (and their constitutent parts)
  instances :  , Ord , Show , NFData , Serialize

    -- * reading all node IDs and this node's own node ID
    allNodes,             -- :: IO [NodeId]
    myNode,               -- :: IO NodeId
    myNode',              -- :: IO (Maybe NodeId)
  instances : Exception , Show , 

    -- * error messages tagged by emitting node
    error,  -- :: String -> a

    -- * debug messages tagged by emitting node
    debug,  -- :: Int -> String -> IO ()

    -- * debug levels
    dbgNone,       -- :: Int
    dbgStats,      -- :: Int
    dbgStaticTab,  -- :: Int
    dbgSpark,      -- :: Int
    dbgMsgSend,    -- :: Int
    dbgMsgRcvd,    -- :: Int
    dbgGIVar,      -- :: Int
    dbgIVar,       -- :: Int
    dbgGRef,       -- :: Int
    dbgFailure     -- :: Int
  ) where

import Prelude hiding (catch, error)
import qualified Prelude (error)
import Control.Exception (catch, evaluate)
import Control.Monad (when)
import Data.Functor ((<$>))
import Data.IORef (readIORef)
import System.IO (stderr, hPutStrLn)
import System.IO.Unsafe (unsafePerformIO)

import Control.Parallel.HdpH.Internal.State.Location
       (myNodeRef, allNodesRef, debugRef)
import Control.Parallel.HdpH.Internal.Type.Location
       (NodeId, MyNodeException(NodeIdUnset))


-----------------------------------------------------------------------------
-- reading this node's own node ID

-- Return this node's node ID;
-- raises 'NodeIdUnset :: MyNodeException' if node ID has not yet been set
-- (by module HdpH.Internal.Comm).
myNode :: IO NodeId
myNode = readIORef myNodeRef


-- Return 'Just' this node's node ID, or 'Nothing' if ID has not yet been set.
myNode' :: IO (Maybe NodeId)
myNode' =
  catch (Just <$> (evaluate =<< myNode))
        (const $ return Nothing :: MyNodeException -> IO (Maybe NodeId))


-- Return list of all nodes (with main node being head of the list),
-- provided the list has been initialised (by module HdpH.Internal.Comm);
-- otherwise returns the empty list.
allNodes :: IO [NodeId]
allNodes = readIORef allNodesRef


-----------------------------------------------------------------------------
-- error messages tagged by emitting node

-- Abort with error 'message'.
error :: String -> a
error message = case unsafePerformIO myNode' of
                  Just node -> Prelude.error (show node ++ " " ++ message)
                  Nothing   -> Prelude.error message


-----------------------------------------------------------------------------
-- debug messages tagged by emitting node

-- Output a debug 'message' to 'stderr' if the given 'level' is less than
-- or equal to the system level; 'level' should be positive.
debug :: Int -> String -> IO ()
debug level message = do
  sysLevel <- readIORef debugRef
  when (level <= sysLevel) $ do
    maybe_this <- myNode'
    case maybe_this of
      Just this -> hPutStrLn stderr $ show this ++ " " ++ message
      Nothing   -> hPutStrLn stderr $ "<unknown> " ++ message


-- debug levels
dbgNone,dbgStats,dbgStaticTab,dbgSpark,
  dbgMsgSend,dbgMsgRcvd,dbgGIVar,dbgIVar,
  dbgGRef,dbgFailure :: Int
dbgNone      = 0 :: Int  -- no debug output
dbgStats     = 1 :: Int  -- print final stats
  on main node , print Static table
dbgSpark     = 3 :: Int  -- spark created or converted
dbgMsgSend   = 4 :: Int  -- message to be sent
dbgMsgRcvd   = 5 :: Int  -- message being handled
  op on a GIVar ( globalising or writing to )
  blocking / unblocking on IVar ( only log event type )
  registry update ( globalise or free )
  Node failure , failed message transmittion

 Locations
   includes API for error and debug messages

---------------------------------------------------------------------------
 * node IDs (and their constitutent parts)
 * reading all node IDs and this node's own node ID
 :: IO [NodeId]
 :: IO NodeId
 :: IO (Maybe NodeId)
 * error messages tagged by emitting node
 :: String -> a
 * debug messages tagged by emitting node
 :: Int -> String -> IO ()
 * debug levels
 :: Int
 :: Int
 :: Int
 :: Int
 :: Int
 :: Int
 :: Int
 :: Int
 :: Int
 :: Int
---------------------------------------------------------------------------
 reading this node's own node ID
 Return this node's node ID;
 raises 'NodeIdUnset :: MyNodeException' if node ID has not yet been set
 (by module HdpH.Internal.Comm).
 Return 'Just' this node's node ID, or 'Nothing' if ID has not yet been set.
 Return list of all nodes (with main node being head of the list),
 provided the list has been initialised (by module HdpH.Internal.Comm);
 otherwise returns the empty list.
---------------------------------------------------------------------------
 error messages tagged by emitting node
 Abort with error 'message'.
---------------------------------------------------------------------------
 debug messages tagged by emitting node
 Output a debug 'message' to 'stderr' if the given 'level' is less than
 or equal to the system level; 'level' should be positive.
 debug levels
 no debug output
 print final stats
 spark created or converted
 message to be sent
 message being handled
  Author :   ,  

module Control.Parallel.HdpH.Internal.Location
  instances :  , Ord , Show , NFData , Serialize

  instances : Exception , Show , 



  ) where

import Prelude hiding (catch, error)
import qualified Prelude (error)
import Control.Exception (catch, evaluate)
import Control.Monad (when)
import Data.Functor ((<$>))
import Data.IORef (readIORef)
import System.IO (stderr, hPutStrLn)
import System.IO.Unsafe (unsafePerformIO)

import Control.Parallel.HdpH.Internal.State.Location
       (myNodeRef, allNodesRef, debugRef)
import Control.Parallel.HdpH.Internal.Type.Location
       (NodeId, MyNodeException(NodeIdUnset))



myNode :: IO NodeId
myNode = readIORef myNodeRef


myNode' :: IO (Maybe NodeId)
myNode' =
  catch (Just <$> (evaluate =<< myNode))
        (const $ return Nothing :: MyNodeException -> IO (Maybe NodeId))


allNodes :: IO [NodeId]
allNodes = readIORef allNodesRef



error :: String -> a
error message = case unsafePerformIO myNode' of
                  Just node -> Prelude.error (show node ++ " " ++ message)
                  Nothing   -> Prelude.error message



debug :: Int -> String -> IO ()
debug level message = do
  sysLevel <- readIORef debugRef
  when (level <= sysLevel) $ do
    maybe_this <- myNode'
    case maybe_this of
      Just this -> hPutStrLn stderr $ show this ++ " " ++ message
      Nothing   -> hPutStrLn stderr $ "<unknown> " ++ message


dbgNone,dbgStats,dbgStaticTab,dbgSpark,
  dbgMsgSend,dbgMsgRcvd,dbgGIVar,dbgIVar,
  dbgGRef,dbgFailure :: Int
  on main node , print Static table
  op on a GIVar ( globalising or writing to )
  blocking / unblocking on IVar ( only log event type )
  registry update ( globalise or free )
  Node failure , failed message transmittion
