Divide turn logic into shed and draw

3 files changed, 49 insertions, 31 deletions

diff --git a/Card.hs b/Card.hs
index 321df84..64c74c8 100644
--- a/Card.hs
+++ b/Card.hs
@@ -1,5 +1,6 @@
 module Card where
 
+import qualified Data.List as L
 import System.Random (RandomGen, random)
 
 data Suit = Spade | Heart | Diamond | Club deriving (Show, Eq, Ord, Enum)
@@ -18,6 +19,10 @@ showCard (Card st rk) = (show st) ++ " " ++ (rkStr)
                     Ace   -> "A"
                     _     -> show $ fromEnum rk + 2
 
+-- | Pretty print a list of cards.
+showCards :: [Card] -> String
+showCards = L.intercalate ", " . map showCard
+
 -- | Produce one full 52-deck.
 fullDeck = [Card st rk | st <- allSuits, rk <- allRanks]
     where allSuits = enumFrom $ toEnum 0
diff --git a/Game.hs b/Game.hs
index 816a65c..871d188 100644
--- a/Game.hs
+++ b/Game.hs
@@ -33,41 +33,48 @@ beginTurn game@(Game plyrs pidx att dir stock disc) = do
     decision <- prompt game
 
     let player = plyrs !! pidx
-    let player' = case decision of
-                    Nothing -> player `draw` (take att stock)
-                    Just card -> player `shed` card
-    let (left, right) = splitAt pidx plyrs
-    let plyrs' = left ++ [player'] ++ (tail right)
+    game'@(Game _ pidx' _ _ _ _)
+        <- case decision of
+             Nothing -> drawAndSkip game
+             Just card -> shedAndContinue card game
 
-    let stock' = case decision of
-                   Nothing -> tail stock
-                   Just _ -> stock
-    let disc' = case decision of
-                  Nothing -> disc
-                  Just card -> card:disc
-
-    let att' = case decision of
-                 Just (Card _ C.Two)   -> if att == 1 then 2 else att + 2
-                 Just (Card _ C.Three) -> if att == 1 then 3 else att + 3
-                 _ -> 1
-    let dir' = case decision of
-                 Just (Card _ C.Queen) -> negate dir
-                 _ -> dir
-    let pidx' = case decision of
-                  Just (Card _ C.Jack) -> (pidx + 2 * dir') `mod` length plyrs
-                  _ -> (pidx + dir') `mod` length plyrs
-    let game' = Game plyrs' pidx' att' dir' stock' disc'
-
-    case decision of
-      Nothing -> do
-          putStrLn $ (P.name player) ++ " draws " ++ (C.showCard $ head stock)
-      Just card -> do
-          putStrLn $ (P.name player) ++ " plays " ++ (C.showCard card)
-
-    if null $ P.cards player'
+    if pidx' == pidx  -- shedAndContinue does this when player wins
        then return game'
        else beginTurn game'
 
+-- | Game state after player draws card(s) and skips turn.
+drawAndSkip :: Game -> IO Game
+drawAndSkip game@(Game plyrs pidx att dir stock disc) = do
+    let player = plyrs !! pidx
+    let player' = player `draw` (take att stock)
+    let plyrs' = P.update plyrs pidx player'
+    let pidx' = (pidx + dir) `mod` length plyrs
+    let stock' = drop att stock
+    putStrLn $ (P.name player) ++ " draws " ++ (C.showCards $ take att stock)
+    return $ Game plyrs' pidx' 1 dir stock' disc
+
+-- | Game state after player sheds card.
+shedAndContinue :: Card -> Game -> IO Game
+shedAndContinue card game@(Game plyrs pidx att dir stock disc) = do
+    let player = plyrs !! pidx
+    let player' = player `shed` card
+    let disc' = card:disc
+    let plyrs' = P.update plyrs pidx player'
+    let dir' = case card of
+                 Card _ C.Queen -> negate dir
+                 _ -> dir
+    let pidx' = if null $ P.cards player'
+                   then pidx  -- round ends
+                   else case card of
+                          Card _ C.Jack -> (pidx + 2 * dir') `mod` length plyrs
+                          _ -> (pidx + dir') `mod` length plyrs
+    let att' = case card of
+                 Card _ C.Two   -> if att == 1 then 2 else att + 2
+                 Card _ C.Three -> if att == 1 then 3 else att + 3
+                 _ -> 1
+    putStrLn $ (P.name player) ++ " plays " ++ (C.showCard card)
+    return $ Game plyrs' pidx' att' dir' stock disc'
+
 -- | Prompt player to play a card (or draw card and skip turn).
 prompt :: Game -> IO (Maybe Card)
 prompt game@(Game plyrs pidx att _ _ _) = do
diff --git a/Player.hs b/Player.hs
index 0b57c7e..6dab74c 100644
--- a/Player.hs
+++ b/Player.hs
@@ -9,6 +9,12 @@ data Player = Player { name :: String
                      , cards :: [Card]
                      }
 
+-- | Update `i`-th player in `ps` to `p`.
+update :: [Player] -> Int -> Player -> [Player]
+update ps i p =
+    let (left, right) = splitAt i ps
+     in left ++ [p] ++ (tail right)
+
 -- | Same player after shedding card specified.
 shed :: Player -> Card -> Player
 shed (Player n p cs) c = Player n p $ L.delete c cs