Haskell Program to Play the Blackjack Card Game

For much of my work using Haskell I deal mostly with pure code with smaller bits of impure code for network and file IO, etc. Realizing that my use case for using Haskell (mostly pure code) may not be typical, I wanted the last example “cookbook recipe” in this book to be an example dealing with changing state, a program to play the Blackjack card game.

The game state is maintained in the type Table that holds information on a randomized deck of cards, the number of players in addition to the game user and the card dealer, the cards in the current hand, and the number of betting chips that all players own. Table data is immutable so all of the major game playing functions take a table and any other required inputs, and generate a new table as the function result.

This example starts by asking how many players, besides the card dealer and the game user, should play a simulated Blackjack game. The game user controls when they want another card while the dealer and any other simulated players play automatically (they always hit when their card score is less than 17).

I define the types for playing cards and an entire card deck in the file Card.hs:

 1 module Card (Card, Rank, Suit, orderedCardDeck, cardValue) where
 2 
 3 import Data.Maybe (fromMaybe)
 4 import Data.List (elemIndex)
 5 import Data.Map (fromList, lookup, keys)
 6 
 7 data Card = Card { rank :: Rank
 8                  , suit :: Suit }
 9                  deriving (Eq, Show)
10                  
11 data Suit = Hearts | Diamonds | Clubs | Spades
12           deriving (Eq, Show, Enum, Ord)
13 
14 data Rank = Two | Three | Four
15           | Five | Six | Seven | Eight
16           | Nine | Ten | Jack  | Queen | King | Ace
17           deriving (Eq, Show, Enum, Ord)
18 
19 rankMap = fromList [(Two,2), (Three,3), (Four,4), (Five,5),
20                     (Six,6), (Seven,7), (Eight,8), (Nine,9),
21                     (Ten,10), (Jack,10), (Queen,10),
22                     (King,10), (Ace,11)]
23 
24 orderedCardDeck :: [Card]
25 orderedCardDeck = [Card rank suit | rank <- keys rankMap,
26                                     suit <- [Hearts .. Clubs]]
27 
28 cardValue :: Card -> Int
29 cardValue aCard =
30   case (Data.Map.lookup (rank aCard) rankMap) of
31     Just n -> n
32     Nothing -> 0 -- should never happen

This module defines essential components for representing and working with playing cards.

Data Types

  • Card: A record type with two fields:

    • rank :: Rank - Represents the card’s rank (e.g., Two, Queen, Ace).
    • suit :: Suit - Represents the card’s suit (e.g., Hearts, Spades).

  • Suit: An enumeration defining the four card suits: Hearts, Diamonds, Clubs, Spades. It derives Eq (equality), Show (string representation), Enum (enumeration capabilities), and Ord (ordering) for convenience.

  • Rank: An enumeration listing the thirteen card ranks, from Two to Ace. It also derives Eq, Show, Enum, and Ord.

Functions and Values

  • rankMap: A Data.Map that associates each Rank with its corresponding numerical value in games like Blackjack.

  • orderedCardDeck: A list comprehension that generates a standard 52-card deck, sorted by rank within each suit.

  • cardValue: A function that takes a Card and returns its numerical value based on the rankMap. It uses pattern matching to handle the Maybe type returned by Data.Map.lookup.

Explanation

  1. Card Data Type: The core of the module. It defines a playing card as a combination of a Rank and a Suit.

  2. Suit and Rank Enumerations: These provide a clear and type-safe representation of suits and ranks. Deriving Enum and Ord allows easy iteration and comparison.

  3. rankMap: This map is crucial for assigning numerical values to cards, particularly in games where card values matter (e.g., Blackjack).

  4. orderedCardDeck: This function generates a standard 52-card deck. It uses list comprehension to iterate over all Rank values (obtained from the keys of rankMap) and all Suit values (from Hearts to Clubs), creating a Card for each combination.

  5. cardValue: This function retrieves the numerical value of a given card. It uses Data.Map.lookup to find the value associated with the card’s rank in rankMap. The case expression handles the possibility of lookup returning Nothing (which should ideally never happen in this context).

Key Points

  • The code provides a well-structured representation of playing cards in Haskell.
  • The use of enumerations enhances type safety and readability.
  • Data.Map is employed for efficient lookup of card values.
  • The orderedCardDeck function conveniently generates a standard deck of cards.

As usual, the best way to understand this code is to go to the GHCi repl:

 1 *Main Card RandomizedList Table> :l Card
 2 [1 of 1] Compiling Card             ( Card.hs, interpreted )
 3 Ok, modules loaded: Card.
 4 *Card> :t orderedCardDeck
 5 orderedCardDeck :: [Card]
 6 *Card> orderedCardDeck
 7 [Card {rank = Two, suit = Hearts},Card {rank = Two, suit = Diamonds},Card {rank = Tw\
 8 o, suit = Clubs},Card {rank = Three, suit = Hearts},Card {rank = Three,
 9     ...
10 *Card> head orderedCardDeck
11 Card {rank = Two, suit = Hearts}
12 *Card> cardValue $ head orderedCardDeck
13 2

So, we have a sorted deck of cards and a utility function for returning the numerical value of a card (we always count ace cards as 11 points, deviating from standard Blackjack rules).

The next thing we need to get is randomly shuffled lists. The Haskell Wiki has a good writeup on randomizing list elements and we are borrowing their function randomizedList (you can see the source code in the file RandomizedList.hs). Here is a sample use:

 1 *Card> :l RandomizedList.hs 
 2 [1 of 1] Compiling RandomizedList   ( RandomizedList.hs, interpreted )
 3 Ok, modules loaded: RandomizedList.
 4 *RandomizedList> import Card
 5 *RandomizedList Card> randomizedList orderedCardDeck
 6 [Card {rank = Queen, suit = Hearts},Card {rank = Six, suit = Diamonds},Card {rank = \
 7 Five, suit = Clubs},Card {rank = Five, suit = Diamonds},Card {rank = Seven, suit = C
 8 lubs},Card {rank = Three, suit = Hearts},Card {rank = Four, suit = Diamonds},Card {r
 9 ank = Ace, suit = Hearts},
10   ...

Much of the complexity in this example is implemented in Table.hs which defines the type Table and several functions to deal and score hands of dealt cards:

  • createNewTable :: Players -> Table. Players is the integer number of other players at the table.
  • setPlayerBet :: Int -> Table -> Table. Given a new value to bet and a table, generate a new modified table.
  • showTable :: Table -> [Char]. Given a table, generate a string describing the table (in a format useful for development)
  • initialDeal :: [Card] -> Table -> Int -> Table. Given a randomized deck of cards, a table, and the number of other players, generate a new table.
  • changeChipStack :: Int -> Int -> Table -> Table. Given a player index (index order: user, dealer, and other players), a new number of betting chips for the player, and a table, then generate a new modified table.
  • setCardDeck :: [Card] -> Table -> Table. Given a randomized card deck and a table, generate a new table containing the new randomized card list; all other table data is unchanged.
  • dealCards :: Table -> [Int] -> Table. Given a table and a list of player indices for players wanting another card, generate a new modified table.
  • resetTable :: [Card] -> Table -> Int -> Table. Given a new randomized card deck, a table, and a new number of other players, generate a new table.
  • scoreHands :: Table -> Table. Given a table, score all dealt hands and generate a new table with these scores. There is no table type score data, rather, we “score” by changing the number of chips all of the players (inclding the dealer) has.
  • dealCardToUser :: Table -> Int -> Table. For the game user, always deal a card. For the dealer and other players, deal another card if their hand score is less than 17.
  • handOver :: Table -> Bool. Determine if the current hand is over.
  • setPlayerPasses :: Table -> Table. Call this function when the payer passes. Other players and dealer are then played out automatically.

The implementation in the file Table.hs is fairly simple, with the exception of the use of Haskell lenses to access nested data in the table type. I will discuss the use of lenses after the program listing, but: as you are reading the code look out for variables starting with the underscore character _ that alerts the Lens system that it should create data accessors for these variables.

This code defines a module named Table which provides data structures and functions to simulate a simplified table in a card game, potentially Blackjack.

Core Components

  • Table data type:

    • Represents the state of the table, storing information like:
      • Number of players
      • Chip stacks for each player
      • Cards dealt to each player (including the dealer)
      • Current player’s bet
      • Whether the user has passed their turn
      • The remaining card deck

  • Functions:

    • createNewTable: Creates a new table with the specified number of players and initial chip stacks.
    • resetTable: Resets the table for a new round, clearing dealt cards and optionally changing the card deck.
    • setCardDeck: Sets a new card deck for the table.
    • dealCards: Deals cards to specified players.
    • initialDeal: Performs the initial deal at the beginning of a round.
    • showTable: Generates a string representation of the table’s current state.
    • scoreHands: Calculates and updates chip stacks based on player and dealer scores.
    • setPlayerBet: Sets the current player’s bet.
    • setPlayerPasses: Simulates the player passing their turn, dealing additional cards to other players and the dealer.
    • changeChipStack: Modifies a specific player’s chip stack.
    • score: Calculates the score of a player’s hand.
    • dealCardToUser: Deals a card to a specified player, with special handling for the user and dealer.
    • handOver: Checks if the user has passed their turn.

Lenses

The code uses lenses (makeLenses ''Table) to provide convenient access and modification of the Table data type’s fields.

Game Logic (Simplified)

  • The code seems to implement a basic version of a card game where players and the dealer are dealt cards.
  • scoreHands calculates scores and updates chip stacks based on win/loss conditions.
  • dealCardToUser handles dealing cards, ensuring the dealer keeps drawing until their score is at least 17.
  • setPlayerPasses simulates the user passing, triggering the dealer and other players to finish their turns. 
  1 {-# LANGUAGE TemplateHaskell #-}  -- for makeLens
  2 
  3 module Table (Table (..), createNewTable, setPlayerBet, showTable, initialDeal,
  4               changeChipStack, setCardDeck, dealCards, resetTable, scoreHands,
  5               dealCardToUser, handOver, setPlayerPasses) where
  6   -- note: export dealCardToUser only required for ghci development
  7 
  8 import Control.Lens
  9 
 10 import Card
 11 import Data.Bool
 12 import Data.Maybe (fromMaybe)
 13 
 14 data Table = Table { _numPlayers :: Int
 15                    , _chipStacks :: [Int] -- number of chips,
 16                                           -- indexed by player index
 17                    , _dealtCards :: [[Card]] -- dealt cards for user,
 18                                              -- dealer, and other players
 19                    , _currentPlayerBet :: Int
 20                    , _userPasses       :: Bool
 21                    , _cardDeck         :: [Card]
 22                    }
 23            deriving (Show)
 24            
 25 type Players = Int
 26              
 27 createNewTable :: Players -> Table
 28 createNewTable n =
 29   Table n
 30         [500 | _ <- [1 .. n]] -- give each player (incuding dealer) 10 chips
 31         [[] | _ <- [0..n]] -- dealt cards for user and other players
 32                            -- (we don't track dealer's chips)
 33         20 -- currentPlayerBet number of betting chips
 34         False
 35         [] -- placeholder for random shuffled card deck
 36  
 37 resetTable :: [Card] -> Table -> Int -> Table
 38 resetTable cardDeck aTable numberOfPlayers =
 39   Table numberOfPlayers
 40         (_chipStacks aTable)       -- using Lens accessor
 41         [[] | _ <- [0..numberOfPlayers]]
 42         (_currentPlayerBet aTable) -- using Lens accessor
 43         False
 44         cardDeck
 45      
 46      -- Use lens extensions for type Table:
 47             
 48 makeLenses ''Table
 49  
 50 showDealtCards :: [[Card]] -> String
 51 showDealtCards dc =
 52   (show [map cardValue hand | hand <- dc])
 53 
 54 setCardDeck :: [Card] -> Table -> Table
 55 setCardDeck newDeck =
 56   over cardDeck (\_ -> newDeck)  -- change value to new card deck
 57 
 58 dealCards :: Table -> [Int] -> Table
 59 dealCards aTable playerIndices =
 60   last $ scanl dealCardToUser aTable playerIndices
 61  
 62 initialDeal cardDeck aTable numberOfPlayers =
 63   dealCards
 64     (dealCards (resetTable cardDeck aTable numberOfPlayers)
 65                [0 .. numberOfPlayers])
 66     [0 .. numberOfPlayers]
 67     
 68 showTable :: Table -> [Char]
 69 showTable aTable =
 70   "\nCurrent table data:\n" ++
 71   "  Chipstacks: " ++
 72   "\n    Player: " ++ (show (head (_chipStacks aTable))) ++
 73   "\n    Other players: " ++ (show (tail (_chipStacks aTable))) ++
 74   "\n  User cards: " ++ (show (head (_dealtCards aTable))) ++
 75   "\n  Dealer cards: " ++ (show ((_dealtCards aTable) !! 1)) ++
 76   "\n  Other player's cards: " ++ (show (tail (tail(_dealtCards aTable)))) ++
 77   -- "\n  Dealt cards: " ++ (show (_dealtCards aTable)) ++
 78   "\n  Dealt card values: " ++ (showDealtCards (_dealtCards aTable)) ++
 79   "\n  Current player bet: " ++
 80   (show (_currentPlayerBet aTable)) ++
 81   "\n  Player pass: " ++
 82   (show (_userPasses aTable)) ++ "\n"
 83   
 84 clipScore aTable playerIndex =
 85   let s = score aTable playerIndex in
 86     if s < 22 then s else 0
 87       
 88 scoreHands aTable =
 89   let chipStacks2 = _chipStacks aTable
 90       playerScore = clipScore aTable 0
 91       dealerScore = clipScore aTable 1
 92       otherScores = map (clipScore aTable) [2..]
 93       newPlayerChipStack = if playerScore > dealerScore then
 94                              (head chipStacks2) + (_currentPlayerBet aTable)
 95                            else
 96                              if playerScore < dealerScore then
 97                                 (head chipStacks2) - (_currentPlayerBet aTable)
 98                              else (head chipStacks2)
 99       newOtherChipsStacks =
100         map (\(x,y) -> if x > dealerScore then
101                          y + 20
102                        else
103                          if x < dealerScore then
104                            y - 20
105                          else y) 
106             (zip otherScores (tail chipStacks2))
107       newChipStacks  = newPlayerChipStack:newOtherChipsStacks
108   in
109     over chipStacks (\_ -> newChipStacks) aTable
110      
111 setPlayerBet :: Int -> Table -> Table
112 setPlayerBet newBet =
113   over currentPlayerBet (\_ -> newBet)  
114 
115 setPlayerPasses :: Table -> Table
116 setPlayerPasses aTable =
117   let numPlayers = _numPlayers aTable
118       playerIndices = [1..numPlayers]
119       t1 = over userPasses (\_ -> True) aTable
120       t2 = dealCards t1 playerIndices
121       t3 = dealCards t2 playerIndices
122       t4 = dealCards t3 playerIndices
123   in
124     t4
125     
126     
127 changeChipStack :: Int -> Int -> Table -> Table
128 changeChipStack playerIndex newValue =
129   over chipStacks (\a -> a & element playerIndex .~ newValue)
130 
131 scoreOLD aTable playerIndex =
132   let scores = map cardValue ((_dealtCards aTable) !! playerIndex)
133       totalScore = sum scores in
134     if totalScore < 22 then totalScore else 0
135 
136 score aTable playerIndex =
137   let scores = map cardValue ((_dealtCards aTable) !! playerIndex)
138       totalScore = sum scores in
139     totalScore
140   
141 dealCardToUser' :: Table -> Int -> Table
142 dealCardToUser' aTable playerIndex =
143   let nextCard = head $ _cardDeck aTable
144       playerCards = nextCard : ((_dealtCards aTable) !! playerIndex)
145       newTable = over cardDeck (\cd -> tail cd) aTable in
146     over dealtCards (\a -> a & element playerIndex .~ playerCards) newTable
147 
148 dealCardToUser :: Table -> Int -> Table
149 dealCardToUser aTable playerIndex
150   | playerIndex == 0  = dealCardToUser' aTable playerIndex -- user
151   | otherwise         = if (score aTable playerIndex) < 17 then
152                              dealCardToUser' aTable playerIndex
153                         else aTable
154   
155 handOver :: Table -> Bool
156 handOver aTable =
157   _userPasses aTable

In line 48 we use the function makeLenses to generate access functions for the type Table. We will look in some detail at lines 54-56 where we use the lense over function to modify a nested value in a table, returning a new table:

1 setCardDeck :: [Card] -> Table -> Table
2 setCardDeck newDeck =
3   over cardDeck (\_ -> newDeck)

The expression in line 3 evaluates to a partial function that takes another argument, a table, and returns a new table with the card deck modified. Function over expects a function as its second argument. In this example, the inline function ignores the argument it is called with, which would be the old card deck value, and returns the new card deck value which is placed in the table value.

Using lenses can greatly simplify the code to manipulate complex types.

Another place where I am using lenses is in the definition of function scoreHands (lines 88-109). On line 109 we are using the over function to replace the old player betting chip counts with the new value we have just calculated:

1   over chipStacks (\_ -> newChipStacks) aTable

Similarly, we use over in line 113 to change the current player bet. In function handOver on line 157, notice how I am using the generated function _userPasses to extract the value of the user passes boolean flag from a table.

The function main, defined in the file Main.hs, uses the code we have just seen to represent a table and modify a table, is fairly simple. A main game loop repetitively accepts game user input, and calls the appropriate functions to modify the current table, producing a new table. Remember that the table data is immutable: we always generate a new table from the old table when we need to modify it.

 1 module Main where
 2 
 3 import Card   -- pure code
 4 import Table  -- pure code
 5 import RandomizedList  -- impure code
 6 
 7 printTable :: Table -> IO ()
 8 printTable aTable =
 9   putStrLn $ showTable aTable
10   
11 randomDeck =
12   randomizedList orderedCardDeck
13 
14 gameLoop :: Table -> Int -> IO b
15 gameLoop aTable numberOfPlayers = do
16   printTable aTable
17   cardDeck <- randomDeck
18   if (handOver aTable) then
19     do
20       putStrLn "\nHand over. State of table at the end of the game:\n"
21       printTable aTable
22       putStrLn "\nNewly dealt hand:\n"
23       gameLoop (initialDeal cardDeck (scoreHands aTable)
24                                      numberOfPlayers)
25                                      numberOfPlayers
26   else
27     do
28       putStrLn "Enter command:"
29       putStrLn "  h)it or set bet to 10, 20, 30; any other key to stay:"
30       command <- getLine
31       if elem command ["10", "20", "30"] then
32         gameLoop (setPlayerBet (read command) aTable) numberOfPlayers
33       else
34         if command == "h" then
35           gameLoop (dealCards aTable [0 .. numberOfPlayers]) numberOfPlayers
36         else
37           gameLoop (setPlayerPasses (dealCards aTable [1 .. numberOfPlayers]))
38                     numberOfPlayers 
39              -- player stays (no new cards)
40   
41 main :: IO b
42 main = do
43   putStrLn "Start a game of Blackjack. Besides yourself, how many other"
44   putStrLn "players do you want at the table?"
45   s <- getLine
46   let num = (read s :: Int) + 1
47   cardDeck <- randomDeck
48   let aTable = initialDeal cardDeck (createNewTable num) num
49   gameLoop aTable num

This module combines the previously defined Card and Table modules with an impure RandomizedList module to implement the main game loop of a simplified Blackjack-like card game.

Core Functions

  • printTable: Prints the current state of the table using the showTable function from the Table module.

  • randomDeck: Generates a randomized version of the orderedCardDeck using the randomizedList function (assumed to be from the RandomizedList module).

  • gameLoop: The core recursive function that drives the game:

    • Prints the current table state.
    • Generates a random card deck.
    • If the hand is over (user has passed), prints the final table state, scores hands, and starts a new game with the updated chip stacks.
    • Otherwise, prompts the user for a command:
      • If the command is “10”, “20”, or “30”, sets the player’s bet.
      • If the command is “h”, deals cards to all players (including the user).
      • If any other command is entered, sets the user as passed and deals cards to the dealer and other players until they stand.
    • Recursively calls itself with the updated table state.

  • main:

    • Prompts the user for the number of additional players.
    • Creates a new table with the specified number of players and an initial deal.
    • Starts the gameLoop.

Key Points

  • The code demonstrates a basic interactive text-based card game implementation.
  • It combines pure modules (Card, Table) with an impure module (RandomizedList) for randomization.
  • The gameLoop function handles user input and game state transitions.
  • The game logic is likely simplified for this example, and a full Blackjack implementation would require additional rules and features.

Remember: The RandomizedList module is assumed to provide a function randomizedList for shuffling the card deck, introducing impurity into the game logic.

I encourage you to try playing the game yourself, but if you don’t here is a sample game:

 1 *Main Card RandomizedList Table> main
 2 Start a game of Blackjack. Besides yourself, how many other
 3 players do you want at the table?
 4 1
 5 
 6 Current table data:
 7   Chipstacks: 
 8     Player: 500
 9     Other players: [500]
10   User cards: [Card {rank = Three, suit = Clubs},Card {rank = Two, suit = Hearts}]
11   Dealer cards: [Card {rank = Queen, suit = Diamonds},Card {rank = Seven, suit = Clu\
12 bs}]
13   Other player's cards: [[Card {rank = King, suit = Hearts},Card {rank = Six, suit =\
14  Diamonds}]]
15   Dealt card values: [[3,2],[10,7],[10,6]]
16   Current player bet: 20
17   Player pass: False
18 
19 Enter command: h)it or set bet to 10, 20, 30; any other key to stay:
20 h
21 
22 Current table data:
23   Chipstacks: 
24     Player: 500
25     Other players: [500]
26   User cards: [Card {rank = Six, suit = Hearts},Card {rank = Three, suit = Clubs},Ca\
27 rd {rank = Two, suit = Hearts}]
28   Dealer cards: [Card {rank = Queen, suit = Diamonds},Card {rank = Seven, suit = Clu\
29 bs}]
30   Other player's cards: [[Card {rank = Eight, suit = Hearts},Card {rank = King, suit\
31  = Hearts},Card {rank = Six, suit = Diamonds}]]
32   Dealt card values: [[6,3,2],[10,7],[8,10,6]]
33   Current player bet: 20
34   Player pass: False
35 
36 Enter command: h)it or set bet to 10, 20, 30; any other key to stay:
37 h
38 
39 Current table data:
40   Chipstacks: 
41     Player: 500
42     Other players: [500]
43   User cards: [Card {rank = King, suit = Clubs},Card {rank = Six, suit = Hearts},Car\
44 d {rank = Three, suit = Clubs},Card {rank = Two, suit = Hearts}]
45   Dealer cards: [Card {rank = Queen, suit = Diamonds},Card {rank = Seven, suit = Clu\
46 bs}]
47   Other player's cards: [[Card {rank = Eight, suit = Hearts},Card {rank = King, suit\
48  = Hearts},Card {rank = Six, suit = Diamonds}]]
49   Dealt card values: [[10,6,3,2],[10,7],[8,10,6]]
50   Current player bet: 20
51   Player pass: False
52 
53 Enter command: h)it or set bet to 10, 20, 30; any other key to stay:
54 
55 Current table data:
56   Chipstacks: 
57     Player: 500
58     Other players: [500]
59   User cards: [Card {rank = King, suit = Clubs},Card {rank = Six, suit = Hearts},Car\
60 d {rank = Three, suit = Clubs},Card {rank = Two, suit = Hearts}]
61   Dealer cards: [Card {rank = Queen, suit = Diamonds},Card {rank = Seven, suit = Clu\
62 bs}]
63   Other player's cards: [[Card {rank = Eight, suit = Hearts},Card {rank = King, suit\
64  = Hearts},Card {rank = Six, suit = Diamonds}]]
65   Dealt card values: [[10,6,3,2],[10,7],[8,10,6]]
66   Current player bet: 20
67   Player pass: True
68 
69 Hand over. State of table at the end of the game:
70 
71 Current table data:
72   Chipstacks: 
73     Player: 520
74     Other players: [520]
75   User cards: [Card {rank = King, suit = Clubs},Card {rank = Six, suit = Hearts},Car\
76 d {rank = Three, suit = Clubs},Card {rank = Two, suit = Hearts}]
77   Dealer cards: [Card {rank = Queen, suit = Diamonds},Card {rank = Seven, suit = Clu\
78 bs}]
79   Other player's cards: [[Card {rank = Eight, suit = Hearts},Card {rank = King, suit\
80  = Hearts},Card {rank = Six, suit = Diamonds}]]
81   Dealt card values: [[10,6,3,2],[10,7],[8,10,6]]
82   Current player bet: 20
83   Player pass: True

Here the game user has four cards with values of [10,6,3,2] for a winning score of 21. The dealer has [10,7] for a score of 17 and the other player has [8,10,6], a value greater than 21 so the player went “bust.”

I hope that you enjoyed this last example that demonstrates a reasonable approach for managing state when using immutable data.

Up next

Section 3 - Larger Projects