From 50e2b803420b997ff9959e1b6af707625c5b0ea9 Mon Sep 17 00:00:00 2001 From: Cam Saul <1455846+camsaul@users.noreply.github.com> Date: Thu, 8 Sep 2022 22:37:36 -0700 Subject: [PATCH] Implement a describe tool (#123) --- .clj-kondo/config.edn | 70 +++++++++++++--- src/methodical/core.clj | 5 ++ src/methodical/impl/cache/simple.clj | 7 +- src/methodical/impl/cache/watching.clj | 23 +++--- src/methodical/impl/combo/clojure.clj | 7 +- src/methodical/impl/combo/clos.clj | 7 +- src/methodical/impl/combo/operator.clj | 33 +++++--- src/methodical/impl/combo/threaded.clj | 9 ++- src/methodical/impl/dispatcher/everything.clj | 10 ++- .../impl/dispatcher/multi_default.clj | 23 ++++-- src/methodical/impl/dispatcher/standard.clj | 11 ++- src/methodical/impl/method_table/clojure.clj | 9 ++- src/methodical/impl/method_table/common.clj | 53 +++++++++++- src/methodical/impl/method_table/standard.clj | 9 ++- src/methodical/impl/multifn/cached.clj | 9 ++- src/methodical/impl/multifn/standard.clj | 18 ++++- src/methodical/impl/standard.clj | 21 ++++- src/methodical/interface.clj | 33 ++++---- src/methodical/macros.clj | 2 +- src/methodical/util.clj | 31 ++++--- src/methodical/util/datafy.clj | 1 - src/methodical/util/describe.clj | 16 ++++ src/methodical/util/trace.clj | 22 ++--- test/methodical/datafy_test.clj | 3 + test/methodical/impl/combo/operator_test.clj | 51 +++++++++--- .../impl/dispatcher/multi_default_test.clj | 16 ++-- .../impl/method_table/standard_test.clj | 14 ++-- .../methodical/impl/multifn/standard_test.clj | 24 +++--- test/methodical/macros_test.clj | 70 ++++++++-------- test/methodical/util/describe_test.clj | 80 +++++++++++++++++++ 30 files changed, 525 insertions(+), 162 deletions(-) delete mode 100644 src/methodical/util/datafy.clj create mode 100644 src/methodical/util/describe.clj create mode 100644 test/methodical/util/describe_test.clj diff --git a/.clj-kondo/config.edn b/.clj-kondo/config.edn index bd99434..3108f92 100644 --- a/.clj-kondo/config.edn +++ b/.clj-kondo/config.edn @@ -2,28 +2,78 @@ ["../resources/clj-kondo.exports/methodical/methodical"] :linters - {:missing-docstring {:level :warning} - :refer {:level :warning} - :unsorted-required-namespaces {:level :warning} - :single-key-in {:level :warning} - :shadowed-var {:level :warning} - :unresolved-symbol {} - - :docstring-leading-trailing-whitespace {:level :warning} + {:docstring-leading-trailing-whitespace {:level :warning} :keyword-binding {:level :warning} :misplaced-docstring {:level :warning} :missing-body-in-when {:level :warning} + :missing-docstring {:level :warning} :missing-else-branch {:level :warning} :namespace-name-mismatch {:level :warning} :non-arg-vec-return-type-hint {:level :warning} :reduce-without-init {:level :warning} :redundant-fn-wrapper {:level :warning} + :refer {:level :warning} + :shadowed-var {:level :warning} + :single-key-in {:level :warning} + :unsorted-required-namespaces {:level :warning} :use {:level :warning} :used-underscored-binding {:level :warning} - :warn-on-reflection {:level :warning}} + :warn-on-reflection {:level :warning} + + :unresolved-symbol + {} + + :consistent-alias + {:aliases + {clojure.core.protocols clojure.protocols + clojure.datafy datafy + clojure.java.classpath classpath + clojure.java.io io + clojure.math.combinatorics combo + clojure.pprint pprint + clojure.spec.alpha s + clojure.string str + clojure.test t + clojure.tools.namespace.find ns.find + clojure.tools.reader.edn edn + clojure.walk walk + environ.core env + humane-are.core humane-are + methodical.core m + methodical.impl impl + methodical.impl.cache.simple cache.simple + methodical.impl.cache.watching cache.watching + methodical.impl.combo.clojure combo.clojure + methodical.impl.combo.clos combo.clos + methodical.impl.combo.common combo.common + methodical.impl.combo.operator combo.operator + methodical.impl.combo.threaded combo.threaded + methodical.impl.dispatcher.common dispatcher.common + methodical.impl.dispatcher.everything dispatcher.everything + methodical.impl.dispatcher.multi-default dispatcher.multi-default + methodical.impl.dispatcher.standard dispatcher.standard + methodical.impl.method-table.clojure method-table.clojure + methodical.impl.method-table.common method-table.common + methodical.impl.method-table.standard method-table.standard + methodical.impl.multifn.cached multifn.cached + methodical.impl.multifn.standard multifn.standard + methodical.impl.standard impl.standard + methodical.interface i + methodical.macros macros + methodical.util u + methodical.util.describe describe + methodical.util.trace trace + pjstadig.humane-test-output humane-test-output + potemkin p + potemkin.namespaces p.namespaces + potemkin.types p.types + pretty.core pretty + puget.printer puget}}} :lint-as - {potemkin.types/deftype+ clojure.core/deftype} + {potemkin/defprotocol+ clojure.core/defprotocol + potemkin.types/deftype+ clojure.core/deftype + potemkin.types/defprotocol+ clojure.core/defprotocol} :skip-comments true diff --git a/src/methodical/core.clj b/src/methodical/core.clj index 6e61db4..56af0c4 100644 --- a/src/methodical/core.clj +++ b/src/methodical/core.clj @@ -6,6 +6,7 @@ methodical.interface methodical.macros methodical.util + methodical.util.describe methodical.util.trace [potemkin :as p])) @@ -14,6 +15,7 @@ methodical.impl/keep-me methodical.interface/keep-me methodical.macros/keep-me + methodical.util.describe/keep-me methodical.util.trace/keep-me methodical.util/keep-me) @@ -115,5 +117,8 @@ prefer-method! with-prefers!] + [methodical.util.describe + describe] + [methodical.util.trace trace]) diff --git a/src/methodical/impl/cache/simple.clj b/src/methodical/impl/cache/simple.clj index 4434be6..05a92fb 100644 --- a/src/methodical/impl/cache/simple.clj +++ b/src/methodical/impl/cache/simple.clj @@ -5,6 +5,7 @@ (:require [clojure.core.protocols :as clojure.protocols] [methodical.interface] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface Cache))) @@ -35,4 +36,8 @@ clojure.protocols/Datafiable (datafy [this] {:class (class this) - :cache @atomm})) + :cache @atomm}) + + describe/Describeable + (describe [this] + (format "It caches methods using a %s." (.getCanonicalName (class this))))) diff --git a/src/methodical/impl/cache/watching.clj b/src/methodical/impl/cache/watching.clj index 6f89ab9..f89fc79 100644 --- a/src/methodical/impl/cache/watching.clj +++ b/src/methodical/impl/cache/watching.clj @@ -1,20 +1,21 @@ (ns methodical.impl.cache.watching - "A `Cache` implementation that wraps any other cache, watching one or more references (such as an - atom or var), calling `clear-cache!` whenever one of those references changes. + "A [[methodical.interface/Cache]] implementation that wraps any other cache, watching one or more references (such as an + atom or var), calling [[methodical.interface/clear-cache!]] whenever one of those references changes. - WatchingCaches can be created by calling `add-watches` on another cache. `add-watches` is composable, meaning you - can thread multiple calls to it to build a cache that watches the entire world go by. You could, for example, use + `WatchingCache`s can be created by calling [[add-watches]] on another cache. [[add-watches]] is composable, meaning + you can thread multiple calls to it to build a cache that watches the entire world go by. You could, for example, use this to build a multifn that supports a dynamic set of hierarchies, letting you add more as you go. The world's your oyster! - WatchingCaches' watch functions weakly reference their caches, meaning they do not prevent garbage collection of + `WatchingCache`s' watch functions weakly reference their caches, meaning they do not prevent garbage collection of potentially large method maps; they also automatically clear out their watches when they are garbage collected and - finalized (which, of course, may actually be never -- but worst-case is that some unneeded calls to `clear-cache!` - get made)." + finalized (which, of course, may actually be never -- but worst-case is that some unneeded calls + to [[methodical.interface/clear-cache!]] get made)." (:require [clojure.core.protocols :as clojure.protocols] [clojure.datafy :as datafy] [methodical.interface :as i] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (java.lang.ref WeakReference) @@ -52,7 +53,11 @@ (datafy [this] {:class (class this) :cache (datafy/datafy cache) - :refs refs})) + :refs refs}) + + describe/Describeable + (describe [this] + (format "It caches methods using a %s." (.getCanonicalName (class this))))) (defn- cache-watch-fn [cache] (let [cache-weak-ref (WeakReference. cache)] @@ -97,7 +102,7 @@ (defn remove-watches "Recursively removes all watches from `cache`, and returning the cache it wrapped (in case you want to thread it into - `add-watches` to watch something else). If `cache` is not an instance of `WatchingCache`, returns the cache as-is." + [[add-watches]] to watch something else). If `cache` is not an instance of `WatchingCache`, returns the cache as-is." [cache] (if-not (instance? WatchingCache cache) cache diff --git a/src/methodical/impl/combo/clojure.clj b/src/methodical/impl/combo/clojure.clj index 693998c..d9955dc 100644 --- a/src/methodical/impl/combo/clojure.clj +++ b/src/methodical/impl/combo/clojure.clj @@ -4,6 +4,7 @@ (:require [clojure.core.protocols :as clojure.protocols] [methodical.interface] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface MethodCombination))) @@ -35,4 +36,8 @@ clojure.protocols/Datafiable (datafy [this] - {:class (class this)})) + {:class (class this)}) + + describe/Describeable + (describe [this] + (format "It uses the method combination %s." (.getCanonicalName (class this))))) diff --git a/src/methodical/impl/combo/clos.clj b/src/methodical/impl/combo/clos.clj index df36a56..9b13e33 100644 --- a/src/methodical/impl/combo/clos.clj +++ b/src/methodical/impl/combo/clos.clj @@ -7,6 +7,7 @@ [clojure.core.protocols :as clojure.protocols] [methodical.impl.combo.common :as combo.common] [methodical.interface] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface MethodCombination))) @@ -84,4 +85,8 @@ clojure.protocols/Datafiable (datafy [this] - {:class (class this)})) + {:class (class this)}) + + describe/Describeable + (describe [this] + (format "It uses the method combination %s." (.getCanonicalName (class this))))) diff --git a/src/methodical/impl/combo/operator.clj b/src/methodical/impl/combo/operator.clj index 9660da7..533e095 100644 --- a/src/methodical/impl/combo/operator.clj +++ b/src/methodical/impl/combo/operator.clj @@ -2,9 +2,11 @@ "Method combinations strategies based on the non-default method combination types in CLOS. All non-default method combinations follow the same basic pattern: - (operator (primary-method-1 args) - (primary-method-2 args) - (primary-method-3 args))) + ```clj + (operator (primary-method-1 args) + (primary-method-2 args) + (primary-method-3 args))) + ``` (Example from \"Object-Oriented Programming in Common Lisp\", Keene 1988.) @@ -28,20 +30,23 @@ One last difference: unlike CLOS operator method combinations, primary method implementations *are not* qualified by their operator. - ;; CLOS - (defmethod total-electric-supply + ((city city)) - ...) + ```clj + ;; CLOS + (defmethod total-electric-supply + ((city city)) + ...) - ;; Methodical - (defmethod total-electric-supply :city - [city] - ...)" + ;; Methodical + (defmethod total-electric-supply :city + [city] + ...) + ```" (:refer-clojure :exclude [methods]) (:require [clojure.core.protocols :as clojure.protocols] [clojure.spec.alpha :as s] [methodical.impl.combo.common :as combo.common] [methodical.interface] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface MethodCombination))) @@ -195,7 +200,13 @@ clojure.protocols/Datafiable (datafy [this] {:class (class this) - :operator operator-name})) + :operator operator-name}) + + describe/Describeable + (describe [this] + (format "It uses the method combination %s\nwith the operator %s." + (.getCanonicalName (class this)) + (pr-str operator-name)))) (defn operator-method-combination "Create a new method combination using the operator named by `operator-name`, a keyword name of one of the diff --git a/src/methodical/impl/combo/threaded.clj b/src/methodical/impl/combo/threaded.clj index f8648ee..9f9ba65 100644 --- a/src/methodical/impl/combo/threaded.clj +++ b/src/methodical/impl/combo/threaded.clj @@ -4,6 +4,7 @@ [clojure.core.protocols :as clojure.protocols] [methodical.impl.combo.common :as combo.common] [methodical.interface] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface MethodCombination))) @@ -102,7 +103,13 @@ clojure.protocols/Datafiable (datafy [this] {:class (class this) - :threading-type threading-type})) + :threading-type threading-type}) + + describe/Describeable + (describe [this] + (format "It uses the method combination %s\nwith the threading strategy %s." + (.getCanonicalName (class this)) + (pr-str threading-type)))) (defn threading-method-combination "Create a new `ThreadingMethodCombination` using the keyword `threading-type` strategy, e.g. `:thread-first` or diff --git a/src/methodical/impl/dispatcher/everything.clj b/src/methodical/impl/dispatcher/everything.clj index 0cbc516..8df1f11 100644 --- a/src/methodical/impl/dispatcher/everything.clj +++ b/src/methodical/impl/dispatcher/everything.clj @@ -4,6 +4,7 @@ [clojure.core.protocols :as clojure.protocols] [methodical.impl.dispatcher.common :as dispatcher.common] [methodical.interface :as i] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface Dispatcher))) @@ -68,4 +69,11 @@ (datafy [this] {:class (class this) :hierarchy hierarchy-var - :prefs prefs})) + :prefs prefs}) + + describe/Describeable + (describe [this] + (format "It uses the dispatcher %s\nwith hierarchy %s\nand prefs %s." + (.getCanonicalName (class this)) + (pr-str hierarchy-var) + (pr-str prefs)))) diff --git a/src/methodical/impl/dispatcher/multi_default.clj b/src/methodical/impl/dispatcher/multi_default.clj index 44e82cb..af20f55 100644 --- a/src/methodical/impl/dispatcher/multi_default.clj +++ b/src/methodical/impl/dispatcher/multi_default.clj @@ -7,6 +7,7 @@ [methodical.impl.dispatcher.common :as dispatcher.common] [methodical.impl.dispatcher.standard :as dispatcher.standard] [methodical.interface :as i] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface Dispatcher))) @@ -44,11 +45,13 @@ "Return a sequence of all partially-specialized default dispatch values for a given `dispatch-value` and `default-value`, in order from most-specific to least-specific. - (default-dispatch-values [:x :y] :default) - -> - ([:x :default] ; if no method for [:x :y] exists, look for [:x :default]... - [:default :y] ; or [:default :y] ... - [:default :default])" + ```clj + (default-dispatch-values [:x :y] :default) + -> + ([:x :default] ; if no method for [:x :y] exists, look for [:x :default]... + [:default :y] ; or [:default :y] ... + [:default :default]) + ```" [dispatch-value default-value] (when (and (sequential? dispatch-value) (not (sequential? default-value))) @@ -193,4 +196,12 @@ :dispatch-fn dispatch-fn :default-value default-value :hierarchy hierarchy-var - :prefs prefs})) + :prefs prefs}) + + describe/Describeable + (describe [this] + (format "It uses the dispatcher %s\nwith hierarchy %s\nand prefs %s.\n\nThe default value is %s." + (.getCanonicalName (class this)) + (pr-str hierarchy-var) + (pr-str prefs) + (pr-str default-value)))) diff --git a/src/methodical/impl/dispatcher/standard.clj b/src/methodical/impl/dispatcher/standard.clj index 94e1fe0..c15a3c5 100644 --- a/src/methodical/impl/dispatcher/standard.clj +++ b/src/methodical/impl/dispatcher/standard.clj @@ -6,6 +6,7 @@ [clojure.core.protocols :as clojure.protocols] [methodical.impl.dispatcher.common :as dispatcher.common] [methodical.interface :as i] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface Dispatcher))) @@ -163,4 +164,12 @@ :dispatch-fn dispatch-fn :default-value default-value :hierarchy hierarchy-var - :prefs prefs})) + :prefs prefs}) + + describe/Describeable + (describe [this] + (format "It uses the dispatcher %s\nwith hierarchy %s\nand prefs %s.\n\nThe default value is %s." + (.getCanonicalName (class this)) + (pr-str hierarchy-var) + (pr-str prefs) + (pr-str default-value)))) diff --git a/src/methodical/impl/method_table/clojure.clj b/src/methodical/impl/method_table/clojure.clj index 2b36eb3..798a2a1 100644 --- a/src/methodical/impl/method_table/clojure.clj +++ b/src/methodical/impl/method_table/clojure.clj @@ -3,6 +3,7 @@ [clojure.core.protocols :as clojure.protocols] [methodical.impl.method-table.common :as method-table.common] [methodical.interface] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface MethodTable))) @@ -51,4 +52,10 @@ clojure.protocols/Datafiable (datafy [this] {:class (class this) - :primary (method-table.common/datafy-primary-methods m)})) + :primary (method-table.common/datafy-primary-methods m)}) + + describe/Describeable + (describe [this] + (format "It uses the method table %s. These primary methods are known:\n\n%s" + (.getCanonicalName (class this)) + (method-table.common/describe-primary-methods m)))) diff --git a/src/methodical/impl/method_table/common.clj b/src/methodical/impl/method_table/common.clj index 6842793..97ac48a 100644 --- a/src/methodical/impl/method_table/common.clj +++ b/src/methodical/impl/method_table/common.clj @@ -1,4 +1,5 @@ -(ns methodical.impl.method-table.common) +(ns methodical.impl.method-table.common + (:require [clojure.string :as str])) (defn- datafy-method [f] (let [mta (meta f)] @@ -36,3 +37,53 @@ [dispatch-value (datafy-methods fns)])) dispatch-value->fns)])) qualifier->dispatch-value->fns)) + +(defn- describe-method + ([f] + (let [{method-ns :ns, :keys [line file doc]} (meta f)] + (str/join + \space + [(when method-ns + (format "defined in %s" (ns-name method-ns))) + (cond + (and file line) + (format "(%s:%d)" file line) + + file + (format "(%s)" file)) + (when doc + (format "\n\nIt has the following documentation:\n\n%s" doc))]))) + + ([dispatch-value f] + (format "* %s, %s" (pr-str dispatch-value) (str/join + "\n " + (str/split-lines (describe-method f)))))) + +(defn describe-primary-methods + "Helper for [[methodical.util.describe/describe]]ing the primary methods in a method table." + [dispatch-value->method] + (when (seq dispatch-value->method) + (format + "\n\nThese primary methods are known:\n\n%s" + (str/join + "\n\n" + (for [[dispatch-value f] dispatch-value->method] + (describe-method dispatch-value f)))))) + +(defn describe-aux-methods + "Helper for [[methodical.util.describe/describe]]ing the aux methods in a method table." + [qualifier->dispatch-value->methods] + (when (seq qualifier->dispatch-value->methods) + (format + "\n\nThese aux methods are known:\n\n%s" + (str/join + "\n\n" + (for [[qualifier dispatch-value->methods] (sort-by first qualifier->dispatch-value->methods)] + (format + "%s methods:\n\n%s" + (pr-str qualifier) + (str/join + "\n\n" + (for [[dispatch-value fns] dispatch-value->methods + f fns] + (describe-method dispatch-value f))))))))) diff --git a/src/methodical/impl/method_table/standard.clj b/src/methodical/impl/method_table/standard.clj index 9b48ccf..e127020 100644 --- a/src/methodical/impl/method_table/standard.clj +++ b/src/methodical/impl/method_table/standard.clj @@ -3,6 +3,7 @@ [clojure.core.protocols :as clojure.protocols] [methodical.impl.method-table.common :as method-table.common] [methodical.interface] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface MethodTable))) @@ -92,4 +93,10 @@ (datafy [this] {:class (class this) :primary (method-table.common/datafy-primary-methods primary) - :aux (method-table.common/datafy-aux-methods aux)})) + :aux (method-table.common/datafy-aux-methods aux)}) + + describe/Describeable + (describe [this] + (format "It uses the method table %s.%s%s" (.getCanonicalName (class this)) + (method-table.common/describe-primary-methods primary) + (method-table.common/describe-aux-methods aux)))) diff --git a/src/methodical/impl/multifn/cached.clj b/src/methodical/impl/multifn/cached.clj index 1e45f48..316fe4a 100644 --- a/src/methodical/impl/multifn/cached.clj +++ b/src/methodical/impl/multifn/cached.clj @@ -3,6 +3,7 @@ [clojure.core.protocols :as clojure.protocols] [clojure.datafy :as datafy] [methodical.interface :as i] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (clojure.lang Named) @@ -78,4 +79,10 @@ (datafy [this] (assoc (datafy/datafy impl) :class (class this) - :cache (datafy/datafy cache)))) + :cache (datafy/datafy cache))) + + describe/Describeable + (describe [_this] + (str (describe/describe cache) + \newline \newline + (describe/describe impl)))) diff --git a/src/methodical/impl/multifn/standard.clj b/src/methodical/impl/multifn/standard.clj index 878c239..4fe1f6b 100644 --- a/src/methodical/impl/multifn/standard.clj +++ b/src/methodical/impl/multifn/standard.clj @@ -5,6 +5,7 @@ [clojure.datafy :as datafy] [methodical.impl.dispatcher.common :as dispatcher.common] [methodical.interface :as i] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (methodical.interface Dispatcher MethodCombination MethodTable MultiFnImpl))) @@ -57,8 +58,11 @@ "Combine multiple composite dispatch values into a single composite dispatch value that has the overall most-specific arg for each position, e.g. - ;; String is more specific than Object; ::parrot is more specific than ::bird - (composite-effective-dispatch-value [[Object ::parrot] [String ::bird]]) ; -> [String ::parrot] + + ```clj + ;; String is more specific than Object; ::parrot is more specific than ::bird + (composite-effective-dispatch-value [[Object ::parrot] [String ::bird]]) ; -> [String ::parrot] + ``` If the most-specific dispatch value is not composite, it returns it directly." [dispatcher actual-dispatch-value method-dispatch-values] @@ -143,4 +147,12 @@ {:class (class this) :combo (datafy/datafy combo) :dispatcher (datafy/datafy dispatcher) - :method-table (datafy/datafy method-table)})) + :method-table (datafy/datafy method-table)}) + + describe/Describeable + (describe [_this] + (str (describe/describe combo) + \newline \newline + (describe/describe dispatcher) + \newline \newline + (describe/describe method-table)))) diff --git a/src/methodical/impl/standard.clj b/src/methodical/impl/standard.clj index 4ad769b..cc53db8 100644 --- a/src/methodical/impl/standard.clj +++ b/src/methodical/impl/standard.clj @@ -3,6 +3,7 @@ [clojure.core.protocols :as clojure.protocols] [clojure.datafy :as datafy] [methodical.interface :as i] + [methodical.util.describe :as describe] [pretty.core :as pretty]) (:import (clojure.lang Named) @@ -234,13 +235,29 @@ clojure.protocols/Datafiable (datafy [this] (with-meta (merge (datafy/datafy impl) - (select-keys mta [:name :arglists]) + (select-keys mta [:name :arglists :file :column :line]) (when (:ns mta) {:ns (ns-name (:ns mta))}) (when (and (:ns mta) (:name mta)) {:name (symbol (str (ns-name (:ns mta))) (str (:name mta)))}) {:class (class this)}) - mta))) + mta)) + + describe/Describeable + (describe [_this] + (let [{mf-name :name, mf-ns :ns, :keys [file line]} mta] + (str (pr-str mf-name) + (let [message (str + (when mf-ns + (ns-name mf-ns)) + (cond + (and file line) (format " (%s:%d)" file line) + file (str \space file) + :else ""))] + (when (seq message) + (format " is defined in %s." message))) + \newline \newline + (describe/describe impl))))) (defn multifn? "True if `x` is an instance of `StandardMultiFn`." diff --git a/src/methodical/interface.clj b/src/methodical/interface.clj index 7de295d..54933ec 100644 --- a/src/methodical/interface.clj +++ b/src/methodical/interface.clj @@ -15,26 +15,28 @@ `next-method` arg)." (allowed-qualifiers [method-combination] "The set containing all qualifiers supported by this method combination. `nil` in the set means the method - combination supports primary methods (because primary methods have no qualifier); all other values refer to - auxiliary methods with that qualifier, e.g. `:before`, `:after`, or `:around`. + combination supports primary methods (because primary methods have no qualifier); all other values refer to auxiliary + methods with that qualifier, e.g. `:before`, `:after`, or `:around`. - (allowed-qualifiers (clojure-method-combination)) ;-> #{nil} - (allowed-qualifiers (clos-method-combination)) ;-> #{nil :before :after :around} - (allowed-qualifiers (doseq-method-combination)) ;-> #{:doseq}") + ```clj + (allowed-qualifiers (clojure-method-combination)) ;-> #{nil} + (allowed-qualifiers (clos-method-combination)) ;-> #{nil :before :after :around} + (allowed-qualifiers (doseq-method-combination)) ;-> #{:doseq} + ```") (combine-methods [method-combination primary-methods aux-methods] "Combine a sequence of matching `primary-methods` with `aux-methods` (a map of qualifier -> sequence of methods) - into a single effective method. Method includes effective `^:dispatch-value` metadata.") + into a single effective method. Method includes effective `^:dispatch-value` metadata.") (transform-fn-tail [method-combination qualifier fn-tail] - "Make appropriate transformations to the `fn-tail` of a `defmethod` macro expansion for a primary - method (qualifier will be `nil`) or an auxiliary method. You can use this method to add implicit args like - `next-method` to the body of a `defmethod` macro. (Because this method is invoked during macroexpansion, it should - return a Clojure form.)")) + "Make appropriate transformations to the `fn-tail` of a [[methodical.macros/defmethod]] macro expansion for a + primary method (qualifier will be `nil`) or an auxiliary method. You can use this method to add implicit args like + `next-method` to the body of a `defmethod` macro. (Because this method is invoked during macroexpansion, it should + return a Clojure form.)")) (defprotocol MethodTable "A *method table* stores primary and auxiliary methods, and returns them when asked. The default implementation, - `standard-method-table`, uses simple Clojure immutable maps." + [[methodical.impl/standard-method-table]], uses simple Clojure immutable maps." (primary-methods [method-table] "Get a `dispatch-value -> fn` map of all primary methods associated with this method table.") @@ -121,10 +123,11 @@ "Return a copy of this multifn using `new-method-table` as its method table.") (effective-method [multifn dispatch-value] - "Return the effective method for `dispatch-value`. The effective method is a combined primary method and - applicable auxiliary methods that can be called like a normal function. `effective-method` is similar in purpose - to `get-method` in vanilla Clojure multimethods; a different name is used here because I felt `get-method` would - be ambiguous with regards to whether it returns only a primary method or a combined effective method.")) + "Return the effective method for `dispatch-value`. The effective method is a combined primary method and applicable + auxiliary methods that can be called like a normal function. [[effective-method]] is similar in purpose + to [[clojure.core/get-method]] in vanilla Clojure multimethods; a different name is used here because I felt + `get-method` would be ambiguous with regards to whether it returns only a primary method or a combined effective + method.")) (defprotocol Cache "A *cache*, if present, implements a caching strategy for effective methods, so that they need not be recomputed on diff --git a/src/methodical/macros.clj b/src/methodical/macros.clj index 310b94a..cede986 100644 --- a/src/methodical/macros.clj +++ b/src/methodical/macros.clj @@ -47,7 +47,7 @@ {:ns *ns*, :name (list 'quote (with-meta name-symb nil))})] `(def ~name-symb (let [impl# (impl/standard-multifn-impl ~combo ~dispatcher ~method-table)] - (impl/multifn impl# ~mta ~cache))))) + (vary-meta (impl/multifn impl# ~mta ~cache) merge (meta (var ~name-symb))))))) (defn default-dispatch-value-spec "A dispatch value as parsed to [[defmethod]] (i.e., not-yet-evaluated) can be ANYTHING other than the following two diff --git a/src/methodical/util.clj b/src/methodical/util.clj index 037313a..fe35d70 100644 --- a/src/methodical/util.clj +++ b/src/methodical/util.clj @@ -3,7 +3,8 @@ interfaces. These functions are compositions of those methods." (:refer-clojure :exclude [prefers prefer-method remove-all-methods]) (:require [methodical.impl.standard :as impl.standard] - [methodical.interface :as i])) + [methodical.interface :as i] + [methodical.util.describe :as describe])) (set! *warn-on-reflection* true) @@ -25,7 +26,7 @@ (defn matching-primary-methods "Return a sequence of applicable primary methods for `dispatch-value`, sorted from most-specific to least-specific. - Methods include the `^:dispatch-valueue` with which they were defined as metadata. The standard dispatcher also checks + Methods include the `^:dispatch-value` with which they were defined as metadata. The standard dispatcher also checks to make sure methods in the sequence are not ambiguously specific, replacing ambiguous methods with ones that will throw an Exception when invoked." ([multifn dispatch-val] @@ -35,16 +36,16 @@ (defn applicable-primary-method "Return the primary method that would be use for `dispatch-value`, including ones from ancestor dispatch values or the - default dipsatch value. Method includes `^:dispatch-valueue` metadata indicating the actual dispatch value for which + default dipsatch value. Method includes `^:dispatch-value` metadata indicating the actual dispatch value for which the applicable method was defined. - Like `primary-method`, the method returned will not have any implicit args (such as `next-method`) bound." + Like [[primary-method]], the method returned will not have any implicit args (such as `next-method`) bound." [multifn dispatch-val] (first (matching-primary-methods multifn dispatch-val))) (defn effective-primary-method "Build and effective method equivalent that would be used for this `dispatch-value` if it had no applicable auxiliary - methods. Implicit args (such as `next-method`) will be bound appropriately. Method has `^:dispatch-valueue` metadata + methods. Implicit args (such as `next-method`) will be bound appropriately. Method has `^:dispatch-value` metadata for the dispatch value with which the most-specific primary method was defined." [multifn dispatch-val] (let [[most-specific-primary-method :as primary-methods] (matching-primary-methods multifn dispatch-val)] @@ -75,7 +76,7 @@ (defn matching-aux-methods "Return a map of aux method qualifier -> sequence of applicable methods for `dispatch-value`, sorted from - most-specific to least-specific. Methods should have the `^:dispatch-valueue` with which they were defined as + most-specific to least-specific. Methods should have the `^:dispatch-value` with which they were defined as metadata." ([multifn dispatch-val] (i/matching-aux-methods multifn multifn dispatch-val)) @@ -234,8 +235,16 @@ (let [{var-ns :ns, var-name :name} (meta multifn-var) varr (if (and var-ns var-name) (ns-resolve var-ns var-name) - multifn-var)] - (apply alter-var-root varr f args))) + multifn-var) + original-doc ((some-fn :original-doc :doc) (meta multifn-var))] + (apply alter-var-root varr f args) + (let [updated-value (var-get varr) + new-doc (str + (when original-doc + (str original-doc \newline \newline)) + (describe/describe updated-value))] + (alter-meta! multifn-var assoc :original-doc original-doc, :doc new-doc)) + multifn-var)) (defn add-primary-method! "Destructive version of [[add-primary-method]]. Operates on a var defining a Methodical multifn." @@ -243,7 +252,7 @@ (alter-var-root+ multifn-var i/add-primary-method dispatch-val f)) (defn remove-primary-method! - "Destructive version of [[remove-primary-method]]. Operates on a var defining a Methodical multifn." + "Destructive version of [[methodical.interface/remove-primary-method]]. Operates on a var defining a Methodical multifn." [multifn-var dispatch-val] (alter-var-root+ multifn-var i/remove-primary-method dispatch-val)) @@ -253,12 +262,12 @@ (alter-var-root+ multifn-var remove-all-primary-methods)) (defn add-aux-method! - "Destructive version of [[add-aux-method]]. Operates on a var defining a Methodical multifn." + "Destructive version of [[methodical.interface/add-aux-method]]. Operates on a var defining a Methodical multifn." [multifn-var qualifier dispatch-val f] (alter-var-root+ multifn-var i/add-aux-method qualifier dispatch-val f)) (defn remove-aux-method! - "Destructive version of [[remove-aux-method]]. Operates on a var defining a Methodical multifn." + "Destructive version of [[methodical.interface/remove-aux-method]]. Operates on a var defining a Methodical multifn." [multifn-var qualifier dispatch-val f] (alter-var-root+ multifn-var i/remove-aux-method qualifier dispatch-val f)) diff --git a/src/methodical/util/datafy.clj b/src/methodical/util/datafy.clj deleted file mode 100644 index 83d70c3..0000000 --- a/src/methodical/util/datafy.clj +++ /dev/null @@ -1 +0,0 @@ -(ns methodical.util.datafy) diff --git a/src/methodical/util/describe.clj b/src/methodical/util/describe.clj new file mode 100644 index 0000000..62d0e78 --- /dev/null +++ b/src/methodical/util/describe.clj @@ -0,0 +1,16 @@ +(ns methodical.util.describe + (:require [clojure.datafy :as datafy] + [potemkin.types :as p.types])) + +(p.types/defprotocol+ Describeable + (describe ^String [this] + "Return a string description of a Methodical object, such as a multifn.")) + +(extend-protocol Describeable + nil + (describe [_this] + "nil") + + Object + (describe [this] + (pr-str (datafy/datafy this)))) diff --git a/src/methodical/util/trace.clj b/src/methodical/util/trace.clj index ea43aa4..a090866 100644 --- a/src/methodical/util/trace.clj +++ b/src/methodical/util/trace.clj @@ -107,8 +107,8 @@ (trace-aux-method (vary-meta aux-method assoc :qualifier qualifier)))]))) (defn trace* - "Function version of `trace` macro. The only difference is this doesn't capture the form of `multifn` passed to - `trace`, and thus can't usually generate a pretty description for the top-level form." + "Function version of [[trace]] macro. The only difference is this doesn't capture the form of `multifn` passed to + [[trace]], and thus can't usually generate a pretty description for the top-level form." [multifn & args] (let [dispatch-value (apply u/dispatch-value multifn args) primary-methods (trace-primary-methods (u/matching-primary-methods multifn dispatch-value)) @@ -126,14 +126,16 @@ Method calls are printed with `n:`, where `n` is the current depth of the trace; the result of each method call is printed with a corresponding `n>`: - (trace/trace my-fn 1 {}) - ;; -> - 0: (my-fn 1 {}) - 1: (#primary-method<:default> nil 1 {}) - 1> {:x 1} - 1: (#aux-method<:after [java.lang.Object :default]> 1 {:x 1}) - 1> {:object? true, :x 1} - 0> {:object? true, :x 1}" + ```clj + (trace/trace my-fn 1 {}) + ;; -> + 0: (my-fn 1 {}) + 1: (#primary-method<:default> nil 1 {}) + 1> {:x 1} + 1: (#aux-method<:after [java.lang.Object :default]> 1 {:x 1}) + 1> {:object? true, :x 1} + 0> {:object? true, :x 1} + ```" [multifn & args] `(trace* (vary-meta ~multifn assoc ::description '~multifn) ~@args)) diff --git a/test/methodical/datafy_test.clj b/test/methodical/datafy_test.clj index 0cfaea7..32ee1db 100644 --- a/test/methodical/datafy_test.clj +++ b/test/methodical/datafy_test.clj @@ -31,6 +31,9 @@ (t/deftest datafy-test (t/is (= {:ns 'methodical.datafy-test :name 'methodical.datafy-test/mf + :file "methodical/datafy_test.clj" + :line 11 + :column 1 :arglists '([x y]) :class methodical.impl.standard.StandardMultiFn :combo {:class methodical.impl.combo.threaded.ThreadingMethodCombination diff --git a/test/methodical/impl/combo/operator_test.clj b/test/methodical/impl/combo/operator_test.clj index ec7c6cb..d043484 100644 --- a/test/methodical/impl/combo/operator_test.clj +++ b/test/methodical/impl/combo/operator_test.clj @@ -1,9 +1,10 @@ (ns methodical.impl.combo.operator-test - (:require [clojure.string :as str] - [clojure.test :as t] - [methodical.core :as m] - [methodical.impl.combo.operator :as combo.operator] - [methodical.interface :as i])) + (:require + [clojure.string :as str] + [clojure.test :as t] + [methodical.core :as m] + [methodical.impl.combo.operator :as combo.operator] + [methodical.interface :as i])) (t/deftest primary-test (t/testing "Empty primary methods" @@ -186,12 +187,15 @@ (t/is (= false (((combo.operator/operator :and) [(constantly true) (constantly false) (constantly true)]))))) - #_(t/testing "with many args" - (t/are [expected args] (= expected (apply combined args)) - [:a :b :b :a] [:a :b] - [:a :b :c :c :b :a] [:a :b :c] - [:a :b :c :d :d :c :b :a] [:a :b :c :d] - [:a :b :c :d :e :e :d :c :b :a] [:a :b :c :d :e] ))) + (t/testing "with many args" + (let [combined ((combo.operator/operator :and) [(fn [& args] + (concat args (reverse args)))])] + (t/are [args expected] (= expected + (apply combined args)) + [:a :b] [:a :b :b :a] + [:a :b :c] [:a :b :c :c :b :a] + [:a :b :c :d] [:a :b :c :d :d :c :b :a] + [:a :b :c :d :e] [:a :b :c :d :e :e :d :c :b :a] )))) (t/deftest or-operator-test (t/is (= [:b :c] @@ -289,3 +293,28 @@ (object "wow")) (seq-multimethod "WOW")) "Test that we can use operator method combinations using the `defmulti` and `defmethod` macros.")) + +;; failing test for #98 +(comment + (t/deftest operator-method-combination-caching-tets + (doseq [ks (combo/permutations [:bird :can :toucan])] + (t/testing (vec ks) + (let [mf (-> (m/multifn + (m/standard-multifn-impl + (m/seq-method-combination) + (m/standard-dispatcher + keyword + :hierarchy (atom (-> (make-hierarchy) + (derive :toucan :can) + (derive :toucan :bird)))) + (m/standard-method-table))) + (m/add-primary-method :bird (constantly {:bird? true})) + (m/add-primary-method :can (constantly {:can? true})) + (m/prefer-method :bird :can))] + (doseq [k ks] + (t/testing k + (t/is (= (case k + :bird {:bird? true} + :can {:can? true} + :toucan {:bird? true, :toucan? true}) + (reduce merge {} (mf k))))))))))) diff --git a/test/methodical/impl/dispatcher/multi_default_test.clj b/test/methodical/impl/dispatcher/multi_default_test.clj index 22917e6..3256c4c 100644 --- a/test/methodical/impl/dispatcher/multi_default_test.clj +++ b/test/methodical/impl/dispatcher/multi_default_test.clj @@ -1,7 +1,7 @@ (ns methodical.impl.dispatcher.multi-default-test (:require [clojure.test :as t] [methodical.core :as m] - [methodical.impl.dispatcher.multi-default :as multi-default] + [methodical.impl.dispatcher.multi-default :as dispatcher.multi-default] methodical.interface) (:import methodical.interface.MethodTable)) @@ -22,14 +22,14 @@ [default y default] [default default z] [default default default]] - (multi-default/partially-specialized-default-dispatch-values [x y z] default)))))) + (dispatcher.multi-default/partially-specialized-default-dispatch-values [x y z] default)))))) (t/deftest partially-specialized-default-dispatch-values-test-2 (doseq [default [:default ::default :a]] (doseq [x [:x nil]] (t/testing (format "dispatch value = %s" (pr-str x)) (t/is (= nil - (multi-default/partially-specialized-default-dispatch-values x default)) + (dispatcher.multi-default/partially-specialized-default-dispatch-values x default)) "If the dispatch value isn't sequential, we shouldn't calculate partial default dispatch values"))) (doseq [x [:x nil] y [:y nil]] @@ -37,11 +37,11 @@ (t/is (= [[x default] [default y] [default default]] - (multi-default/partially-specialized-default-dispatch-values [x y] default)) + (dispatcher.multi-default/partially-specialized-default-dispatch-values [x y] default)) (str "If the dispatch value is sequental, but default is not, we should return a sequence of partial" " default dispatch values")) (t/is (= nil - (multi-default/partially-specialized-default-dispatch-values [x y] [default x])) + (dispatcher.multi-default/partially-specialized-default-dispatch-values [x y] [default x])) "If the default value is sequential, we shouldn't calculate partial default dispatch values"))))) (defn- test-method-symbol->dispatch-value [default symb] @@ -90,7 +90,7 @@ (derive :x :letter) (derive :y :letter))]] (t/testing (format "default value = %s dispatch value = %s" (pr-str default) (pr-str dispatch-value)) - (let [matching-methods (multi-default/matching-primary-methods + (let [matching-methods (dispatcher.multi-default/matching-primary-methods {:hierarchy h :prefs nil :default-value default @@ -122,7 +122,7 @@ (derive :large-beak :thing) (derive :eats-fruit :thing))] (letfn [(invoke-with-prefs [prefs dispatch-val] - (let [[matching-method] (multi-default/matching-primary-methods + (let [[matching-method] (dispatcher.multi-default/matching-primary-methods {:hierarchy h :prefs prefs :default-value default @@ -186,7 +186,7 @@ (derive :y :letter))]] (t/testing (format "method-type = %s default value = %s dispatch value = %s" method-type default (pr-str dispatch-value)) - (let [matching-methods (multi-default/matching-aux-methods + (let [matching-methods (dispatcher.multi-default/matching-aux-methods {:hierarchy h :prefs nil #_prefs :default-value default diff --git a/test/methodical/impl/method_table/standard_test.clj b/test/methodical/impl/method_table/standard_test.clj index a60fd31..082f4a9 100644 --- a/test/methodical/impl/method_table/standard_test.clj +++ b/test/methodical/impl/method_table/standard_test.clj @@ -2,32 +2,32 @@ (:require [clojure.test :as t] [clojure.tools.reader.edn :as edn] - [methodical.impl.method-table.standard :as standard] + [methodical.impl.method-table.standard :as method-table.standard] [methodical.interface :as i])) (t/deftest print-test (t/is (= "(standard-method-table)" - (pr-str (standard/->StandardMethodTable {} {}))) + (pr-str (method-table.standard/->StandardMethodTable {} {}))) "Empty method tables should print simply.") (letfn [(pr-str-read [x] (edn/read-string (pr-str x)))] (t/is (= '(standard-method-table {:primary [:a :b]}) (pr-str-read - (standard/->StandardMethodTable {:a +, :b +} {}))) + (method-table.standard/->StandardMethodTable {:a +, :b +} {}))) "Method tables should print the count of primary methods if it has any.") (t/is (= '(standard-method-table {:aux {:after [:a], :before [:a :b :b]}}) - (pr-str-read (standard/->StandardMethodTable {} {:before {:a [+] :b [+ +]}, :after {:a [+]}}))) + (pr-str-read (method-table.standard/->StandardMethodTable {} {:before {:a [+] :b [+ +]}, :after {:a [+]}}))) "Method tables should print the count of aux methods if it hash any.") (t/is (= '(standard-method-table {:primary [:a], :aux {:before [:a :b :b], :after [:a]}}) - (pr-str-read (standard/->StandardMethodTable {:a +} {:before {:a [+] :b [+ +]}, :after {:a [+]}}))) + (pr-str-read (method-table.standard/->StandardMethodTable {:a +} {:before {:a [+] :b [+ +]}, :after {:a [+]}}))) "Method tables should be able to print both primary + aux counts.") (t/is (= '(standard-method-table {:aux {:before [:b :b]}}) - (pr-str-read (standard/->StandardMethodTable {} {:before {:b [+ +]}, :after {:a []}, :around {}}))) + (pr-str-read (method-table.standard/->StandardMethodTable {} {:before {:b [+ +]}, :after {:a []}, :around {}}))) "Method tables shouldn't print counts aux qualifiers that are empty."))) (t/deftest add-dispatch-value-metadata-test (t/testing "should add ^:dispatch-value metadata to methods when you add them" - (let [table (-> (standard/->StandardMethodTable {} {}) + (let [table (-> (method-table.standard/->StandardMethodTable {} {}) (i/add-primary-method [:x :y] 'f) (i/add-aux-method :before :x 'f))] (t/testing "primary method" diff --git a/test/methodical/impl/multifn/standard_test.clj b/test/methodical/impl/multifn/standard_test.clj index d6f86db..a9e289c 100644 --- a/test/methodical/impl/multifn/standard_test.clj +++ b/test/methodical/impl/multifn/standard_test.clj @@ -3,7 +3,7 @@ [clojure.math.combinatorics :as combo] [clojure.test :as t] [methodical.core :as m] - [methodical.impl.multifn.standard :as standard])) + [methodical.impl.multifn.standard :as multifn.standard])) (set! *warn-on-reflection* true) @@ -19,7 +19,7 @@ :let [permutation (cons [Double ::parrot] permutation)]] (t/testing (vec permutation) (t/is (= [[Double ::parrot] [Integer ::parrot] [Number ::parrot] [Object ::bird] ::default] - (standard/sort-dispatch-values dispatcher permutation))))))) + (multifn.standard/sort-dispatch-values dispatcher permutation))))))) (t/deftest composite-effective-dispatch-value-test (doseq [[dispatch-values expected] @@ -40,13 +40,13 @@ dispatch-values (distinct (combo/permutations dispatch-values))] (t/testing (pr-str dispatch-values) (t/is (= expected - (standard/composite-effective-dispatch-value + (multifn.standard/composite-effective-dispatch-value (m/multi-default-dispatcher (fn [x y] [x y]) :default-value ::default) [String ::parakeet] dispatch-values))))) (t/testing "If there's ambiguity between values, always prefer values from the first dispatch value" (t/is (= [String ::parakeet] - (standard/composite-effective-dispatch-value + (multifn.standard/composite-effective-dispatch-value (m/multi-default-dispatcher (fn [x y] [x y]) :default-value ::default) [String ::budgie] [[String ::parrot] [Number ::parrot] [Object ::parakeet]]))))) @@ -144,19 +144,19 @@ (m/prefer-method :bird :can))] k ks] (t/testing (format "order = %s, testing %s" (pr-str ks) k) - (t/testing `standard/composite-effective-dispatch-value + (t/testing `multifn.standard/composite-effective-dispatch-value (t/is (= k - (standard/composite-effective-dispatch-value m k [:bird :can])))) - (t/testing `standard/effective-dispatch-value + (multifn.standard/composite-effective-dispatch-value m k [:bird :can])))) + (t/testing `multifn.standard/effective-dispatch-value (t/is (= k - (standard/effective-dispatch-value + (multifn.standard/effective-dispatch-value m k (m/matching-primary-methods m k) (m/matching-aux-methods m k))))) - (t/testing `standard/standard-effective-method + (t/testing `multifn.standard/standard-effective-method (t/is (= k - (:dispatch-value (meta (standard/standard-effective-method m m m k)))))) + (:dispatch-value (meta (multifn.standard/standard-effective-method m m m k)))))) (t/testing `m/effective-dispatch-value (t/is (= k (m/effective-dispatch-value m k)))) @@ -182,7 +182,7 @@ ::love-bird ::parrot}] (t/testing dv (t/is (= {:dispatch-value expected} - (meta (standard/standard-effective-method combo dispatcher method-table dv)))))))) + (meta (multifn.standard/standard-effective-method combo dispatcher method-table dv)))))))) (t/testing "multiple dispatch values" (let [combo (m/thread-last-method-combination) @@ -207,7 +207,7 @@ (t/is (= {:dispatch-value (if (= [expected-1 expected-2] [:default :default]) :default [expected-1 expected-2])} - (meta (standard/standard-effective-method combo dispatcher method-table dv))))))))) + (meta (multifn.standard/standard-effective-method combo dispatcher method-table dv))))))))) (t/deftest nil-dispatch-values-test (t/testing "Dispatch values for `nil` should be calculated correctly (#112)" diff --git a/test/methodical/macros_test.clj b/test/methodical/macros_test.clj index 735909a..c3233a1 100644 --- a/test/methodical/macros_test.clj +++ b/test/methodical/macros_test.clj @@ -4,7 +4,7 @@ [clojure.test :as t] [methodical.impl :as impl] [methodical.interface :as i] - [methodical.macros :as m] + [methodical.macros :as macros] [methodical.util :as u] [potemkin.namespaces :as p.namespaces])) @@ -18,22 +18,22 @@ (s/conform :methodical.macros/defmulti-args (quote args))) (clojure-multifn class - :combo (m/clojure-method-combination)) + :combo (macros/clojure-method-combination)) {:name-symb clojure-multifn :dispatch-fn class - :options [{:k :combo, :v (m/clojure-method-combination)}]}) + :options [{:k :combo, :v (macros/clojure-method-combination)}]}) (t/testing "Throw error on invalid args (#36)" (t/is (thrown? clojure.lang.Compiler$CompilerException (macroexpand - '(m/defmulti multifn :default + '(macros/defmulti multifn :default [x y z] :ok)))))) (t/deftest method-fn-symbol-test (letfn [(method-fn-symbol [dispatch-value] - (#'m/method-fn-symbol 'my-multimethod "primary" dispatch-value))] + (#'macros/method-fn-symbol 'my-multimethod "primary" dispatch-value))] (t/testing "Keyword dispatch value" (t/is (= 'my-multimethod-primary-method-something (method-fn-symbol :something)))) @@ -65,11 +65,11 @@ (t/is (= 'my-multimethod-primary-method-can_SINGLEQUOTE_t-use-this (method-fn-symbol "can't use this")))))) -(m/defmulti ^:private mf1 :type) +(macros/defmulti ^:private mf1 :type) (t/deftest parse-defmethod-args-test (t/are [args parsed] (= (quote parsed) - (#'m/parse-defmethod-args mf1 (quote args))) + (#'macros/parse-defmethod-args mf1 (quote args))) (:x [m] body1 body2) {:method-type :primary :dispatch-value :x @@ -194,7 +194,7 @@ :dispatch-value "str" :fn-tail [[_x]]})) -(m/defmethod mf1 :x +(macros/defmethod mf1 :x [m] (assoc m :method :x)) @@ -204,25 +204,25 @@ (macroexpand (quote invalid-form))) ;; bad aux method - (m/defmethod mf1 :arounds :x + (macros/defmethod mf1 :arounds :x [m] (assoc m :method :x)) ;; missing function tail - (m/defmethod mf1 :around :x) + (macros/defmethod mf1 :around :x) ;; invalid function tail - (m/defmethod mf1 :around :x {} a b c) + (macros/defmethod mf1 :around :x {} a b c) ;; string unique key - (m/defmethod mf1 :around :x "unique-key" "docstr" [a] b c))) + (macros/defmethod mf1 :around :x "unique-key" "docstr" [a] b c))) (s/def ::arg-validation-spec (s/or :default (partial = :default) :x-y (s/spec (s/cat :x keyword? :y keyword?)))) -(m/defmulti validate-args-spec-mf +(macros/defmulti validate-args-spec-mf {:arglists '([x y]), :dispatch-value-spec ::arg-validation-spec} (fn [x y] [(keyword x) (keyword y)])) @@ -235,17 +235,17 @@ #'validate-args-spec-mf)) (t/testing "valid" (t/are [form] (some? (macroexpand (quote form))) - (m/defmethod validate-args-spec-mf :default [x y]) - (m/defmethod validate-args-spec-mf [:x :y] [x y]))) + (macros/defmethod validate-args-spec-mf :default [x y]) + (macros/defmethod validate-args-spec-mf [:x :y] [x y]))) (t/testing "invalid" (t/are [form] (thrown? clojure.lang.Compiler$CompilerException (macroexpand (quote form))) - (m/defmethod validate-args-spec-mf :x [x y]) - (m/defmethod validate-args-spec-mf [:x 1] [x y]) - (m/defmethod validate-args-spec-mf [:x] [x y]) - (m/defmethod validate-args-spec-mf [:x :y :z] [x y])))) + (macros/defmethod validate-args-spec-mf :x [x y]) + (macros/defmethod validate-args-spec-mf [:x 1] [x y]) + (macros/defmethod validate-args-spec-mf [:x] [x y]) + (macros/defmethod validate-args-spec-mf [:x :y :z] [x y])))) (t/deftest defmethod-primary-methods-test (t/is (= mf1 (let [impl (impl/standard-multifn-impl @@ -262,13 +262,13 @@ {:type :x, :method :x}) "We should be able to define new primary methods using `defmethod`")) -(m/defmulti ^:private mf2 :type) +(macros/defmulti ^:private mf2 :type) -(m/defmethod mf2 :x +(macros/defmethod mf2 :x [m] (assoc m :method :x)) -(m/defmethod mf2 :before :default +(macros/defmethod mf2 :before :default [m] (assoc m :before? true)) @@ -277,13 +277,13 @@ {:type :x, :before? true, :method :x}) "We should be able to define new aux methods using `defmethod`")) -(m/defmulti ^:private mf3 :type) +(macros/defmulti ^:private mf3 :type) -(m/defmethod mf3 :x +(macros/defmethod mf3 :x [m] (assoc m :method :x)) -(m/defmethod mf3 :after :default +(macros/defmethod mf3 :after :default [m] (assoc m :after? true)) @@ -293,7 +293,7 @@ (p.namespaces/link-vars #'mf3 #'mf4) -(m/defmethod mf4 :y +(macros/defmethod mf4 :y [m] (assoc m :method :y)) @@ -308,7 +308,7 @@ (mf3 {:type :y}) (mf4 {:type :y}))))) -(m/defmulti multi-arity +(macros/defmulti multi-arity {:arglists '([x] [x y])} (fn ([x] @@ -316,24 +316,24 @@ ([x _] (keyword x)))) -(m/defmethod multi-arity ::wow +(macros/defmethod multi-arity ::wow ([x] {:x x}) ([x y] {:x x, :y y})) -(m/defmethod multi-arity :after :default +(macros/defmethod multi-arity :after :default ([m] (assoc m :after? true)) ([x m] (assoc m :after? x))) -(m/defmulti no-dispatch-fn) +(macros/defmulti no-dispatch-fn) -(m/defmethod no-dispatch-fn :first [& _] +(macros/defmethod no-dispatch-fn :first [& _] 1) -(m/defmethod no-dispatch-fn :second [& _] +(macros/defmethod no-dispatch-fn :second [& _] 2) (t/deftest multi-arity-test @@ -348,13 +348,13 @@ (t/is (= 1 (no-dispatch-fn :first))) (t/is (= 2 (no-dispatch-fn :second))))) -(m/defmulti docstring-multifn) +(macros/defmulti docstring-multifn) -(m/defmethod docstring-multifn :docstring +(macros/defmethod docstring-multifn :docstring "Docstring" [_x]) -(m/defmethod docstring-multifn :around :docstring +(macros/defmethod docstring-multifn :around :docstring "Docstring" [_x]) diff --git a/test/methodical/util/describe_test.clj b/test/methodical/util/describe_test.clj new file mode 100644 index 0000000..70645bd --- /dev/null +++ b/test/methodical/util/describe_test.clj @@ -0,0 +1,80 @@ +(ns methodical.util.describe-test + (:require + [clojure.string :as str] + [clojure.test :as t] + [methodical.core :as m] + [methodical.util.describe :as describe])) + +(defonce ^:private dispatch-first + (fn [x _y] + (keyword x))) + +(m/defmulti mf + "mf is a great multimethod." + {:arglists '([x y])} + dispatch-first) + +(m/defmethod mf :default + "Here is a docstring." + [x y] + {:x x, :y y}) + +(m/defmethod mf :before [:x :default] + "Another docstring." + [_x y] + y) + +(m/defmethod mf :around [:x :y] + [x y] + (next-method x y)) + +(m/prefer-method! #'mf :x :y) + +(def ^:private expected-description + ["mf is defined in methodical.util.describe-test (methodical/util/describe_test.clj:12)." + "" + "It caches methods using a methodical.impl.cache.watching.WatchingCache." + "" + "It uses the method combination methodical.impl.combo.threaded.ThreadingMethodCombination" + "with the threading strategy :thread-last." + "" + "It uses the dispatcher methodical.impl.dispatcher.multi_default.MultiDefaultDispatcher" + "with hierarchy #'clojure.core/global-hierarchy" + "and prefs {:x #{:y}}." + "" + "The default value is :default." + "" + "It uses the method table methodical.impl.method_table.standard.StandardMethodTable." + "" + "These primary methods are known:" + "" + "* :default, defined in methodical.util.describe-test (methodical/util/describe_test.clj:17) " + " " + " It has the following documentation:" + " " + " Here is a docstring." + "" + "These aux methods are known:" + "" + ":around methods:" + "" + "* [:x :y], defined in methodical.util.describe-test (methodical/util/describe_test.clj:27) " + "" + ":before methods:" + "" + "* [:x :default], defined in methodical.util.describe-test (methodical/util/describe_test.clj:22) " + " " + " It has the following documentation:" + " " + " Another docstring."]) + +(t/deftest describe-test + (t/is (= expected-description + (str/split-lines (describe/describe mf))))) + +(t/deftest update-docstrings-test + (t/is (= (concat + ["mf is a great multimethod." + ""] + expected-description) + (str/split-lines (:doc (meta #'mf))))))