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

View File

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

View File

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

View File

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

View File

@ -101,7 +101,6 @@ module Waterdeep.Types
) where
import Control.Applicative
import Control.Lens
import Control.Monad
import Control.Monad.Prompt
import Control.Monad.Random
@ -112,7 +111,13 @@ import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
import Control.Monad.Trans.State (StateT, runStateT)
import Data.IntMap (IntMap)
import Data.Map (Map)
import Data.Maybe
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 qualified Data.IntMap as IM
@ -205,9 +210,9 @@ data WaterdeepState =
, _gameIntrigueDiscard :: [IntrigueCard]
, _gameBuildingDeck :: [Building]
, _gameBuildingDiscard :: [Building]
, _gameBuildersHall :: [BuildingState]
, _gameBuildings :: [BuildingState]
, _gameWaterdeepHarbor :: ([PlayerID], [PlayerID], [PlayerID])
, _gameBuildersHall :: IntMap BuildingState
, _gameBuildings :: IntMap BuildingState
, _gameWaterdeepHarbor :: IntMap [PlayerID]
, _gameStdGen :: StdGen
}
@ -305,7 +310,9 @@ instance MonadSplit StdGen Waterdeep where
getSplit = gameStdGen %%= R.split
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 n = gamePlayerState n . playerName
@ -320,7 +327,8 @@ activePlayerName = activePlayerState . playerName
withActivePlayer :: PlayerID -> Waterdeep a -> Waterdeep a
withActivePlayer p m = do
p0 <- gameActivePlayer <<.= p
p0 <- use gameActivePlayer
gameActivePlayer .= p
r <- m
gameActivePlayer .= p0
return r

View File

@ -4,8 +4,10 @@ module Waterdeep.Util
, on
, nubOn
, sortOn
, countOf
) where
import Lens.Family2
import Data.List
import Data.Monoid
@ -23,3 +25,6 @@ nubOn f = nubBy ((==) `on` f)
sortOn :: Ord b => (a -> b) -> [a] -> [a]
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)