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:
parent
e12f8e1f0d
commit
0b6fd62255
1 changed files with 7 additions and 8 deletions
|
@ -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 =
|
||||||
|
|
Loading…
Reference in a new issue