implement quest completion, Builder's Hall, and misc. specialized actions

src/Test.hs

@@ -1,3 +1,4 @@
+#! /usr/bin/runhaskell
 {-# LANGUAGE GADTs           #-}
 {-# LANGUAGE RankNTypes      #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -5,7 +6,6 @@
 import Waterdeep.Types
 import Waterdeep.Monad
 import Waterdeep.Logic
-import Waterdeep.Util (mrepeat)
 import Control.Applicative
 import Control.Lens
 import Control.Monad
@@ -41,71 +41,71 @@ p2 = ("Ned", f2, l2)
 q1 = Quest { _questType = Arcana
            , _questTitle = "Research Palantirs"
            , _questQuote = ""
-           , _questAction = ReturnResource [Cleric]
+           , _questAction = ReturnResources 1 [Cleric]
-                         <> ReturnResource [Rogue]
+                         <> ReturnResources 1 [Rogue]
-                         <> ReturnResource [Rogue]
+                         <> ReturnResources 1 [Rogue]
-                         <> ReturnResource [Wizard]
+                         <> ReturnResources 1 [Wizard]
-                         <> mrepeat 4 (ReturnResource [Gold])
+                         <> ReturnResources 4 [Gold]
                          <> ScorePoints 15
-                         <> mrepeat 8 (TakeResource [Gold])
+                         <> TakeResources 8 [Gold]
            , _questPlotActions = []
            }
 
 q2 = Quest { _questType = Skullduggery
            , _questTitle = "Rob Waterdeep Bank"
            , _questQuote = ""
-           , _questAction = mrepeat 8 (ReturnResource [Rogue])
+           , _questAction = ReturnResources 8 [Rogue]
                          <> ScorePoints 10
-                         <> mrepeat 16 (TakeResource [Gold])
+                         <> TakeResources 16 [Gold]
            , _questPlotActions = []
            }
 
 b1 = Building { _buildingCost = 6
               , _buildingTitle = "Monastary"
-              , _buildingAction = mrepeat 2 (TakeResource [Cleric])
+              , _buildingAction = TakeResources 2 [Cleric]
-              , _buildingOwnerAction = TakeResource [Cleric]
+              , _buildingOwnerAction = TakeResources 1 [Cleric]
               , _buildingAccumType = NoAccumulation
               }
 
 b2 = Building { _buildingCost = 4
               , _buildingTitle = "Training Hall"
-              , _buildingAction = mrepeat 2 (TakeResource [Fighter])
+              , _buildingAction = TakeResources 2 [Fighter]
-              , _buildingOwnerAction = TakeResource [Fighter]
+              , _buildingOwnerAction = TakeResources 1 [Fighter]
               , _buildingAccumType = NoAccumulation
               }
 
 b3 = Building { _buildingCost = 4
               , _buildingTitle = "Prison Yard"
-              , _buildingAction = mrepeat 2 (TakeResource [Rogue])
+              , _buildingAction = TakeResources 2 [Rogue]
-              , _buildingOwnerAction = TakeResource [Rogue]
+              , _buildingOwnerAction = TakeResources 1 [Rogue]
               , _buildingAccumType = NoAccumulation
               }
 
 b4 = Building { _buildingCost = 6
               , _buildingTitle = "Wizard School"
-              , _buildingAction = mrepeat 2 (TakeResource [Wizard])
+              , _buildingAction = TakeResources 2 [Wizard]
-              , _buildingOwnerAction = TakeResource [Wizard]
+              , _buildingOwnerAction = TakeResources 1 [Wizard]
               , _buildingAccumType = NoAccumulation
               }
 
 b5 = Building { _buildingCost = 4
               , _buildingTitle = "Gold Mine"
-              , _buildingAction = mrepeat 4 (TakeResource [Gold])
+              , _buildingAction = TakeResources 4 [Gold]
-              , _buildingOwnerAction = mrepeat 4 (TakeResource [Gold])
+              , _buildingOwnerAction = TakeResources 2 [Gold]
               , _buildingAccumType = NoAccumulation
               }
 
 i1 = IntrigueCard { _intrigueTitle  = "Graduation Day"
                   , _intrigueType   = Utility
-                  , _intrigueAction = mrepeat 2 (TakeResource [Wizard])
+                  , _intrigueAction = TakeResources 2 [Wizard]
-                                   <> OneOpponent (TakeResource [Wizard])
+                                   <> OneOpponent (TakeResources 1 [Wizard])
                   , _intrigueQuote  = ""
                   }
 
 i2 = IntrigueCard { _intrigueTitle  = "Call for Adventurers"
                   , _intrigueType   = Utility
-                  , _intrigueAction = mrepeat 2 (TakeResource [Cleric, Fighter, Rogue, Wizard])
+                  , _intrigueAction = TakeResources 2 [Cleric, Fighter, Rogue, Wizard]
-                                   <> OneOpponent (TakeResource [Cleric, Fighter, Rogue, Wizard])
+                                   <> OneOpponent (TakeResources 1 [Cleric, Fighter, Rogue, Wizard])
                   , _intrigueQuote  = ""
                   }
 

src/Waterdeep/Logic.hs

@@ -14,7 +14,7 @@ import Control.Lens
 import Control.Monad
 import Control.Monad.Random
 import Control.Monad.State
-import Control.Monad.Writer
+import Control.Monad.Trans.Writer
 import Data.List
 import Data.Maybe
 import Data.Monoid
@@ -88,13 +88,16 @@ newBuildingState p b =
 
 basicBuildings :: [Building]
 basicBuildings =
-   [ basicBuilding "Aurora's Realms Shop" (mrepeat 4 $ TakeResource [Gold])
+   [ basicBuilding "Aurora's Realms Shop" (TakeResources 4 [Gold])
-   , basicBuilding "Blackstaff Tower" (TakeResource [Wizard])
+   , basicBuilding "Blackstaff Tower" (TakeResources 1 [Wizard])
    , basicBuilding "Builder's Hall" BuyBuilding
-   , basicBuilding "Castle Waterdeep" (BecomeFirstPlayer `Then` DrawIntrigue)
+   , basicBuilding "Castle Waterdeep" (BecomeFirstPlayer <> DrawIntrigue)
-   , basicBuilding "Field of Triumph" (mrepeat 2 $ TakeResource [Fighter])
+   , basicBuilding "Field of Triumph" (TakeResources 2 [Fighter])
-   , basicBuilding "The Grinning Lion Tavern" (mrepeat 2 $ TakeResource [Rogue])
+   , basicBuilding "The Grinning Lion Tavern" (TakeResources 2 [Rogue])
-   , basicBuilding "The Plinth" (TakeResource [Cleric])
+   , basicBuilding "The Plinth" (TakeResources 1 [Cleric])
+   , basicBuilding "Cliffwatch Inn (2 Gold)" (ChooseQuest <> TakeResources 2 [Gold])
+   , basicBuilding "Cliffwatch Inn (Intrigue)" (ChooseQuest <> DrawIntrigue)
+   , basicBuilding "Cliffwatch Inn (Reset)" (ReplaceQuests <> ChooseQuest)
    ]
 
 basicBuilding :: String -> GameAction -> Building
@@ -115,15 +118,19 @@ waterdeepGame = do
    forM_ ps $ \p -> do
       replicateM_ 2 $ performAction p DrawQuest
       replicateM_ 2 $ performAction p DrawIntrigue
-      replicateM_ (3 + p) $ performAction p $ TakeResource [Gold]
+      performAction p $ TakeResources (3 + p) [Gold]
    forM_ [1..8] $ \round -> do
       beginRound round
+      -- TODO: Assign ambassador (if in play)
       fix $ \loop -> do
          p <- use gameCurrentPlayer
          success <- filterChoices $ performAction p AssignAgent
          case success of
             True -> do
-               filterChoices $ performAction p CompleteQuest
+               filterChoices $ join $ solicitChoice p "Complete quest?" $
+                  [ ("Yes", performAction p CompleteQuest)
+                  , ("No",  return True)
+                  ]
                gameCurrentPlayer .= (p `mod` length ps) + 1
                gameConsecutivePasses .= 0
                loop
@@ -190,6 +197,31 @@ filterChoices m = do
       forwardPrompt (NotifyState w) = get >>= \w0 -> put w >> notifyState >> put w0
       forwardPrompt (Broadcast s)   = broadcast' s
 
+-- Returns True if there exists some sequence of choices
+-- which would make the action succeed, or False otherwise.
+canPerformAction :: PlayerID -> GameAction -> Waterdeep Bool
+canPerformAction p a = do
+   return . tryChoice . runWaterdeepC Done Cont (performAction p a) =<< get
+   where
+      tryChoice :: ContWD Bool -> Bool
+      tryChoice (Done a) = fst a
+      tryChoice (Cont (NotifyState w) cont) = tryChoice $ cont ()
+      tryChoice (Cont (Broadcast s)   cont) = tryChoice $ cont ()
+      tryChoice (Cont (SolicitChoice p t cs) cont) =
+         or $ map (tryChoice . cont . snd) cs
+
+-- Like (<$>), but with the same fixity and precedence as ($)
+(<$$>) :: Applicative f => (a -> b) -> f a -> f b
+(<$$>) = (<$>)
+infixr 0 <$$>
+
+joinStrings :: [String] -> String
+joinStrings []      = "nothing"
+joinStrings [x]     = x
+joinStrings [x,y]   = x ++ " and " ++ y
+joinStrings [x,y,z] = x ++ ", " ++ y ++ ", and " ++ z
+joinStrings (x:xs)  = x ++ ", " ++ joinStrings xs
+
 performAction :: PlayerID -> GameAction -> Waterdeep Bool
 performAction p a = do
    name <- use $ gamePlayer p . playerName
@@ -197,50 +229,218 @@ performAction p a = do
       NoAction -> return True
       ScorePoints n -> do
          gamePlayer p . playerScore += n
-         broadcast $ name ++ " scored " ++ show n ++ "points."
+         broadcast $ name ++ " scored " ++ show n ++ " points."
          return True
-      TakeResource rs -> do
+      TakeResources n rs -> do
-         r <- solicitChoice p "Take one item:" $ map (show &&& id) rs
+         received <- map (head &&& length) . group . sort <$$> replicateM n $ do
-         gamePlayer p . playerTavern %= flip (M.unionWith (+)) (M.fromList [(r, 1)])
+            r <- solicitChoice p "Take one item:" $ map (show &&& id) rs
-         broadcast $ name ++ " received one " ++ show r ++ "."
+            gamePlayer p . playerTavern %= M.insertWith' (+) r 1
+            return r
+         let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) received
+         broadcast $ name ++ " received " ++ items ++ "."
          return True
-      ReturnResource rs -> do
+      ReturnResources n rs -> do
-         tavern <- use $ gamePlayer p . playerTavern
+         maybeReturned <- replicateM n $ do
-         let rs' = filter ((> 0) . maybe 0 id . flip M.lookup tavern) rs
+            tavern <- use $ gamePlayer p . playerTavern
-         if null rs'
+            let rs' = filter ((>= 1) . maybe 0 id . flip M.lookup tavern) rs
-            then return False
+            if null rs'
-            else do
+               then return Nothing
-               r <- solicitChoice p "Return one item:" $ map (show &&& id) rs'
+               else do
-               let removeOne x = if x > 1 then Just (x-1) else Nothing
+                  r <- solicitChoice p "Return one item:" $ map (show &&& id) rs'
-               gamePlayer p . playerTavern %= M.update removeOne r
+                  let removeOne x = if x > 1 then Just (x-1) else Nothing
-               broadcast $ name ++ " returned one " ++ show r ++ " to the supply."
+                  gamePlayer p . playerTavern %= M.update removeOne r
-               return True
+                  return (Just r)
+         let success = and . map isJust $ maybeReturned
+         let returned = map (head &&& length) . group . catMaybes $ maybeReturned
+         let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) $ returned
+         broadcast $ name ++ " returned " ++ items ++ " to the supply."
+         return success
       ChooseQuest -> do
-         qs <- use gameCliffwatchInn
+         quests <- use gameCliffwatchInn
-         if null qs
+         if null quests
             then return False
             else do
-               let names = qs ^.. traverse . questTitle
+               let titles = quests ^.. traverse . questTitle
-               q <- solicitChoice p "Please choose a quest:" $ zip names qs
+               i <- solicitChoice p "Choose one quest:" $ zip titles [0..]
-               gameCliffwatchInn %= (\\ [q])
+               let quest = quests !! i
-               gamePlayer p . playerIncompleteQuests <>= [q]
+               gameCliffwatchInn %= deleteAt i
-               broadcast $ name ++ " chose " ++ (q ^. questTitle) ++ " from Cliffwatch Inn."
+               gamePlayer p . playerIncompleteQuests <>= [quest]
+               broadcast $ name ++ " chose " ++ (quest ^. questTitle) ++ " from Cliffwatch Inn."
                restockCliffwatchInn
                return True
+      ReplaceQuests -> do
+         quests <- gameCliffwatchInn <<.= []
+         gameQuestDiscard <>= quests
+         restockCliffwatchInn
+         return True
       DrawQuest -> do
          mq <- drawQuest
          case mq of
-            Nothing -> return False
+            Nothing -> do
+               broadcast $ name ++ " failed to draw a quest because the quest deck is empty."
+               return False
             Just q  -> do
                gamePlayer p . playerIncompleteQuests <>= [q]
                broadcast $ name ++ " drew " ++ (q ^. questTitle) ++ " from the quest deck."
                return True
+      DrawNamedQuestType -> do
+         let qtypes = [Piety, Warfare, Skullduggery, Arcana, Commerce]
+         qtype <- solicitChoice p "Choose a quest type:" $ map (show &&& id) qtypes
+         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 False
+               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) >> return True
+                     else do
+                        gameQuestDiscard <>= discards
+                        gamePlayer p . playerIncompleteQuests <>= [q]
+                        return True
+      DistributeQuests -> do
+         np <- IM.size <$> use gamePlayers
+         let loop p' remQuests = do
+               unless (null remQuests) $ do
+                  i <- solicitChoice p' "Choose a quest:" $
+                     zip (map (view questTitle) remQuests) [0..]
+                  gamePlayer p' . playerIncompleteQuests <>= [remQuests !! i]
+                  loop ((p' `mod` np) + 1) (deleteAt i remQuests)
+         loop p =<< return . catMaybes =<< replicateM np drawQuest
+         return True
+      CompleteQuest -> do
+         quests <- use (gamePlayer p . playerIncompleteQuests)
+         if null quests
+            then return False
+            else filterChoices $ do
+               let choices = zip (map (view questTitle) quests) [0..]
+               i <- solicitChoice p "Complete one quest:" choices
+               let quest = quests !! i
+               if (quest ^. questType /= Mandatory &&
+                   or (map (\q -> q ^. questType == Mandatory) quests))
+                  then return False
+                  else do
+                     gamePlayer p . playerIncompleteQuests %= deleteAt i
+                     success <- performAction p (quest ^. questAction)
+                     if null (quest ^. questPlotActions)
+                        then gamePlayer p . playerCompletedQuests  <>= [quest]
+                        else gamePlayer p . playerActivePlotQuests <>= [quest]
+                     broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest."
+                     return success
+      ChooseAndCompleteQuest bonusAction -> do
+         quests <- use gameCliffwatchInn
+         if null quests
+            then return False
+            else filterChoices $ do
+               let titles = quests ^.. traverse . questTitle
+               i <- solicitChoice p "Choose one quest:" $ zip titles [0..]
+               let quest = quests !! i
+               if (quest ^. questType /= Mandatory &&
+                   or (map (\q -> q ^. questType == Mandatory) quests))
+                  then return False
+                  else do
+                     gameCliffwatchInn %= deleteAt i
+                     broadcast $ name ++ " chose " ++ (quest ^. questTitle) ++ " from Cliffwatch Inn."
+                     restockCliffwatchInn
+                     doQuest <- solicitChoice p "Complete this quest immediately?"
+                                             [("Yes", True), ("No", False)]
+                     case doQuest of
+                        True -> do
+                           questSuccess <- performAction p (quest ^. questAction)
+                           bonusSuccess <- performAction p bonusAction
+                           if null (quest ^. questPlotActions)
+                              then gamePlayer p . playerCompletedQuests  <>= [quest]
+                              else gamePlayer p . playerActivePlotQuests <>= [quest]
+                           broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest."
+                           return (questSuccess && bonusSuccess)
+                        False -> do
+                           gamePlayer p . playerIncompleteQuests <>= [quest]
+                           return True
+      DiscardUncompletedQuest -> do
+         quests <- use (gamePlayer p . playerIncompleteQuests)
+         if null quests
+            then return False
+            else do
+               i <- solicitChoice p "Choose a quest to discard:" $
+                  zip (map (view questTitle) quests) [0..]
+               let quest = quests !! i
+               gamePlayer p . playerIncompleteQuests %= deleteAt i
+               gameQuestDiscard <>= [quest]
+               broadcast $ name ++ " discarded the " ++ (quest ^. questTitle) ++ " quest."
+               return True
+      BuyBuilding -> do
+         buildings <- use gameBuildersHall
+         if null buildings
+            then return False
+            else do
+               let labels = flip map buildings $ \b -> printf "%s (%d Gold, %d Points)"
+                     (b ^. building . buildingTitle)
+                     (b ^. building . buildingCost)
+                     (b ^. buildingAccumulation)
+               filterChoices $ do
+                  i <- solicitChoice p "Choose a building from Builder's Hall:" $
+                     zip labels [0..]
+                  let b = buildings !! i
+                  let cost = b ^. building . buildingCost
+                  paid <- performAction p $ ReturnResources cost [Gold]
+                  performAction p $ ScorePoints (b ^. buildingAccumulation)
+                  gameBuildersHall %= deleteAt i
+                  gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0]
+                  broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "."
+                  restockBuildersHall
+                  return paid
+      ChooseFreeBuilding -> do
+         buildings <- use gameBuildersHall
+         if null buildings
+            then return False
+            else do
+               let labels = flip map buildings $ \b -> printf "%s (%d Points)"
+                     (b ^. building . buildingTitle)
+                     (b ^. buildingAccumulation)
+               i <- solicitChoice p "Choose a building from Builder's Hall:" $
+                  zip labels [0..]
+               let b = buildings !! i
+               performAction p $ ScorePoints (b ^. buildingAccumulation)
+               gameBuildersHall %= deleteAt i
+               gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0]
+               broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ " for free."
+               restockBuildersHall
+               return True
+      DrawFreeBuilding -> do
+         mb <- drawBuilding
+         case mb of
+            Nothing -> return False
+            Just b -> do
+               gameBuildings <>= [newBuildingState p b]
+               broadcast $ name ++ " built the " ++ (b ^. buildingTitle) ++ " for free."
+               return True
+      DiscardUnoccupiedBuilding -> do
+         allBuildings <- use gameBuildings
+         let choices = flip mapMaybe (zip allBuildings [0..]) $ \(b, i) ->
+               case b ^. buildingOwner == p of
+                  True -> Just (b ^. building . buildingTitle, i)
+                  False -> Nothing
+         if null choices
+            then return False
+            else do
+               i <- solicitChoice p "Choose a building to discard:" choices
+               let b = allBuildings !! i
+               gameBuildings %= deleteAt i
+               gameBuildingDiscard <>= [b ^. building]
+               broadcast $ name ++ " discarded the " ++ (b ^. building . buildingTitle) ++ "."
+               return True
       DrawIntrigue -> do
          mi <- drawIntrigue
          case mi of
             Nothing -> return False
             Just i  -> do
                gamePlayer p . playerIntrigueCards <>= [i]
+               broadcast $ name ++ " drew an Intrigue card."
                return True
       PlayIntrigue -> do
          intrigues <- use (gamePlayer p . playerIntrigueCards)
@@ -250,15 +450,20 @@ performAction p a = do
                let sameTitle a b = fst a == fst b
                let choices = nubBy sameTitle $ zip (map (view intrigueTitle) intrigues) [0..]
                i <- solicitChoice p "Play one intrigue card:" choices
-               let deleteAt n l = (take n l) ++ (drop (n + 1) l)
+               let intrigue = intrigues !! i
-               gamePlayer p . playerIntrigueCards %= deleteAt i
+               filterChoices $ do
-               performAction p (intrigues ^. singular (ix i) . intrigueAction)
+                  gamePlayer p . playerIntrigueCards %= deleteAt i
+                  broadcast $ name ++ " played the " ++ (intrigue ^. intrigueTitle) ++ " Intrigue card."
+                  success <- performAction p (intrigue ^. intrigueAction)
+                  gameIntrigueDiscard <>= [intrigue]
+                  return success
+      ReturnAgent -> return False -- TODO
+      ReturnAgentFromHarbor -> return False -- TODO
       AssignAgent -> do
          agents <- use (gamePlayer p . playerAgentsInPool)
          if agents <= 0
             then return False
             else do
-               w <- get
                let assignToBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep Bool
                    assignToBuilding bl = do
                      gamePlayer p . playerAgentsInPool -= 1
@@ -266,7 +471,7 @@ performAction p a = do
                      bName <- use (bl . building . buildingTitle)
                      broadcast $ name ++ " assigned an agent to " ++ bName ++ "."
                      owner <- use (bl . buildingOwner)
-                     when (owner /= noPlayerID) $
+                     when (owner `notElem` [noPlayerID, p]) $
                         void . performAction owner =<< use (bl . building . buildingOwnerAction)
                      performAction p =<< use (bl . building . buildingAction)
                let assignToHarbor l = do
@@ -274,29 +479,57 @@ performAction p a = do
                      gameWaterdeepHarbor . l <>= [p]
                      broadcast $ name ++ " assigned an agent to Waterdeep Harbor."
                      performAction p PlayIntrigue
-               let findBuildings :: Writer [(String, Waterdeep Bool)] ()
+               buildings <- execWriterT $ do
-                   findBuildings = do
+                  w <- get
-                     forM_ [0 .. length (w ^. gameBuildings) - 1] $ \i -> do
+                  forM_ [0 .. length (w ^. gameBuildings) - 1] $ \i -> do
-                        let l :: Lens' WaterdeepState BuildingState
+                     let l :: Lens' WaterdeepState BuildingState
-                            l = gameBuildings . singular (ix i)
+                         l = gameBuildings . singular (ix i)
-                        when (null (w ^. l . buildingAgents)) $ do
+                     when (null (w ^. l . buildingAgents)) $ do
-                           tell [(w ^. l . building . buildingTitle, assignToBuilding l)]
+                        tell [(w ^. l . building . buildingTitle, assignToBuilding l)]
-                     case w ^. gameWaterdeepHarbor of
+                  case w ^. gameWaterdeepHarbor of
-                        ([], _, _) -> tell [("Waterdeep Harbor", assignToHarbor _1)]
+                     ([], _, _) -> tell [("Waterdeep Harbor", assignToHarbor _1)]
-                        (_, [], _) -> tell [("Waterdeep Harbor", assignToHarbor _2)]
+                     (_, [], _) -> tell [("Waterdeep Harbor", assignToHarbor _2)]
-                        (_, _, []) -> tell [("Waterdeep Harbor", assignToHarbor _3)]
+                     (_, _, []) -> tell [("Waterdeep Harbor", assignToHarbor _3)]
-                        _          -> return ()
+                     _          -> return ()
-               let buildings = execWriter findBuildings
                if null buildings
                   then return False
                   else do
                      join $ solicitChoice p "Assign one agent to:" buildings
-      Optional a1 -> do
+      AssignAgentToBuildersHall -> return False -- TODO
-         join $ solicitChoice p "Perform action?" $
+      AssignAgentToOpponentsSpace -> return False -- TODO
-            [ ("Yes", performAction p a1)
+      UseOpponentsSpace -> return False -- TODO
-            , ("No",  return False)]
+      GainLieutenant -> do
+         gamePlayer p . playerHasLieutenant .= True
+         gamePlayer p . playerAgentsInPool += 1
+         broadcast $ name ++ " gained the Lieutenant."
+         return True
+      GainAmbassador -> do
+         unavail <- or . toListOf (traverse . playerHasAmbassador) <$> use gamePlayers
+         if unavail
+            then return False
+            else do
+               gameBuildings . each . buildingAgents %= (\\ [noPlayerID])
+               gameWaterdeepHarbor . each %= (\\ [noPlayerID])
+               gamePlayer p . playerHasAmbassador .= True
+               broadcast $ name ++ " gained the Ambassador."
+               return True
+      TakeAccumulated ->
+         return True
+      AssignMandatoryQuest quest -> do
+         players <- toListOf traverse <$> use gamePlayers
+         let opponents = filter (\player -> (player ^. playerNumber) /= p) players
+         let choices = map (\p -> (p ^. playerName, p ^. playerNumber)) opponents
+         opID <- solicitChoice p "Choose one opponent:" choices
+         opName <- use (gamePlayer opID . playerName)
+         gamePlayer opID . playerIncompleteQuests <>= [quest]
+         broadcast $ name ++ " assigned " ++ opName ++ " a mandatory quest."
+         return True
+      BecomeFirstPlayer -> do
+         gameFirstPlayer .= p
+         broadcast $ name ++ " is now the first player."
+         return True
       ChooseOne as -> do
-         a1 <- solicitChoice p "Choose an action:" $ map (show &&& id) as
+         a1 <- solicitChoice p "Choose one:" $ map (show &&& id) as
          performAction p a1
       a1 `Then` a2 -> do
          (&&) <$> performAction p a1 <*> performAction p a2
@@ -327,7 +560,6 @@ performAction p a = do
          return True
       CurrentPlayer a1 ->
          flip performAction a1 =<< use gameCurrentPlayer
-      _ -> return False
 
 scoreFinalPoints :: Waterdeep ()
 scoreFinalPoints = do

src/Waterdeep/Types.hs

@@ -193,16 +193,16 @@ data AccumulationType = NoAccumulation
 
 data GameAction = NoAction
                 | ScorePoints Int
-                | TakeResource [Resource]
+                | TakeResources Int [Resource]
-                | ReturnResource [Resource]
+                | ReturnResources Int [Resource]
-                | GiveResource [Resource]
+                | GiveResources Int [Resource]
                 | ChooseQuest
                 | ReplaceQuests
                 | DrawQuest
                 | DrawNamedQuestType
                 | DistributeQuests
                 | CompleteQuest
-                | ChooseAndCompleteQuest
+                | ChooseAndCompleteQuest GameAction
                 | DiscardUncompletedQuest
                 | BuyBuilding
                 | ChooseFreeBuilding
@@ -219,10 +219,8 @@ data GameAction = NoAction
                 | GainLieutenant
                 | GainAmbassador
                 | TakeAccumulated
-                | TakeResourceFromOpponent [Resource]
                 | AssignMandatoryQuest Quest
                 | BecomeFirstPlayer
-                | Optional GameAction
                 | ChooseOne [GameAction]
                 | Then GameAction GameAction
                 | OrElse GameAction GameAction

src/Waterdeep/Util.hs

@@ -1,8 +1,12 @@
 module Waterdeep.Util 
    ( mrepeat
+   , deleteAt
    ) where
 
 import Data.Monoid
 
 mrepeat :: (Monoid m) => Int -> m -> m
 mrepeat n m = mconcat $ replicate n m
+
+deleteAt :: Int -> [a] -> [a]
+deleteAt n l = (take n l) ++ (drop (n + 1) l)