DevotedServant.hs

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

module Game.Werewolf.Test.Engine.DevotedServant (
    -- * Tests
    allDevotedServantEngineTests,
) where

import Control.Lens hiding (isn't)

import Game.Werewolf
import Game.Werewolf.Command.Global
import Game.Werewolf.Test.Arbitrary
import Game.Werewolf.Test.Util

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

allDevotedServantEngineTests :: [TestTree]
allDevotedServantEngineTests =
    [ testProperty "check stage skips devoted servant's turn when no devoted servant" prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant

    , testProperty "check devoted servant's turn advances to wolf-hound's turn"             prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn
    , testProperty "check devoted servant's turn advances when no devoted servant"          prop_checkDevotedServantsTurnAdvancesWhenNoDevotedServant
    , testProperty "check devoted servant's turn does nothing unless revealed or passed"    prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed
    ]

prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant :: GameWithMajorityVote -> Bool
prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant (GameWithMajorityVote game) =
    hasn't (stage . _DevotedServantsTurn) game'
    where
        devotedServantsName = game ^?! players . devotedServants . name
        game'               = run_ (apply (quitCommand devotedServantsName) >> checkStage) game

prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn :: GameAtDevotedServantsTurn -> Property
prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn (GameAtDevotedServantsTurn game) = do
    forAll (arbitraryCommand game) $ \(Blind command) ->
        isn't angel target && isn't hunter target && isn't wolfHound target
        ==> has (stage . _WolfHoundsTurn) (run_ (apply command >> checkStage) game)
    where
        target = head $ getVoteResult game

prop_checkDevotedServantsTurnAdvancesWhenNoDevotedServant :: GameAtDevotedServantsTurn -> Bool
prop_checkDevotedServantsTurnAdvancesWhenNoDevotedServant (GameAtDevotedServantsTurn game) = do
    let devotedServantsName = game ^?! players . devotedServants . name
    let command             = quitCommand devotedServantsName

    hasn't (stage . _DevotedServantsTurn) (run_ (apply command >> checkStage) game)

prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed :: GameAtDevotedServantsTurn -> Bool
prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed (GameAtDevotedServantsTurn game) =
    has (stage . _DevotedServantsTurn) (run_ checkStage game)