{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE LambdaCase                #-}
{-# LANGUAGE MultiWayIf                #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Waterdeep.Actions
   ( noAction
   , scorePoints
   , takeResources
   , returnResources
   , chooseQuest
   , replaceQuests
   , drawQuest
   , drawNamedQuestType
   , distributeQuests
   , completeQuest
   , chooseAndCompleteQuest
   , discardUncompletedQuest
   , buyBuilding
   , chooseFreeBuilding
   , drawFreeBuilding
   , discardUnoccupiedBuilding
   , drawIntrigue
   , playIntrigue
   , returnAgent
   , returnAgentFromHarbor
   , assignAmbassador
   , assignAgent
   , assignAgentToBuildersHall
   , assignAgentToOpponentsSpace
   , useOpponentsSpace
   , gainLieutenant
   , gainAmbassador
   , assignMandatoryQuest
   , becomeFirstPlayer
   , enableAssignOnceToOpponentsSpace
   , forOneOpponent
   , forEachOpponent
   , forCurrentPlayer
   , forEachBuilding
   , forEachControlledBuilding
   , restockCliffwatchInn
   , restockBuildersHall
   , getOpponents
   , doPlotAction
   , mandatoryQuestCard
   ) where

import Control.Applicative
import Control.Arrow ((&&&))
import Control.Monad (when, unless, guard, join, replicateM, replicateM_, void)
import Control.Monad.Random
import Control.Monad.State (get)
import Control.Monad.Trans.Writer
import Data.Char
import Data.Function
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Foldable (foldMap, forM_, mapM_)
import Data.Traversable (traverse, for, forM, mapM)
import Lens.Family2 hiding ((&))
import Lens.Family2.State
import Lens.Family2.Stock
import Prelude hiding (forM, mapM)
import System.Random.Shuffle
import Text.Printf
import Waterdeep.Types
import Waterdeep.Util

import qualified Data.Foldable    as F
import qualified Data.IntMap      as IM
import qualified Data.Map         as M
import qualified Data.MultiSet    as MS
import qualified Data.Traversable as T

noAction :: GameAction
noAction = return ()

scorePoints :: Int -> GameAction
scorePoints n = do
   activePlayerState . playerScore += n
   name <- use activePlayerName
   broadcast $ printf "%s scored %d points." name n

takeResources :: Int -> [Resource] -> GameAction
takeResources n rs = do
   received <- map (head &&& length) . group . sort <$$> replicateM n $ do
      r <- solicitChoice "Take one item:" $ map (show &&& id) rs
      activePlayerState . playerTavern <>= MS.singleton r
      actionProvided r
      return r
   let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) received
   name <- use $ activePlayerName
   broadcast $ printf "%s received %s." name items

returnResources :: Int -> [Resource] -> GameAction
returnResources n rs = do
   returned <- replicateM n $ do
      r <- solicitChoice "Return one item:" $ map (show &&& id) rs
      guard . (r `MS.member`) =<< use (activePlayerState . playerTavern)
      activePlayerState . playerTavern %= (`MS.difference` MS.singleton r)
      return r
   let groups = map (head &&& length) $ group returned
   let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) groups
   name <- use $ activePlayerName
   broadcast $ name ++ " returned " ++ items ++ " to the supply."

chooseQuest' :: Waterdeep Quest
chooseQuest' = do
   choices <- zipWith (\i q -> (q ^. questTitle, (i, q))) [0..] <$> use gameCliffwatchInn
   (i, quest) <- solicitChoice "Choose one quest:" $ nubOn fst choices
   gameCliffwatchInn %= deleteAt i
   name <- use $ activePlayerName
   broadcast $ name ++ " chose " ++ (quest ^. questTitle) ++ " from Cliffwatch Inn."
   restockCliffwatchInn
   return quest

chooseQuest :: GameAction
chooseQuest = do
   quest <- chooseQuest'
   activePlayerState . playerIncompleteQuests <>= [quest]
   return ()

replaceQuests :: GameAction
replaceQuests = do
   quests <- use gameCliffwatchInn
   gameCliffwatchInn .= []
   gameQuestDiscard <>= quests
   restockCliffwatchInn

drawQuest :: GameAction
drawQuest = do
   Just q <- drawQuest'
   name <- use $ activePlayerName
   activePlayerState . playerIncompleteQuests <>= [q]
   broadcast $ printf "%s drew %s from the quest deck." name (q ^. questTitle)

drawNamedQuestType :: GameAction
drawNamedQuestType = do
   let qtypes = [Piety, Warfare, Skullduggery, Arcana, Commerce]
   qtype <- solicitChoice "Choose a quest type:" $ map (show &&& id) qtypes
   name <- use $ activePlayerName
   broadcast $ name ++ " chose the " ++ (show qtype) ++ " quest type."
   flip fix [] $ \loop discards -> do
      mq <- drawQuest'
      case mq of
         Nothing -> do
            broadcast $ "There were no " ++ show qtype ++ " quests available."
            gameQuestDiscard <>= discards
            return ()
         Just q -> do
            broadcast $ printf "%s drew the %s quest %s."
               name (show (q ^. questType)) (q ^. questTitle)
            if (q ^. questType /= qtype)
               then loop (q : discards)
               else do
                  gameQuestDiscard <>= discards
                  activePlayerState . playerIncompleteQuests <>= [q]
                  return ()

distributeQuests :: GameAction
distributeQuests = do
   let distribute remQuests = unless (null remQuests) $ do
         let choices = zipWith (\i q -> (q ^. questTitle, (i, q))) [0..] remQuests
         (i, quest) <- solicitChoice "Choose a quest:" $ nubOn fst choices
         activePlayerState . playerIncompleteQuests <>= [quest]
         name <- use $ activePlayerName
         broadcast $ printf "%s chose the %s quest." name (quest ^. questTitle)
         p' <- nextPlayerID <$> use gameActivePlayer <*> get
         withActivePlayer p' $ distribute (deleteAt i remQuests)
   distribute =<< catMaybes <$> (flip replicateM drawQuest' =<< use gameNumberOfPlayers)

completeQuest :: GameAction
completeQuest = do
   quests <- zip [0..] <$> use (activePlayerState . playerIncompleteQuests)
   let mandatoryQuests = filter ((== Mandatory) . view questType . snd) quests
   let availQuests = if null mandatoryQuests then quests else mandatoryQuests
   let choices = map (\(i,q) -> (q ^. questTitle, (i, q))) availQuests
   (i, quest) <- solicitChoice "Complete one quest:" $ nubOn fst choices
   activePlayerState . playerIncompleteQuests %= deleteAt i
   completeQuest' quest

chooseAndCompleteQuest :: GameAction -> GameAction
chooseAndCompleteQuest bonusAction = do
   quest <- chooseQuest'
   join $ solicitChoice "Complete this quest immediately?" $
      [ ("Yes", do { incompleteQuests <- use (activePlayerState . playerIncompleteQuests)
                   ; guard . and $ map ((/= Mandatory) . view questType) incompleteQuests
                   ; completeQuest' quest
                   ; bonusAction
                   })
      , ("No", activePlayerState . playerIncompleteQuests <>= [quest])
      ]

-- common to both completeQuest and chooseAndCompleteQuest
completeQuest' :: Quest -> GameAction
completeQuest' quest = do
   tavern <- use $ activePlayerState . playerTavern
   guard $ ((quest ^. questCost) `MS.isSubsetOf` tavern)
   activePlayerState . playerTavern %= (`MS.difference` (quest ^. questCost))
   name <- use activePlayerName
   broadcast $ name ++ " completed the \"" ++ (quest^.questTitle) ++ "\" "
                    ++ map toLower (show (quest^.questType)) ++ " quest."
   delimitAction $ do
      quest ^. questReward
      forM_ (filter (\(s,c,a) -> c == Immediately) (quest^.questPlotActions)) $ \(s,c,a) -> a
   if (quest ^. questType == Mandatory)
      then gameIntrigueDiscard <>= [mandatoryQuestCard quest]
      else if null (quest ^. questPlotActions)
           then activePlayerState . playerCompletedQuests <>= [quest]
           else activePlayerState . playerPlotQuests . intAtNext .= Just quest
   doPlotAction (== CompletesQuest (quest^.questType))

discardUncompletedQuest :: GameAction
discardUncompletedQuest = do
   choices <- zipWith (\i q -> (q ^. questTitle, (i, q))) [0..] <$>
                  use (activePlayerState . playerIncompleteQuests)
   (i, quest) <- solicitChoice "Choose a quest to discard:" $ nubOn fst choices
   activePlayerState . playerIncompleteQuests %= deleteAt i
   gameQuestDiscard <>= [quest]
   name <- use $ activePlayerName
   broadcast $ name ++ " discarded the " ++ (quest ^. questTitle) ++ " quest."

chooseFromBuildersHall :: Waterdeep (Int, BuildingState)
chooseFromBuildersHall = do
   choices <- IM.foldrWithKey accumBuildings [] <$> use gameBuildersHall
   (i, b) <- solicitChoice "Choose a building from Builder's Hall:" $ nubOn fst choices
   gameBuildersHall . intAt i .= Nothing
   return (i, b)
   where
      accumBuildings i b a = (label b, (i, b)) : a
      label b = printf "%s (%d Gold, %d Points)"
                (b ^. building . buildingTitle)
                (b ^. building . buildingCost)
                (b ^. buildingAccumulation)

buyBuilding :: GameAction
buyBuilding = do
   (i, b) <- chooseFromBuildersHall
   p      <- use gameActivePlayer
   name   <- use activePlayerName
   returnResources (b ^. building . buildingCost) [Gold]
   let newState = b & buildingOwner .~ p & buildingAccumulation .~ 0
   gameBuildings . intAtNext .= Just newState
   broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "."
   scorePoints (b ^. buildingAccumulation)
   doPlotAction (== BuysBuilding)
   restockBuildersHall

chooseFreeBuilding :: GameAction
chooseFreeBuilding = do
   (i, b) <- chooseFromBuildersHall
   p      <- use gameActivePlayer
   name   <- use activePlayerName
   let newState = b & buildingOwner .~ p & buildingAccumulation .~ 0
   gameBuildings . intAtNext .= Just newState
   broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ " for free."
   scorePoints (b ^. buildingAccumulation)
   restockBuildersHall

drawFreeBuilding :: GameAction
drawFreeBuilding = do
   Just b <- drawBuilding'
   p <- use gameActivePlayer
   gameBuildings . intAtNext .= Just (newBuildingState p b)
   name <- use $ activePlayerName
   broadcast $ name ++ " built the " ++ (b ^. buildingTitle) ++ " for free."

discardUnoccupiedBuilding :: GameAction
discardUnoccupiedBuilding = do
   allBuildings <- IM.toAscList <$> use gameBuildings
   p <- use gameActivePlayer
   let ownedBuildings = filter ((== p) . view buildingOwner . snd) allBuildings
   let emptyBuildings = filter (null . view buildingAgents . snd) ownedBuildings
   let choices = map (\(i,b) -> (b ^. building . buildingTitle, (i, b))) emptyBuildings
   (i, b) <- solicitChoice "Choose a building to discard:" $ nubOn fst choices
   gameBuildings . intAt i .= Nothing
   gameBuildingDiscard <>= [b ^. building]
   name <- use $ activePlayerName
   broadcast $ name ++ " discarded the " ++ (b ^. building . buildingTitle) ++ "."

drawIntrigue :: GameAction
drawIntrigue = do
   Just ic <- drawIntrigue'
   activePlayerState . playerIntrigueCards <>= [ic]
   name <- use $ activePlayerName
   broadcast $ name ++ " drew an Intrigue card."

playIntrigue :: GameAction
playIntrigue = do
   choices <- zipWith (\i ic -> (ic ^. intrigueTitle, (i, ic))) [0..] <$>
                  use (activePlayerState . playerIntrigueCards)
   (i, intrigue) <- solicitChoice "Play one intrigue card:" $ nubOn fst choices
   activePlayerState . playerIntrigueCards %= deleteAt i
   name <- use $ activePlayerName
   broadcast $ name ++ " played the " ++ (intrigue ^. intrigueTitle) ++ " Intrigue card."
   intrigue ^. intrigueAction
   unless (intrigue ^. intrigueType == MandatoryQuest) $
      gameIntrigueDiscard <>= [intrigue]
   doPlotAction (== PlaysIntrigue)
   return ()

returnAgent :: GameAction
returnAgent = do
   w <- get
   let p = w^.gameActivePlayer
   let buildings = flip foldMapBuildings w $ \_ bl ->
         let agents = w^.bl.buildingAgents
             title  = w^.bl.building.buildingTitle
         in mif (p `elem` agents) [(title, bl.buildingAgents %= (\\[p]))]
   join $ solicitChoice "Recall an agent from:" $ nubOn fst buildings
   activePlayerState . playerAgentsInPool += 1

returnAgentFromHarbor :: GameAction
returnAgentFromHarbor = do
   w <- get
   let p = w ^. gameActivePlayer
   let choices = flip foldMap [1,2,3] $ \i ->
         let bl :: Lens' WaterdeepState BuildingState
             bl = gameWaterdeepHarbor . intAt i . singular _Just
         in mif (p `elem` (w^.bl.buildingAgents))
                [(w^.bl.building.buildingTitle, bl.buildingAgents %= (\\[p]))]
   join $ solicitChoice "Recall an agent from:" $ choices
   activePlayerState . playerAgentsInPool += 1

foldMapBuildings ::
   (Monoid m) => (Bool -> Lens' WaterdeepState BuildingState -> m) -> WaterdeepState -> m
foldMapBuildings f w = normal <> harbor <> hall
   where
      normal = flip foldMap (w ^. gameBuildings . to IM.keys) $ \i ->
         f False $ gameBuildings . intAt i . singular _Just
      (harborOccupied, harborUnoccupied) = flip foldMap [1,2,3] $ \i ->
         let bl :: Lens' WaterdeepState BuildingState
             bl = gameWaterdeepHarbor . intAt i . singular _Just
         in if null (w^.bl.buildingAgents)
            then (mempty, First $ Just $ f False bl)
            else (f False bl, mempty)
      harbor = harborOccupied <> (maybe mempty id $ getFirst harborUnoccupied)
      hall = flip foldMap (w ^. gameBuildersHall . to IM.keys) $ \i ->
         f True $ gameBuildersHall . intAt i . singular _Just

useBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep ()
useBuilding bl = do
   p <- use gameActivePlayer
   owner <- use $ bl.buildingOwner
   when (owner `notElem` [noPlayerID, p]) $ fst <$$> delimitAction $
      withActivePlayer owner =<< use (bl.building.buildingOwnerAction)
   join . use $ bl.building.buildingAction

assignAgentToBuilding :: PlayerID -> Lens' WaterdeepState BuildingState -> Waterdeep ()
assignAgentToBuilding agent bl = do
   when (agent /= noPlayerID) $
      gamePlayerState agent . playerAgentsInPool -= 1
   bl.buildingAgents <>= [agent]
   name  <- use $ activePlayerName
   bName <- use $ bl.building.buildingTitle
   broadcast $ name ++ " assigned an agent to " ++ bName ++ "."
   useBuilding bl

assignAmbassador :: GameAction
assignAmbassador = do
   w <- get
   let p = w^.gameActivePlayer
   let opponents = (w^..gamePlayerStates.traverse.playerNumber) \\ [p]
   let includesOpponent = any (`elem` opponents)
   let usedOpSpace = (activePlayerState . playerCanUseOpSpace .= False)
   let canUseOpSpace = w ^. activePlayerState . playerCanUseOpSpace
   let buildings = flip foldMapBuildings w $ \inHall bl ->
         let agents = w^.bl.buildingAgents
             title  = w^.bl.building.buildingTitle
         in if | canUseOpSpace && includesOpponent agents ->
                  [(title, usedOpSpace >> assignAgentToBuilding noPlayerID bl)]
               | null agents && not inHall ->
                  [(title, assignAgentToBuilding noPlayerID bl)]
               | otherwise -> []
   join $ solicitChoice "Assign an agent to:" $ nubOn fst buildings

assignAgent :: GameAction
assignAgent = do
   agents <- use (activePlayerState . playerAgentsInPool)
   guard (agents > 0)
   w <- get
   let p = w^.gameActivePlayer
   let opponents = (w^..gamePlayerStates.traverse.playerNumber) \\ [p]
   let includesOpponent = any (`elem` opponents)
   let usedOpSpace = (activePlayerState . playerCanUseOpSpace .= False)
   let canUseOpSpace = w ^. activePlayerState . playerCanUseOpSpace
   let buildings = flip foldMapBuildings w $ \inHall bl ->
         let agents = w^.bl.buildingAgents
             title  = w^.bl.building.buildingTitle
         in if | canUseOpSpace && includesOpponent agents ->
                  [(title, usedOpSpace >> assignAgentToBuilding p bl)]
               | null agents && not inHall ->
                  [(title, assignAgentToBuilding p bl)]
               | otherwise -> []
   join $ solicitChoice "Assign an agent to:" $ nubOn fst buildings

assignAgentToBuildersHall :: GameAction
assignAgentToBuildersHall = do
   agents <- use (activePlayerState . playerAgentsInPool)
   guard (agents > 0)
   w <- get
   let p = w^.gameActivePlayer
   let opponents = (w^..gamePlayerStates.traverse.playerNumber) \\ [p]
   let includesOpponent = any (`elem` opponents)
   let usedOpSpace = (activePlayerState . playerCanUseOpSpace .= False)
   let canUseOpSpace = w ^. activePlayerState . playerCanUseOpSpace
   let buildings = flip foldMapBuildings w $ \inHall bl -> mif inHall $
         let agents = w^.bl.buildingAgents
             title  = w^.bl.building.buildingTitle
         in if null agents
            then [(title, assignAgentToBuilding p bl)]
            else if canUseOpSpace && includesOpponent agents
                 then [(title, usedOpSpace >> assignAgentToBuilding p bl)]
                 else []
   join $ solicitChoice "Assign an agent to:" $ nubOn fst buildings

assignAgentToOpponentsSpace :: GameAction
assignAgentToOpponentsSpace = do
   agents <- use (activePlayerState . playerAgentsInPool)
   guard (agents > 0)
   w <- get
   let p = w^.gameActivePlayer
   let opponents = (w^..gamePlayerStates.traverse.playerNumber) \\ [p]
   let includesOpponent = any (`elem` opponents)
   let buildings = flip foldMapBuildings w $ \inHall bl ->
         mif (includesOpponent (w^.bl.buildingAgents)) $
            [(w^.bl.building.buildingTitle, assignAgentToBuilding p bl)]
   join $ solicitChoice "Assign an agent to:" $ nubOn fst buildings

useOpponentsSpace :: GameAction
useOpponentsSpace = do
   agents <- use (activePlayerState . playerAgentsInPool)
   guard (agents > 0)
   w <- get
   let p = w^.gameActivePlayer
   let opponents = (w^..gamePlayerStates.traverse.playerNumber) \\ [p]
   let includesOpponent = any (`elem` opponents)
   let buildings = flip foldMapBuildings w $ \inHall bl ->
         mif (includesOpponent (w^.bl.buildingAgents)) $
            [(w^.bl.building.buildingTitle, useBuilding bl)]
   join $ solicitChoice "Use the effect of one building:" $ nubOn fst buildings

gainLieutenant :: GameAction
gainLieutenant = do
   activePlayerState . playerHasLieutenant .= True
   activePlayerState . playerAgentsInPool += 1
   name <- use $ activePlayerName
   broadcast $ name ++ " gained the Lieutenant."
   return ()

gainAmbassador :: GameAction
gainAmbassador = do
   guard . not . or . toListOf (traverse . playerHasAmbassador) =<< use gamePlayerStates
   gameBuildings       . traverse . buildingAgents %= (\\ [noPlayerID])
   gameWaterdeepHarbor . traverse . buildingAgents %= (\\ [noPlayerID])
   gameBuildersHall    . traverse . buildingAgents %= (\\ [noPlayerID])
   activePlayerState . playerHasAmbassador .= True
   name <- use $ activePlayerName
   broadcast $ name ++ " gained the Ambassador."

assignMandatoryQuest :: Quest -> GameAction
assignMandatoryQuest quest = do
   name <- use $ activePlayerName
   opponents <- getOpponents
   let choices = map (view playerName &&& (view playerNumber &&& view playerName)) opponents
   (opID, opName) <- solicitChoice "Choose one opponent:" choices
   gamePlayerState opID . playerIncompleteQuests <>= [quest]
   broadcast $ name ++ " assigned " ++ opName ++ " a mandatory quest."

becomeFirstPlayer :: GameAction
becomeFirstPlayer = do
   assign gameFirstPlayer =<< use gameActivePlayer
   name <- use $ activePlayerName
   broadcast $ name ++ " is now the first player."

enableAssignOnceToOpponentsSpace :: GameAction
enableAssignOnceToOpponentsSpace = do
   activePlayerState . playerCanUseOpSpace .= True

forOneOpponent :: Waterdeep a -> Waterdeep a
forOneOpponent a1 = do
   opponents <- getOpponents
   let choices = map (view playerName &&& (view playerNumber &&& view playerName)) opponents
   (opID, opName) <- solicitChoice "Choose one opponent:" choices
   name <- use $ activePlayerName
   broadcast $ name ++ " chose " ++ opName ++ "."
   withActivePlayer opID (fst <$> delimitAction a1)

forEachOpponent :: Monoid a => Waterdeep a -> Waterdeep a
forEachOpponent a1 = do
   opponents <- getOpponents
   mconcat <$$> forM opponents $ \op ->
      withActivePlayer (op ^. playerNumber) (fst <$> delimitAction a1)

forCurrentPlayer :: Waterdeep a -> Waterdeep (a, ResourceSet)
forCurrentPlayer a1 = do
   p <- use gameCurrentPlayer
   withActivePlayer p $ delimitAction a1

shufflePiles :: Lens WaterdeepState WaterdeepState [a] [a]
             -> Lens WaterdeepState WaterdeepState [a] [a]
             -> Waterdeep ()
shufflePiles deck discard = do
   xs  <- (++) <$> use discard <*> use deck
   xs' <- shuffleM xs
   deck    .= xs'
   discard .= []
   return ()

shuffleQuests    = shufflePiles gameQuestDeck    gameQuestDiscard
shuffleIntrigues = shufflePiles gameIntrigueDeck gameIntrigueDiscard
shuffleBuildings = shufflePiles gameBuildingDeck gameBuildingDiscard

draw :: Lens WaterdeepState WaterdeepState [a] [a]
     -> Lens WaterdeepState WaterdeepState [a] [a]
     -> Waterdeep (Maybe a)
draw deck discard = do
   out <- null <$> use deck
   when out $ shufflePiles deck discard
   listToMaybe <$> (deck %%= splitAt 1)

drawQuest'    = draw gameQuestDeck    gameQuestDiscard
drawIntrigue' = draw gameIntrigueDeck gameIntrigueDiscard
drawBuilding' = draw gameBuildingDeck gameBuildingDiscard

restockCliffwatchInn :: Waterdeep ()
restockCliffwatchInn = do
   num <- length <$> use gameCliffwatchInn
   when (num < 4) $ do
      mq <- drawQuest'
      case mq of
         Nothing -> return ()
         Just q  -> do
            gameCliffwatchInn <>= [q]
            broadcast $ "Added " ++ (q ^. questTitle) ++ " to Cliffwatch Inn."
            restockCliffwatchInn

restockBuildersHall :: Waterdeep ()
restockBuildersHall = do
   hall <- use gameBuildersHall
   let missing = getFirst $ flip F.foldMap [1,2,3] $ \i -> First $
         if i `IM.member` hall then Nothing else Just i
   case missing of
      Nothing -> return ()
      Just i  -> do
         mb <- drawBuilding'
         case mb of
            Nothing -> return ()
            Just b  -> do
               gameBuildersHall . intAt i .= Just (newBuildingState noPlayerID b)
               broadcast $ "Added " ++ (b ^. buildingTitle) ++ " to Builder's Hall."
               restockBuildersHall

getOpponents :: Waterdeep [PlayerState]
getOpponents = do
   p <- use gameActivePlayer
   filter (\p1 -> (p1 ^. playerNumber) /= p) . toListOf traverse <$> use gamePlayerStates

forEachBuilding :: GameAction -> GameAction
forEachBuilding m = do
   advancedBuildings <- countOf traverse isAdvanced <$> use gameBuildings
   replicateM_ advancedBuildings m
   where
      isAdvanced b = b ^. buildingOwner /= noPlayerID

forEachControlledBuilding :: GameAction -> GameAction
forEachControlledBuilding m = do
   p <- use gameActivePlayer
   controlledBuildings <- countOf traverse (`isControlledBy` p) <$> use gameBuildings
   replicateM_ controlledBuildings m
   where
      b `isControlledBy` p = b ^. buildingOwner == p

doPlotAction :: (PlotQualifier -> Bool) -> Waterdeep ()
doPlotAction f = void $ delimitAction $ do
   walkIntMap (activePlayerState . playerPlotQuests) $ \k l -> do
      -- Assumption: Plot actions within the same card do not affect each other.
      actions  <- use $ l . singular _Just . questPlotActions
      actions' <- forM actions $ \case
         (Active, cond@(Whenever qual), action) | f qual -> do
            filterChoices action
            return (Active,cond,action)
         -- TODO: Let player choose when (or if) to use once-per-round actions
         (Active, cond@(OncePerRoundWhen qual), action) | f qual -> do
            filterChoices action >>= \case
               Nothing -> return (Active,cond,action)  -- action can't be completed now
               Just _  -> return (Used,cond,action)    -- action is used up for this round
         x -> return x
      l . singular _Just . questPlotActions .= actions'

mandatoryQuestCard :: Quest -> IntrigueCard
mandatoryQuestCard q =
   IntrigueCard
      { _intrigueTitle  = (q ^. questTitle)
      , _intrigueType   = MandatoryQuest
      , _intrigueAction = assignMandatoryQuest q
      , _intrigueQuote  = (q ^. questQuote)
      }