Tic Tac Toe game in haskell follow up

Question

This is a follow-up question of this one: Tic Tac Toe game in Haskell

I have revised my code. How does it look now?

import System.Random (randomRIO)
import System.IO (hFlush, stdout, getLine)
import Data.List (intercalate)
import Data.Array

data Tile   = EmptyTile | X | O deriving (Eq)
data Player = Player1 | Player2

showTile :: Tile -> String
showTile EmptyTile = " "
showTile X         = "X"
showTile O         = "O"

showBoard :: Board -> String
showBoard b = let bstr = fmap showTile b
                  blist = boardAsList bstr
              in  unlines [intercalate "|" row | row <- blist]
              where
                boardAsList b = [[b!(x,y) | y <- [1,2,3]] | x <- [1,2,3]]

type Board = Array (Int,Int) Tile

emptyBoard :: Board
emptyBoard = array ((1,1),(3,3)) [((x,y), EmptyTile) | x <- [1,2,3], y <- [1,2,3]]

put :: Board -> Tile -> Int -> Int -> Maybe Board
put b t x y = case b!(x,y) of
                EmptyTile -> Just (b // [((x,y), t)])
                _         -> Nothing

p1wins, p2wins :: Board -> Bool
p1wins b = tileWins b X
p2wins b = tileWins b O

tileWins :: Board -> Tile -> Bool
tileWins b t = 
   any (\row -> all (\col -> b!(row,col) == t) [1..3]) [1..3] ||
   any (\col -> all (\row -> b!(row,col) == t) [1..3]) [1..3] ||
   all (\rc -> b!(rc,rc) == t) [1..3] ||
   all (\rc -> b!(rc,4-rc) == t) [1..3]

checkFull :: Board -> Bool
checkFull b = all (\row -> all (\col -> b!(row, col) /= EmptyTile) [1..3]) [1..3]

compMove :: Board -> IO (Board)
compMove b = do
    (row, col) <- getRandomEmpty b
    let (Just b') = put b O row col
    return b'

getRandomEmpty :: Board -> IO (Int, Int)
getRandomEmpty b = do
    col <- randomRIO (1,3)
    row <- randomRIO (1,3)
    case b!(row, col) of
        EmptyTile -> return (row, col)
        _         -> getRandomEmpty b

prompt :: String -> IO String
prompt s = do
    putStr s
    hFlush stdout
    getLine

showTileNumbers :: String
showTileNumbers  = (unlines
                   [intercalate "|" ["(" ++ show x ++ "," ++ show y ++ ")" |
                   y <- [1,2,3]] | x <- [1,2,3]])

main :: IO ()
main = do
    putStrLn "This is classic tic tac toe game."
    putStrLn "In order to play, you need to put a number between 0 and 8"
    putStrLn "This table shows tile numbers"
    putStrLn showTileNumbers
    putStrLn $ showBoard emptyBoard
    playTurn emptyBoard Player1
    where
        playTurn b Player1 = do
            row <- prompt "Row: "
            col <- prompt "Col: "
            let newboard = put b X (read row) (read col)
            case newboard of
                Nothing -> do
                            putStrLn "Invalid move."
                            playTurn b Player1
                Just b' -> if p1wins b' then
                                putStrLn "You win"
                            else
                                playTurnIfNotTie b' Player2
        playTurn b Player2 = do
            b' <- compMove b
            putStrLn $ showBoard b'
            if p2wins b' then
                putStrLn "You Lose!"
            else
                playTurnIfNotTie b' Player1

        playTurnIfNotTie b p = if checkFull b then
                                  putStrLn "Tie."
                               else
                                  playTurn b p

Answer 1

With the new board representation, the brute-force pattern matching is gone, which is good. Still, I personally prefer the 1–9 numbering for simpler user interface — perhaps a translation function could be implemented. Note that you forgot to adjust the introductory message for the new coordinate system.

Instead of the showTile function, you should use the standard Show typeclass:

instance Show Tile where
    show EmptyTile = " "
    show X         = "X"
    show O         = "O"

In showBoard you used both let … in and where. Pick one or the other (I prefer where).

As mentioned in my previous answer, all of your functions that accept a Board should place the board parameter last, since the board is what they all operate on. With tileWins :: Tile -> Board, for example, you can define p1wins = tileWins X using the point-free style.

data Player = Player1 | Player2 isn't doing anything useful for you. You are hard-coding the Player1 ↔︎ X and the Player2 ↔︎ O correspondence all over the place, in main, p1wins, p2wins, and compMove.

With this second version, then, I would say that the greatest improvement can be made in handling the two players. Here is my suggestion:

humanTurn :: Tile -> Board -> IO Board
humanTurn t b = do
    putStrLn $ showBoard b
    move
    where
        move = do
            row <- prompt "Row: "
            col <- prompt "Col: "
            let newboard = put b t (read row) (read col)
            case newboard of
                Nothing -> do
                            putStrLn "Invalid move."
                            move
                Just b' -> return b'

computerTurn :: Tile -> Board -> IO Board
computerTurn t b = do
    (row, col) <- getRandomEmpty b 
    let (Just b') = put b t row col
    return b'

main :: IO ()
main = do
    putStrLn "This is the classic tic tac toe game."
    putStrLn "Enter the coordinates for each move according to this scheme:"
    putStrLn showTileNumbers
    play player1 player2 emptyBoard
    where
        player1 = (X, humanTurn, "You win!")
        player2 = (O, computerTurn, "You lose.")
        play p@(tile, turn, winMsg) p' b = do
            b' <- turn tile b
            if tileWins tile b' then do
                putStrLn $ showBoard b'
                putStrLn winMsg
            else if checkFull b' then do
                putStrLn $ showBoard b'
                putStrLn "Tie."
            else
                play p' p b'

This turns main into a leaner state machine. As evidence of the superiority of this design, observe that you can make a human-vs.-human game simply by changing two lines to…

       player1 = (X, humanTurn, "X wins.")
       player2 = (O, humanTurn, "O wins.")