cursive-ghost · September 16, 2024 14:52 · Sep 16, 2024
diff --git a/nodes.clj b/nodes.clj
@@ -0,0 +1,182 @@
+(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))))
No results found