{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
module Game (Game (..), newGame, makeATurn, makeASolve, nextPlayerAlive) where
import Data.Aeson
import Data.Aeson.TH
import Word
import Player
import Data.List
import Data.Maybe
data Game = Game
{ gameId :: Int
, solution :: SolutionWord
, players :: [Player]
, isRunning :: Bool
, atTurn :: Player
, guesses :: String
} deriving (Eq, Show, Read)
instance ToJSON Game where
toJSON (Game gid solution players running atTurn guesses) = object
[ "gameID" .= gid
, "solution" .= showSolution solution
, "players" .= toJSON players
, "atTurn" .= toJSON atTurn
, "guesses" .= guesses
, "isRunning" .= running
]
newGame::
Int
-> String
-> Maybe Game
newGame gid word
| null word = Nothing
| otherwise =
let solution = createSolutionWord word
player = newPlayer 0
in Just $ Game gid solution [player] (isPlayable solution) player ""
makeATurn::
Player
-> Char
-> Game
-> (Game, Bool)
makeATurn p char g
| not (validTurn p char g) = (g, False)
| char `elem` guesses g = (playersMistake p char g, True)
| tryChar char $ solution g = (playersSuccess p char g, True)
| otherwise = (playersMistake p char g, True)
makeASolve::
Player
-> String
-> Game
-> (Game, Bool)
makeASolve p try g
| not (validTurn p ' ' g) = (g, False)
| fst $ solveWord try (solution g) = do
let solved = snd $ solveWord try (solution g)
(g {solution = solved, isRunning = False}, True)
| otherwise = do
let newPlayers = updatePlayers (killPlayer p) (players g)
(g {players = newPlayers, atTurn = nextPlayerAlive g}, False)
nextPlayerAlive::
Game
-> Player
nextPlayerAlive g =
let index = fromMaybe (-1) (findIndex (\p -> playerId p == playerId (atTurn g)) (players g) )
in head $ playersAlive ((\(a, b) -> b ++ a) (splitAt (index + 1) (players g )))
validTurn ::
Player
-> Char
-> Game
-> Bool
validTurn p _ g
| not $ isRunning g = False
| not $ isAlive p = False
| p /= atTurn g = False
| otherwise = True
trimPlayers::
Game
-> Game
trimPlayers g = Game (gameId g) (solution g) (filter isAlive (players g)) (isRunning g) (atTurn g) (guesses g)
updatePlayers::
Player
-> [Player]
-> [Player]
updatePlayers x = map (\c-> if playerId c == playerId x then x else c)
playersMistake ::
Player
-> Char
-> Game
-> Game
playersMistake p c g =
let newPlayers = updatePlayers (wrongGuess p) (players g);
newGuesses = if c `elem` guesses g then guesses g else guesses g ++ [c];
in let tmpGame = g {players= newPlayers, guesses= newGuesses}
in tmpGame {atTurn= nextPlayerAlive tmpGame}
playersSuccess ::
Player
-> Char
-> Game
-> Game
playersSuccess p c g =
let newSolution = solveChar c (solution g)
in g {solution= newSolution, isRunning= isPlayable newSolution, atTurn= nextPlayerAlive g, guesses= guesses g ++ [c] }