As the final part of this blogging series I will put myself to the test using a coding challenge. I am really glad that I have been prepared to do this challenge.
Give me six hours to chop down a tree and I will spend the first four sharpening the axe. Abraham Lincoln
The first thing we need to do in order to achieve this challenge is defining some types:
data Move = O | X
deriving (Eq, Show, Enum, Ord)
type Position = (Char, Int)
data BoardMove = BoardMove
{ bMove :: Maybe Move, bPos :: Position }
deriving (Eq, Show)
type Board = [BoardMove]
type InvalidMove = StringTo start the game we will make a main method like this:
main :: IO ()
main = do
putStrLn "Starting game..."
putStrLn "Type quit to exit the game."
let newBoard = empty 3
in do (putStrLn . (\s->"\n"++s++"\n") . printBoard) newBoard
gameExecution Nothing newBoardAfter that we code the game to make it work:
coord = (['A'..], [1..])
empty :: Int -> Board
empty size = do
x <- take size (fst coord)
y <- take size (snd coord)
return $ BoardMove Nothing (x,y)
printBoard :: Board -> String
printBoard b = intercalate "\n" $
map (\row-> [(fst . bPos) (row !! 0)] ++ "] | " ++
(intercalate " | "
$ map (\bm-> maybe " " show $ bMove bm) row)
++ " |")
(cut 3 b)
cut :: Int -> [a] -> [[a]]
cut n [] = []
cut n xs = take n xs : cut n (drop n xs)
gameExecution prevMove board = do
let currPlayer = maybe X (\(BoardMove mv _) ->
case mv of
Just X -> O
Just O -> X) prevMove
putStr $ "Player '" ++ (show currPlayer) ++ "': "
hFlush stdout
playerMove <- getLine
case (playerMove, (map toUpper playerMove) `elem` allCoord) of
("quit", _) ->
putStrLn "Thanks for playing, come again!"
(_, False) -> do
putStrLn $ "Possible options: " ++ intercalate ", " allCoord
gameExecution prevMove board
otherwise -> do
let pos = (toUpper $ playerMove !! 0,
read [(playerMove !! 1)] :: Int)
currMove = BoardMove (Just currPlayer) pos
currBoard = move currMove board
either putStrLn (putStrLn . (\s->"\n"++s++"\n") . printBoard) currBoard
case currBoard of
Right r -> if win currMove r
then do putStrLn $ "Player '"
++ (show currPlayer) ++"' wins!"
main
else if draw currMove r
then do putStrLn $ "It's a draw!"
main
else gameExecution (Just currMove) r
Left err -> gameExecution prevMove board
where allCoord = [[x] ++ show y | x <- take 3 (fst coord),
y <- take 3 (snd coord)]
move :: BoardMove -> Board -> Either InvalidMove Board
move (BoardMove _ (c,r)) [] =
Left $ "Could not make the move to given position " ++ [c] ++ (show r)
move bm@(BoardMove nmov npos) (x:xs)
| findMove x = Right $ bm:xs
| otherwise =
case move bm xs of
Right r -> Right $ x:r
err -> err
where findMove (BoardMove m p) =
p == npos && isNothing m && nmov /= Nothing
draw :: BoardMove -> Board -> Bool
draw bm b = not (any (isNothing . bMove) b)
&& not (win bm b)
win :: BoardMove -> Board -> Bool
win (BoardMove Nothing _) _ = False
win (BoardMove m (c,r)) b = row || col || diag' cb || diag' (reverse cb)
where row = length
(filter (\(BoardMove m2 (_,r2)) ->
m2 == m && r2 == r) b) == 3
col = length
(filter (\(BoardMove m2 (c2,_)) ->
m2 == m && c2 == c) b) == 3
diag' xss = all (\(BoardMove m2 _) ->
m2 == m) $ diag xss
cb = cut 3 b
diag :: [[a]] -> [a]
diag xss = [xss !! n !! n | n <- [0 .. length xss - 1]]And now we will look at the results. Getting a draw:
*Main> main
Starting game...
Type quit to exit the game.
A] | | | |
B] | | | |
C] | | | |
Player 'X': A1
A] | X | | |
B] | | | |
C] | | | |
Player 'O': A2
A] | X | O | |
B] | | | |
C] | | | |
Player 'X': C3
A] | X | O | |
B] | | | |
C] | | | X |
Player 'O': B2
A] | X | O | |
B] | | O | |
C] | | | X |
Player 'X': C2
A] | X | O | |
B] | | O | |
C] | | X | X |
Player 'O': C1
A] | X | O | |
B] | | O | |
C] | O | X | X |
Player 'X': A3
A] | X | O | X |
B] | | O | |
C] | O | X | X |
Player 'O': B3
A] | X | O | X |
B] | | O | O |
C] | O | X | X |
Player 'X': B1
A] | X | O | X |
B] | X | O | O |
C] | O | X | X |
It's a draw!Winning:
Starting game...
Type quit to exit the game.
A] | | | |
B] | | | |
C] | | | |
Player 'X': C3
A] | | | |
B] | | | |
C] | | | X |
Player 'O': A1
A] | O | | |
B] | | | |
C] | | | X |
Player 'X': C1
A] | O | | |
B] | | | |
C] | X | | X |
Player 'O': C2
A] | O | | |
B] | | | |
C] | X | O | X |
Player 'X': A3
A] | O | | X |
B] | | | |
C] | X | O | X |
Player 'O': B2
A] | O | | X |
B] | | O | |
C] | X | O | X |
Player 'X': B3
A] | O | | X |
B] | | O | X |
C] | X | O | X |
Player 'X' wins!I feel like Haskell is a really hard language to learn if you only know Java (and C#), PHP and just a little more than the basics of Javascript. With a lot of help from the internet and the seven languages in seven weeks book I managed to make something out of learning this language, but I am sure I have still a lot to learn about it. It was a fun time to do programming with Haskell, because of the functional paradigm and the logical outputs. (once you get to know what the functions are supposed to do)
I will definitely keep on learning this language deeper to fully understand it and I will start to learn the other languages that are available in this book.