two players can now play each other, however only the best case scena…

…rio is implemented, need more failure and exception handling

TTTCLI.hs

@@ -23,14 +23,6 @@ nextRound b = do
   let p = currentPlayer b
   putStrLn $ show b
 
-  -- get choice from input
-  --putStr "Column: "
-  --col <- getLine
-  --let colNum = read col
-  --putStr "Row: "
-  --row <- getLine
-  --let rowNum = read row
-
   -- get choice from input
   col <- getInput "Input column: "
   row <- getInput "Input row: "
@@ -41,8 +33,8 @@ nextRound b = do
          putStrLn msg
          nextRound b
        Right b' -> nextRound b'
-  
-  
+
+
 getInput :: String -> IO Int
 getInput msg = do
   putStr msg

TTTClient.hs

@@ -4,23 +4,51 @@ import System.IO
 import TTTServer
 import TicTacToe
 
-openConnection :: HostName -> String -> IO Player
-openConnection hostname port = do
+
+playGame :: HostName -> String -> IO ()
+playGame hostname port = do
+  p <- getPlayerFromConnection hostname port
+  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 ()
+
+getPlayerFromConnection :: HostName -> String -> IO Player
+getPlayerFromConnection hostname port = do
+
+  -- | create the server's address using the input parameters
   addrinfos <- getAddrInfo Nothing (Just hostname) (Just port)
   let serveraddr = head addrinfos
 
+  putStrLn $ "did create server address: " ++ show serveraddr
+
+  -- | create a TCP socket for the incoming data
   sock <- socket (addrFamily serveraddr) Stream defaultProtocol
 
+  -- | configure socket
   setSocketOption sock KeepAlive 1
 
+  -- | connect to server
   connect sock (addrAddress serveraddr)
 
+  -- | turn socket into handle
   h <- socketToHandle sock ReadWriteMode
-
   hSetBuffering h LineBuffering
 
-  messages <- hGetContents h
-  putStrLn messages
-  
+  info <- hGetLine h
+  putStrLn $ "initial info: " ++ info
+
   return $ Player h Cross
 

TTTServer.hs

@@ -5,28 +5,43 @@ import Network.BSD
 import Data.List
 import System.IO
 import Control.Concurrent
+import Text.Read
 import TicTacToe
 
 data Player = Player { handle :: Handle,
                        marker :: Marker }
 
 data Game = Game { player1 :: Player,
                    player2 :: Player,
-                   boardOrMsg :: BoardOrMsg }
+                   board :: Board }
+
+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
+
 
 type HandlerFunc = SockAddr -> String -> IO ()
 
 serveTTT :: String -> HandlerFunc -> IO ()
-serveTTT port handlerfunc = do 
+serveTTT port handlerfunc = do
+
+  -- create the server's address
   addrinfos <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) Nothing (Just port)
   let serveraddr = head addrinfos
 
+  -- create a TCP socket
   sock <- socket (addrFamily serveraddr) Stream defaultProtocol
 
-  bind sock (addrAddress serveraddr)
+  putStrLn $ "did creater server address: " ++ show serveraddr
 
+  -- bind the socket to the address and start listening
+  bind sock (addrAddress serveraddr)
   listen sock 4
 
+  -- request processing loop
   processRequest sock []
 
   where
@@ -42,31 +57,82 @@ serveTTT port handlerfunc = do
         handlePlayer :: Socket -> [Handle] -> IO [Handle]
         handlePlayer playersock handles = do
           h <- socketToHandle playersock ReadWriteMode
+          hSetBuffering h LineBuffering
           let newHandles = handles ++ [h]
           if let l = length newHandles
                in even l && l > 0
              then do
                     initiateNewGame $ toTuple $ lastN 2 newHandles
-                    return $ take ((length newHandles) - 2) newHandles
+                    return $ take (length newHandles - 2) newHandles
             else return newHandles
 
         -- | initiate a new game
         initiateNewGame :: (Handle, Handle) -> IO () 
         initiateNewGame (h1, h2) = do
-          let player1 = Player h1 Cross
-          let player2 = Player h2 Circle
-          let game = Game player1 player2 (Right initialBoard)
-          sendMessage "Let the game begin" player1 
-          sendMessage "Let the game begin" player2 
+          let p1 = Player h1 Cross
+          let p2 = Player h2 Circle
+          let game = Game p1 p2 initialBoard
+          sendMessage (Message INFO "You're playing 'X'") p1
+          sendMessage (Message INFO "You're playing 'O'") p2
+          manageRound game
           return ()
 
+        manageRound :: Game -> IO () 
+        manageRound game = do
+          case checkWinnerPure $ board game of
+            Nothing -> print $ board game
+            Just p -> do
+              putStrLn $ "Player " ++ show p ++ " won the game"
+              handleGameOver game
+              return ()
+
+          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
+          (col, row) <- getPlayerChoice p
+          case mkChoice (col, row, marker p) $ board game of
+            Left msg -> do
+              putStrLn msg
+              sendMessage (Message INFO msg) p
+              manageRound game
+            Right b -> do
+              let newGame = updateBoard b game
+              manageRound newGame
+          return ()
+
+        getPlayerChoice :: Player -> IO (Int, Int)
+        getPlayerChoice p = do
+          col <- getPlayerInput p "column" 
+          putStrLn $ "did receive col: " ++ show col
+          row <- getPlayerInput p "row"
+          putStrLn $ "did receive row: " ++ show row
+          return (col, row)
+
+        getPlayerInput :: Player -> String -> IO Int
+        getPlayerInput p s = do
+          sendMessage (Message REQ_INPUT $ "Input " ++ s ++ ": ") p
+          inp <- hGetLine (handle p)
+          case readMaybe inp of
+            Nothing -> getPlayerInput p s
+            Just n -> return n
+
+        handleGameOver :: Game -> IO ()
+        handleGameOver game = do
+          hClose (handle $ player1 game)
+          hClose (handle $ player2 game)
+          return ()
 
 -- | Helpers
 
-sendMessage :: String -> Player -> IO ()
-sendMessage msg p = do
-  hPutStrLn (handle p) msg
-  hFlush (handle p)
+updateBoard :: Board -> Game -> Game
+updateBoard b g = Game (player1 g) (player2 g) b
+
+sendMessage :: Message -> Player -> IO ()
+sendMessage m p = do
+  hPrint (handle p) m 
+  putStrLn $ "did send message to client: " ++ show m
 
 toTuple :: [a] -> (a, a)
 toTuple (x:y:xs) = (x, y)
@@ -79,3 +145,16 @@ zipLeftover (x:xs) (y:ys) = zipLeftover xs ys
 
 lastN :: Int -> [a] -> [a]
 lastN n xs = zipLeftover (drop n xs) xs
+
+isPrefix :: String -> String -> Bool
+isPrefix [] _ = True
+isPrefix _ [] = False
+isPrefix (p:ps) (x:xs)
+  | p == x    = isPrefix ps xs
+  | otherwise = False
+
+stringToMsg :: String -> Message
+stringToMsg s 
+    | isPrefix "INFO" s = Message INFO (drop 5 s)
+    | isPrefix "REQ_INPUT" s = Message REQ_INPUT (drop 10 s)
+

TicTacToe.hs

@@ -37,6 +37,7 @@ initialBoard = let initialRows = replicate 3 (RowCons Empty Empty Empty)
                  in case boardFromRows initialRows of
                     (Right b) -> b
 
+
 boardFromRows :: [Row] -> BoardOrMsg
 boardFromRows rows
   | length rows /= 3 = Left ("Not the right number of rows: " ++ show (length rows))

test.hs

@@ -0,0 +1,7 @@
+
+
+main = do
+  putStr "Input: "
+  x <- getLine
+  putStrLn $ "Input was: " ++ x
+  return ()