hanafuda
/
lib
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix bug in dealing cards to Players — it is supposed to reset the players' meld and yakus while setting their hand

This commit is contained in:
Tissevert 2019-10-23 15:25:34 +02:00
parent e12f8e1f0d
commit 0b6fd62255
1 changed files with 7 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Hanafuda/Player.hs
View File

@ -5,7 +5,7 @@ module Hanafuda.Player where
import Hanafuda (Card, Pack, contains, packOfCards, remove) import Hanafuda (Card, Pack, contains, packOfCards, remove)
import qualified Hanafuda.ID as Hanafuda (ID) import qualified Hanafuda.ID as Hanafuda (ID)
import Data.Map ((!), Map, elemAt, insert, keys, size) import Data.Map ((!), Map, elemAt, insert, keys, size)
import qualified Data.Map as Map (fromList, toList) import qualified Data.Map as Map (fromList, keys)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Except (MonadError(..)) import Control.Monad.Except (MonadError(..))
import System.Random (Random(..)) import System.Random (Random(..))
@ -18,15 +18,15 @@ data Player yakus = Player {
} deriving (Show) } deriving (Show)
newtype Players yakus = Players (Map (ID yakus) (Player yakus)) deriving (Show) newtype Players yakus = Players (Map (ID yakus) (Player yakus)) deriving (Show)
new :: Monoid yakus => Player yakus new :: Monoid yakus => [Card] -> Player yakus
new = Player { new cards = Player {
hand = packOfCards [] hand = packOfCards cards
, meld = packOfCards [] , meld = packOfCards []
, yakus = mempty , yakus = mempty
} }
players :: Monoid yakus => [ID yakus] -> Players yakus players :: Monoid yakus => [ID yakus] -> Players yakus
players = Players . Map.fromList . fmap (\playerID -> (playerID, new)) players = Players . Map.fromList . fmap (\playerID -> (playerID, new []))
random :: MonadIO m => Players yakus -> m (ID yakus) random :: MonadIO m => Players yakus -> m (ID yakus)
random (Players playersByID) = random (Players playersByID) =
@ -42,10 +42,9 @@ set playerID player (Players playersByID) = Players $ insert playerID player pla
deal :: Monoid yakus => Players yakus -> [[Card]] -> Players yakus deal :: Monoid yakus => Players yakus -> [[Card]] -> Players yakus
deal (Players playersByID) hands = deal (Players playersByID) hands =
Players . Map.fromList . zipWith setHand hands $ Map.toList playersByID Players . Map.fromList . zipWith setHand hands $ Map.keys playersByID
where where
setHand cards (playerID, player) = setHand cards playerID = (playerID, new cards)
(playerID, player {hand = packOfCards cards})
plays :: MonadError String m => Player yakus -> Card -> m (Player yakus) plays :: MonadError String m => Player yakus -> Card -> m (Player yakus)
plays player@(Player {hand}) card = plays player@(Player {hand}) card =