rework question API to use arbitrary functions for dispatch
This commit is contained in:
parent
8b3c2d99b0
commit
27fa774f7b
|
@ -1,33 +1,38 @@
|
||||||
(ns hottub.question
|
(ns hottub.question
|
||||||
(:require [clojure.set :as set]))
|
(:require [clojure.set :as set]))
|
||||||
|
|
||||||
|
(defstruct responder :fnrespond :fncanrespond)
|
||||||
|
|
||||||
(def question-registry (atom {}))
|
(def question-registry (atom {}))
|
||||||
|
|
||||||
(defn set-questions-for-key [key & questions]
|
|
||||||
(swap! question-registry
|
|
||||||
#(reduce (fn [registry question]
|
|
||||||
(assoc registry question
|
|
||||||
(if-let [keys (get registry question)]
|
|
||||||
(conj keys key)
|
|
||||||
#{key})))
|
|
||||||
%1 questions)))
|
|
||||||
|
|
||||||
(defn keys-for-question
|
|
||||||
([question]
|
|
||||||
(or (get @question-registry question) #{}))
|
|
||||||
([question entity]
|
|
||||||
(set/intersection (keys-for-question question) (set (keys entity)))))
|
|
||||||
|
|
||||||
(defn questions [] (keys @question-registry))
|
(defn questions [] (keys @question-registry))
|
||||||
|
(defn clear-responder
|
||||||
|
[id]
|
||||||
|
(doseq [question (questions)]
|
||||||
|
(clear-responder question id))
|
||||||
|
[question id]
|
||||||
|
(swap! question-registry
|
||||||
|
#(if-let [responders (get % question)]
|
||||||
|
(assoc % question (disassoc responders id))
|
||||||
|
%)))
|
||||||
|
|
||||||
(defmacro defquestion [name [entity & rest-args] & impl]
|
(defn set-responder [id question fnrespond fncanrespond]
|
||||||
`(do
|
(let [responder (struct responder fnrespond fncanrespond)]
|
||||||
(defmulti ~name [entity# ~@rest-args] (first (keys-for-question ~name entity#)))
|
(swap! question-registry assoc-in [question id] responder)))
|
||||||
(defmethod ~name :default [~entity ~@rest-args] ~@impl)))
|
|
||||||
|
|
||||||
(set-questions-for-key :foo :bar :x)
|
(defn responders
|
||||||
(set-questions-for-key :baz :bar :y)
|
[question]
|
||||||
(keys-for-question :bar)
|
(vals (get @question-registry question))
|
||||||
(keys-for-question :bar {})
|
[question entity]
|
||||||
(keys-for-question :bar {:foo 3})
|
(filter #((:fncanrespond %) question entity) (responders question)))
|
||||||
(questions)
|
|
||||||
|
(defn ask-all [question entity]
|
||||||
|
(map #((:fnrespond %) question entity) (responders question entity)))
|
||||||
|
|
||||||
|
(defn ask
|
||||||
|
[question entity] (ask question entity nil)
|
||||||
|
[question entity default]
|
||||||
|
(let [results (ask-all question entity)]
|
||||||
|
(if (seq results)
|
||||||
|
(first results)
|
||||||
|
default)))
|
||||||
|
|
Loading…
Reference in a new issue