https://forums.bigbears.io/t/hangman-the-series-3-reactive-api-the-dance-between-hot-and-cold-streams/524

reactive-hangman.repl

(require '[cognitect.transcriptor :refer (check!)])

(require '[hangman.reactive-hangman :refer :all])

(comment "win case")

(-> (init-game-data "bigbear" 7)
    (prefill-letters ["a"])
    (handle-new-event [:guess "b"])
    (handle-new-event [:guess "o"])
    (handle-new-event [:guess "i"])
    (handle-new-event [:guess "g"])
    (handle-new-event [:guess "e"])
    (handle-new-event [:guess "y"])
    (handle-new-event [:time-tick])
    (handle-new-event [:guess "r"])
    (handle-new-event [:time-tick])
    update-status
    game-state)

(check! #{{:status :won
           :selected-letters ["a" "b" "o" "i" "g" "e" "y" "r"]
           :life-left 5
           :secret-word-length 7
           :known-secret-word "bigbear"
           :time-left 4}})



(comment "lose case")

(-> (init-game-data "bigbear" 7)
    (prefill-letters ["a"])
    (handle-new-event [:guess "b"])
    (handle-new-event [:guess "b"])
    (handle-new-event [:guess "o"])
    (handle-new-event [:guess "o"])
    (handle-new-event [:guess "e"])
    (handle-new-event [:guess "n"])
    (handle-new-event [:guess "u"])
    (handle-new-event [:guess "t"])
    (handle-new-event [:guess "z"])
    (handle-new-event [:guess "x"])
    (handle-new-event [:guess "v"])
    update-status
    game-state)

(check! #{{:status :lose,
           :selected-letters ["a" "b" "o" "e" "n" "u" "t" "z" "x" "v"],
           :life-left 0,
           :secret-word-length 7,
           :known-secret-word "b__bea_"
           :time-left 5}})



(comment "reactive")

(require '[clojure.spec.alpha :as s]
         '[clojure.core.async :as async :refer [chan to-chan take! go >!]])

(create-ns 'hangman.reactive-hangman.check.async-win)
(alias 'chk1 'hangman.reactive-hangman.check.async-win)

(def secret-word "bigbear")
(def events ["b" :t :t "o" :t "i" :t "g" :t "a" :t :t :t :t :t :t :t :t "e" :t "y" :t "r"])

(s/def ::chk1/game (s/keys :req-un [::chk1/status :chk1/secret-word-length ::chk1/known-secret-word
                                    ::chk1/selected-letters ::chk1/life-left]))
(s/def ::chk1/status #{:won})
(s/def ::chk1/secret-word-length #{(count secret-word)})
(s/def ::chk1/known-secret-word #{secret-word})
(s/def ::chk1/selected-letters (fn [lts] (every? (set lts) (vectorize secret-word))))
(s/def ::chk1/life-left pos-int?)

(let [letters-chan (chan)
      time-chan (chan)
      out-chan (reactive-hangman secret-word letters-chan time-chan)]
  (go
    (doseq [e events]
      (cond
        (string? e) (>! letters-chan e)
        (= :t e) (>! time-chan 1))))
  (take! (async/into [] out-chan)
         (fn [games] (check! ::chk1/game (last games)))))



(defn run-this-file
  []
  (require 'cognitect.transcriptor)
  (defn tmp [])
  (cognitect.transcriptor/run (-> #'tmp meta :file)))

(comment
  (run-this-file))

reactive_hangman.clj

(ns hangman.reactive-hangman
  (:require [clojure.string :as string]
            [clojure.core.async :refer [chan go-loop alts! close! alt! timeout]]))

(def guess-clock 5)

(defn vectorize [text]
  (mapv str text))

(defn init-game-data [secret-word life]
  (let [word-length (count secret-word)]
    {:secret-word secret-word
     :secret-word-vec (vectorize secret-word)
     :status :in-progress
     :selected-letters []
     :life-left life
     :secret-word-length word-length
     :known-secret-word (apply str (take word-length (repeat "_")))
     :time-left guess-clock}))

(defn initial-letters-count
  [word-length]
  (-> (dec word-length)
      (quot 5)
      (inc)))

(defn rand-initial-letters
  [secret-word]
  (let [letters (map str (-> secret-word seq set))
        no-letters (initial-letters-count (count secret-word))]
    (take no-letters (shuffle letters))))

(defn known-secret-word
  [{:keys [secret-word-vec selected-letters]}]
  (let [selected-letters-set (set selected-letters)]
    (->> secret-word-vec
         (map #(get selected-letters-set % "_"))
         (apply str))))

(defn new-life-left
  [{:keys [life-left secret-word-vec selected-letters]} new-letter]
  (cond
    (some #{new-letter} selected-letters) life-left
    (not-any? #{new-letter} secret-word-vec) (dec life-left)
    :default life-left))

(defn apply-letter [game letter]
  (-> game
      (#(assoc % :life-left (new-life-left % letter)))
      (update :selected-letters (fn [lts] (if (some #{letter} lts) lts (conj lts letter))))
      (#(assoc % :known-secret-word (known-secret-word %)))
      (assoc :time-left guess-clock)))

(defn prefill-letters
  [game letters]
  (reduce apply-letter game letters))

(defn create-game [secret-word life]
  (let [game (init-game-data secret-word life)
        initial-letters (rand-initial-letters (:secret-word-vec game))]
    (prefill-letters game initial-letters)))

(defn game-state
  [game]
  (select-keys game [:status :selected-letters :life-left :secret-word-length :known-secret-word :time-left]))

(defn time-tick [game]
  (let [game-after (if (zero? (:time-left game))
                     (assoc game :time-left guess-clock)
                     (update game :time-left dec))]
    (if (zero? (:time-left game-after))
      (update game-after :life-left dec)
      game-after)))

(defn resolve-status
  [game]
  (cond
    (zero? (:life-left game)) :lose
    (string/includes? (:known-secret-word game) "_") :in-progress
    :else :won))

(defn update-status
  [game]
  (assoc game :status (resolve-status game)))

(defn handle-new-event
  [game [e & args]]
  (-> (case e
        :guess (apply-letter game (first args))
        :time-tick (time-tick game))
      update-status))

(def game-end? (comp #{:won :lose} :status))

(defn reactive-hangman [secret-word letters-chan time-chan]
  (let [output-chan (chan 1)]
    (go-loop [game (create-game secret-word 7)]
      (alts! [[output-chan (game-state game)] (timeout 5000)])
      (if (game-end? game)
        (close! output-chan)
        (when-let [event (alt!
                      letters-chan ([letter] [:guess letter])
                      time-chan ([_] [:time-tick])
                      (timeout 5000) ([_] (close! output-chan)))]
          (recur (handle-new-event game event)))))
    output-chan))

web_game.clj

(ns hangman.web-game
  (:require [clojure.core.async
             :refer [chan go-loop timeout <! offer! close! mult tap sliding-buffer <!! >!! untap]]
            [clojure.data :refer [diff]]
            [clojure.set :refer [rename-keys]]
            [hangman.reactive-hangman :as core])
  (:import [java.time Instant]))

(defonce app-state (atom nil))

(defn update-app
  [f & args]
  (apply swap! app-state f args))

(def words
  ["adventurous"
   "courageous"
   "extramundane"
   "generous"
   "intransigent"
   "sympathetic"
   "vagarious"
   "witty"])

(defn create-game-id
  [i]
  (str "game-id-" i))

(defn format-game-data
  [game game-id]
  (-> game
      (select-keys [:status :selected-letters :life-left :secret-word-length :known-secret-word])
      (assoc :id game-id)))

(defn game-ref
  [game-id]
  (-> @app-state :games (get game-id)))

(defn game-snapshot
  [game-id]
  (-> game-id game-ref :snapshot))

(defn game-letters-chan
  [game-id]
  (-> game-id game-ref :letters-chan))

(defn game-out-mult
  [game-id]
  (-> game-id game-ref :out-mult))

(defn game-time-status-mult
  [game-id]
  (-> game-id game-ref :time-status-mult))

(defn recent-game-id
  [app-state]
  (-> app-state :current-game-seq create-game-id))

(defn game->time-status
  [game]
  {:timestamp (.getEpochSecond (Instant/now))
   :event (if (core/game-end? game) "game-over" "time-spent")
   :data (select-keys game [:time-left :life-left])})

(defn create-new-game
  [app-state]
  (let [game-seq (-> app-state :current-game-seq inc)
        timer-chan (chan (sliding-buffer 1))
        _ (tap (:timer-mult app-state) timer-chan)
        letters-chan (chan 1)
        out-chan (core/reactive-hangman (rand-nth words) letters-chan timer-chan)
        out-mult (mult out-chan)
        time-status-chan (chan 1 (map game->time-status))
        _ (tap out-mult time-status-chan)
        new-game {:timer-chan timer-chan
                  :letters-chan letters-chan
                  :out-chan out-chan
                  :out-mult out-mult
                  :time-status-chan time-status-chan
                  :time-status-mult (mult time-status-chan)}]
    (-> app-state
        (update :games assoc (create-game-id game-seq) new-game)
        (assoc :current-game-seq game-seq))))

(defn synchronous-update-game
  ([game-id] (synchronous-update-game game-id nil))
  ([game-id update-fn]
   (let [return-chan (chan 1)
         game-mult (game-out-mult game-id)
         _ (tap game-mult return-chan)]
     (when update-fn (update-fn))
     (let [o (<!! return-chan)]
       (untap game-mult return-chan)
       (close! return-chan)
       (format-game-data o game-id)))))

(defn time-status-mult
  [game-id]
  (game-time-status-mult game-id))

(defn guess
  [game-id letter]
  (synchronous-update-game game-id (fn [] (>!! (game-letters-chan game-id) letter))))

(defn update-game-snapshot
  [game-id v]
  (update-app update-in [:games game-id] assoc :snapshot v))

(defn start-game-snapshoter
  [game-id]
  (let [snapshot-chan (chan 1)
        _ (tap (game-out-mult game-id) snapshot-chan)]
    (go-loop []
      (when-let [v (<! snapshot-chan)]
        (update-game-snapshot game-id (format-game-data v game-id))
        (recur)))))

(defn create-game
  []
  (let [new-game-id (recent-game-id (update-app create-new-game))
        game (synchronous-update-game new-game-id)]
    (start-game-snapshoter new-game-id)
    game))

(defn start-timer
  []
  (let [out-chan (:timer-chan @app-state)]
    (go-loop []
      (if @app-state
        (do
          (<! (timeout 1000))
          (when @app-state
            (update-app update :current-time inc)
            (offer! out-chan (:current-time @app-state)))
          (recur))
        (close! out-chan)))))

(defn start
  []
  (let [timer-chan (chan 1)]
    (reset! app-state {:games {}
                       :current-game-seq 0
                       :timer-chan timer-chan
                       :timer-mult (mult timer-chan)
                       :current-time 0}))
  (start-timer)
  :started)

(defn game-started?
  []
  (boolean @app-state))

(defn stop
  []
  (reset! app-state nil)
  :stopped)

web_handler.clj

(ns hangman.web-handler
  (:require [bidi.bidi :refer [tag]]
            [environ.core :refer [env]]
            [yada.yada :as yada :refer [listener resource as-resource]]
            [yada.resources.webjar-resource :refer [new-webjar-resource]]
            [hangman.web-game :as game]))

(defonce server (atom nil))

(def routes
  [""
   (-> [""
        [["/hangman/"
          [[""
            (resource
              {:methods
               {:post
                {:produces "application/json"
                 :response
                 (fn [_]
                   (game/create-game))}}})]
           [[:id]
            [[""
              (resource
                {:produces "application/json"
                 :response
                 (fn [{{{:keys [id]} :params} :request}]
                   (game/game-snapshot id))})]
             [["/timer"]
              (resource
                {:swagger/description "WARN: This enpoint can't be tested with this swagger UI"
                 :methods
                 {:get
                  {:produces "text/event-stream"
                   :response
                   (fn [{{{:keys [id]} :params} :request}]
                     (game/time-status-mult id))}}})]
             [["/" :letter]
              (resource
                {:methods
                 {:put
                  {:produces "application/json"
                   :response
                   (fn [{{{:keys [id letter]} :params} :request}]
                     (game/guess id letter))}}})]]]]]]]
       yada/swaggered)])

(defn start [& [port]]
  (when-not (game/game-started?) "WARN: Game hasn't started")
  (let [svr (listener #'routes {:port (or port 3000)})]
    (reset! server svr))
  (println "Server start at port 3000"))

(defn stop []
  (when @server ((:close @server)))
  (reset! server nil))

(defn restart []
  (stop)
  (start))

(defn -main [& [port]]
  (let [port (Integer. (or port (env :port)))]
    (game/start)
    (start port)))