~subsetpark/whist

223584f22b9c429bd7fe01147d857edd48b5dccb — Zach Smith 1 year, 19 days ago d1d302f
Complete first lead
A .gitignore => .gitignore +2 -0
@@ 0,0 1,2 @@
*~
/janet_modules

A actions.janet => actions.janet +5 -0
@@ 0,0 1,5 @@
(defn new-action [name type count choices] {:name name :action "select" :count 1 :from choices})

(defn pick1 [name choices] (new-action name "select" 1 choices))

(defn draw [count] @{:hand [{:action "draw" :count count}]})

M bids.janet => bids.janet +40 -32
@@ 1,40 1,48 @@
(def-
  bids
  [["3u" "3 Uptown"]
   ["3d" "3 Downtown"]
   ["3n" "3 No-Trumps"]
   ["4u" "4 Uptown"]
   ["4d" "4 Downtown"]
   ["4n" "4 No-Trumps"]
   ["5u" "5 Uptown"]
   ["5d" "5 Downtown"]
   ["5n" "5 No-Trumps"]
   ["6u" "6 Uptown"]
   ["6d" "6 Downtown"]
   ["6n" "6 No-Trumps"]
   ["7u" "7 Uptown"]
   ["7d" "7 Downtown"]
   ["7n" "7 No-Trumps"]])
  [[{"count" 3 "direction" "up"} "3 Uptown"]
   [{"count" 3 "direction" "down"} "3 Downtown"]
   [{"count" 3 "suit" "no_trumps"} "3 No-Trumps"]
   [{"count" 4 "direction" "up"} "4 Uptown"]
   [{"count" 4 "direction" "down"} "4 Downtown"]
   [{"count" 4 "suit" "no_trumps"} "4 No-Trumps"]
   [{"count" 5 "direction" "up"} "5 Uptown"]
   [{"count" 5 "direction" "down"} "5 Downtown"]
   [{"count" 5 "suit" "no_trumps"} "5 No-Trumps"]
   [{"count" 6 "direction" "up"} "6 Uptown"]
   [{"count" 6 "direction" "down"} "6 Downtown"]
   [{"count" 6 "suit" "no_trumps"} "6 No-Trumps"]
   [{"count" 7 "direction" "up"} "7 Uptown"]
   [{"count" 7 "direction" "down"} "7 Downtown"]
   [{"count" 7 "suit" "no_trumps"} "7 No-Trumps"]])

(def direction [[{"direction" "up"} "Uptown"]
		[{"direction" "down"} "Downtown"]])

(def suit [[{"suit" "hearts"} "Hearts"]
	   [{"suit" "spades"} "Spades"]
	   [{"suit" "diamonds"} "Diamonds"]
	   [{"suit" "clubs"} "Clubs"]])

(defn- no-trumps? [bid] (= (bid "suit") "no_trumps"))
(defn- find-row-index [bid source] (find-index |(= ($0 0) bid) source))

(defn to-text [bid &opt source]
  (default source bids)
  (if-let [ind (find-row-index bid source)
	   row (source ind)]
    (row 1)
    (error (string "Not found: " (string/format "%q" bid) " in " (string/format "%q" source)))))

(defn
  available-bids
  [&opt high-bid]
  (case high-bid
    nil
    bids
    (let
	[minimum-bid
	 (case (slice high-bid 1)
	   "n"
	   (string/from-bytes
	    (inc (high-bid 0))
	    (chr "u"))
	   (string
	    (slice high-bid 0 1)
	    "n"))
	 minimum-bid-ind
	 (or (find-index
	      |
	      (= ($0 0) minimum-bid)
	      bids) -1)]
    nil bids
    (let [minimum-bid (if (no-trumps? high-bid)
		 	{"count" (inc (high-bid "count")) "direction" "up"} 
			{"count" (high-bid "count") "suit" "no_trumps"})
	  minimum-bid-ind (find-row-index minimum-bid bids)]
      (slice bids minimum-bid-ind))))

(defn second-bid [bid] (if (no-trumps? bid) direction suit))

A cards.janet => cards.janet +103 -0
@@ 0,0 1,103 @@
(defmacro intern-cards! []
  # Easily generate card structs.
  (def suits {"D" "diamonds" "S" "spades" "C" "clubs" "H" "hearts"})
  (def ranks {"1" 1 "A" 1 "2" 2 "3" 3 "4" 4 "5" 5 "6" 6 "7" 7 "8" 8 "9" 9 "T" 10 "J" 11 "Q" 12 "K" 13})

  (var defs @[])
  (loop [suit :in ["D" "S" "C" "H"]
	 rank :in ["A" "2" "3" "4" "5" "6" "7" "8" "9" "T" "J" "Q" "K"]]
    (let [sym (symbol suit rank)]
      (array/push defs ~(def ,sym {"suit" ,(in suits suit) "rank" ,(in ranks rank)}))))
  (loop [rank :in ["1" "2"]]
    (let [sym (symbol "J" rank)]
      (array/push defs ~(def ,sym {"suit" "joker" "rank" ,(in ranks rank)}))))
  (do ;defs))

(defn to-text [{"suit" suit "rank" rank}]
  (let [suits {"diamonds" "♦" "spades" "♠" "clubs" "♣" "hearts" "♥"}
	ranks {1 "Ace" 2 "2" 3 "3" 4 "4" 5 "5" 6 "6" 7 "7" 8 "8" 9 "9" 10 "10" 11 "J" 12 "Q" 13 "K"}]
    (string (suits suit) (ranks rank))))

(defn of-suit
  "Return any cards in stack that match the led suit."
  [led-suit stack]
  (let [with-jokers |(or (= led-suit ($0 "suit"))
			 (= "joker" ($0 "suit")))]
    (filter with-jokers stack)))
(defn of-suit-or-off
  "Return any cards in stack that match the led suit, otherwise return all cards."
  [led-suit stack]
  (let [on-suit (of-suit led-suit stack)]
    (if (> 0 (length on-suit)) on-suit stack)))

(defn- uptown [a b] (match [a b]
		    # `1` is the rank of the Ace.
		    @[1 1] 0
		    @[1 _] 1
		    @[_ 1] -1
		    @[x y] (compare x y)))

(defn- downtown [a b] (match [a b]
		    # `1` is the rank of the Ace.
		    @[1 1] 0
		    @[1 _] 1
		    @[_ 1] -1
		    @[x y] (- (compare x y))))

(def- uptown-card
  @{:compare (fn [self other]
	       (match [(self "suit") (other "suit")]
				@["joker" "joker"] (compare (self "rank") (other "rank"))
				@["joker" _] 1
				@[_ "joker"] -1
				@[_ _] (uptown (self "rank") (other "rank"))))})
 
(def- downtown-card
  @{:compare (fn [self other]
	       (match [(self "suit") (other "suit")]
				@["joker" "joker"] (compare (self "rank") (other "rank"))
				@["joker" _] 1
				@[_ "joker"] -1
				@[_ _] (downtown (self "rank") (other "rank"))))})
 
(def- notrumps-card
  @{:compare (fn [self other]
	       (match [(self "suit") (other "suit")]
				@["joker" "joker"] (compare (self "rank") (other "rank"))
				@["joker" _] -1
				@[_ "joker"] 1
				@[_ _] (uptown (self "rank") (other "rank"))))})
 
(def- notrumps-downtown-card
  @{:compare (fn [self other]
	       (match [(self "suit") (other "suit")]
				@["joker" "joker"] (compare (self "rank") (other "rank"))
				@["joker" _] -1
				@[_ "joker"] 1
				@[_ _] (downtown (self "rank") (other "rank"))))})
 
(defn make-uptown [suit rank]
  (table/setproto @{"suit" suit
		    "rank" rank}
		  uptown-card))

(defn make-downtown [suit rank]
  (table/setproto @{"suit" suit
		    "rank" rank}
		  downtown-card))

(defn make-notrumps [suit rank]
  (table/setproto @{"suit" suit
		    "rank" rank}
		  notrumps-card))

(defn make-notrumps-downtown [suit rank]
  (table/setproto @{"suit" suit
		    "rank" rank}
		  notrumps-downtown-card))

(defn high-card [led-suit & stack]
  "Trick resolution for all Bid Whist games."
  (->> stack
       (of-suit led-suit)
       (extreme compare>)))

A game/beginplay.janet => game/beginplay.janet +23 -0
@@ 0,0 1,23 @@
(defn- discard [from to-discard]
  (let [new @[]]
    (each in-from from
      (if (not (find |(= in-from $0) to-discard))
	(array/push new in-from)))
    new))

(defn begin-play-phase
  ```
  The bidder has discarded six cards. 

  They may lead any card from their hand.

  Provides:
  - `suit`: The led suit of the current trick.
  ```
  [{:meta meta} players {"player" bidder "value" to-discard}]
  # It's the first trick; bidder gets one trick for the discard.
  (let [bidder-record (find |(= ($0 :id) bidder) players)
	current-hand (in bidder-record :hand)]
    [{:phase "play" :meta (merge meta {"suit" :null})}
     {bidder {:score 1 :hand (discard current-hand to-discard)}}
     {bidder {:name "play" :action "play" :to "trick" :count 1}}]))

A game/bid.janet => game/bid.janet +53 -0
@@ 0,0 1,53 @@
(import players)
(import bids)
(import actions)

(defn- track-pass [not-passed player] (put not-passed player nil))

(defn bid-phase
  ```
  The players bid in an auction to name trump. 

  The highest bid is a number of tricks to take above six with a named
  suit or no-trumps.
  
  Provides:
  - `high_bid`: The current high bid.
  - `not_passed`: The players that haven't yet passed.
  ```
  [{:meta meta} players action]
  (let [{"player" last-bidder "value" last-bid} action
	{"player" previous-high-bidder "bid" high-bid} (meta "high_bid")
	[high-bid high-bidder] (case last-bid
				 "pass" [high-bid previous-high-bidder]
				 [last-bid last-bidder])
	remaining-players (filter |(in (meta "not_passed") ($0 :id)) players)
	next-bidder (players/next-player last-bidder remaining-players)
	player-state @{}
	not-passed (meta "not_passed")
	meta @{"high_bid" {"player" high-bidder "bid" high-bid}}]
    # Handle passes. Mark the player as passed and remove them from the set.
    (each player players (put player-state player @{}))
    (case last-bid
      "pass" (do (put-in player-state [last-bidder :meta] {"bid_action" "passed"})
		 (track-pass not-passed last-bidder))
      (do (put-in player-state [last-bidder :meta] {"bid_action" "declarer" "bid" (bids/to-text high-bid)})
	  # Remove "declarer" annotation from previous bidder.
	  (put-in player-state [previous-high-bidder :meta] {"bid_action" :null})))
    (if (= 1 (length not-passed))
      # If all but one have passed, bidding is over.
      [{:meta meta
	# State: Bid -> Discard
	:phase "discard"}
       player-state
       # Bidder selects suit in a trumps bid or direction in a no-trumps bid.
       {high-bidder (actions/pick1 "bid" (bids/second-bid high-bid))}]
       # Otherwise, move to the next bidder.
       (do
	 (put-in player-state [next-bidder :meta] {"bid_action" "bidding"})
	 (put meta "not_passed" not-passed)
	 [{:meta meta
	   #State: Bid -> Bid
	   :phase "bid"}
	  player-state
	  {next-bidder (actions/pick1 "bid" (bids/available-bids high-bid))}]))))

A game/deal.janet => game/deal.janet +22 -0
@@ 0,0 1,22 @@
(import actions)
(import bids)

(defn- all-draw [players] (zipcoll (map |($0 :id) players) (map (fn [_] (actions/draw 12)) players)))

(defn- new-meta [[p1 p2 p3 p4]] {"high_bid" {} "not_passed" {p1 true p2 true p3 true p4 true}})

(defn deal-phase
  ```
  Each player starts with 12 cards. 

  The first player is prompted to begin bidding.
  ```
  [state players]
  (let [bidder ((in players 0) :id)
       player-meta (all-draw players)]
    # State: Deal -> Bid
    (put-in player-meta [bidder :meta] {"bid_action" "bidding"})
    [{:phase "bid"
      :meta (new-meta players)}
     player-meta
     {bidder (actions/pick1 "bid" (bids/available-bids))}]))

A game/discard.janet => game/discard.janet +23 -0
@@ 0,0 1,23 @@
(import actions)
(import bids)

(defn- make-full-bid [high-bid second-bid]
  (merge high-bid second-bid))

(defn discard-phase
  ```
  The bidder has named their full contract. 

  They pick up the kitty, and are then prompted to discard 6 cards.

  Expected metadata:
  - `high_bid`: The winning bid in the auction.
  Provides:
  - `bid`: The full bid for the hand. 
  ```
  [{:meta {"high_bid" {"bid" high-bid}}} {"player" bidder "value" second-bid}]
  # State: Discard -> Begin Play
  [{:phase "begin_play" :meta {"bid" (make-full-bid high-bid second-bid)}}
   {bidder {:meta {"high_bid" (string (bids/to-text high-bid) ": " (bids/to-text second-bid bids/suit))}
	    :hand (actions/draw 6)}}
   {bidder {"name" "discard" :action "discard" :count 6 :from :hand}}])

A game/play.janet => game/play.janet +52 -0
@@ 0,0 1,52 @@
(import cards)
(import players)
 
(defn- add-to-stack [stack card] (tuple ;stack card))
(defn- with-player [card player] (merge-into @{"player" player} card))

(defn play-phase
  ```
  Players play to tricks.
  
  In the first trick, the bidder leads; every subsequent trick, the
  winner of the previous trick leads.

  Players must follow suit if possible; if not, they can either
  discard or trump.

  Expected stacks:
  - `trick`: The current trick.
  Expected metadata:
  - `suit`: The led suit of the current trick.
  ```
  [old-state players {"player" player "value" card}]
  # We need to explicitly set the current suit to null. This
  # allows us to check for the edge case where the suit has
  # not been set, even after a card (or two) has been played
  # - if the first card is a Joker.
  (var new-state @{:phase "play" :meta @{"suit" :null} :stacks @{"trick" []}})
  (var player-effects @{player {:meta {"play_action" (string "played " (cards/to-text card))}}})
  (var prompt @{})
  (let [current-trick (get-in old-state [:stacks "trick"])]
    (case (length current-trick)
      3 (let [current-suit ("suit" (old-state :meta))
	      highest (cards/high-card current-suit ;current-trick)
	      highest-player (highest :player)
	      their-current-score (get-in players [highest :score])]
	  (put-in player-effects [highest-player :score] (inc their-current-score)))
      (let [old-meta (old-state :meta)
	    current-suit (old-meta "suit")
	    new-suit (if (and (= :null current-suit) (not= (card "suit") "joker"))
		       (card "suit")
		       current-suit)
	    id-to-prompt (players/next-player player players)
	    player-to-prompt (find |(= ($0 :id) id-to-prompt) players)]
	(put-in new-state [:meta "suit"] new-suit)
	(put-in new-state [:stacks "trick"] (add-to-stack current-trick (with-player card player)))
	(put prompt id-to-prompt
	     {:name "play"
	      :action "play"
	      :to "trick"
	      :count 1
	      :from (cards/of-suit-or-off new-suit (player-to-prompt :hand))})))
    [new-state player-effects prompt]))

A init.janet => init.janet +24 -0
@@ 0,0 1,24 @@
(defn
  config
  []
  {:deck "52JJ"
   :stacks {"trick" {:orientation :up
		    :max-size 4
		    :alignment :stagger}}})

(defn-
  make-player
  [id team]
  {:id id :team team :score 0 :meta {} :hand []})

(defn init
  "Create an initial game state."
  [[fst snd] [thd fth]]
  (let [rng (math/rng (os/time))
	players [fst snd thd fth]
	forehand (players (math/rng-int rng 4))]
      {:players [(make-player fst 1)
		 (make-player thd 2)
		 (make-player snd 1)
		 (make-player fth 2)]
       :state {:phase "deal"}}))

A players.janet => players.janet +9 -0
@@ 0,0 1,9 @@
(defn next-player
  [id players]
  (let [ind (find-index
	     |(= ($0 :id) id)
	     players)
	new-ind (mod (inc ind) (length players))]
    ((players new-ind) :id)))



A project.janet => project.janet +5 -0
@@ 0,0 1,5 @@
(declare-project
  :name "bidwhist" # required
  # Optional urls to git repositories that contain required artifacts.
  :dependencies ["https://github.com/janet-lang/json.git"
		 "https://github.com/pyrmont/testament"])

A test/cards.janet => test/cards.janet +99 -0
@@ 0,0 1,99 @@
(import testament :prefix "")
(import cards)

(deftest high-card-aces
  (is (deep= (cards/make-uptown "clubs" 1)
	     (cards/high-card "clubs"
			      (cards/make-uptown "clubs" 1) (cards/make-uptown "clubs" 2)))
      "Aces high")
  (is (deep= (cards/make-downtown "clubs" 1)
	     (cards/high-card "clubs"
			      (cards/make-downtown "clubs" 1) (cards/make-downtown "clubs" 2)))
      "Aces high"))

(deftest high-card-uptown
  (is (deep= (cards/make-uptown "joker" 1)
	     (cards/high-card "clubs"
			      (cards/make-uptown "joker" 1) (cards/make-uptown "clubs" 2)))
      "jokers beat anything")

  (is (deep= (cards/make-uptown "joker" 2)
	     (cards/high-card "clubs"
			      (cards/make-uptown "joker" 1) (cards/make-uptown "joker" 2)))
      "big joker beats little joker")

  (is (deep= (cards/make-uptown "clubs" 1)
	     (cards/high-card "clubs" (cards/make-uptown "clubs" 1) (cards/make-uptown "clubs" 2)))
      "led-suits rank normally")

  (is (deep= (cards/make-uptown "clubs" 1)
	     (cards/high-card "clubs"
			      (cards/make-uptown "clubs" 1) (cards/make-uptown "diamonds" 2)))
      "led-suits beat higher off-suit")

  (is (deep= (cards/make-uptown "clubs" 1)
	     (cards/high-card "clubs"
			      (cards/make-uptown "clubs" 1) (cards/make-uptown "diamonds" 2)))
      "trump beats off-suit"))

(deftest high-card-downtown
  (is (deep= (cards/make-downtown "joker" 1)
	     (cards/high-card "clubs"
			      (cards/make-downtown "joker" 1) (cards/make-downtown "clubs" 2)))
      "jokers beat anything")

  (is (deep= (cards/make-downtown "joker" 2)
	     (cards/high-card "clubs"
			      (cards/make-downtown "joker" 1) (cards/make-downtown "joker" 2)))
      "big joker beats little joker")

  (is (deep= (cards/make-downtown "clubs" 2)
	     (cards/high-card "clubs" (cards/make-downtown "clubs" 2) (cards/make-downtown "clubs" 3)))
      "led-suits rank reversed")

  (is (deep= (cards/make-downtown "clubs" 1)
	     (cards/high-card "clubs"
			      (cards/make-downtown "clubs" 1) (cards/make-downtown "diamonds" 2)))
      "led-suits beat higher off-suit"))

(deftest high-card-notrumps-uptown
  (is (deep= (cards/make-notrumps "clubs" 2)
	     (cards/high-card "clubs"
			      (cards/make-notrumps "joker" 1) (cards/make-notrumps "clubs" 2)))
      "jokers never win")

  (is (deep= (cards/make-notrumps "joker" 2)
	     (cards/high-card "clubs"
			      (cards/make-notrumps "joker" 1) (cards/make-notrumps "joker" 2)))
      "big joker beats little joker")

  (is (deep= (cards/make-notrumps "clubs" 1)
	     (cards/high-card "clubs" (cards/make-notrumps "clubs" 1) (cards/make-notrumps "clubs" 2)))
      "led-suits rank normally")

  (is (deep= (cards/make-notrumps "clubs" 1)
	     (cards/high-card "clubs"
			      (cards/make-notrumps "clubs" 1) (cards/make-notrumps "diamonds" 2)))
      "led-suits beat higher off-suit"))

(deftest high-card-notrumps-downtown
  (is (deep= (cards/make-notrumps-downtown "clubs" 2)
	     (cards/high-card "clubs"
			      (cards/make-notrumps-downtown "joker" 1)
			      (cards/make-notrumps-downtown "clubs" 2)))
      "jokers never win")

  (is (deep= (cards/make-notrumps-downtown "joker" 2)
	     (cards/high-card "clubs"
			      (cards/make-notrumps-downtown "joker" 1) (cards/make-notrumps-downtown "joker" 2)))
      "big joker beats little joker")

  (is (deep= (cards/make-notrumps-downtown "clubs" 2)
	     (cards/high-card "clubs" (cards/make-notrumps-downtown "clubs" 3) (cards/make-notrumps-downtown "clubs" 2)))
      "led-suits rank reversed")

  (is (deep= (cards/make-notrumps-downtown "clubs" 1)
	     (cards/high-card "clubs"
			      (cards/make-notrumps-downtown "clubs" 1) (cards/make-notrumps-downtown "diamonds" 2)))
      "led-suits beat higher off-suit"))
(run-tests!)

A test/whist.janet => test/whist.janet +131 -0
@@ 0,0 1,131 @@
(import testament :prefix "")

(import whist)
(import bids)
(import init)
(import cards)

(cards/intern-cards!)

(def- players [["North" "South"] ["East" "West"]])

(def- player-state [{:hand [] :score 0 :team 1 :meta {} :id "North"}
		    {:hand [] :score 0 :team 2 :meta {} :id "East"}
		    {:hand [] :score 0 :team 1 :meta {} :id "South"}
		    {:hand [] :score 0 :team 2 :meta {} :id "West"}])

(defn all-not-passed [] @{"North" true "East" true "South" true "West" true}) 

(deftest init
  (is (= {:players player-state
	  :state {:phase "deal"}}
	 (init/init ;players))))

(deftest deal
  (def [_state player-meta prompt] (whist/next {:players player-state :state {:phase "deal"}}))
  (is (= {"bid_action" "bidding"} (get-in player-meta ["North" :meta])))
  (is (= {"North" {:name "bid" :count 1 :action "select" :from (bids/available-bids)}} prompt)))

(deftest bidding
  (def first-bid {:players player-state
		  :state {:phase "bid"
			  :meta {"high_bid" {}
				 "not_passed" (all-not-passed)}}
		  :action {"player" "North" "name" "bid" "value" {"count" 3 "direction" "up"}}})
  (def [state player-meta prompt] (whist/next first-bid))
  (is (= {"bid_action" "bidding"} (get-in player-meta ["East" :meta])))
  (is (= {"bid" "3 Uptown" "bid_action" "declarer"} (get-in player-meta ["North" :meta])))
  (is (= {:name "bid" :count 1 :action "select" :from (bids/available-bids {"count" 3 "direction" "up"})} (in prompt "East")))
  (is (= {"bid" {"count" 3 "direction" "up"} "player" "North"} (get-in state [:meta "high_bid"])))
  (is (deep= @{"North" true "East" true "South" true "West" true} (get-in state [:meta "not_passed"]))))

(deftest overbid
  (def player-overbid {:players player-state
		       :state {:phase "bid"
			       :meta {"high_bid" {"bid" {"count" 3 "direction" "up"} "player" "North"}
				      "not_passed" (all-not-passed)}}
		       :action {"player" "East" "value" {"count" 3 "suit" "no_trumps"}}})
  (def [state player-meta prompt] (whist/next player-overbid))
  (is (= {"bid" "3 No-Trumps" "bid_action" "declarer"} (get-in player-meta ["East" :meta])))
  (is (= {"bid_action" :null} (get-in player-meta ["North" :meta])))
  (is (= {"bid_action" "bidding"} (get-in player-meta ["South" :meta])))
  (is (= {:name "bid" :count 1 :action "select" :from (bids/available-bids {"count" 3 "suit" "no_trumps"})} (in prompt "South")))
  (is (= {"bid" {"count" 3 "suit" "no_trumps"} "player" "East"} (get-in state [:meta "high_bid"])))
  (is (deep= @{"North" true "East" true "South" true "West" true} (get-in state [:meta "not_passed"]))))

(deftest pass
  (def player-passed {:players player-state
		      :state {:phase "bid"
			      :meta {"high_bid" {}
				     "not_passed" (all-not-passed)}}
		      :action {"name" "bid" "player" "North" "value" "pass"}})
  (def [state player-meta prompt] (whist/next player-passed))
  (is (= {"bid_action" "bidding"} (get-in player-meta ["East" :meta])))
  (is (= {"bid_action" "passed"} (get-in player-meta ["North" :meta])))
  (is (= {:name "bid" :count 1 :action "select" :from (bids/available-bids)} (in prompt "East")))
  (is (= {} (get-in state [:meta "high_bid"])))
  (is (deep= @{"East" true "South" true "West" true} (get-in state [:meta "not_passed"]))))


(deftest last-pass
  (def last-player-passed {:players player-state
			   :state {:phase "bid"
				   :meta {"high_bid" {"bid" {"count" 3 "direction" "up"} "player" "East"}
					  "not_passed" @{"East" true "North" true}}}
			   :action {"name" "bid" "player" "North" "value" "pass"}})
  (def [state player-meta prompt] (whist/next last-player-passed))
  # Player-meta for East is nil, because there are no side effects for that player this round. 
  (is (= nil (in player-meta "East")))
  (is (= {"bid_action" "passed"} (get-in player-meta ["North" :meta])))
  (is (= {:name "bid" :count 1 :action "select" :from bids/suit} (in prompt "East")))
  (is (= {"bid" {"count" 3 "direction" "up"} "player" "East"} (get-in state [:meta "high_bid"])))
  # not_passed is gone because we are moved to the next phase.
  (is (= nil (get-in state [:meta "not_passed"])))
  (is (= "discard" (in state :phase))))

(deftest discard-prompt
  (def player-completed-bid {:players player-state
			     :state {:phase "discard"
				     :meta {"high_bid" {"bid" {"count" 3 "direction" "up"} "player" "East"}}}
			     :action {"player" "North" "value" {"suit" "clubs"}}})
  (def [state player-meta prompt effects] (whist/next player-completed-bid))
  (is (deep= {:phase "begin_play" :meta {"bid" @{"count" 3 "direction" "up" "suit" "clubs"}}} state))
  (is (= "3 Uptown: Clubs" (get-in player-meta ["North" :meta "high_bid"])))
  (is (= {"name" "discard" :count 6 :action "discard" :from :hand} (in prompt "North"))))

(deftest begin-play
  (let [two-cards [CA C2]
	with-two [{:hand two-cards :score 0 :team 1 :meta {} :id "North"}
		  {:hand [] :score 0 :team 2 :meta {} :id "East"}
		  {:hand [] :score 0 :team 1 :meta {} :id "South"}
		  {:hand [] :score 0 :team 2 :meta {} :id "West"}]
	player-discarded {:players with-two
			  :state {:phase "begin_play"
				  :meta {"suit" :null}}
			  :action {"player" "North" "name" "discard" "value" [C2]}}]
    (def [state player-meta prompt] (whist/next player-discarded))
    (is (deep= {:phase "play" :meta @{"suit" :null}} state))
    (is (deep= {"North" {:hand @[CA] :score 1}} player-meta))
    (is (= {"North" { :count 1 :to "trick" :action "play" :name "play"}}) prompt)))

(def- players-with-full-hands
  # Discarded: Deuces + Jokers
  [{:hand [CA C3 C4 C5 C6 C7 C8 C9 CT CJ CQ CK] :score 0 :team 1 :meta {} :id "North"}
   {:hand [DA D3 D4 D5 D6 D7 D8 D9 DT DJ DQ DK] :score 0 :team 2 :meta {} :id "East"}
   {:hand [HA H3 H4 H5 H6 H7 H8 H9 HT HJ HQ HK] :score 0 :team 1 :meta {} :id "South"}
   {:hand [SA S3 S4 S5 S6 S7 S8 S9 ST SJ SQ SK] :score 0 :team 2 :meta {} :id "West"}])

(deftest first-lead
  (def player-lead {:players players-with-full-hands
		    :state {:phase "play" :meta {"suit" :null} :stacks {"trick" []}}
		    :action {"player" "North" "name" "play" "value" CJ}})
  (def [state player-meta prompt] (whist/next player-lead))
  (let [played-card (merge-into @{"player" "North"} CJ)]
    (is (deep= @{"suit" "clubs"} (state :meta)))
    (is (deep= @{"trick" [played-card]}  (state :stacks))))
  (is (deep= @{"North" {:meta {"play_action" "played \xE2\x99\xA3J"}}} player-meta))
  (is (deep= @{"East" {:name "play" :action "play" :count 1 :to "trick"
		       :from [DA D3 D4 D5 D6 D7 D8 D9 DT DJ DQ DK]}}
	     prompt)))

(run-tests!)

M whist.janet => whist.janet +18 -104
@@ 1,110 1,24 @@
(import bids)
(import cards)
(import actions)
(import players)

(defn-
  make-player
  [id team]
  {:id id :team team :meta {}})
(import game/deal)
(import game/bid)
(import game/discard)
(import game/beginplay)
(import game/play)

(defn-
  make-trick-stack
  []
  {:orientation :up
   :max-size 4
   :alignment :stagger})

(defn-
  make-lookup
  [players]
  (let
      [lookup @{}]
      (loop
	  [player
	   :in players
	   meta
	   :in (player :meta)]
	  (put lookup meta player))))


(defn-
  next-player
  [id players]
  (let
      [ind
       (find-index
	|
	(= ($0 :id) id)
	players)]
      (mod
       (inc ind)
       (length players))))

(defn
  init
  "Create an initial game state."
  [[fst snd] [thd fth]]
  (let
      [rng
       (math/rng (os/time))
       players
       [fst snd thd fth]
       forehand
       (players (math/rng-int rng 4))]
      {:players [(make-player fst 1)
		 (make-player thd 2)
		 (make-player snd 1)
		 (make-player fth 2)]
       :state {:stacks {:trick (make-trick-stack)}
	       :phase "deal"}}))

(defn
  next
(defn next
  ```
  Rules engine for Bid Whist.
  ```
  [{:state state
    :players players
    :action action}]
  (match
      state
      # THE DEAL
      {:phase "deal"}
      (let
	  [hands
	   @{}
	   bidder
	   ((players 0) :id)]
	  (each
	      player
	      players
	      (put
	       hands
	       (player :id)
	       {:do [{:draw 12}]}))
	  {:hands hands
	   :phase "bid"
	   :meta {"high_bid" {}}
	   :-player-meta {bidder {:set ["bidding"]}}
	   :-prompt {bidder (bids/available-bids)}})
      # BIDDING
      {:phase "bid" :meta {"high_bid" high-bid-meta}}
      (let
	  [{"player" last-bidder "bid" last-bid}
	   action
	   {"player" high-bidder
	    "bid" high-bid}
	   high-bid-meta
	   [high-bid high-bidder]
	   (case last-bid
	     "pass"
	     [high-bid high-bidder]
	     [last-bid last-bidder])
	   next-bidder
	   (next-player last-bidder players)]
	  {:-prompt {next-bidder (bids/available-bids high-bid)}
	   :-player-meta {high-bidder {:set ["declarer"]}
			  next-bidder {:set ["bidding"]}}
	   :meta {"high_bid" {"player" high-bidder "bid" high-bid}}})
      {:phase "play"}
      (match
	  state
	  ({:stacks {:trick trick}}
	   (= (length trick) 4))
	  # (handle-winner)
	  {:stacks {:trick trick}}))) 
  (match (state :phase)
    "deal" (deal/deal-phase state players)
    "bid" (bid/bid-phase state players action)
    "discard" (discard/discard-phase state action)
    "begin_play" (beginplay/begin-play-phase state players action)
    "play" (play/play-phase state players action)))