client.hs

import Prelude hiding (catch)
import Network
import Network.Socket
import System.IO
import Control.Exception
import Control.Concurrent

main :: IO ()
main = withSocketsDo $ do
  addrInfos <- getAddrInfo Nothing (Just "localhost") (Just "1337")
  s <- socket (addrFamily (head addrInfos)) Stream defaultProtocol
  connect s (addrAddress (head addrInfos))
  h <- socketToHandle s ReadWriteMode
  hSetBuffering h NoBuffering
  threadID <- forkIO $ writeTo h
  readFrom h `catch` disconnected ` finally` disconnect h threadID

disconnected = \ex -> do
  let err = show (ex :: IOException)
  putStrLn "Server has closed the connection."

disconnect h threadID = do
  hClose h
  killThread threadID

readFrom h = do
  s <- hGetContents h
  putStr s
  readFrom h

writeTo h = do
  s <- getLine
  hPutStrLn h s
  writeTo h

server.hs

import Network
import System.IO
import Control.Concurrent
import System.Random
import Data.List

main :: IO ()
main = withSocketsDo $ do
  sock <- listenOn $ PortNumber 1337
  putStrLn $ "Listening on " ++ show 1337
  sockHandler sock

sockHandler :: Socket -> IO ()
sockHandler sock = do
  (handle, _, _) <- accept sock
  hSetBuffering handle NoBuffering
  forkIO $ startGame handle
  sockHandler sock

startGame :: Handle -> IO ()
startGame handle = do
  number <- makeNumber
  commandProcessor handle number


commandProcessor :: Handle -> String -> IO ()
commandProcessor handle hidden_number = do
  word <- hGetLine handle
  if word == "quit"
  then do
    hClose handle
    return ()
  else do
    let cows = length $ intersect word hidden_number
    let bulls = foldl (+) 0 (zipWith (\x y -> if x == y then 1 else 0) word hidden_number)
    if bulls == 4
    then do
      hPutStrLn handle "You Win!"
      hClose handle
    else do
      hPutStrLn handle $ "Cows:" ++ (show cows) ++ " Bulls:" ++ (show bulls)
      commandProcessor handle hidden_number

shuffle :: String -> IO (String)
shuffle str = moveLetter str (length str)
  where
    moveLetter str times = do
      index <- randomRIO (0, length str - 1)
      let sym = str !! index
      let new_str = (take index str) ++ (drop (index + 1) str) ++ [sym]
      if times > 0
      then moveLetter new_str (times - 1)
      else return new_str

makeNumber = do
  number <- shuffle ['1'..'9']
  return $ take 4 number