Orphan.hs

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

module Game.Werewolf.Test.Engine.Orphan (
    -- * Tests
    allOrphanEngineTests,
) where

import Control.Lens hiding (isn't)

import Data.Maybe

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

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

allOrphanEngineTests :: [TestTree]
allOrphanEngineTests =
    [ testProperty "check stage skips orphan's turn when no orphan" prop_checkStageSkipsOrphansTurnWhenNoOrphan

    , testProperty "check orphan's turn advances to protector's turn"   prop_checkOrphansTurnAdvancesToProtectorsTurn
    , testProperty "check orphan's turn advances when no orphan"        prop_checkOrphansTurnAdvancesWhenNoOrphan
    , testProperty "check orphan's turn does nothing unless chosen"     prop_checkOrphansTurnDoesNothingUnlessRoleModelChosen

    , testProperty "check sunset sets orphan's allegiance when role model dead" prop_checkSunsetSetsOrphansAllegianceWhenRoleModelDead
    ]

prop_checkStageSkipsOrphansTurnWhenNoOrphan :: GameWithSee -> Bool
prop_checkStageSkipsOrphansTurnWhenNoOrphan (GameWithSee game) =
    hasn't (stage . _OrphansTurn) game'
    where
        orphansName = game ^?! players . orphans . name
        game'       = run_ (apply (quitCommand orphansName) >> checkStage) game

prop_checkOrphansTurnAdvancesToProtectorsTurn :: GameAtOrphansTurn -> Property
prop_checkOrphansTurnAdvancesToProtectorsTurn (GameAtOrphansTurn game) =
    forAll (arbitraryOrphanChooseCommand game) $ \(Blind command) ->
    has (stage . _ProtectorsTurn) (run_ (apply command >> checkStage) game)

prop_checkOrphansTurnAdvancesWhenNoOrphan :: GameAtOrphansTurn -> Bool
prop_checkOrphansTurnAdvancesWhenNoOrphan (GameAtOrphansTurn game) = do
    let orphan  = game ^?! players . orphans
    let command = quitCommand $ orphan ^. name

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

prop_checkOrphansTurnDoesNothingUnlessRoleModelChosen :: GameAtOrphansTurn -> Bool
prop_checkOrphansTurnDoesNothingUnlessRoleModelChosen (GameAtOrphansTurn game) =
    has (stage . _OrphansTurn) (run_ checkStage game)

prop_checkSunsetSetsOrphansAllegianceWhenRoleModelDead :: GameWithRoleModelAtVillagesTurn -> Property
prop_checkSunsetSetsOrphansAllegianceWhenRoleModelDead (GameWithRoleModelAtVillagesTurn game) = do
    let game' = foldr (\player -> run_ (apply $ voteCommand (player ^. name) (roleModel' ^. name))) game (game ^. players)

    let devotedServantsName = game ^?! players . devotedServants . name
    let command             = passCommand devotedServantsName

    isn't angel roleModel' && isn't devotedServant roleModel' && isn't hunter roleModel' && isn't jester roleModel'
        ==> is werewolf $ run_ (checkStage >> apply command >> checkStage) game' ^?! players . orphans
    where
        roleModel' = game ^?! players . traverse . filteredBy name (fromJust $ game ^. roleModel)