Skip to content

Instantly share code, notes, and snippets.

@pbaille
Last active Feb 8, 2017
Embed
What would you like to do?
;; error handling -----------------------------------
(defn check-cyclic-prefs [sd spec specs]
(assert (not-any? #(contains? (set (get @(:prefs sd) %))
spec)
specs)
(str "circular dependency:"
"\nname: " (:name sd)
"\nspec:" spec
"\nconflicts: " (keep #(contains? (set (get @(:prefs sd) %))
spec)
specs))))
(defn check-opts [opts]
(assert (instance? clojure.lang.IDeref (:dispatch-map opts (atom {})))
"dispatch-map must be an atom")
(assert (instance? clojure.lang.IDeref (:prefs opts (atom {})))
"prefs must be an atom"))
(defn throw-unresolvable-impl-error [matching-specs]
(throw (Exception. (str "can't choose an implementation for those matches: "
matching-specs
"\n you have to specify preferences."))))
;; impl -----------------------------------------------
(defn choose-impl
"resolve cases where multiple specs matches"
[prefs matches]
(let [matching-specs (set (keys matches))
concerned-prefs
(into {} (filter (comp matching-specs key) prefs))
[chosen-spec]
(filter (fn [spec]
(every? (get concerned-prefs spec (constantly false))
(disj matching-specs spec)))
matching-specs)]
(if chosen-spec
(get matches chosen-spec)
(throw-unresolvable-impl-error matching-specs))))
(defrecord SpecDispatcher [name dispatch-map prefs]
clojure.lang.IFn
(invoke [this a1]
(let [matches (into {}
(filter (fn [[spec impl]]
(try (cs/valid? spec a1)
(catch Exception e nil)))
@dispatch-map))]
(condp = (count matches)
0 (throw (Exception. (str "No implementation for: " a1)))
1 ((-> matches first val) a1)
((choose-impl @prefs matches) a1)))))
;; API ----------------------------------------------------------
(defn prefer! [sd spec & specs]
(check-cyclic-prefs sd spec specs)
(swap! (:prefs sd) (fn [xs] (into (set xs) specs)))
sd)
(defn unprefer! [sd spec & specs]
(swap! (:prefs sd) (fn [xs] (apply disj (set xs) specs)))
sd)
(defn add-impl! [sd spec impl]
(swap! (:dispatch-map sd) assoc spec impl)
sd)
(defn rem-impl! [sd spec]
(swap! (:dispatch-map sd) dissoc spec)
sd)
(defn default-opts []
{:name (gensym)
:dispatch-map (atom {})
:prefs (atom {})})
(defn sdf
([opts]
(check-opts opts)
(map->SpecDispatcher
(merge (default-opts) opts)))
([name dm prefs]
(SpecDispatcher. name dm prefs)))
;; tests ------------------------------------------------------
(def f (sdf
{:name :sd
:dispatch-map
(atom
{int? (fn [x] :int-case)
even? (fn [x] :even-case)
ident? (fn [x] :ident-case)
keyword? (fn [x] :kw-case)})
:prefs
(atom {even? #{int?}})}))
(comment
(f 2)
(f 1)
(f 'foo)
(f :foo)
(f []))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment