haverer 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+60/−39 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• haverer.cabal +1/−1
• lib/Haverer.hs +3/−2
• lib/Haverer/Deck.hs +20/−13
• lib/Haverer/Game.hs +2/−2
• lib/Haverer/Round.hs +32/−19
• lib/Haverer/Testing.hs +2/−2

@@ -16,7 +16,7 @@ -- see http://haskell.org/cabal/users-guide/  name:                haverer-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Implementation of the rules of Love Letter description:         Implementation of the rules of Love Letter license:             Apache-2.0

@@ -38,7 +38,8 @@   currentTurn,   Card(..),   Deck,-  Complete,+  DeckSize(..),+  FullDeck,   newDeck,   Play(..),   viewAction,@@ -52,7 +53,7 @@   import Haverer.Action (Play(..), viewAction)-import Haverer.Deck (Card(..), Complete, Deck, newDeck)+import Haverer.Deck (Card(..), Deck, DeckSize(..), FullDeck, newDeck) import Haverer.Game (   Game,   finalScores,

@@ -12,6 +12,8 @@ -- See the License for the specific language governing permissions and -- limitations under the License. +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE NoImplicitPrelude #-}  @@ -19,10 +21,10 @@   allCards,   baseCards,   Card(..),-  Complete,+  DeckSize(..),   deal,   Deck,-  Incomplete,+  FullDeck,   makeDeck,   newDeck,   pop,@@ -45,11 +47,13 @@ allCards = [Soldier ..]  -data Complete-data Incomplete+data DeckSize = Incomplete | Complete -newtype Deck a = Deck [Card] deriving (Eq, Show, Ord)+newtype Deck (a :: DeckSize) = Deck [Card] deriving (Eq, Show, Ord) +type FullDeck = Deck 'Complete++ baseCards :: [Card] baseCards = [   Soldier@@ -70,28 +74,31 @@   , Prince   ] -baseDeck :: Deck Complete+baseDeck :: Deck 'Complete baseDeck = Deck baseCards  shuffleDeck :: MonadRandom m => Deck a -> m (Deck a) shuffleDeck (Deck d) = liftM Deck $ shuffleM d -newDeck :: MonadRandom m => m (Deck Complete)+newDeck :: MonadRandom m => m (Deck 'Complete) newDeck = shuffleDeck baseDeck -makeDeck :: [Card] -> Maybe (Deck Complete)+makeDeck :: [Card] -> Maybe (Deck 'Complete) makeDeck cards =   if sort cards == baseCards then Just (Deck cards) else Nothing -pop :: Deck a -> (Maybe Card, Deck Incomplete)+pop :: Deck a -> (Maybe Card, Deck 'Incomplete) pop (Deck []) = (Nothing, Deck []) pop (Deck (c:cards)) = (Just c, Deck cards) -deal :: Deck a -> Int -> (Maybe [Card], Deck Incomplete)-deal (Deck cards) n =++deal :: FullDeck -> Int -> Maybe (Card, [Card], Deck 'Incomplete)+deal (Deck (burn:cards)) n =   case splitAt n cards of-   (_, []) -> (Nothing, Deck cards)-   (top, rest) -> (Just top, Deck rest)+   (_, []) -> Nothing+   (top, rest) -> Just (burn, top, Deck rest)+deal (Deck _) _ = Nothing+  toList :: Deck a -> [Card] toList (Deck xs) = xs

@@ -32,7 +32,7 @@ import BasicPrelude import Control.Monad.Random (MonadRandom) -import Haverer.Deck (Deck, Complete, newDeck)+import Haverer.Deck (FullDeck, newDeck) import Haverer.Player (   PlayerSet,   toPlayers,@@ -67,7 +67,7 @@   }  -- | Start a new round of the game with an already-shuffled deck of cards.-newRound' :: (Ord playerId, Show playerId) => Game playerId -> Deck Complete -> Round playerId+newRound' :: (Ord playerId, Show playerId) => Game playerId -> FullDeck -> Round playerId newRound' game deck = Round.makeRound deck (_playerSet game)  -- | Start a new round of the game, shuffling the deck cards ourselves.

@@ -12,6 +12,7 @@ -- See the License for the specific language governing permissions and -- limitations under the License. +{-# LANGUAGE DataKinds #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}@@ -33,6 +34,7 @@   , currentPlayer   , currentTurn   , getActivePlayers+  , getBurnCard   , getPlayer   , getPlayerMap   , getPlayers@@ -42,6 +44,7 @@      -- The outcome of a Round   , Victory(..)+  , survivors   , victory      -- Properties used for testing that rely on unexposed fields.@@ -69,7 +72,7 @@   getTarget,   playToAction,   viewAction)-import Haverer.Deck (Card(..), Complete, Deck, deal, Incomplete, pop)+import Haverer.Deck (Card(..), Deck, DeckSize(..), FullDeck, deal, pop) import qualified Haverer.Deck as Deck import Haverer.Player (   bust,@@ -98,7 +101,7 @@   data Round playerId = Round {-  _stack :: Deck Incomplete,+  _stack :: Deck 'Incomplete,   _playOrder :: Ring playerId,   _players :: Map playerId Player,   _roundState :: RoundState,@@ -110,19 +113,17 @@   -- | Make a new round, given a complete Deck and a set of players.-makeRound :: (Ord playerId, Show playerId) => Deck Complete -> PlayerSet playerId -> Round playerId+makeRound :: (Ord playerId, Show playerId) => FullDeck -> PlayerSet playerId -> Round playerId makeRound deck playerSet =   nextTurn $ case deal deck (length playerList) of-   (Just cards, remainder) ->-     case pop remainder of-      (Nothing, _) -> terror ("Not enough cards for burn: " ++ show deck)-      (Just burn', stack') -> Round {-        _stack = stack',-        _playOrder = fromJust (makeRing playerList),-        _players = Map.fromList $ zip playerList (map makePlayer cards),-        _roundState = NotStarted,-        _burn = burn'-        }+   Just (burn', cards, stack') ->+     Round {+       _stack = stack',+       _playOrder = fromJust (makeRing playerList),+       _players = Map.fromList $ zip playerList (map makePlayer cards),+       _roundState = NotStarted,+       _burn = burn'+       }    _ -> terror ("Given a complete deck - " ++ show deck ++ "- that didn't have enough cards for players - " ++ show playerSet)   where playerList = toPlayers playerSet @@ -158,6 +159,16 @@ getPlayer round pid = view (players . at pid) round  +-- | Get the burn card for the Round. Only possible when the Round is over.+--+-- Since 0.1.1+getBurnCard :: Round playerId -> Maybe Card+getBurnCard round =+  case view roundState round of+   Over -> Just $ view burn round+   _ -> Nothing++ -- | Draw a card from the top of the Deck. Returns the card and a new Round. drawCard :: Monad m => StateT (Round playerId) m (Maybe Card) drawCard = do@@ -399,19 +410,21 @@   deriving (Eq, Show)  --- | The currently surviving players in the round, with their cards.-survivors :: Round playerId -> [(playerId, Card)]-survivors = Map.toList . Map.mapMaybe getHand . view players-- -- | If the Round is Over, return the Victory data. Otherwise, Nothing. victory :: Round playerId -> Maybe (Victory playerId) victory (round@Round { _roundState = Over }) =-  case survivors round of+  case survivors' round of    [(pid, card)] -> Just $ SoleSurvivor pid card    xs -> let (best:rest) = reverse (groupBy ((==) `on` snd) (sortBy (compare `on` snd) xs))          in Just $ HighestCard (snd $ head best) (map fst best) (concat rest)+  where survivors' = Map.toList . Map.mapMaybe getHand . view players victory _ = Nothing+++-- | The currently surviving players in the round, with their cards.+survivors :: Victory playerId -> [(playerId, Card)]+survivors (SoleSurvivor pid card) = [(pid, card)]+survivors (HighestCard topCard topPlayers rest) = zip topPlayers (repeat topCard) ++ rest   getWinners :: Victory playerId -> [playerId]

@@ -33,7 +33,7 @@ import Test.Tasty.QuickCheck  import Haverer.Action (Play(..))-import Haverer.Deck (baseCards, Card(..), Complete, Deck, makeDeck)+import Haverer.Deck (baseCards, Card(..), FullDeck, makeDeck) import Haverer.Player (PlayerSet, toPlayerSet) import Haverer.Round (   Round@@ -48,7 +48,7 @@ type PlayerId = Int  -instance Arbitrary (Deck Complete) where+instance Arbitrary FullDeck where   -- | An arbitrary complete deck is a shuffled set of cards.   arbitrary = fmap (fromJust . makeDeck) (shuffled baseCards)