SpindleyQ/hottub
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

rework question API to use arbitrary functions for dispatch

Browse source
This commit is contained in:
Jeremy Penner 2013-05-04 00:19:46 -04:00
parent 8b3c2d99b0
commit 27fa774f7b
1 changed files with 30 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
src/hottub/question.clj
View file

@ -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)))