match for spec

adt.clj

(ns adt
  (:require [clojure.spec :as s]))

(defmacro match [spec x & cases]
  (let [fr (s/form spec)
        [ffr & frcases] fr
        _ (assert (= `s/or ffr)
                  "match only works on clojure.spec/or specs")
        expected-cases (set (take-nth 2 frcases))
        found-cases (set (map first cases))
        _ (assert (= expected-cases found-cases)
                  (str "match missing case: expected: " expected-cases
                       " found: " found-cases))
        spec-name-s (gensym "spec-name")
        spec-children-s (gensym "spec-children")]
    `(let [[~spec-name-s ~spec-children-s] (s/conform ~spec ~x)]
       (case ~spec-name-s
         ~@(reduce into
                   []
                   (for [[kw# binding# body#] cases]
                     [kw# `(let [~binding# ~spec-children-s]
                             ~body#)]))))))

(s/def ::body string?)
(s/def ::status number?)

(s/def ::reply (s/keys :req [::body
                             ::status]))

(s/def ::error string?)

(s/def ::retry number?)

(s/def ::response (s/or :reply ::reply
                        :error ::error
                        :retry ::retry))
(defn doit [a]
  (match ::response a
         (:reply {:keys [::body ::status]}
                 (println "reply" body status))
         (:error message
                 (println "error" message))
         (:retry n
                 (println "retry" n))))


(def b {::body "Hello world"
        ::status 200})

(def e "Error message")


(doit b)
;; => reply Hello world 200
;; nil
(doit e)
;; => error Error message
;; nil
(doit 103)
;; => retry 103
;; nil