Example creating custom seeker nodes for Malli exceptions

nodes.clj

(ns nodes
  (:refer-clojure :exclude [format])
  (:require [malli.core :as m]
            [malli.dev.virhe :as v]
            [malli.error :as me]))

(defn node [params & children]
  (tagged-literal 'cursive/node
                  (assoc params :children (remove nil? children))))

(defn labeled-forms [label & forms]
  (tagged-literal 'cursive/node
                  {:presentation (into [{:text label}]
                                       (comp
                                         (remove nil?)
                                         (map (fn [form]
                                                {:form form}))
                                         (interpose {:text " "}))
                                       forms)
                   :children     (remove nil? forms)}))

(defn title-node [text & children]
  (let [params (if (map? (first children))
                 (first children)
                 nil)
        remainder (if params (rest children) children)]
    (tagged-literal 'cursive/node
                    (merge {:presentation [{:text text}]
                            :children     (remove nil? remainder)}
                           params))))

(defn link-node [text url]
  (tagged-literal 'cursive/node
                  {:presentation [{:text  text
                                   :style :link}]
                   :action       :browse
                   :url          url}))

(defn -errors [explanation]
  (for [error (->> explanation (me/with-error-messages) :errors)]
    (into {} error)))

(defn -explain [schema value]
  (-errors (m/explain schema value)))

(defmulti -format (fn [e _] (-> e (ex-data) :type)) :default ::default)

(defn -hierarchy [^Class k]
  (loop [sk (.getSuperclass k), ks [k]]
    (if-not (= sk Object)
      (recur (.getSuperclass sk) (conj ks sk))
      ks)))

(defmethod -format ::default [e data]
  (if-let [-format (some (methods -format) (-hierarchy (class e)))]
    (-format e data)
    (node {:presentation [{:text  "Unknown Error"
                           :style :error}]}
      (node {:presentation [{:text "Type: "}
                            {:form (type e)}]}
        (type e))
      (node {:presentation [{:text "Message: "}
                            {:form (ex-message e)}]})
      (when data
        (node {:presentation [{:text "Ex-data: "}]}
          data)))))

(defn format [e]
  (-format e (-> e (ex-data) :data)))

(defmethod -format ::m/explain [_ {:keys [schema] :as explanation}]
  (title-node "Explain"
    (labeled-forms "Value: " (me/error-value explanation))
    (apply labeled-forms "Errors: " (me/humanize (me/with-spell-checking explanation)))
    (labeled-forms "Schema: " schema)
    (link-node "More information" "https://cljdoc.org/d/metosin/malli/CURRENT")))

(defmethod -format ::m/coercion [_ {:keys [explain]}]
  (format (m/-exception ::m/explain explain)))

(defmethod -format ::m/invalid-input [_ {:keys [args input fn-name]}]
  (title-node "Invalid Function Input"
    (apply labeled-forms "Invalid function arguments: " args)
    (when fn-name (labeled-forms "Function Var: " fn-name))
    (labeled-forms "Input Schema: " input)
    (apply labeled-forms "Errors: " (-explain input args))
    (link-node "More information" "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas")))

(defmethod -format ::m/invalid-output [_ {:keys [value args output fn-name]}]
  (title-node "Invalid Function Output"
    (labeled-forms "Invalid function return value: " value)
    (when fn-name (labeled-forms "Function Var: " fn-name))
    (apply labeled-forms "Function arguments: " args)
    (labeled-forms "Output Schema: " output)
    (apply labeled-forms "Errors: " (-explain output value))
    (link-node "More information" "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas")))

(defmethod -format ::m/invalid-guard [_ {:keys [value args guard fn-name]}]
  (title-node "Function Guard Error"
    (when fn-name (labeled-forms "Function Var: " fn-name))
    (labeled-forms "Guard arguments: " [args value])
    (labeled-forms "Guard schema: " guard)
    (apply labeled-forms "Errors: " (-explain guard [args value]))
    (link-node "More information" "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas")))

(defmethod -format ::m/invalid-arity [_ {:keys [args arity schema fn-name]}]
  (title-node "Invalid Function Arity"
    (apply labeled-forms (str "Invalid function arity (" arity "): ") args)
    (labeled-forms "Function Schema: " schema)
    (when fn-name (labeled-forms "Function Var: " fn-name))
    (link-node "More information" "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas")))


(defmethod -format ::m/child-error [_ {:keys [type children properties] :as data}]
  (let [form (m/-raw-form type properties children)
        constraints (reduce (fn [acc k] (if-let [v (get data k)] (assoc acc k v) acc)) nil [:min :max])
        size (count children)]
       (title-node "Schema Creation Error"
         (labeled-forms "Invalid Schema" form)
         (title-node "Reason" {:auto-expand? true}
           (node {:presentation [{:text (str "Schema has " size
                                             (if (= 1 size) " child" " children")
                                             ", expected: ")}
                                 {:form constraints}]}
             constraints))
         (link-node "More information" "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas"))))


; Doc examples

(def pow
  (m/-instrument
    {:schema [:=> [:cat :int] [:int {:max 6}]]}
    (fn [x] (* x x))))

(def arg<ret
  (m/-instrument
    {:schema [:=>
              [:cat :int]
              :int
              [:fn {:error/message "argument should be less than return"}
               (fn [[[arg] ret]] (< arg ret))]]}
    (fn [x] x)))

(defn plus-err
  [x] (inc x))



(comment
  (try
    (m/coerce :string 47)
    (catch Exception ex
      (format ex)))

  (try
    (pow "2")
    (catch Exception ex
      (format ex)))

  (try
    (pow 4)
    (catch Exception ex
      (format ex)))

  (try
    (pow 4 2)
    (catch Exception ex
      (format ex)))

  (try
    (arg<ret 0)
    (catch Exception ex
      (format ex)))

  (try
    (def arg<ret
      (m/-instrument
        {:schema [:=> [:cat [:vector]] [:int {:max 6}]]}
        (fn ->plus-err [] plus-err)))
    (catch Exception ex
      (format ex))))