Permalink
Browse files

Encode in the types that you can't run askPlayer with an empty list.

  • Loading branch information...
1 parent b3caa21 commit b04dbf2c3e491bc5852a516d4f1aa88d7958e463 @bartavelle committed May 12, 2014
Showing with 26 additions and 9 deletions.
  1. +12 −6 Startups/Game.hs
  2. +14 −3 Startups/GameTypes.hs
View
@@ -236,8 +236,12 @@ playAge age = do
let recyclers = pm ^.. traverse . filtered (has (_2 . cardEffects . _Recycling)) . _1
forM_ recyclers $ \pid -> do
stt <- use id
- card <- askCardSafe age pid (stt ^. discardpile) stt "Choose a card to recycle (play for free)"
- playermap . ix pid . pCards %= (card :)
+ case stt ^? discardpile . _NonEmpty of
+ Just nedp -> do
+ card <- askCardSafe age pid nedp stt "Choose a card to recycle (play for free)"
+ playermap . ix pid . pCards %= (card :)
+ discardpile %= filter (/= card)
+ Nothing -> tellPlayer pid "The discard pile was empty, you can't recycle."
-- resolve the "military" part
resolvePoaching age
@@ -251,10 +255,12 @@ checkCopyCommunity = use playermap >>= itraverse_ checkPlayer
mvioletCards <- forM (stt ^.. pNeighborhood . traverse) $ \nid ->
toListOf (pCards . traverse . filtered (has (cType . _Community))) <$> getPlayerState nid
let violetCards = concat mvioletCards
- unless (null violetCards) $ do
- gs <- use id
- card <- askCardSafe Age3 pid violetCards gs "Which community would you like to copy ?"
- playermap . ix pid . pCards %= (card:)
+ case violetCards ^? _NonEmpty of
+ Just nevc -> do
+ gs <- use id
+ card <- askCardSafe Age3 pid nevc gs "Which community would you like to copy ?"
+ playermap . ix pid . pCards %= (card:)
+ Nothing -> tellPlayer pid "There were no violet cards bought by your neighbors. You can't use your copy capacity."
victoryPoints :: GameStateOnly m => m (M.Map PlayerId (M.Map VictoryType VictoryPoint))
victoryPoints = use playermap >>= itraverse computeScore
View
@@ -51,6 +51,17 @@ type Message = String
data PlayerAction = PlayerAction ActionType Card
data ActionType = Play | Drop | BuildCompany
+-- | Some types for non empty lists
+data NonEmpty a = NonEmpty a [a]
+
+_NonEmpty :: Prism' [a] (NonEmpty a)
+_NonEmpty = prism fromNonEmpty toNonEmpty
+ where
+ fromNonEmpty (NonEmpty x xs) = x : xs
+ toNonEmpty l = case l of
+ [] -> Left l
+ (x:xs) -> Right (NonEmpty x xs)
+
-- | This describe the capabilities needed to write the rules, when no
-- interaction with the player is required.
type NonInteractive m = (MonadState GameState m, Monad m, MonadError Message m, Functor m, Applicative m)
@@ -61,15 +72,15 @@ class NonInteractive m => GameMonad m where
playerDecision :: Age -> Turn -> PlayerId -> [Card] -> GameState -> m (PlayerAction, Exchange)
-- | Ask the player to chose a card, along with a descriptive message.
-- This is used for the Recycling and CopyCommunity effects.
- askCard :: Age -> PlayerId -> [Card] -> GameState -> Message -> m Card
+ askCard :: Age -> PlayerId -> NonEmpty Card -> GameState -> Message -> m Card
tellPlayer :: PlayerId -> Message -> m () -- ^ Tell some information to a specific player
generalMessage :: Message -> m () -- ^ Broadcast some information
-- We define "safe" versions of the `askCard` function, that makes sure the
-- player doesn't introduce a new card in the game.
-askCardSafe :: GameMonad m => Age -> PlayerId -> [Card] -> GameState -> Message -> m Card
+askCardSafe :: GameMonad m => Age -> PlayerId -> NonEmpty Card -> GameState -> Message -> m Card
askCardSafe a p cl s m = do
card <- askCard a p cl s m
- when (card `notElem` cl) (throwError "The player tried to play a non proposed card")
+ when (card `notElem` (cl ^. re _NonEmpty)) (throwError "The player tried to play a non proposed card")
return card

0 comments on commit b04dbf2

Please sign in to comment.