Skip to content

Commit

Permalink
Encode in the types that you can't run askPlayer with an empty list.
Browse files Browse the repository at this point in the history
  • Loading branch information
bartavelle committed May 12, 2014
1 parent b3caa21 commit b04dbf2
Show file tree
Hide file tree
Showing 2 changed files with 26 additions and 9 deletions.
18 changes: 12 additions & 6 deletions Startups/Game.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand Down
17 changes: 14 additions & 3 deletions Startups/GameTypes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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.