6
\$\begingroup\$

I wrote a simple tic-tac-toe program in Haskell. It runs on the command line, has a one and two player mode, and implements a minimax algorithm when you play against it.

I'm used to writing proper code in OO languages, but Haskell is new to me. This code works reasonably well, but seems hard to read (even to me!). Any suggestions on how to make this code more...Haskellian?

import Data.List
import Data.Char
import Data.Maybe
import Control.Monad

data Square = A | B | C | D | E | F | G | H | I | X | O deriving (Read, Eq, Ord)
instance Show Square where
   show A = "a" 
   show B = "b" 
   show C = "c" 
   show D = "d" 
   show E = "e" 
   show F = "f" 
   show G = "g" 
   show H = "h" 
   show I = "i" 
   show X = "X" 
   show O = "O"
type Row = [Square]
type Board = [Row]
data Player = PX | PO deriving (Read, Eq)
instance Show Player where
   show PX = "Player X"
   show PO = "Player O"
data Result = XWin | Tie | OWin deriving (Read, Show, Eq, Ord) 

main :: IO ()
main = do
    putStrLn "Let's play some tic tac toe!!!"
    putStrLn "Yeeeaaaaaahh!!!"
    gameSelect

gameSelect :: IO ()
gameSelect = do
    putStrLn "Who gonna play, one playa or two??? (Enter 1 or 2)"
    gameMode <- getLine
    case gameMode of "1" -> onePlayerMode
                     "2" -> twoPlayerMode
                     gameMode -> gameSelect
    where onePlayerMode = do
             putStrLn "One playa"
             putStrLn "Cool!  Get ready to play...AGAINST MY INVINCIBLE TIC TAC TOE AI!!!!! HAHAHAHA!!!"
             gameLoop 1 emptyBoard PX
          twoPlayerMode = do
             putStrLn "Two players"
             gameLoop 2 emptyBoard PX
          emptyBoard = [[A,B,C],[D,E,F],[G,H,I]]

gameLoop :: Int -> Board -> Player -> IO ()
gameLoop noOfPlayers board player = do
    case detectWin board of Just XWin -> endgame board XWin
                            Just OWin -> endgame board OWin
                            Just Tie -> endgame board Tie
                            Nothing -> if noOfPlayers == 1
                                       then if player == PX 
                                            then enterMove 1 board player 
                                            else enterBestMove board PO
                                       else enterMove 2 board player

enterMove :: Int -> Board -> Player -> IO () 
enterMove noOfPlayers board player = do
     displayBoard board
     if noOfPlayers == 1
     then do putStrLn ("Make your move. (A-I)")
     else do putStrLn (show player ++ ", it's your turn. (A-I)")
     move <- getLine
     print move
     if not $ move `elem` ["a","b","c","d","e","f","g","h","i"]
         then do
            putStrLn $ move ++ " is not a move, doofus"
            gameLoop noOfPlayers board player
         else if (read (map toUpper move) :: Square) `elem` [ sq | sq <- concat board]
            then do
               gameLoop noOfPlayers (newBoard (read (map toUpper move) :: Square) player board) (if player == PX then PO else PX)
            else do
               putStrLn "That square is already occupied"
               gameLoop noOfPlayers board player

enterBestMove :: Board -> Player -> IO ()
enterBestMove board player = gameLoop 1 (newBoard bestmove player board) PX
    where bestmove = fst $ findBestMove PO board
          findBestMove :: Player -> Board -> (Square, Result)
          findBestMove player board
            | player == PO = findMax results
            | player == PX = findMin results
            where findMin = foldl1 (\ acc x -> if snd x < snd acc then x else acc)
                  findMax = foldl1 (\ acc x -> if snd x > snd acc then x else acc)
                  results = [ (sq, getResult b) | (sq, b) <- boards player board ]
                  getResult b = if detectWin b == Nothing 
                                then snd (findBestMove (if player == PX then PO else PX) b) 
                                else fromJust $ detectWin b
                  boards :: Player -> Board -> [(Square, Board)]
                  boards player board = [(sq, newBoard sq player board) | sq <- concat board, sq /= X, sq /=O]

displayBoard :: Board -> IO ()
displayBoard board = do
    mapM_ print board

newBoard :: Square -> Player -> Board -> Board
newBoard move player board = [ [if sq == move then mark else sq | sq <- row] | row <- board]
    where mark = if player == PX then X else O

detectWin :: Board -> (Maybe Result)
detectWin board
   | [X,X,X] `elem` board ++ transpose board = Just XWin
   | [X,X,X] `elem` [diagonal1 board, diagonal2 board] = Just XWin
   | [O,O,O] `elem` board ++ transpose board = Just OWin
   | [O,O,O] `elem` [diagonal1 board, diagonal2 board] = Just OWin
   | [X,X,X,X,X,O,O,O,O] == (sort $ concat board) = Just Tie
   | otherwise = Nothing
   where
     diagonal1 :: Board -> [Square]
     diagonal1 bs = bs!!0!!0 : bs!!1!!1 : bs!!2!!2 : []
     diagonal2 :: Board -> [Square]
     diagonal2 bs = bs!!0!!2 : bs!!1!!1 : bs!!2!!0 : []

endgame :: Board -> Result -> IO ()
endgame board result = do
    displayBoard board
    if result `elem` [XWin, OWin]
        then 
            let player = if result == XWin then PX else PO
            in do 
                putStrLn ("The game is over, and " ++ show player ++ " wins!")
                putStrLn ((if player == PX then show PO else show PX) ++ " is a loser lol")
        else do
            putStrLn "The game is a tie"
            putStrLn "You are both losers!  Ugh!"
    putStrLn "Want to play again? (y/n)"
    again <- getLine
    if again `elem` ["y", "Y", "yes", "Yes", "YES"] 
        then gameSelect 
        else do
            putStrLn "Goodbye"
\$\endgroup\$
6
\$\begingroup\$

Pure functions

The concept of a pure function is fundamental in Haskell, a pure function, like a Mathematical function given an input returns an output, with no change to the outside world.

Your code lacks readability because too many functions make too much contact with the outside world, in other words code in the IO() monad is too much.

Let me take endgame as a practical example:

endgame :: Board -> Result -> IO ()
endgame board result = do
    displayBoard board

    -- <section>
    if result `elem` [XWin, OWin]
        then 
            let player = if result == XWin then PX else PO
            in do 
                putStrLn ("The game is over, and " ++ show player ++ " wins!")
                putStrLn ((if player == PX then show PO else show PX) ++ " is a loser lol")
        else do
            putStrLn "The game is a tie"
            putStrLn "You are both losers!  Ugh!"

    -- </section>

    putStrLn "Want to play again? (y/n)"
    again <- getLine
    if again `elem` ["y", "Y", "yes", "Yes", "YES"] 
        then gameSelect 
        else do
            putStrLn "Goodbye"

All the code betweeen the section tags just prints a message, the action should be one putStrLn called over a pure function that decides what the output should be:

endgame :: Board -> Result -> IO ()
endgame board result = do
    displayBoard board

    putStrLn $ endgameMessage result

    putStrLn "Want to play again? (y/n)"
    again <- getLine
    if again `elem` ["y", "Y", "yes", "Yes", "YES"] 
        then gameSelect 
        else do
            putStrLn "Goodbye"

Where endgameMessage is pretty easy to define:

endgameMessage :: Result -> String
endgameMessage result
  | result `elem` [XWin, OWin] = winnerNotice ++ loserNotice
  | otherwise = "The game is a tie\n" ++ "You are both losers!  Ugh!"
  where
    player = if result == XWin then PX else PO
    winnerNotice = "The game is over, and " ++ show player ++ " wins!\n"
    loserNotice = (if player == PX then show PO else show PX) ++ " is a loser lol"

Other re-factoring (small functions)

otherPlayer

Actually I would refactor further to make the code even more evident:

otherPlayer PX = PO
otherPlayer PO = PX

And:

loserNotice = (show $ otherPlayer player) ++ " is a loser lol"

triplets

detectWin contained repetition and was not obvious at all, I reduced it to:

detectWin :: Board -> (Maybe Result)
detectWin board
   | [X,X,X] `elem` (triplets board) = Just XWin
   | [O,O,O] `elem` (triplets board) = Just OWin
   | [X,X,X,X,X,O,O,O,O] == (sort $ concat board) = Just Tie
   | otherwise = Nothing

Where triplets is simple (note that I flattened the board to extract the diagonals more easily):

triplets :: Board -> [[Square]]
triplets board = board ++ transpose board ++ [diagonal1] ++ [diagonal2]
  where
    flat = concat board
    diagonal1 = [flat !! 0, flat !! 4,flat !! 8]
    diagonal2 = [flat !! 2, flat !! 4,flat !! 6]

Do not be scared of tiny functions, they are an essential part of the Functional Programming principle.

Nitpicks

Useless list comprehension

[ sq | sq <- concat board] is exactly the same as (concat board), just more complicated.

Weird indentation

 if not $ move `elem` ["a","b","c","d","e","f","g","h","i"]
     then do
        putStrLn $ move ++ " is not a move, doofus"
        gameLoop noOfPlayers board player
     else if (read (map toUpper move) :: Square) `elem` [ sq | sq <- concat board]
        then do
           gameLoop noOfPlayers (newBoard (read (map toUpper move) :: Square) player board) (if player == PX then PO else PX)
        else do
           putStrLn "That square is already occupied"
           gameLoop noOfPlayers board player

Looks weird, just indent as in any other imperative language:

if not $ move `elem` ["a","b","c","d","e","f","g","h","i"] then do
  putStrLn $ move ++ " is not a move, doofus"
  gameLoop noOfPlayers board player
else if (read (map toUpper move) :: Square) `elem` [ sq | sq <- concat board] then do
  gameLoop noOfPlayers (newBoard (read (map toUpper move) :: Square) player board) (if player == PX then PO else PX)
else do
  putStrLn "That square is already occupied"
  gameLoop noOfPlayers board player

Do not repeat the type

 diagonal1 :: Board -> [Square]
 diagonal1 bs = bs!!0!!0 : bs!!1!!1 : bs!!2!!2 : []
 diagonal2 :: Board -> [Square]
 diagonal2 bs = bs!!0!!2 : bs!!1!!1 : bs!!2!!0 : []

Becomes:

 diagonal1, diagonal2 :: Board -> [Square]
 diagonal1 bs = bs!!0!!0 : bs!!1!!1 : bs!!2!!2 : []
 diagonal2 bs = bs!!0!!2 : bs!!1!!1 : bs!!2!!0 : []

It is clearly better to avoid repeating an identical type signature twice.

case in gameloop

You had repetition in:

case detectWin board of Just XWin -> endgame board XWin
                        Just OWin -> endgame board OWin
                        Just Tie -> endgame board Tie

That you can simplify as:

case detectWin board of
    Just x -> endgame board x;

_ stands for anything else as a convention

case gameMode of "1" -> onePlayerMode
                 "2" -> twoPlayerMode
                 gameMode -> gameSelect

Where gameMode stands for anything else, becomes:

case gameMode of "1" -> onePlayerMode
                 "2" -> twoPlayerMode
                 _ -> gameSelect

As a convention.

\$\endgroup\$
  • 1
    \$\begingroup\$ Very thorough, this is definitely going to be integrated into my Haskell skills. Great work! \$\endgroup\$ – Mark Karavan Jan 8 '16 at 1:59
  • \$\begingroup\$ why is extracting endGameMessage (a function that only gets called once) better form than writing it inline? In imperative coding, there's no sense in doing method extraction on code that you only use once, so I'm trying to understand why functional programming emphasizes it. Also, is there a rule of thumb as to what depth you should perform these extractions? (i.e. a function shouldn't be longer than n lines) (I realize much of this is subjective, I just really what to understand where the style comes from) \$\endgroup\$ – Mark Karavan Jan 8 '16 at 20:16
  • 1
    \$\begingroup\$ @MarkKaravan your question has no clear-cut answer. Imperative programming is fundamentally different from a Functional Programming. They are as similar as a Turing Machine and Lambda Calculus, using concepts from one won't work in the other. An example of the importance of functions in, well, Functional Programming: haskell.org/tutorial/functions.html \$\endgroup\$ – Caridorc Jan 8 '16 at 21:13
  • \$\begingroup\$ @MarkKaravan In imperative programming, there is a lot of sense to extract methods that are only called once, see Is it OK to split long functions and methods into smaller ones even though they won't be called by anything else? and its duplicates \$\endgroup\$ – Franky Jan 14 '16 at 14:32

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.