From 5c6f8480ebd4d23c7d16e069575fb2f0da0de689 Mon Sep 17 00:00:00 2001
From: Nikolas Burk <nikolas.burk@gmail.com>
Date: Wed, 25 Nov 2015 11:52:41 -0500
Subject: [PATCH] improved the ways messages are sent between client and server
 and introduced new msg type BOARD

---
 Board.hs     |  7 +++++--
 TTTClient.hs | 40 +++++++++++++++++++++++-----------------
 TTTServer.hs | 36 +++++++++++++++++++++++-------------
 3 files changed, 51 insertions(+), 32 deletions(-)

diff --git a/Board.hs b/Board.hs
index 4fd9fc2..ae06df9 100644
--- a/Board.hs
+++ b/Board.hs
@@ -65,6 +65,9 @@ boardFromRows rows
   | length rows /= 3 = Left ("Not the right number of rows: " ++ show (length rows))
   | otherwise = Right (BoardCons (rows !! 0) (rows !! 1) (rows !! 2))
 
+boardFromRows' :: [Row] -> Board
+boardFromRows' rows = (BoardCons (rows !! 0) (rows !! 1) (rows !! 2))
+
 
 -- checks the range of the indices
 isValidIndex :: (Int, Int) -> Bool
@@ -94,8 +97,8 @@ replaceRow newRow i (BoardCons r0 r1 r2)
 
 -- HELPERS: Board encoding / decoding
 
-decodeBoard :: String -> BoardOrMsg
-decodeBoard s = boardFromRows $ snd $ foldl dec (0, [], []) s 
+decodeBoard :: String -> Board
+decodeBoard s = boardFromRows' $ snd $ foldl dec (0, [], []) s 
   where snd (_, x, _) = x
 
 dec :: (Int, [Row], [Field])-> Char -> (Int, [Row], [Field])
diff --git a/TTTClient.hs b/TTTClient.hs
index e40413d..2c980a4 100644
--- a/TTTClient.hs
+++ b/TTTClient.hs
@@ -1,29 +1,35 @@
 import Network.Socket
 import Network.BSD
+import Control.Monad
 import System.IO
 import TTTServer
 import TicTacToe
-
+import Board
 
 playGame :: HostName -> String -> IO ()
 playGame hostname port = do
   p <- getPlayerFromConnection hostname port
-  playersTurn p 
+  playersTurn' p 
   return ()
 
-
-playersTurn :: Player -> IO ()
-playersTurn p = do
-  m1 <- hGetLine $ handle p
-  putStrLn $ "did reveive msg from server: " ++ m1
-  col <- getLine
-  hPutStrLn (handle p) col
-  m2 <- hGetLine $ handle p
-  putStrLn $ "did reveive msg from server: " ++ m2
-  row <- getLine
-  hPutStrLn (handle p) row
-  playersTurn p
-  return ()
+playersTurn' :: Player -> IO ()
+playersTurn' p = do
+  m <- hGetLine $ handle p
+  putStrLn m
+  maybeInp <- processMsg m
+  case maybeInp of
+    Nothing -> playersTurn' p
+    Just inp  -> do
+                   hPutStrLn (handle p) inp 
+                   playersTurn' p
+
+processMsg :: String -> IO (Maybe String)
+processMsg s = let msg = stringToMsg s
+                   in case msgType msg of
+                        REQ_INPUT -> do
+                          inp <- getLine
+                          return $ Just inp
+                        _ -> return Nothing
 
 getPlayerFromConnection :: HostName -> String -> IO Player
 getPlayerFromConnection hostname port = do
@@ -47,8 +53,8 @@ getPlayerFromConnection hostname port = do
   h <- socketToHandle sock ReadWriteMode
   hSetBuffering h LineBuffering
 
-  info <- hGetLine h
-  putStrLn $ "initial info: " ++ info
+  --info <- hGetLine h
+  --putStrLn $ "initial info: " ++ info
 
   return $ Player h Cross
 
diff --git a/TTTServer.hs b/TTTServer.hs
index 00c1bba..a8c1e6a 100644
--- a/TTTServer.hs
+++ b/TTTServer.hs
@@ -18,13 +18,6 @@ data Game = Game { player1 :: Player,
 
 type PendingPlayers = [Handle]
 
-data MsgType = REQ_INPUT | INFO deriving (Eq, Show)
-data Message = Message { msgType :: MsgType,
-                         msg :: String }
-
-instance Show Message where
-  show m = show (msgType m) ++ ": " ++ msg m
-
 
 serveTTT :: String -> IO ()
 serveTTT port = do
@@ -77,9 +70,11 @@ serveTTT port = do
           sendMessage (Message INFO "You're playing 'O'") p2
           manageRound game
           return ()
-          
+
         manageRound :: Game -> IO () 
         manageRound game = do
+
+          -- | check if someone won the game already
           case checkWinnerPure $ board game of
             Nothing -> print $ board game
             Just p -> do
@@ -87,11 +82,15 @@ serveTTT port = do
               handleGameOver game
               return ()
 
+          -- | determined the current player
           let p = case currentPlayer $ board game of
                 Cross -> player1 game
                 Circle -> player2 game
-          --let boardInfo = "Board:\n" ++ show (board game)
-          --sendMessage (Message INFO boardInfo) p
+
+          -- | send the current board to the player
+          sendMessage (Message BOARD $ encodeBoard $ board game) p
+
+          -- | get the input from the current player
           (col, row) <- getPlayerChoice p
           case mkChoice (col, row, marker p) $ board game of
             Left msg -> do
@@ -103,6 +102,7 @@ serveTTT port = do
               manageRound newGame
           return ()
 
+        -- | get input from from a player
         getPlayerChoice :: Player -> IO (Int, Int)
         getPlayerChoice p = do
           col <- getPlayerInput p "column" 
@@ -130,16 +130,26 @@ serveTTT port = do
 
 -- | HELPERS: Messaging
 
+data MsgType = REQ_INPUT | INFO | BOARD | UNKNOWN deriving (Eq, Show)
+data Message = Message { msgType :: MsgType,
+                         content :: String}
+
+instance Show Message where
+  show m = show (msgType m) ++ ": " ++ content m 
+
 sendMessage :: Message -> Player -> IO ()
 sendMessage m p = do
-  hPrint (handle p) m 
+  hPrint (handle p) m
   putStrLn $ "did send message to client: " ++ show m
 
 stringToMsg :: String -> Message
 stringToMsg s 
-    | isPrefix "INFO" s = Message INFO (drop 5 s)
-    | isPrefix "REQ_INPUT" s = Message REQ_INPUT (drop 10 s)
+    | isPrefix "INFO" s = Message INFO $ drop 5 s
+    | isPrefix "REQ_INPUT" s = Message REQ_INPUT $ drop 10 s
+    | isPrefix "BOARD" s = Message BOARD $ drop 6 s
+    | otherwise = Message UNKNOWN s
 
+-- HELPERS :: General
 
 updateBoard :: Board -> Game -> Game
 updateBoard b g = Game (player1 g) (player2 g) b