content: -- ----------------------------------------------------------------------------
  
  {- |
    Module     : Holumbus
    Copyright  : Copyright (C) 2009 Stefan Schmidt
    License    : MIT
  
    Maintainer : Stefan Schmidt (stefanschmidt@web.de)
    Stability  : experimental
    Portability: portable
    Version    : 0.1
    
  -}
  
  -- ----------------------------------------------------------------------------
  
  module Main(main) where
  
  import           Control.Concurrent
  import qualified Data.Map as Map
  import           Data.Maybe
  import qualified Data.Set as Set
  
  import           Holumbus.Distribution.DNode
  import           Holumbus.Distribution.DFunction
  import           Holumbus.Common.Logging
  
  import           InterfacesDFunction
  
  
  
  data ServerData = ServerData {
      sd_clients   :: Map.Map Int (String, RemoteClientInterface)
    , sd_names     :: Set.Set String
    , sd_number    :: Int
    }
  
  type Server = MVar ServerData
  
  
  -- what to do when a client becomes unreachable
  negativeHandlerFunction :: Server -> Int -> DHandlerId -> IO ()
  negativeHandlerFunction cs cId hdlId
    = do
      putStrLn "negative Trigger"
      unregisterClient cs cId
      -- delete this trigger, it won't be called again
      delForeignHandler hdlId
  
  
  registerClient :: Server -> RegisterClientFunction
  registerClient _ "" _ _ = return Nothing
  registerClient cs cn dni stub
    = do
      putStrLn $ "registering: " ++ cn
      server <- takeMVar cs
      if (Set.member cn (sd_names server))
        then do
          putMVar cs server
          return Nothing
        else do
          let sd_clients' = Map.insert (sd_number server) (cn, createRemoteClientInterface stub) (sd_clients server)
              sd_names'   = Set.insert cn (sd_names server)
              sd_number'  = 1 + (sd_number server)
          putMVar cs $ server { sd_clients = sd_clients', sd_names = sd_names', sd_number = sd_number' }
          -- install a handler to remove the client when he becomes unreachable
          addForeignDNodeHandler False dni (negativeHandlerFunction cs (sd_number server))
          return (Just $ sd_number server)
  
  
  unregisterClient :: Server -> UnregisterClientFunction
  unregisterClient cs cId
    = do
      putStrLn $ "unregistering: " ++ (show cId)
      server <- takeMVar cs
      case (Map.lookup cId (sd_clients server)) of
        Nothing -> do
          putMVar cs server
          return ()
        (Just (cn,_)) -> do
          let sd_clients' = Map.delete cId (sd_clients server)
              sd_names'   = Set.delete cn (sd_names server)
          putMVar cs $ server { sd_clients = sd_clients', sd_names = sd_names' }
  
  
  sendChatMessage :: Server -> SendChatMessageFunction
  sendChatMessage cs cId msg
    = do
      putStrLn $ "sending: " ++ (show cId) ++ "> " ++ msg
      server <- readMVar cs
      case (Map.lookup cId (sd_clients server)) of
        Nothing -> do
          -- TODO return true / false to tell the client that his request was accepted or not
          putStrLn $ "warning: unnkown client with id " ++ (show cId) ++ " wants to send message: " ++ msg
          return ()
        (Just (cn,_)) -> do
          -- TODO exception handling here
          let funs = map (\t -> (cif_receive $ snd t) cn msg) $ Map.elems $ Map.filterWithKey (\cId' _ -> cId' /= cId) (sd_clients server)
          sequence_ funs
  
  
  mkChatServer :: IO Server
  mkChatServer = newMVar $ ServerData Map.empty Set.empty 1
  
  
  main :: IO ()
  main
    = do
      initializeLogging []
      initDNode $ (defaultDNodeConfig "ChatServer")
        { dnc_MinPort = (fromInteger 7999), dnc_MaxPort = (fromInteger 7999) }
      cs <- mkChatServer
      sifs <- createLocalServerInterfaceStub
        (registerClient cs)
        (unregisterClient cs)
        (sendChatMessage cs)
      inputLoop
      closeLocalServerInterfaceStub sifs
      deinitDNode
  
  
  inputLoop :: IO ()
  inputLoop
    = do
      msg <- getLine
      case msg of
        "exit" -> return ()
        _ -> inputLoop
  
  