Implement the concept of "questions" one can ask of an arbitrary entity (ad-hoc components)
Not entirely convinced that this design is the way to go, but am currently without better ideas. Perhaps each "key" (answerer) could/should provide a dispatch function?
This commit is contained in:
parent
4d0dd8ba8d
commit
5548363a06
33
src/hottub/question.clj
Normal file
33
src/hottub/question.clj
Normal file
|
@ -0,0 +1,33 @@
|
||||||
|
(ns hottub.question
|
||||||
|
(:require [clojure.set :as set]))
|
||||||
|
|
||||||
|
(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))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
(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)
|
|
@ -8,3 +8,12 @@
|
||||||
|
|
||||||
(defn timestamp []
|
(defn timestamp []
|
||||||
(/ (System/nanoTime) 1000000))
|
(/ (System/nanoTime) 1000000))
|
||||||
|
|
||||||
|
(defn ?assoc
|
||||||
|
"Same as assoc, b ut skip the assoc if v is nil"
|
||||||
|
[m & kvs]
|
||||||
|
(into m
|
||||||
|
(for [[k v :as e] (partition 2 kvs) :when (not (nil? v))]
|
||||||
|
(vec e))))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue