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
|
||||
(:require [clojure.set :as set]))
|
||||
|
||||
(defstruct responder :fnrespond :fncanrespond)
|
||||
|
||||
(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 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]
|
||||
`(do
|
||||
(defmulti ~name [entity# ~@rest-args] (first (keys-for-question ~name entity#)))
|
||||
(defmethod ~name :default [~entity ~@rest-args] ~@impl)))
|
||||
(defn set-responder [id question fnrespond fncanrespond]
|
||||
(let [responder (struct responder fnrespond fncanrespond)]
|
||||
(swap! question-registry assoc-in [question id] responder)))
|
||||
|
||||
(set-questions-for-key :foo :bar :x)
|
||||
(set-questions-for-key :baz :bar :y)
|
||||
(keys-for-question :bar)
|
||||
(keys-for-question :bar {})
|
||||
(keys-for-question :bar {:foo 3})
|
||||
(questions)
|
||||
(defn responders
|
||||
[question]
|
||||
(vals (get @question-registry question))
|
||||
[question entity]
|
||||
(filter #((:fncanrespond %) question entity) (responders question)))
|
||||
|
||||
(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