DSTM-0.1: Chat/ChatClient.hs

module Main where

import ChatData
import Control.Concurrent
import Control.Distributed.STM.DSTM
import Maybe
import System.IO

main :: IO ()
main = startDist $ do
  putStrLn "Your Name: "
  name <- getLine
  serverTVar <- lookupTVar "localhost" "Chat"
  case serverTVar of 
    Nothing -> putStrLn "Chatserver not reachable"
    Just cmdTVar -> do
      myTVar <- atomic $ do
        new <- newTVar Nothing
        writeTVar cmdTVar (Just (Join name new))
        return new
      forkIO (serverClient myTVar)
      stdinClient name cmdTVar

stdinClient :: String -> CmdTVar -> IO ()
stdinClient name cmdTVar = do
  putStrLn (name ++ " >")
  msg <- getLine
  if msg == "bye"
    then atomic $ writeTVar cmdTVar (Just (Leave name))
    else do
      atomic $ writeTVar cmdTVar (Just (Msg name msg))
      stdinClient name cmdTVar

serverClient :: CmdTVar -> IO ()
serverClient myTVar = do
  s <- atomic $ do
    cmd <- readTVar myTVar
    case cmd of
      Nothing -> retry
      Just (Msg name msg) -> do
        writeTVar myTVar Nothing
        return (name ++ ": " ++ msg)
      _ -> return ""
  putStrLn s
  serverClient myTVar