2
\$\begingroup\$

I decided to take a more general approach while implementing the TicTacToe game in Haskell.

Util

module Data.List.Utils where 

import Data.List (intersperse)

surround :: a -> [a] -> [a]
surround x ys = x : intersperse x ys ++ [x]

nth :: Int -> (a -> a) -> [a] -> [a]
nth _ _ [] = []
nth 0 f (x:xs) = f x : xs
nth n f (x:xs) = x : nth (n - 1) f xs

TicTacToe

module TicTacToe where

import Data.List (transpose)
import Data.Foldable (asum)
import Data.List.Utils (surround, nth)

data Tile = O | X | Empty deriving (Eq)

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

-- ======================
-- Board Helper Functions
-- ======================
type Board = [[ Tile ]]

showBoard :: Board -> String
showBoard xss = unlines
             . surround vtx
             . map (concat . surround mid . map show)
             $ xss

    where mid = "|"
          vtx = surround '+' $ replicate (length xss) '-'                   

whoWon :: Board -> Maybe Player
whoWon xss = asum
           . map winner
           $ diag : anti : cols ++ xss

    where cols = transpose xss
          diag = zipWith (!!) xss           [0..]
          anti = zipWith (!!) (reverse xss) [0..]

          winner (x:xs) = if all (==x) xs && x /= Empty
                              then Just (toPlayer x)
                              else Nothing

getCoords :: Int -> Board -> (Int, Int)
getCoords n = divMod (n - 1) . length

fillTile :: Board -> Int -> Tile -> Board
fillTile xss n tile = nth row (nth col (const tile)) xss

    where (row, col) = getCoords n xss

isOver :: Board -> Bool
isOver = all (notElem Empty)

-- ========================
-- Player related functions
-- ========================
data Player = Player1 | Player2 deriving (Eq)

instance Show Player where
    show Player1 = "1st Player"
    show Player2 = "2nd Player"

toPlayer :: Tile -> Player
toPlayer X = Player1
toPlayer O = Player2

fromPlayer :: Player -> Tile
fromPlayer Player1 = X
fromPlayer Player2 = O

changePlayer :: Player -> Player
changePlayer Player1 = Player2
changePlayer Player2 = Player1

-- ====================
-- Game logic functions
-- ====================
validateInput :: Board -> String -> Either String Int
validateInput xss s  = case reads s of 

    [(n, "")] -> check n
    _         -> Left "Only integers allowed"

    where check n

            | n < 1 || n > length xss ^ 2 = Left "Out of range"
            | xss !! row !! col /= Empty  = Left "Already filled"
            | otherwise                   = Right n

            where (row, col) = getCoords n xss

askInput :: Player -> Board -> IO ()
askInput player board = do

    putStrLn $ showBoard board
    putStrLn $ "Your turn, " ++ show player ++ "!"

    putStr $ "Tile number (1 - " ++ show (length board ^ 2) ++ "): "
    number <- getLine

    case validateInput board number of

        Left s  -> putStrLn ("Invalid input: " ++ s) >> gameStep player board

        Right n -> let tile = fromPlayer player
                       next = changePlayer player

                   in gameStep next (fillTile board n tile)

gameStep :: Player -> Board -> IO ()
gameStep player board = case whoWon board of

    Just winner -> do

        putStrLn $ showBoard board
        putStrLn $ show winner ++ " won!"

    Nothing | isOver board -> putStrLn "Game ended in a draw"
            | otherwise    -> askInput player board

startBoard :: Int -> Board
startBoard x = replicate x (replicate x Empty)

main :: IO ()
main = gameStep Player1 (startBoard 3) -- Change NxN
\$\endgroup\$
  • 3
    \$\begingroup\$ please, when editing a post, try not to change the source code or state which changes you have done. Writing an answer takes some time and it can quickly be out of phase and have no sense in the end ;-) \$\endgroup\$ – zigazou Aug 1 '15 at 18:14
4
\$\begingroup\$

Do you use the '-Wall' options of GHC ? It is quite handy, especially when there are non-exhaustive pattern matches in your (non-exhaustive pattern matches are bad ;-) )

TicTacToe.hs:84:41: Warning:
    Defaulting the following constraint(s) to type ‘Integer’
      (Num b0) arising from the literal ‘2’ at TicTacToe.hs:84:41
      (Integral b0) arising from a use of ‘^’ at TicTacToe.hs:84:39
    In the second argument of ‘(^)’, namely ‘2’
    In the second argument of ‘(>)’, namely ‘length xss ^ 2’
    In the second argument of ‘(||)’, namely ‘n > length xss ^ 2’

TicTacToe.hs:96:58: Warning:
    Defaulting the following constraint(s) to type ‘Integer’
      (Num b0) arising from the literal ‘2’ at TicTacToe.hs:96:58
      (Integral b0) arising from a use of ‘^’ at TicTacToe.hs:96:56
    In the second argument of ‘(^)’, namely ‘2’
    In the first argument of ‘show’, namely ‘(length board ^ 2)’
    In the first argument of ‘(++)’, namely ‘show (length board ^ 2)’

TicTacToe.hs:37:11: Warning:
    Pattern match(es) are non-exhaustive
    In an equation for ‘winner’: Patterns not matched: []

TicTacToe.hs:62:1: Warning:
    Pattern match(es) are non-exhaustive
    In an equation for ‘toPlayer’: Patterns not matched: Empty
Linking dist/build/TicTacToe/TicTacToe ...

Note: you can also feed your source code into hlint. It will sometimes be able to find some smarter ways to write code (though it won’t give you anything special in your case).

Util module

Concerning the Util module, unless you want to distribute it apart from your project, it should not be placed in Data.Utils.

The nth function can be written using splitAt:

nth :: Int -> (a -> a) -> [a] -> [a]
nth i f l = case splitAt i l of
                (start, elm:end) -> start ++ [f elm] ++ end
                _                -> []

That way, just reading the code makes it clear the nth function applies a function to the nth element of a list.

TicTacToe

You still have problems with putStr and the buffering of ouput. You should put a hFlush stdout right after your putStr call (imported from System.IO). Here’s my terminal:

Turn: Player 1
1
Tile number (1-9): +-+-+-+
|X| | |
+-+-+-+
| | | |
+-+-+-+
| | | |
+-+-+-+

Turn: Player 2
2
Tile number (1-9): +-+-+-+
|X|O| |
+-+-+-+
| | | |
+-+-+-+
| | | |
+-+-+-+

You have placed validateInput and askInput in the "Game logic functions" block though they obviously are UI related.

In validateInput:

  • "Only integers allowed" is a message that must be generated by the user interface since it converts a String to an Int (this has no direct link to the game and could be reused in other programs)
  • "Out of range" and "Already filled" are messages that must be generated by the game itself

Note: as the error messages themselves are related to the user interface, the functions should not return them in plain english. One way to do this is to create a type : data ValidateError = OutOfRange | AlreadyFilled | OnlyInteger deriving (Eq) (or a class of types for more advanced error handling). With this, your functions do not deal with translation problems or with representation (an error could also be represented by a sound, an animation or a graphic).

You have a mutual recursion between askInput and gameStep. askInput should not call gameStep. askInput should just do one thing: ask the player a value and return it, nothing else. askInput also decides which player will play. Again, it is not its role. Try to apply the Single responsibility principle.

\$\endgroup\$
  • \$\begingroup\$ In my terminal, it prints fine. What might be the problem? \$\endgroup\$ – Afonso Matos Aug 1 '15 at 19:04
  • \$\begingroup\$ you probably run your program with runhaskell. The output buffering between runhaskell and a compiled Haskell program are not the same. Even for small program, try to create a Cabal project. \$\endgroup\$ – zigazou Aug 1 '15 at 19:09
  • 1
    \$\begingroup\$ Note: you can also use -Wall with runhaskell like this → runhaskell -Wall TicTacToe.hs \$\endgroup\$ – zigazou Aug 1 '15 at 19:11
  • \$\begingroup\$ When I use -Wall I get some default contraint warnings. To solve the first one I do ` ^ (2 :: Integer)`, but this is really annoying. Is it necessary / good practice ? \$\endgroup\$ – Afonso Matos Aug 1 '15 at 19:26
  • 1
    \$\begingroup\$ I used hSetBuffering stdout NoBuffering to fix the awkard printing. Is this ok? \$\endgroup\$ – Afonso Matos Aug 1 '15 at 21:22

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.