Merge pull request #21 from kepler16/20-excessive-error-wrapping

fix(#20): do not throw wrapped error

deps.edn

@@ -4,12 +4,21 @@
 
  :deps
  {funcool/promesa {:mvn/version "9.0.489"}
+  org.clojure/tools.logging {:mvn/version "1.2.4"}
   metosin/malli {:mvn/version "0.9.2"}}
 
  :aliases
  {:dev {:extra-paths ["test"]
         :extra-deps {thheller/shadow-cljs {:mvn/version "2.19.5"}
-                     lambdaisland/kaocha {:mvn/version "1.70.1086"}}}
+                     lambdaisland/kaocha {:mvn/version "1.70.1086"}
+                     ;; pipe other logging facades to slf4j
+                     org.slf4j/jul-to-slf4j {:mvn/version "1.7.36"}
+                     org.slf4j/jcl-over-slf4j {:mvn/version "1.7.36"}
+                     org.slf4j/log4j-over-slf4j {:mvn/version "1.7.36"}
+                     org.slf4j/osgi-over-slf4j {:mvn/version "1.7.36"}
+                     ch.qos.logback/logback-classic {:mvn/version "1.2.3"}
+                     org.clojure/tools.logging {:mvn/version "1.2.4"}}
+        :jvm-opts ["-Dclojure.tools.logging.factory=clojure.tools.logging.impl/slf4j-factory"]}
 
   :test {:extra-paths ["test"]
          :extra-deps {io.github.cognitect-labs/test-runner

repl_sessions/failures.clj

@@ -0,0 +1,29 @@
+(ns failures
+  (:require [k16.gx.beta.system :as gx.system]))
+
+(defn start-1 [_]
+  (let [a 10
+        e 0]
+    (/ a e)))
+
+(defn stop-1 [_] :stopped)
+
+(def parent-component {:gx/start {:gx/processor start-1}
+                       :gx/stop {:gx/processor stop-1}})
+
+(def graph {:config {:foo {:bar "something"}}
+            :parent {:gx/component 'failures/parent-component
+                     :gx/props '(gx/ref :config)}
+            :child {:foo 1
+                    :paren-data '(gx/ref :parent)}})
+
+(def system_name ::sys)
+
+(comment
+  (gx.system/register! system_name {:graph graph})
+  @(gx.system/signal! system_name :gx/start)
+  (print (gx.system/failures-humanized system_name))
+  (gx.system/failed-nodes system_name)
+  (:exception (first (:causes (last (gx.system/failures system_name)))))
+  (:internal-data (first (:failures (ex-data (.getCause *e)))))
+  (first (gx.system/failures system_name)))

src/k16/gx/beta/errors.cljc

@@ -69,18 +69,19 @@
   [& token-pairs]
   (assert (even? (count token-pairs))
           "tokenize accepts only even number of forms")
-  (->> token-pairs
-       (map stringify)
-       (partition 2)
-       (filter (comp seq second))
-       (map (fn [[a b]] [a (str "'" b "'")]))
-       (interpose ", ")
-       (flatten)
-       (apply str)))
+  (apply str (transduce (comp
+                         (map stringify)
+                         (partition-all 2)
+                         (filter (comp seq second))
+                         (map (fn [[a b]] [a (str "'" b "'")]))
+                         (interpose ", "))
+                        (completing conj flatten)
+                        token-pairs)))
 
 (defn- cause->str
-  [{:keys [title data exception]}]
-  (str "cause(" title " = " data "): " (gather-error-messages exception)))
+  [{:keys [data exception]}]
+  (str "cause" (when data (str "(data = " data ")")) ": "
+       (gather-error-messages exception)))
 
 (defn humanize-error
   [{:keys [node-key signal-key message causes]} & rest-of-error]

src/k16/gx/beta/system.cljc

@@ -1,5 +1,6 @@
 (ns k16.gx.beta.system
   (:require [k16.gx.beta.core :as gx]
+            #?(:clj [clojure.tools.logging :as log])
             [k16.gx.beta.errors :as gx.errors]
             [promesa.core :as p]))
 
@@ -11,6 +12,14 @@
     (select-keys graph selector)
     graph))
 
+(defn throw-root-exception!
+  [failures]
+  (let [{:keys [message causes]} (last failures)
+        {:keys [exception]} (first causes)]
+    (cond
+      exception (throw exception)
+      :else (throw (ex-info message {:failures failures})))))
+
 (defn states
   "Gets list of states of the graph as map.
    Optionally accepts selector as set of nodes from the graph.
@@ -39,6 +48,17 @@
   (when-let [gx-map (get @registry* system-name)]
     (seq (:failures gx-map))))
 
+(defn failed-nodes
+  [system-name]
+  (when-let [gx-map (get @registry* system-name)]
+    (into {}
+          (comp
+           (filter (fn [[_k node]]
+                     (-> node :gx/failure :causes)))
+           (map (fn [[k node]]
+                  [k (-> node :gx/failure :causes)])))
+          (:graph gx-map))))
+
 (defn failures-humanized
   "Returns all failures as single humanized formatted string (ready for output)."
   [system-name]
@@ -51,9 +71,9 @@
   (let [normalized (gx/normalize gx-map)]
     (swap! registry* assoc system-name normalized)
     (if-let [failures (seq (:failures normalized))]
-      (throw (ex-info (str "Normalize error\n"
-                           (gx.errors/humanize-all failures))
-                      {:failures failures}))
+      (do (#?(:clj log/error :cljs js/console.error)
+           (str "Normalize error\n" (gx.errors/humanize-all failures)))
+          (throw-root-exception! failures))
       normalized)))
 
 (defn get-by-name
@@ -78,9 +98,10 @@
          (p/then (fn [g]
                    (swap! registry* assoc system-name g)
                    (if-let [failures (:failures g)]
-                     (throw (ex-info (str "Signal failed!\n"
-                                          (gx.errors/humanize-all failures))
-                                     {:failures failures}))
+                     (do (#?(:clj log/error :cljs js/console.error)
+                          (str "Signal failed!\n"
+                               (gx.errors/humanize-all failures)))
+                         (throw-root-exception! failures))
                      g))))
      (p/resolved nil))))
 
@@ -109,5 +130,4 @@
    (failures-humanized :sys))
 
   (values :sys)
-  (first (failures :sys))
-  )
+  (first (failures :sys)))

test/k16/gx/beta/system_test.cljc

@@ -70,4 +70,3 @@
                 :signal-key :gx/stop
                 :causes []}]}
              (ex-data err))))))
-