nybble
/
waterdeep
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

replace Control.Lens with the lighter-weight lens-family package

This commit is contained in:
Jesse D. McDonald 2014-05-11 02:19:38 -05:00
parent c582d83267
commit 349472da78
5 changed files with 142 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/ConsoleUI.hs
View File

@ -6,7 +6,6 @@
module Main (main) where module Main (main) where
import Control.Applicative import Control.Applicative
import Control.Lens
import Control.Monad import Control.Monad
import Control.Monad.Prompt import Control.Monad.Prompt
import Control.Monad.Random import Control.Monad.Random
@ -14,6 +13,11 @@ import Control.Monad.State
import Data.IORef import Data.IORef
import Data.List import Data.List
import Data.Monoid import Data.Monoid
import Data.Traversable (traverse)
import Lens.Family2
import Lens.Family2.Stock
import Lens.Family2.State
import Lens.Family2.TH
import System.IO import System.IO
import System.Random import System.Random
import System.Random.Shuffle import System.Random.Shuffle
@ -141,7 +145,7 @@ printWaterdeep w = do
putStrLn (" " ++ (q ^. questTitle)) putStrLn (" " ++ (q ^. questTitle))
putStrLn "" putStrLn ""
putStrLn "Builder's Hall:" putStrLn "Builder's Hall:"
forM_ (w ^. gameBuildersHall) $ \b -> do forM_ (w ^.. gameBuildersHall . traverse) $ \b -> do
printf " %s (%d gold -> %d points)\n" printf " %s (%d gold -> %d points)\n"
(b ^. building . buildingTitle) (b ^. building . buildingTitle)
(b ^. building . buildingCost) (b ^. building . buildingCost)

162
src/Waterdeep/Actions.hs
View File

@ -44,22 +44,28 @@ module Waterdeep.Actions
import Control.Applicative import Control.Applicative
import Control.Arrow ((&&&)) import Control.Arrow ((&&&))
import Control.Lens
import Control.Monad import Control.Monad
import Control.Monad.Random import Control.Monad.Random
import Control.Monad.State import Control.Monad.State
import Control.Monad.Trans.Writer import Control.Monad.Trans.Writer
import Data.Function
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Data.Traversable (traverse)
import Lens.Family2
import Lens.Family2.State
import Lens.Family2.Stock
import System.Random.Shuffle import System.Random.Shuffle
import Text.Printf import Text.Printf
import Waterdeep.Types import Waterdeep.Types
import Waterdeep.Util import Waterdeep.Util
import qualified Data.IntMap as IM import qualified Data.Foldable as F
import qualified Data.Map as M import qualified Data.IntMap as IM
import qualified Data.MultiSet as MS import qualified Data.Map as M
import qualified Data.MultiSet as MS
import qualified Data.Traversable as T
noAction :: GameAction noAction :: GameAction
noAction = return () noAction = return ()
@ -110,7 +116,8 @@ chooseQuest = do
replaceQuests :: GameAction replaceQuests :: GameAction
replaceQuests = do replaceQuests = do
quests <- gameCliffwatchInn <<.= [] quests <- use gameCliffwatchInn
gameCliffwatchInn .= []
gameQuestDiscard <>= quests gameQuestDiscard <>= quests
restockCliffwatchInn restockCliffwatchInn
@ -201,56 +208,62 @@ discardUncompletedQuest = do
name <- use $ activePlayerName name <- use $ activePlayerName
broadcast $ name ++ " discarded the " ++ (quest ^. questTitle) ++ " quest." 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 :: GameAction
buyBuilding = do buyBuilding = do
let label b = printf "%s (%d Gold, %d Points)" (i, b) <- chooseFromBuildersHall
(b ^. building . buildingTitle) p <- use gameActivePlayer
(b ^. building . buildingCost) name <- use activePlayerName
(b ^. buildingAccumulation) returnResources (b ^. building . buildingCost) [Gold]
choices <- zipWith (\i b -> (label b, (i, b))) [0..] <$> use gameBuildersHall newKey <- (+1) . fst . IM.findMax <$> use gameBuildings
(i, b) <- solicitChoice "Choose a building from Builder's Hall:" $ nubOn fst choices let newState = b & buildingOwner .~ p & buildingAccumulation .~ 0
let cost = b ^. building . buildingCost gameBuildings %= IM.insert newKey newState
returnResources cost [Gold]
scorePoints (b ^. buildingAccumulation)
gameBuildersHall %= deleteAt i
p <- use gameActivePlayer
gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0]
name <- use $ activePlayerName
broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "." broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "."
scorePoints (b ^. buildingAccumulation)
restockBuildersHall restockBuildersHall
chooseFreeBuilding :: GameAction chooseFreeBuilding :: GameAction
chooseFreeBuilding = do chooseFreeBuilding = do
let label b = printf "%s (%d Points)" (i, b) <- chooseFromBuildersHall
(b ^. building . buildingTitle) p <- use gameActivePlayer
(b ^. buildingAccumulation) name <- use activePlayerName
choices <- zipWith (\i b -> (label b, (i, b))) [0..] <$> use gameBuildersHall newKey <- (+1) . fst . IM.findMax <$> use gameBuildings
(i, b) <- solicitChoice "Choose a building from Builder's Hall:" $ nubOn fst choices let newState = b & buildingOwner .~ p & buildingAccumulation .~ 0
scorePoints (b ^. buildingAccumulation) gameBuildings %= IM.insert newKey newState
gameBuildersHall %= deleteAt i
p <- use gameActivePlayer
gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0]
name <- use $ activePlayerName
broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ " for free." broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ " for free."
scorePoints (b ^. buildingAccumulation)
restockBuildersHall restockBuildersHall
drawFreeBuilding :: GameAction drawFreeBuilding :: GameAction
drawFreeBuilding = do drawFreeBuilding = do
Just b <- drawBuilding' Just b <- drawBuilding'
p <- use gameActivePlayer p <- use gameActivePlayer
gameBuildings <>= [newBuildingState p b] newKey <- (+1) . fst . IM.findMax <$> use gameBuildings
gameBuildings %= IM.insert newKey (newBuildingState p b)
name <- use $ activePlayerName name <- use $ activePlayerName
broadcast $ name ++ " built the " ++ (b ^. buildingTitle) ++ " for free." broadcast $ name ++ " built the " ++ (b ^. buildingTitle) ++ " for free."
discardUnoccupiedBuilding :: GameAction discardUnoccupiedBuilding :: GameAction
discardUnoccupiedBuilding = do discardUnoccupiedBuilding = do
allBuildings <- zip [0..] <$> use gameBuildings allBuildings <- IM.toAscList <$> use gameBuildings
p <- use gameActivePlayer p <- use gameActivePlayer
let ownedBuildings = filter ((== p) . view buildingOwner . snd) allBuildings let ownedBuildings = filter ((== p) . view buildingOwner . snd) allBuildings
let emptyBuildings = filter (null . view buildingAgents . snd) ownedBuildings let emptyBuildings = filter (null . view buildingAgents . snd) ownedBuildings
let choices = map (\(i,b) -> (b ^. building . buildingTitle, (i, b))) emptyBuildings let choices = map (\(i,b) -> (b ^. building . buildingTitle, (i, b))) emptyBuildings
(i, b) <- solicitChoice "Choose a building to discard:" $ nubOn fst choices (i, b) <- solicitChoice "Choose a building to discard:" $ nubOn fst choices
gameBuildings %= deleteAt i gameBuildings . intAt i .= Nothing
gameBuildingDiscard <>= [b ^. building] gameBuildingDiscard <>= [b ^. building]
name <- use $ activePlayerName name <- use $ activePlayerName
broadcast $ name ++ " discarded the " ++ (b ^. building . buildingTitle) ++ "." broadcast $ name ++ " discarded the " ++ (b ^. building . buildingTitle) ++ "."
@ -280,24 +293,24 @@ returnAgent = return () -- TODO
returnAgentFromHarbor :: GameAction returnAgentFromHarbor :: GameAction
returnAgentFromHarbor = return () -- TODO returnAgentFromHarbor = return () -- TODO
assignAgentToBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep () assignAgentToBuilding :: Traversal' WaterdeepState BuildingState -> Waterdeep ()
assignAgentToBuilding bl = do assignAgentToBuilding bt = do
activePlayerState . playerAgentsInPool -= 1 activePlayerState.playerAgentsInPool -= 1
p <- use gameActivePlayer p <- use gameActivePlayer
bl . buildingAgents <>= [p] bt.buildingAgents <>= [p]
name <- use $ activePlayerName name <- use $ activePlayerName
bName <- use (bl . building . buildingTitle) bName <- fromJust . firstOf (bt.building.buildingTitle) <$> get
broadcast $ name ++ " assigned an agent to " ++ bName ++ "." broadcast $ name ++ " assigned an agent to " ++ bName ++ "."
owner <- use (bl . buildingOwner) owner <- fromJust . firstOf (bt.buildingOwner) <$> get
when (owner `notElem` [noPlayerID, p]) $ when (owner `notElem` [noPlayerID, p]) $
withActivePlayer owner =<< use (bl . building . buildingOwnerAction) withActivePlayer owner . fromJust . firstOf (bt.building.buildingOwnerAction) =<< get
join $ use (bl . building . buildingAction) fromJust . firstOf (bt.building.buildingAction) =<< get
assignAgentToHarbor :: Lens' ([PlayerID], [PlayerID], [PlayerID]) [PlayerID] -> Waterdeep () assignAgentToHarbor :: Traversal' WaterdeepState [PlayerID] -> Waterdeep ()
assignAgentToHarbor l = do assignAgentToHarbor t = do
activePlayerState . playerAgentsInPool -= 1 activePlayerState.playerAgentsInPool -= 1
p <- use gameActivePlayer p <- use gameActivePlayer
gameWaterdeepHarbor . l <>= [p] t <>= [p]
name <- use $ activePlayerName name <- use $ activePlayerName
broadcast $ name ++ " assigned an agent to Waterdeep Harbor." broadcast $ name ++ " assigned an agent to Waterdeep Harbor."
playIntrigue playIntrigue
@ -308,16 +321,21 @@ assignAgent = do
guard (agents > 0) guard (agents > 0)
w <- get w <- get
let buildings = execWriter $ do let buildings = execWriter $ do
forM_ [0 .. length (w ^. gameBuildings) - 1] $ \i -> do forM_ (w ^. gameBuildings . to IM.keys) $ \i -> do
let l :: Lens' WaterdeepState BuildingState let t :: Traversal' WaterdeepState BuildingState
l = gameBuildings . singular (ix i) t = gameBuildings . intAt i . traverse
when (null (w ^. l . buildingAgents)) $ do when (anyOf (t . buildingAgents) null w) $ do
tell [(w ^. l . building . buildingTitle, assignAgentToBuilding l)] let title = fromJust $ firstOf (t.building.buildingTitle) w
case w ^. gameWaterdeepHarbor of tell [(title, assignAgentToBuilding t)]
([], _, _) -> tell [("Waterdeep Harbor", assignAgentToHarbor _1)] let harbor = getFirst $ flip F.foldMap [1,2,3] $ \i -> First $
(_, [], _) -> tell [("Waterdeep Harbor", assignAgentToHarbor _2)] let t :: Traversal' WaterdeepState [PlayerID]
(_, _, []) -> tell [("Waterdeep Harbor", assignAgentToHarbor _3)] t = gameWaterdeepHarbor . intAt i . traverse
_ -> return () in if (anyOf t null w)
then Just (assignAgentToHarbor t)
else Nothing
case harbor of
Just f -> tell [("Waterdeep Harbor", f)]
Nothing -> return ()
join $ solicitChoice "Assign one agent to:" $ nubOn fst buildings join $ solicitChoice "Assign one agent to:" $ nubOn fst buildings
assignAgentToBuildersHall :: GameAction assignAgentToBuildersHall :: GameAction
@ -340,8 +358,8 @@ gainLieutenant = do
gainAmbassador :: GameAction gainAmbassador :: GameAction
gainAmbassador = do gainAmbassador = do
guard . not . or . toListOf (traverse . playerHasAmbassador) =<< use gamePlayerStates guard . not . or . toListOf (traverse . playerHasAmbassador) =<< use gamePlayerStates
gameBuildings . each . buildingAgents %= (\\ [noPlayerID]) gameBuildings . traverse . buildingAgents %= (\\ [noPlayerID])
gameWaterdeepHarbor . each %= (\\ [noPlayerID]) gameWaterdeepHarbor . traverse %= (\\ [noPlayerID])
activePlayerState . playerHasAmbassador .= True activePlayerState . playerHasAmbassador .= True
name <- use $ activePlayerName name <- use $ activePlayerName
broadcast $ name ++ " gained the Ambassador." broadcast $ name ++ " gained the Ambassador."
@ -357,7 +375,7 @@ assignMandatoryQuest quest = do
becomeFirstPlayer :: GameAction becomeFirstPlayer :: GameAction
becomeFirstPlayer = do becomeFirstPlayer = do
gameFirstPlayer <~ use gameActivePlayer assign gameFirstPlayer =<< use gameActivePlayer
name <- use $ activePlayerName name <- use $ activePlayerName
broadcast $ name ++ " is now the first player." broadcast $ name ++ " is now the first player."
@ -432,16 +450,19 @@ restockCliffwatchInn = do
restockBuildersHall :: Waterdeep () restockBuildersHall :: Waterdeep ()
restockBuildersHall = do restockBuildersHall = do
num <- length <$> use gameBuildersHall hall <- use gameBuildersHall
when (num < 3) $ do let missing = getFirst $ flip F.foldMap [1,2,3] $ \i -> First $
mb <- drawBuilding' if i `IM.member` hall then Nothing else Just i
case mb of case missing of
Nothing -> return () Nothing -> return ()
Just b -> do Just i -> do
gameBuildersHall <>= [newBuildingState noPlayerID b] mb <- drawBuilding'
broadcast $ "Added " ++ (b ^. buildingTitle) ++ " to Builder's Hall." case mb of
restockBuildersHall 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 :: Waterdeep [PlayerState]
getOpponents = do getOpponents = do
@ -449,10 +470,13 @@ getOpponents = do
filter (\p1 -> (p1 ^. playerNumber) /= p) . toListOf traverse <$> use gamePlayerStates filter (\p1 -> (p1 ^. playerNumber) /= p) . toListOf traverse <$> use gamePlayerStates
getNumberOfBuildings :: Waterdeep Int getNumberOfBuildings :: Waterdeep Int
getNumberOfBuildings = getNumberOfBuildings = countOf traverse isOwned <$> use gameBuildings
length . filter (\b -> b ^. buildingOwner /= noPlayerID) <$> use gameBuildings where
isOwned b = b ^. buildingOwner /= noPlayerID
getNumberOfControlledBuildings :: Waterdeep Int getNumberOfControlledBuildings :: Waterdeep Int
getNumberOfControlledBuildings = do getNumberOfControlledBuildings = do
p <- use gameActivePlayer p <- use gameActivePlayer
length . filter (\b -> b ^. buildingOwner == p) <$> use gameBuildings countOf traverse (`isOwnedBy` p) <$> use gameBuildings
where
b `isOwnedBy` p = b ^. buildingOwner == p

41
src/Waterdeep/Logic.hs
View File

@ -11,7 +11,6 @@ module Waterdeep.Logic
import Control.Applicative import Control.Applicative
import Control.Arrow ((&&&)) import Control.Arrow ((&&&))
import Control.Lens
import Control.Monad import Control.Monad
import Control.Monad.Random import Control.Monad.Random
import Control.Monad.State import Control.Monad.State
@ -19,6 +18,10 @@ import Control.Monad.Trans.Writer
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Data.Traversable (traverse)
import Lens.Family2
import Lens.Family2.State
import Lens.Family2.Stock
import System.Random.Shuffle import System.Random.Shuffle
import Text.Printf import Text.Printf
import Waterdeep.Actions import Waterdeep.Actions
@ -51,13 +54,15 @@ newGame players quests intrigues buildings rndgen =
, _gameIntrigueDiscard = intrigues , _gameIntrigueDiscard = intrigues
, _gameBuildingDeck = [] , _gameBuildingDeck = []
, _gameBuildingDiscard = buildings , _gameBuildingDiscard = buildings
, _gameBuildersHall = [] , _gameBuildersHall = IM.empty
, _gameBuildings = map (newBuildingState noPlayerID) basicBuildings , _gameBuildings = IM.fromAscList buildingStates
, _gameWaterdeepHarbor = ([], [], []) , _gameWaterdeepHarbor = IM.fromAscList [(1,[]),(2,[]),(3,[])]
, _gameStdGen = rndgen , _gameStdGen = rndgen
} }
where where
playerStates = [ (i, newPlayerState i p) | (i, p) <- zip [1..] players ] playerStates = zipWith (\i p -> (i, newPlayerState i p)) [1..] players
buildingStates = zipWith (\i b -> (i, newBuildingState np b)) [1..] basicBuildings
np = noPlayerID
basicBuildings :: [Building] basicBuildings :: [Building]
basicBuildings = basicBuildings =
@ -97,7 +102,7 @@ waterdeepGame = do
beginRound round beginRound round
-- TODO: Assign ambassador (if in play) -- TODO: Assign ambassador (if in play)
fix $ \loop -> do fix $ \loop -> do
gameActivePlayer <~ use gameCurrentPlayer assign gameActivePlayer =<< use gameCurrentPlayer
filterChoices assignAgent >>= \case filterChoices assignAgent >>= \case
Just () -> do Just () -> do
filterChoices $ join $ solicitChoice "Complete a quest?" $ filterChoices $ join $ solicitChoice "Complete a quest?" $
@ -108,7 +113,8 @@ waterdeepGame = do
advanceToNextPlayer advanceToNextPlayer
loop loop
Nothing -> do Nothing -> do
passes <- gameConsecutivePasses <+= 1 gameConsecutivePasses += 1
passes <- use gameConsecutivePasses
when (passes < np) $ do when (passes < np) $ do
advanceToNextPlayer advanceToNextPlayer
loop loop
@ -125,18 +131,19 @@ beginRound :: Int -> Waterdeep ()
beginRound round = do beginRound round = do
broadcast $ "Starting round " ++ show round ++ "." broadcast $ "Starting round " ++ show round ++ "."
gameCurrentRound .= round gameCurrentRound .= round
gameCurrentPlayer <~ use gameFirstPlayer assign gameCurrentPlayer =<< use gameFirstPlayer
gameActivePlayer <~ use gameFirstPlayer assign gameActivePlayer =<< use gameFirstPlayer
gameBuildings . traverse . buildingAgents .= [] gameBuildings . traverse . buildingAgents .= []
gameBuildersHall . traverse . buildingAgents .= [] gameBuildersHall . traverse . buildingAgents .= []
gameBuildersHall . traverse . buildingAccumulation += 1 gameBuildersHall . traverse . buildingAccumulation += 1
gameWaterdeepHarbor . each .= [] gameWaterdeepHarbor . traverse .= []
np <- use gameNumberOfPlayers np <- use gameNumberOfPlayers
let agents = initialAgents np round let agents = initialAgents np round
forM_ [1..np] $ \p -> withActivePlayer p $ do forM_ [1..np] $ \p -> withActivePlayer p $ do
qs <- activePlayerState . playerUsedPlotQuests <<.= [] qs <- use $ activePlayerState . playerUsedPlotQuests
activePlayerState . playerUsedPlotQuests .= []
activePlayerState . playerActivePlotQuests <>= qs activePlayerState . playerActivePlotQuests <>= qs
activePlayerState . playerAgentsInPool .= agents activePlayerState . playerAgentsInPool .= agents
use (activePlayerState . playerHasLieutenant) >>= \case use (activePlayerState . playerHasLieutenant) >>= \case
True -> activePlayerState . playerAgentsInPool += 1 >> return () True -> activePlayerState . playerAgentsInPool += 1 >> return ()
False -> return () False -> return ()
@ -164,7 +171,7 @@ scoreFinalPoints = do
printf "%s scored %d points for completing %d %s and/or %s quests." printf "%s scored %d points for completing %d %s and/or %s quests."
name (matches * pts) matches (show (types !! 0)) (show (types !! 1)) name (matches * pts) matches (show (types !! 0)) (show (types !! 1))
BuildingBonus pts -> do BuildingBonus pts -> do
owned <- length . filter ((== p) . (view buildingOwner)) <$> use gameBuildings owned <- countOf (traverse.buildingOwner) (== p) <$> use gameBuildings
activePlayerState . playerScore += owned * pts activePlayerState . playerScore += owned * pts
when (owned > 0) $ broadcast $ when (owned > 0) $ broadcast $
printf "%s scored %d points for controlling %d buildings." printf "%s scored %d points for controlling %d buildings."
@ -177,7 +184,7 @@ determineWinners = do
let winners1 = filter ((== bestScore) . view playerScore) playerStates let winners1 = filter ((== bestScore) . view playerScore) playerStates
let bestGold = maximum $ map playerGold winners1 let bestGold = maximum $ map playerGold winners1
let winners2 = filter ((== bestGold) . playerGold) winners1 let winners2 = filter ((== bestGold) . playerGold) winners1
return (winners2 ^.. each . playerNumber) return (winners2 ^.. traverse . playerNumber)
where where
playerGold = MS.occur Gold . view playerTavern playerGold = MS.occur Gold . view playerTavern

20
src/Waterdeep/Types.hs
View File

@ -101,7 +101,6 @@ module Waterdeep.Types
) where ) where
import Control.Applicative import Control.Applicative
import Control.Lens
import Control.Monad import Control.Monad
import Control.Monad.Prompt import Control.Monad.Prompt
import Control.Monad.Random import Control.Monad.Random
@ -112,7 +111,13 @@ import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
import Control.Monad.Trans.State (StateT, runStateT) import Control.Monad.Trans.State (StateT, runStateT)
import Data.IntMap (IntMap) import Data.IntMap (IntMap)
import Data.Map (Map) import Data.Map (Map)
import Data.Maybe
import Data.Monoid import Data.Monoid
import Lens.Family2
import Lens.Family2.State
import Lens.Family2.Stock
import Lens.Family2.TH
import Lens.Family2.Unchecked (lens)
import System.Random (StdGen) import System.Random (StdGen)
import qualified Data.IntMap as IM import qualified Data.IntMap as IM
@ -205,9 +210,9 @@ data WaterdeepState =
, _gameIntrigueDiscard :: [IntrigueCard] , _gameIntrigueDiscard :: [IntrigueCard]
, _gameBuildingDeck :: [Building] , _gameBuildingDeck :: [Building]
, _gameBuildingDiscard :: [Building] , _gameBuildingDiscard :: [Building]
, _gameBuildersHall :: [BuildingState] , _gameBuildersHall :: IntMap BuildingState
, _gameBuildings :: [BuildingState] , _gameBuildings :: IntMap BuildingState
, _gameWaterdeepHarbor :: ([PlayerID], [PlayerID], [PlayerID]) , _gameWaterdeepHarbor :: IntMap [PlayerID]
, _gameStdGen :: StdGen , _gameStdGen :: StdGen
} }
@ -305,7 +310,9 @@ instance MonadSplit StdGen Waterdeep where
getSplit = gameStdGen %%= R.split getSplit = gameStdGen %%= R.split
gamePlayerState :: PlayerID -> Lens' WaterdeepState PlayerState gamePlayerState :: PlayerID -> Lens' WaterdeepState PlayerState
gamePlayerState n = gamePlayerStates . singular (ix n) gamePlayerState n = lens
(\w -> w ^. gamePlayerStates . intAt n . to fromJust)
(\w ps' -> w & gamePlayerStates . intAt n .~ Just ps')
gamePlayerName :: PlayerID -> Lens' WaterdeepState String gamePlayerName :: PlayerID -> Lens' WaterdeepState String
gamePlayerName n = gamePlayerState n . playerName gamePlayerName n = gamePlayerState n . playerName
@ -320,7 +327,8 @@ activePlayerName = activePlayerState . playerName
withActivePlayer :: PlayerID -> Waterdeep a -> Waterdeep a withActivePlayer :: PlayerID -> Waterdeep a -> Waterdeep a
withActivePlayer p m = do withActivePlayer p m = do
p0 <- gameActivePlayer <<.= p p0 <- use gameActivePlayer
gameActivePlayer .= p
r <- m r <- m
gameActivePlayer .= p0 gameActivePlayer .= p0
return r return r

5
src/Waterdeep/Util.hs
View File

@ -4,8 +4,10 @@ module Waterdeep.Util
, on , on
, nubOn , nubOn
, sortOn , sortOn
, countOf
) where ) where
import Lens.Family2
import Data.List import Data.List
import Data.Monoid import Data.Monoid
@ -23,3 +25,6 @@ nubOn f = nubBy ((==) `on` f)
sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn f = sortBy (compare `on` f) sortOn f = sortBy (compare `on` f)
countOf :: Num r => FoldLike (Sum r) a a' b b' -> (b -> Bool) -> a -> r
countOf l f = getSum . views l (\b -> if f b then Sum 1 else Sum 0)