4
\$\begingroup\$

I want to get better at functional programming so I started with this simple 2-player TicTacToe game. Next I want to add a simple min-max algorithm to make it a 1-player game, but before that I'd like to get some feedback on this program. I tried to follow the FP ideology, but I may have done some things the imperative way, or just made some functions inefficient. I would greatly appreciate any comments.

import Data.Char
import Data.Either
import Data.List
import Data.Maybe

data Player = O | X deriving (Eq, Show)
data Move = Move Int Player deriving (Eq, Show)

instance Ord Move where
    (Move i1 _) `compare` (Move i2 _) = i1 `compare` i2

type Board = [Move]

showBoard :: Board -> String
showBoard board = intercalate "\n" $ intersperse "--+---+--" $ map showRow (segment 3 $ fillBoard board [1..9])
    where showRow b = intercalate " | " (map toChar b)
          toChar (Left i)           = show i
          toChar (Right (Move _ p)) = show p
          
segment :: Int -> [a] -> [[a]]
segment n [] = []
segment n xs = take n xs : segment n (drop n xs)

fillBoard :: Board -> [Int] -> [Either Int Move]
fillBoard [] xs = map Left xs
fillBoard b@(m@(Move i p):ms) (x:xs) | i >  x    = Left x : fillBoard b xs
                                     | i == x    = Right m : fillBoard ms xs
                                     | otherwise = error "Impossible state"

moveLegal :: Board -> Int -> Bool
moveLegal [] _ = True
moveLegal ((Move i' _ ):ms) i = (i /= i') && moveLegal ms i

makeMove :: Board -> Int -> Board
makeMove board pos = sort $ Move pos (nextPlayer board) : board

gameOver :: Board -> Bool
gameOver board = length board == 9 || isJust (hasWinner board)

nextPlayer :: Board -> Player
nextPlayer [] = O
nextPlayer (m:ms) = if nextPlayer ms == O then X else O

hasWinner :: Board -> Maybe Player
hasWinner board | winnerO board = Just O
                | winnerX board = Just X
                | otherwise     = Nothing

getPositions :: Board -> Player -> [Int]
getPositions board p = map (\(Move i _) -> i) $ filter (filterByPlayer p) board
    where filterByPlayer player (Move _ p) = p == player

winnerO board = containsLine $ getPositions board O
winnerX board = containsLine $ getPositions board X

containsLine :: [Int] -> Bool
containsLine ps = any (containsAll ps) Main.lines

{- HLINT ignore -}
containsAll :: (Eq a) => [a] -> [a] -> Bool
containsAll as     [] = True
containsAll as (b:bs) = b `elem` as && containsAll as bs

-- Every possible winning line
lines :: [[Int]]
lines = [[1,2,3],
         [4,5,6],
         [7,8,9],
         [1,4,7],
         [2,5,8],
         [3,6,9],
         [1,5,9],
         [3,5,7]]


doTurn :: Board -> IO ()
doTurn board = do
    putStrLn $ showBoard board
    if gameOver board then
        case hasWinner board of
            Nothing -> putStrLn "Draw"
            Just w -> putStrLn $ show w ++ " wins"
    else do
        inp <- getLine
        let pos = read inp
        if not (moveLegal board pos) then do
            putStrLn "Illegal move, please try again"
            doTurn board
        else
            doTurn (makeMove board pos)

main :: IO ()
main = doTurn []
New contributor
Peter is a new contributor to this site. Take care in asking for clarification, commenting, and answering. Check out our Code of Conduct.
\$\endgroup\$

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.