module Main where

import System.Random
import Data.List (intercalate, find, minimumBy)
import System.Environment (getArgs)
import Data.Char (digitToInt)
import Data.Maybe (listToMaybe, mapMaybe)
import Control.Monad (guard)
import Data.Ord (comparing)

-- check if there is a horizontal, vertical or diagonal line of
-- X or O
tictactoe :: String -> Bool
tictactoe a = tictactoeFor 'X' a /= tictactoeFor 'O' a

-- check if there is a horizontal, vertical or diagonal line
-- for the given player "n"
tictactoeFor :: Char -> String -> Bool
tictactoeFor n [a,b,c,d,e,f,g,h,i] =
    [n,n,n] `elem` [[a,b,c],[d,e,f],[g,h,i],[a,d,g],
                    [b,e,h],[c,f,i],[a,e,i],[c,e,g]]

-- empty game board
start :: String
start = "         "

-- check if there is an X or an O at the given position
isPossible :: Int -> String -> Bool
isPossible n game = (game !! n) `notElem` "XO"

-- try to place an X or an O at a given position.
-- "Right" + modified board means success, "Left" + unmodified board
-- means failure
place :: Int -> Char -> String -> Either String String
place i c game =
    if isPossible i game
    then Right $ take i game ++ [c] ++ drop (i + 1) game
    else Left game

-- COMPUTER AI
-- get the number of movements, starting from a given non-empty board
-- and a position for the next movement, until the specified player
-- wins or no movement is possible
-- the positions are chosen sequentially, so there's not much
-- intelligence here anyway
developGame :: Bool -> Int -> Int -> Char -> String -> (Int, Char, String)
developGame iterateMore moves i player game
    | i > 8 =
        -- if i arrives to the last position, iterate again from 0
        -- but do it only once
        if iterateMore
        then developGame False moves 0 player game
        -- draw game (after one iteration, still no winning moves)
        else (moves, player, game)
        -- draw game (game board full) or a win for the player
    | moves == 9 || tictactoeFor player game = (moves, player, game)
        -- make a move, if possible, and continue playing
    | otherwise = case place i otherPlayer game of
        -- position i is not empty. try with the next position
        Left _ -> developGame iterateMore moves (i + 1)
                    otherPlayer game
        -- position i was empty, so it was a valid move.
        -- change the player and make a new move, starting at pos 0
        Right newGame -> developGame iterateMore (moves + 1) 0
                    otherPlayer newGame
        where
            otherPlayer = changePlayer player

-- COMPUTER AI
-- starting from a given non-empty board, try to guess which position
-- could lead the player to the fastest victory.
bestMoveFor :: Char -> String -> Int
bestMoveFor player game = bestMove
    where
        -- drive the game to its end for each starting position
        continuations = [ (x, developGame True 0 x player game) |
            x <- [0..8] ]
        -- compare the number of moves of the game and take the
        -- shortest one
        move (_, (m, _, _)) = m
        (bestMove, _) = minimumBy (comparing move) continuations

-- canBlock checks if the opponent has two pieces in a row and the
-- other cell in the row is empty, and places the player's piece there,
-- blocking the opponent
canBlock :: Char -> String -> Maybe Int
canBlock p [a,b,c,d,e,f,g,h,i] =
    listToMaybe $ mapMaybe blockable [[a,b,c],[d,e,f],[g,h,i],[a,d,g],
                                      [b,e,h],[c,f,i],[a,e,i],[c,e,g]]
    where
        blockable xs = do
          guard $ length (filter (== otherPlayer) xs) == 2
          x <- find (`elem` "123456789") xs
          return $ digitToInt x
        otherPlayer = changePlayer p

-- format a game board for on-screen printing
showGame :: String -> String
showGame [a,b,c,d,e,f,g,h,i] =
    topBottom ++
    "|    | 1 | 2 | 3 |\n" ++
    topBottom ++
    row "0" [[a],[b],[c]] ++
    row "3" [[d],[e],[f]] ++
    row "6" [[g],[h],[i]]
    where
        topBottom = "+----+---+---+---+\n"
        row n x = "| " ++ n ++ "+ | " ++
            intercalate " | " x ++ " |\n" ++ topBottom

-- ask the user to press a numeric key and convert it to an int
enterNumber :: IO Int
enterNumber = do
    c <- getChar
    if c `elem` "123456789"
    then do
        putStrLn ""
        return $ digitToInt c
    else do
        putStrLn "\nPlease enter a digit!"
        enterNumber

-- a human player's turn: get the number of pieces put on the board,
-- the next piece to be put (X or O) and a game board, and return
-- a new game state, checking if the piece can be placed on the board.
-- if it can't, make the user try again.
turn :: (Int, Char, String) -> IO (Int, Char, String)
turn (count, player, game) = do
    putStr $ "Please tell me where you want to put an " ++
        [player] ++ ": "
    pos <- enterNumber
    case place (pos - 1) player game of
        Left oldGame -> do
            putStrLn "That place is already taken!\n"
            turn (count, player, oldGame)
        Right newGame ->
            return (count + 1, changePlayer player, newGame)

-- alternate between X and O players
changePlayer :: Char -> Char
changePlayer 'O' = 'X'
changePlayer 'X' = 'O'

-- COMPUTER AI
-- make an automatic turn, placing an X or an O game board.
-- the first movement is always random.
-- first, the computer looks for two pieces of his opponent in a row
-- and tries to block.
-- otherwise, it tries to guess the best position for the next movement.
-- as a last resort, it places a piece randomly.
autoTurn :: Bool -> (Int, Char, String) -> IO (Int, Char, String)
autoTurn forceRandom (count, player, game) = do
    -- try a random position 'cause everything else failed
    -- count == 0 overrides the value of forceRandom
    i <- if count == 0 || forceRandom
            then randomRIO (0,8)
            else return $
                case canBlock player game of
                    -- opponent can't be blocked. try to guess
                    -- the best movement
                    Nothing -> bestMoveFor player game
                    -- opponent can be blocked, so just do it!
                    Just blockPos -> blockPos
    -- if trying to place a piece at a calculated position doesn't work,
    -- just try again with a random value
    case place i player game of
        Left oldGame -> autoTurn True (count, player, oldGame)
        Right newGame -> do
            putStrLn $ "It's player " ++ [player] ++ "'s turn."
            return (count + 1, changePlayer player, newGame)

-- play a game until someone wins or the board becomes full.
-- depending on the value of the variable "auto", ask the user(s) to
-- put some pieces on the board or do it automatically
play :: Int -> (Int, Char, String) -> IO ()
play auto cpg@(_, player, game) = do
    newcpg@(newCount, newPlayer, newGame) <- case auto of
        -- if both players are human, always ask them
        0 -> turn cpg
        -- if both players are computer, always play auto
        1 -> autoTurn False cpg
        -- X is computer, O is human
        2 -> if player == 'X' then autoTurn False cpg else turn cpg
        -- X is human, O is computer
        3 -> if player == 'O' then autoTurn False cpg else turn cpg
    putStrLn $ "\n" ++ showGame newGame
    if tictactoe newGame
    then putStrLn $ "Player " ++ [changePlayer newPlayer] ++ " wins!\n"
    else
        if newCount == 9
        then putStrLn "Draw!\n"
        else play auto newcpg

-- main program: greet the user, ask for a game type, ask for the
-- player that'll start the game, and play the game beginning with an
-- empty board
main :: IO ()
main = do
    a <- getArgs
    if null a
    then usage
    else do
        let option = head a
        if option `elem` ["0","1","2","3"]
        then do
            putStrLn $ "\n" ++ showGame start
            let m = read option :: Int
            play m (0, 'X', start)
        else usage

usage :: IO ()
usage = do
    putStrLn "TIC-TAC-TOE GAME\n================\n"
    putStrLn "How do you want to play?"
    putStrLn "Run the program with one of the following options."
    putStrLn "0 : both players are human"
    putStrLn "1 : both players are computer"
    putStrLn "2 : player X is computer and player O is human"
    putStrLn "3 : player X is human and player O is computer"
    putStrLn "Player X always begins."