Village.hs

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

module Game.Werewolf.Test.Engine.Village (
    -- * Tests
    allVillageEngineTests,
) where

import Control.Lens hiding (isn't)

import Game.Werewolf
import Game.Werewolf.Test.Arbitrary
import Game.Werewolf.Test.Util

import Test.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck

allVillageEngineTests :: [TestTree]
allVillageEngineTests =
    [ testProperty "check stage skips village's turn when allowed voters empty"         prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty

    , testProperty "check villages' turn advances to devoted servant's turn"            prop_checkVillagesTurnAdvancesToDevotedServantsTurn
    , testProperty "check villages' turn skips devoted servant's turn when conflicted"  prop_checkVillagesTurnSkipsDevotedServantsTurnWhenConflicted
    , testProperty "check villages' turn does nothing unless all voted"                 prop_checkVillagesTurnDoesNothingUnlessAllVoted
    ]

prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty :: GameAtWitchsTurn -> Property
prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty (GameAtWitchsTurn game) =
    forAll (arbitraryWitchPassCommand game') $ \(Blind passWitchsTurnCommand) -> do
        hasn't (stage . _VillagesTurn) (run_ (apply passWitchsTurnCommand >> checkStage) game')
    where
        game' = game & allowedVoters .~ []

prop_checkVillagesTurnAdvancesToDevotedServantsTurn :: GameWithMajorityVote -> Property
prop_checkVillagesTurnAdvancesToDevotedServantsTurn (GameWithMajorityVote game) =
    isn't angel target && isn't devotedServant target
    ==> has (stage . _DevotedServantsTurn) (run_ checkStage game)
    where
        target = head $ getVoteResult game

prop_checkVillagesTurnSkipsDevotedServantsTurnWhenConflicted :: GameWithConflictingVote -> Bool
prop_checkVillagesTurnSkipsDevotedServantsTurnWhenConflicted (GameWithConflictingVote game) =
    hasn't (stage . _DevotedServantsTurn) (run_ checkStage game)

prop_checkVillagesTurnDoesNothingUnlessAllVoted :: GameAtVillagesTurn -> Property
prop_checkVillagesTurnDoesNothingUnlessAllVoted (GameAtVillagesTurn game) =
    forAll (runArbitraryCommands n game) $ \game' ->
    has (stage . _VillagesTurn) (run_ checkStage game')
    where
        n = length (game ^. players) - 1