Command.hs

{-|
Module      : Game.Werewolf.Test.Command
Copyright   : (c) Henry J. Wylde, 2015
License     : BSD3
Maintainer  : public@hjwylde.com
-}

{-# OPTIONS_HADDOCK hide, prune #-}

module Game.Werewolf.Test.Command (
    -- * devourVoteCommand
    prop_devourVoteCommandErrorsWhenGameIsOver, prop_devourVoteCommandErrorsWhenCallerDoesNotExist,
    prop_devourVoteCommandErrorsWhenTargetDoesNotExist,
    prop_devourVoteCommandErrorsWhenCallerIsDead, prop_devourVoteCommandErrorsWhenTargetIsDead,
    prop_devourVoteCommandErrorsWhenNotWerewolvesTurn,
    prop_devourVoteCommandErrorsWhenCallerNotWerewolf,
    prop_devourVoteCommandErrorsWhenCallerHasVoted, prop_devourVoteCommandErrorsWhenTargetWerewolf,
    prop_devourVoteCommandUpdatesVotes,

    -- * healCommand
    prop_healCommandErrorsWhenGameIsOver, prop_healCommandErrorsWhenCallerDoesNotExist,
    prop_healCommandErrorsWhenCallerIsDead, prop_healCommandErrorsWhenNoTargetIsDevoured,
    prop_healCommandErrorsWhenNotWitchsTurn, prop_healCommandErrorsWhenCallerHasHealed,
    prop_healCommandErrorsWhenCallerNotWitch, prop_healCommandSetsHeal,
    prop_healCommandSetsHealUsed,

    -- * lynchVoteCommand
    prop_lynchVoteCommandErrorsWhenGameIsOver, prop_lynchVoteCommandErrorsWhenCallerDoesNotExist,
    prop_lynchVoteCommandErrorsWhenTargetDoesNotExist, prop_lynchVoteCommandErrorsWhenCallerIsDead,
    prop_lynchVoteCommandErrorsWhenTargetIsDead, prop_lynchVoteCommandErrorsWhenNotVillagesTurn,
    prop_lynchVoteCommandErrorsWhenCallerHasVoted, prop_lynchVoteCommandUpdatesVotes,

    -- * passCommand
    prop_passCommandErrorsWhenGameIsOver, prop_passCommandErrorsWhenCallerDoesNotExist,
    prop_passCommandErrorsWhenCallerIsDead, prop_passCommandErrorsWhenNotWitchsTurn,
    prop_passCommandUpdatesPasses,

    -- * poisonCommand
    prop_poisonCommandErrorsWhenGameIsOver, prop_poisonCommandErrorsWhenCallerDoesNotExist,
    prop_poisonCommandErrorsWhenTargetDoesNotExist, prop_poisonCommandErrorsWhenCallerIsDead,
    prop_poisonCommandErrorsWhenTargetIsDead, prop_poisonCommandErrorsWhenTargetIsDevoured,
    prop_poisonCommandErrorsWhenNotWitchsTurn, prop_poisonCommandErrorsWhenCallerHasPoisoned,
    prop_poisonCommandErrorsWhenCallerNotWitch, prop_poisonCommandSetsPoison,
    prop_poisonCommandSetsPoisonUsed,

    -- * protectCommand
    prop_protectCommandErrorsWhenGameIsOver, prop_protectCommandErrorsWhenCallerDoesNotExist,
    prop_protectCommandErrorsWhenTargetDoesNotExist, prop_protectCommandErrorsWhenCallerIsDead,
    prop_protectCommandErrorsWhenTargetIsDead, prop_protectCommandErrorsWhenNotDefendersTurn,
    prop_protectCommandErrorsWhenCallerNotDefender, prop_protectCommandErrorsWhenTargetIsCaller,
    prop_protectCommandErrorsWhenTargetIsPriorProtect, prop_protectCommandSetsPriorProtect,
    prop_protectCommandSetsProtect,

    -- * quitCommand
    prop_quitCommandErrorsWhenGameIsOver, prop_quitCommandErrorsWhenCallerDoesNotExist,
    prop_quitCommandErrorsWhenCallerIsDead, prop_quitCommandKillsPlayer,
    prop_quitCommandClearsHealWhenCallerIsWitch, prop_quitCommandClearsHealUsedWhenCallerIsWitch,
    prop_quitCommandClearsPoisonWhenCallerIsWitch,
    prop_quitCommandClearsPoisonUsedWhenCallerIsWitch,
    prop_quitCommandClearsPriorProtectWhenCallerIsDefender,
    prop_quitCommandClearsProtectWhenCallerIsDefender, prop_quitCommandClearsPlayersDevourVote,
    prop_quitCommandClearsPlayersLynchVote,

    -- * seeCommand
    prop_seeCommandErrorsWhenGameIsOver, prop_seeCommandErrorsWhenCallerDoesNotExist,
    prop_seeCommandErrorsWhenTargetDoesNotExist, prop_seeCommandErrorsWhenCallerIsDead,
    prop_seeCommandErrorsWhenTargetIsDead, prop_seeCommandErrorsWhenNotSeersTurn,
    prop_seeCommandErrorsWhenCallerNotSeer, prop_seeCommandSetsSee,
) where

import Control.Lens hiding (elements)

import           Data.Either.Extra
import qualified Data.Map          as Map
import           Data.Maybe

import Game.Werewolf.Command
import Game.Werewolf.Engine         (checkStage)
import Game.Werewolf.Game
import Game.Werewolf.Player
import Game.Werewolf.Test.Arbitrary
import Game.Werewolf.Test.Util

import Test.QuickCheck

prop_devourVoteCommandErrorsWhenGameIsOver :: Game -> Property
prop_devourVoteCommandErrorsWhenGameIsOver game =
    forAll (arbitraryDevourVoteCommand game') $ verbose_runCommandErrors game'
    where
        game' = game { _stage = GameOver }

prop_devourVoteCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property
prop_devourVoteCommandErrorsWhenCallerDoesNotExist game caller =
    not (doesPlayerExist (caller ^. name) (game ^. players))
    ==> forAll (arbitraryPlayer game) $ \target ->
        verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name))

prop_devourVoteCommandErrorsWhenTargetDoesNotExist :: Game -> Player -> Property
prop_devourVoteCommandErrorsWhenTargetDoesNotExist game target =
    not (doesPlayerExist (target ^. name) (game ^. players))
    ==> forAll (arbitraryWerewolf game) $ \caller ->
        verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name))

prop_devourVoteCommandErrorsWhenCallerIsDead :: Game -> Property
prop_devourVoteCommandErrorsWhenCallerIsDead game =
    forAll (arbitraryWerewolf game) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let game'   = killPlayer game caller
        let command = devourVoteCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game' command

prop_devourVoteCommandErrorsWhenTargetIsDead :: Game -> Property
prop_devourVoteCommandErrorsWhenTargetIsDead game =
    forAll (arbitraryWerewolf game) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let game'   = killPlayer game target
        let command = devourVoteCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game' command

prop_devourVoteCommandErrorsWhenNotWerewolvesTurn :: Game -> Property
prop_devourVoteCommandErrorsWhenNotWerewolvesTurn game =
    not (isWerewolvesTurn game)
    ==> forAll (arbitraryDevourVoteCommand game) $ verbose_runCommandErrors game

prop_devourVoteCommandErrorsWhenCallerNotWerewolf :: Game -> Property
prop_devourVoteCommandErrorsWhenCallerNotWerewolf game =
    forAll (suchThat (arbitraryPlayer game) (not . isWerewolf)) $ \caller ->
    forAll (arbitraryPlayer game) $ \target ->
    verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name))

prop_devourVoteCommandErrorsWhenCallerHasVoted :: Game -> Property
prop_devourVoteCommandErrorsWhenCallerHasVoted game =
    forAll (arbitraryWerewolf game') $ \caller ->
    forAll (suchThat (arbitraryPlayer game') (not . isWerewolf)) $ \target -> do
        let command = devourVoteCommand (caller ^. name) (target ^. name)
        let game''  = run_ (apply command) game'

        verbose_runCommandErrors game'' command
    where
        game' = game { _stage = WerewolvesTurn }

prop_devourVoteCommandErrorsWhenTargetWerewolf :: Game -> Property
prop_devourVoteCommandErrorsWhenTargetWerewolf game =
    forAll (suchThat (arbitraryPlayer game) isWerewolf) $ \target ->
    forAll (arbitraryPlayer game) $ \caller ->
    verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name))

prop_devourVoteCommandUpdatesVotes :: Game -> Property
prop_devourVoteCommandUpdatesVotes game =
    forAll (arbitraryDevourVoteCommand game') $ \command -> do
        let game'' = run_ (apply command) game'

        Map.size (game'' ^. votes) == 1
    where
        game' = game { _stage = WerewolvesTurn }

prop_healCommandErrorsWhenGameIsOver :: Game -> Property
prop_healCommandErrorsWhenGameIsOver game =
    forAll (arbitraryWitch game') $ \witch ->
    verbose_runCommandErrors game' (healCommand $ witch ^. name)
    where
        game' = game { _stage = GameOver }

prop_healCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property
prop_healCommandErrorsWhenCallerDoesNotExist game caller =
    not (doesPlayerExist (caller ^. name) (game ^. players))
    ==> verbose_runCommandErrors game (healCommand (caller ^. name))

prop_healCommandErrorsWhenCallerIsDead :: Game -> Property
prop_healCommandErrorsWhenCallerIsDead game =
    forAll (arbitraryPlayer game) $ \caller -> do
        let game'   = killPlayer game caller
        let command = healCommand (caller ^. name)

        verbose_runCommandErrors game' command

prop_healCommandErrorsWhenNoTargetIsDevoured :: Game -> Property
prop_healCommandErrorsWhenNoTargetIsDevoured game =
    forAll (arbitraryWitch game) $ \witch ->
    verbose_runCommandErrors game (healCommand $ witch ^. name)

prop_healCommandErrorsWhenNotWitchsTurn :: Game -> Property
prop_healCommandErrorsWhenNotWitchsTurn game =
    not (isWitchsTurn game)
    ==> forAll (arbitraryWitch game) $ \witch ->
        verbose_runCommandErrors game (healCommand $ witch ^. name)

prop_healCommandErrorsWhenCallerHasHealed :: Gen Property
prop_healCommandErrorsWhenCallerHasHealed = do
    game <- arbitraryGameWithDevourEventForVillager

    return $ forAll (arbitraryHealCommand game) $ \command -> do
        let game' = run_ (apply command) game

        verbose_runCommandErrors game' command

prop_healCommandErrorsWhenCallerNotWitch :: Game -> Property
prop_healCommandErrorsWhenCallerNotWitch game =
    forAll (suchThat (arbitraryPlayer game) (not . isWitch)) $ \caller ->
    verbose_runCommandErrors game (healCommand (caller ^. name))

prop_healCommandSetsHeal :: Gen Property
prop_healCommandSetsHeal = do
    game <- arbitraryGameWithDevourEventForVillager

    return $ forAll (arbitraryHealCommand game) $ \command ->
        (run_ (apply command) game) ^. heal

prop_healCommandSetsHealUsed :: Gen Property
prop_healCommandSetsHealUsed = do
    game <- arbitraryGameWithDevourEventForVillager

    return $ forAll (arbitraryHealCommand game) $ \command ->
        (run_ (apply command) game) ^. healUsed

prop_lynchVoteCommandErrorsWhenGameIsOver :: Game -> Property
prop_lynchVoteCommandErrorsWhenGameIsOver game =
    forAll (arbitraryLynchVoteCommand game') $ verbose_runCommandErrors game'
    where
        game' = game { _stage = GameOver }

prop_lynchVoteCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property
prop_lynchVoteCommandErrorsWhenCallerDoesNotExist game caller =
    not (doesPlayerExist (caller ^. name) (game ^. players))
    ==> forAll (arbitraryPlayer game) $ \target ->
        verbose_runCommandErrors game (lynchVoteCommand (caller ^. name) (target ^. name))

prop_lynchVoteCommandErrorsWhenTargetDoesNotExist :: Game -> Player -> Property
prop_lynchVoteCommandErrorsWhenTargetDoesNotExist game target =
    not (doesPlayerExist (target ^. name) (game ^. players))
    ==> forAll (arbitraryPlayer game) $ \caller ->
        verbose_runCommandErrors game (lynchVoteCommand (caller ^. name) (target ^. name))

prop_lynchVoteCommandErrorsWhenCallerIsDead :: Game -> Property
prop_lynchVoteCommandErrorsWhenCallerIsDead game =
    forAll (arbitraryPlayer game) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let game'   = killPlayer game caller
        let command = lynchVoteCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game' command

prop_lynchVoteCommandErrorsWhenTargetIsDead :: Game -> Property
prop_lynchVoteCommandErrorsWhenTargetIsDead game =
    forAll (arbitraryPlayer game) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let game'   = killPlayer game target
        let command = lynchVoteCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game' command

prop_lynchVoteCommandErrorsWhenNotVillagesTurn :: Game -> Property
prop_lynchVoteCommandErrorsWhenNotVillagesTurn game =
    not (isVillagesTurn game)
    ==> forAll (arbitraryLynchVoteCommand game) $ verbose_runCommandErrors game

prop_lynchVoteCommandErrorsWhenCallerHasVoted :: Game -> Property
prop_lynchVoteCommandErrorsWhenCallerHasVoted game =
    forAll (arbitraryPlayer game') $ \caller ->
    forAll (arbitraryPlayer game') $ \target -> do
        let command = lynchVoteCommand (caller ^. name) (target ^. name)
        let game''  = run_ (apply command) game'

        verbose_runCommandErrors game'' command
    where
        game' = game { _stage = VillagesTurn }

prop_lynchVoteCommandUpdatesVotes :: Game -> Property
prop_lynchVoteCommandUpdatesVotes game =
    forAll (arbitraryLynchVoteCommand game') $ \command -> do
        let game'' = run_ (apply command) game'

        Map.size (game'' ^. votes) == 1
    where
        game' = game { _stage = VillagesTurn }

prop_passCommandErrorsWhenGameIsOver :: Game -> Property
prop_passCommandErrorsWhenGameIsOver game =
    forAll (arbitraryPassCommand game') $ verbose_runCommandErrors game'
    where
        game' = game { _stage = GameOver }

prop_passCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property
prop_passCommandErrorsWhenCallerDoesNotExist game caller =
    not (doesPlayerExist (caller ^. name) (game ^. players))
    ==> verbose_runCommandErrors game (passCommand (caller ^. name))

prop_passCommandErrorsWhenCallerIsDead :: Game -> Property
prop_passCommandErrorsWhenCallerIsDead game =
    forAll (arbitraryPlayer game) $ \caller -> do
        let game'   = killPlayer game caller
        let command = passCommand (caller ^. name)

        verbose_runCommandErrors game' command

prop_passCommandErrorsWhenNotWitchsTurn :: Game -> Property
prop_passCommandErrorsWhenNotWitchsTurn game =
    not (isWitchsTurn game)
    ==> forAll (arbitraryPassCommand game) $ verbose_runCommandErrors game

prop_passCommandUpdatesPasses :: Game -> Property
prop_passCommandUpdatesPasses game =
    forAll (arbitraryPassCommand game') $ \command -> do
        let game'' = run_ (apply command) game'

        length (game'' ^. passes) == 1
    where
        game' = game { _stage = WitchsTurn }

prop_poisonCommandErrorsWhenGameIsOver :: Game -> Property
prop_poisonCommandErrorsWhenGameIsOver game =
    forAll (arbitraryPoisonCommand game') $ verbose_runCommandErrors game'
    where
        game' = game { _stage = GameOver }

prop_poisonCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property
prop_poisonCommandErrorsWhenCallerDoesNotExist game caller =
    not (doesPlayerExist (caller ^. name) (game ^. players))
    ==> forAll (arbitraryPlayer game) $ \target ->
        verbose_runCommandErrors game (poisonCommand (caller ^. name) (target ^. name))

prop_poisonCommandErrorsWhenTargetDoesNotExist :: Game -> Player -> Property
prop_poisonCommandErrorsWhenTargetDoesNotExist game target =
    not (doesPlayerExist (target ^. name) (game ^. players))
    ==> forAll (arbitraryPlayer game) $ \caller ->
        verbose_runCommandErrors game (poisonCommand (caller ^. name) (target ^. name))

prop_poisonCommandErrorsWhenCallerIsDead :: Game -> Property
prop_poisonCommandErrorsWhenCallerIsDead game =
    forAll (arbitraryPlayer game) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let game'   = killPlayer game caller
        let command = poisonCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game' command

prop_poisonCommandErrorsWhenTargetIsDead :: Game -> Property
prop_poisonCommandErrorsWhenTargetIsDead game =
    forAll (arbitraryPlayer game) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let game'   = killPlayer game target
        let command = poisonCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game' command

prop_poisonCommandErrorsWhenTargetIsDevoured :: Game -> Property
prop_poisonCommandErrorsWhenTargetIsDevoured game =
    forAll (runArbitraryCommands n game') $ \game'' ->
    length (getVoteResult game'') == 1
    ==> forAll (arbitraryWitch game'') $ \caller ->
        let game''' = run_ checkStage game''
            votee   = head (getVoteResult game'')
        in verbose_runCommandErrors game''' (poisonCommand (caller ^. name) (votee ^. name))
    where
        game'   = game { _stage = WerewolvesTurn }
        n       = length . filterWerewolves $ game' ^. players

prop_poisonCommandErrorsWhenNotWitchsTurn :: Game -> Property
prop_poisonCommandErrorsWhenNotWitchsTurn game =
    not (isWitchsTurn game)
    ==> forAll (arbitraryPoisonCommand game) $ verbose_runCommandErrors game

prop_poisonCommandErrorsWhenCallerHasPoisoned :: Game -> Property
prop_poisonCommandErrorsWhenCallerHasPoisoned game =
    forAll (arbitraryWitch game') $ \caller ->
    forAll (arbitraryPlayer game') $ \target ->
    let command = poisonCommand (caller ^. name) (target ^. name)
    in verbose_runCommandErrors (run_ (apply command) game') command
    where
        game' = game { _stage = WitchsTurn }

prop_poisonCommandErrorsWhenCallerNotWitch :: Game -> Property
prop_poisonCommandErrorsWhenCallerNotWitch game =
    forAll (suchThat (arbitraryPlayer game) (not . isWitch)) $ \caller ->
    forAll (arbitraryPlayer game) $ \target ->
    verbose_runCommandErrors game (poisonCommand (caller ^. name) (target ^. name))

prop_poisonCommandSetsPoison :: Game -> Property
prop_poisonCommandSetsPoison game =
    forAll (arbitraryPoisonCommand game') $ \command ->
    isJust (run_ (apply command) game' ^. poison)
    where
        game' = game { _stage = WitchsTurn }

prop_poisonCommandSetsPoisonUsed :: Game -> Property
prop_poisonCommandSetsPoisonUsed game =
    forAll (arbitraryPoisonCommand game') $ \command ->
    run_ (apply command) game' ^. poisonUsed
    where
        game' = game { _stage = WitchsTurn }

prop_protectCommandErrorsWhenGameIsOver :: Game -> Property
prop_protectCommandErrorsWhenGameIsOver game =
    forAll (arbitraryProtectCommand game') $ verbose_runCommandErrors game'
    where
        game' = game { _stage = GameOver }

prop_protectCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property
prop_protectCommandErrorsWhenCallerDoesNotExist game caller =
    not (doesPlayerExist (caller ^. name) (game ^. players))
    ==> forAll (arbitraryPlayer game) $ \target -> do
        let command = protectCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game command

prop_protectCommandErrorsWhenTargetDoesNotExist :: Game -> Player -> Property
prop_protectCommandErrorsWhenTargetDoesNotExist game target =
    not (doesPlayerExist (target ^. name) (game ^. players))
    ==> forAll (arbitraryDefender game) $ \caller -> do
        let command = protectCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game command

prop_protectCommandErrorsWhenCallerIsDead :: Game -> Property
prop_protectCommandErrorsWhenCallerIsDead game =
    forAll (arbitraryDefender game) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let game'   = killPlayer game caller
        let command = protectCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game' command

prop_protectCommandErrorsWhenTargetIsDead :: Game -> Property
prop_protectCommandErrorsWhenTargetIsDead game =
    forAll (arbitraryDefender game) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let game'   = killPlayer game target
        let command = protectCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game' command

prop_protectCommandErrorsWhenNotDefendersTurn :: Game -> Property
prop_protectCommandErrorsWhenNotDefendersTurn game =
    not (isDefendersTurn game)
    ==> forAll (arbitraryProtectCommand game) $ verbose_runCommandErrors game

prop_protectCommandErrorsWhenCallerNotDefender :: Game -> Property
prop_protectCommandErrorsWhenCallerNotDefender game =
    forAll (suchThat (arbitraryPlayer game) (not . isDefender)) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let command = protectCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game command

prop_protectCommandErrorsWhenTargetIsCaller :: Game -> Property
prop_protectCommandErrorsWhenTargetIsCaller game =
    forAll (arbitraryDefender game) $ \caller -> do
        let command = protectCommand (caller ^. name) (caller ^. name)

        verbose_runCommandErrors game command

prop_protectCommandErrorsWhenTargetIsPriorProtect :: Gen Property
prop_protectCommandErrorsWhenTargetIsPriorProtect = do
    game <- arbitraryGameWithProtect
    let game' = game { _protect = Nothing }

    return $ forAll (arbitraryDefender game') $ \caller -> do
        let command = protectCommand (caller ^. name) (fromJust $ game' ^. priorProtect)

        verbose_runCommandErrors game' command

prop_protectCommandSetsPriorProtect :: Game -> Property
prop_protectCommandSetsPriorProtect game =
    forAll (arbitraryProtectCommand game') $ \command ->
    isJust $ run_ (apply command) game' ^. priorProtect
    where
        game' = game { _stage = DefendersTurn }

prop_protectCommandSetsProtect :: Game -> Property
prop_protectCommandSetsProtect game =
    forAll (arbitraryProtectCommand game') $ \command ->
    isJust $ run_ (apply command) game' ^. protect
    where
        game' = game { _stage = DefendersTurn }

prop_quitCommandErrorsWhenGameIsOver :: Game -> Property
prop_quitCommandErrorsWhenGameIsOver game =
    forAll (arbitraryQuitCommand game') $ verbose_runCommandErrors game'
    where
        game' = game { _stage = GameOver }

prop_quitCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property
prop_quitCommandErrorsWhenCallerDoesNotExist game caller =
    not (doesPlayerExist (caller ^. name) (game ^. players))
    ==> verbose_runCommandErrors game (quitCommand $ caller ^. name)

prop_quitCommandErrorsWhenCallerIsDead :: Game -> Property
prop_quitCommandErrorsWhenCallerIsDead game =
    forAll (arbitraryPlayer game) $ \caller ->
    verbose_runCommandErrors (killPlayer game caller) (quitCommand $ caller ^. name)

prop_quitCommandKillsPlayer :: Game -> Property
prop_quitCommandKillsPlayer game =
    not (isGameOver game)
    ==> forAll (arbitraryQuitCommand game) $ \command ->
        length (filterDead $ run_ (apply command) game ^. players) == 1

prop_quitCommandClearsHealWhenCallerIsWitch :: Game -> Property
prop_quitCommandClearsHealWhenCallerIsWitch game =
    forAll (runArbitraryCommands n game') $ \game'' ->
    length (getVoteResult game'') == 1
    ==> let target = head $ getVoteResult game''
        in not (isWitch target)
        ==> forAll (arbitraryWitch game'') $ \caller ->
            let command = healCommand (caller ^. name)
                game''' = run_ (apply command) $ run_ checkStage game''
            in not $ run_ (apply $ quitCommand (caller ^. name)) game''' ^. heal
    where
        game'   = game { _stage = WerewolvesTurn }
        n       = length . filterWerewolves $ game' ^. players

prop_quitCommandClearsHealUsedWhenCallerIsWitch :: Game -> Property
prop_quitCommandClearsHealUsedWhenCallerIsWitch game =
    forAll (runArbitraryCommands n game') $ \game'' ->
    length (getVoteResult game'') == 1
    ==> let target = head $ getVoteResult game''
        in not (isWitch target)
        ==> forAll (arbitraryWitch game'') $ \caller ->
            let command = healCommand (caller ^. name)
                game''' = run_ (apply command) $ run_ checkStage game''
            in not $ run_ (apply $ quitCommand (caller ^. name)) game''' ^. healUsed
    where
        game'   = game { _stage = WerewolvesTurn }
        n       = length . filterWerewolves $ game' ^. players

prop_quitCommandClearsPoisonWhenCallerIsWitch :: Game -> Property
prop_quitCommandClearsPoisonWhenCallerIsWitch game =
    forAll (arbitraryWitch game') $ \caller ->
    forAll (arbitraryPlayer game') $ \target ->
    let game'' = run_ (apply $ poisonCommand (caller ^. name) (target ^. name)) game'
    in isNothing $ run_ (apply $ quitCommand (caller ^. name)) game'' ^. poison
    where
        game' = game { _stage = WitchsTurn }

prop_quitCommandClearsPriorProtectWhenCallerIsDefender :: Game -> Property
prop_quitCommandClearsPriorProtectWhenCallerIsDefender game =
    forAll (arbitraryDefender game') $ \caller ->
    forAll (suchThat (arbitraryPlayer game') (not . isDefender)) $ \target -> do
        let command = protectCommand (caller ^. name) (target ^. name)
        let game''  = run_ (apply command) game'

        isNothing $ run_ (apply $ quitCommand (caller ^. name)) game'' ^. priorProtect
    where
        game' = game { _stage = DefendersTurn }

prop_quitCommandClearsProtectWhenCallerIsDefender :: Game -> Property
prop_quitCommandClearsProtectWhenCallerIsDefender game =
    forAll (arbitraryDefender game') $ \caller ->
    forAll (suchThat (arbitraryPlayer game') (not . isDefender)) $ \target -> do
        let command = protectCommand (caller ^. name) (target ^. name)
        let game''  = run_ (apply command) game'

        isNothing $ run_ (apply $ quitCommand (caller ^. name)) game'' ^. protect
    where
        game' = game { _stage = DefendersTurn }

prop_quitCommandClearsPoisonUsedWhenCallerIsWitch :: Game -> Property
prop_quitCommandClearsPoisonUsedWhenCallerIsWitch game =
    forAll (arbitraryWitch game') $ \caller ->
    forAll (arbitraryPlayer game') $ \target ->
    let game'' = run_ (apply $ poisonCommand (caller ^. name) (target ^. name)) game'
    in not $ run_ (apply $ quitCommand (caller ^. name)) game'' ^. poisonUsed
    where
        game' = game { _stage = WitchsTurn }

prop_quitCommandClearsPlayersDevourVote :: Game -> Property
prop_quitCommandClearsPlayersDevourVote game =
    forAll (arbitraryWerewolf game') $ \caller ->
    forAll (suchThat (arbitraryPlayer game') (not . isWerewolf)) $ \target ->
    let game'' = run_ (apply $ devourVoteCommand (caller ^. name) (target ^. name)) game'
    in Map.null $ run_ (apply $ quitCommand (caller ^. name)) game'' ^. votes
    where
        game' = game { _stage = WerewolvesTurn }

prop_quitCommandClearsPlayersLynchVote :: Game -> Property
prop_quitCommandClearsPlayersLynchVote game =
    forAll (arbitraryPlayer game') $ \caller ->
    forAll (arbitraryPlayer game') $ \target ->
    let game'' = run_ (apply $ lynchVoteCommand (caller ^. name) (target ^. name)) game'
        in Map.null $ run_ (apply $ quitCommand (caller ^. name)) game'' ^. votes
    where
        game' = game { _stage = VillagesTurn }

prop_seeCommandErrorsWhenGameIsOver :: Game -> Property
prop_seeCommandErrorsWhenGameIsOver game =
    forAll (arbitrarySeeCommand game') $ verbose_runCommandErrors game'
    where
        game' = game { _stage = GameOver }

prop_seeCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property
prop_seeCommandErrorsWhenCallerDoesNotExist game caller =
    not (doesPlayerExist (caller ^. name) (game ^. players))
    ==> forAll (arbitraryPlayer game) $ \target -> do
        let command = seeCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game command

prop_seeCommandErrorsWhenTargetDoesNotExist :: Game -> Player -> Property
prop_seeCommandErrorsWhenTargetDoesNotExist game target =
    not (doesPlayerExist (target ^. name) (game ^. players))
    ==> forAll (arbitrarySeer game) $ \caller -> do
        let command = seeCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game command

prop_seeCommandErrorsWhenCallerIsDead :: Game -> Property
prop_seeCommandErrorsWhenCallerIsDead game =
    forAll (arbitrarySeer game) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let game'   = killPlayer game caller
        let command = seeCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game' command

prop_seeCommandErrorsWhenTargetIsDead :: Game -> Property
prop_seeCommandErrorsWhenTargetIsDead game =
    forAll (arbitrarySeer game) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let game'   = killPlayer game target
        let command = seeCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game' command

prop_seeCommandErrorsWhenNotSeersTurn :: Game -> Property
prop_seeCommandErrorsWhenNotSeersTurn game =
    not (isSeersTurn game)
    ==> forAll (arbitrarySeeCommand game) $ verbose_runCommandErrors game

prop_seeCommandErrorsWhenCallerNotSeer :: Game -> Property
prop_seeCommandErrorsWhenCallerNotSeer game =
    forAll (suchThat (arbitraryPlayer game) (not . isSeer)) $ \caller ->
    forAll (arbitraryPlayer game) $ \target -> do
        let command = seeCommand (caller ^. name) (target ^. name)

        verbose_runCommandErrors game command

prop_seeCommandSetsSee :: Game -> Property
prop_seeCommandSetsSee game =
    forAll (arbitrarySeeCommand game') $ \command ->
    isJust $ run_ (apply command) game' ^. see
    where
        game' = game { _stage = SeersTurn }

verbose_runCommandErrors :: Game -> Command -> Property
verbose_runCommandErrors game command = whenFail (mapM_ putStrLn [show game, show . fromRight $ run (apply command) game]) (isLeft $ run (apply command) game)