diff --git a/src/state_flow/core.clj b/src/state_flow/core.clj index 8b47aff..be5188a 100644 --- a/src/state_flow/core.clj +++ b/src/state_flow/core.clj @@ -3,7 +3,8 @@ (:require [cats.core :as m] [cats.monad.exception :as e] [clojure.pprint :as pp] - [clojure.string :as str] + [clojure.string :as string] + [state-flow.internals.description :as description] [state-flow.state :as state] [taoensso.timbre :as log])) @@ -31,15 +32,16 @@ "Returns a flow that will modify the state metadata. For internal use. Subject to change." - [description {:keys [line ns file]}] - (modify-meta - (fn [m] (-> m - (update :top-level-description #(or % description)) - (update :description-stack (fnil conj []) - (cond-> {:description description - :ns ns} - line (assoc :line line) - file (assoc :file file))))))) + [description {:keys [line ns file call-site-meta]}] + (let [meta-map (cond-> {:description description + :ns ns} + call-site-meta (assoc :call-site-meta call-site-meta) + line (assoc :line line) + file (assoc :file file))] + (modify-meta + (fn [m] (-> m + (update :top-level-description #(or % description)) + (update :description-stack (fnil conj []) meta-map)))))) (defn pop-meta "Returns a flow that will modify the state metadata. @@ -54,20 +56,41 @@ (defn description->file [{:keys [file]}] - (when file (last (str/split file #"/")))) + (when file (last (string/split file #"/")))) -(defn ^:private format-single-description +(defn- format-single-description [{:keys [line description file] :as m}] (let [filename (description->file m)] (str description (when line - (format " (%s:%s)" filename line))))) + (if filename + (format " (%s:%s)" filename line) + ;; TODO: we can probably pull filename info from previous stack entries + (format " (line %s)" line)))))) + +(defn- remove-non-terminal-call-site-meta + "non-terminal call-site meta is usually redudant with the meta-data provided + by `flow` forms. + + It is thus mostly useful at the end of the call-stack, as a way to get more + precise line information for issues that arise after the last `flow` form." + [stack] + (let [call-site-meta? #(contains? % :call-site-meta) + last-call-site-metas (->> stack + reverse + (take-while call-site-meta?) + reverse) + filtered-stack (-> (remove call-site-meta? stack) + (concat last-call-site-metas))] + ;; `into` to preserve the `stack` sequence type + (into (empty stack) filtered-stack))) (defn format-description [stack] (->> stack + remove-non-terminal-call-site-meta (map format-single-description) - (str/join " -> "))) + (string/join " -> "))) (defn description-stack "Returns the list of descriptions in the current stack. @@ -81,13 +104,13 @@ [s] (-> s meta :description-stack)) -(defn ^:private string-expr? [x] +(defn- string-expr? [x] (or (string? x) (and (sequential? x) (or (= (first x) 'str) (= (first x) 'clojure.core/str))))) -(defn ^:private state->current-description [s] +(defn- state->current-description [s] (-> (description-stack s) format-description)) @@ -121,32 +144,27 @@ [hook (state/gets (comp :before-flow-hook meta))] (state/modify (or hook identity)))) -(def ^:private abbr-size 15) -(defn ellipsify [expr-str] - (let [short-expr (subs expr-str 0 (- abbr-size 3))] - (case (first expr-str) - \( (str short-expr "...)") - \[ (str short-expr "...]") - (str short-expr "...")))) - -(defn abbr-sexpr [expr] - (let [expr-str (str expr) - short-expr (if (< abbr-size (count expr-str)) - (ellipsify expr-str) - expr-str)] - (str "`" short-expr "`"))) - -(defn push-abbr-meta [flow] - `(push-meta ~(abbr-sexpr flow) - ~(meta flow))) +(defn- push-abbr-meta [flow] + `(push-meta ~(description/abbr-sexpr flow) + ~(assoc (meta flow) + :call-site-meta true))) + +(defn- flow-expr? [expr] + (and (coll? expr) + (or (= 'flow (first expr)) + (= `flow (first expr))))) (defn annote-with-line-meta [flows] - (when-let [subflow-lines (->> flows - (map push-abbr-meta) - seq)] - (butlast (interleave subflow-lines - flows - (repeat `(pop-meta)))))) + (let [annotated-flows (reduce (fn [acc flow] + (if (flow-expr? flow) + (conj acc flow) ;; `flow`s push their own meta data + (into [] (concat acc [(push-abbr-meta flow) flow `(pop-meta)])))) + [] + flows)] + ;; to preserve the return value, exclude terminal pop-meta's + (if (= `(pop-meta) (last annotated-flows)) + (butlast annotated-flows) + annotated-flows))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Public API @@ -164,12 +182,17 @@ (throw (IllegalArgumentException. "The first argument to flow must be a description string"))) (when (vector? (last flows)) (throw (ex-info "The last argument to flow must be a flow/step, not a binding vector." {}))) - (let [flow-meta caller-meta - flows' (or flows `[(m/return nil)])] + (let [flow-meta caller-meta + annotated-flows (annote-with-line-meta + (or flows `[(m/return nil)])) + pop-line-meta (if (flow-expr? (last annotated-flows)) + '() + `((pop-meta)))] `(m/do-let (push-meta ~description ~flow-meta) (apply-before-flow-hook) - [ret# (m/do-let ~@(annote-with-line-meta flows'))] + [ret# (m/do-let ~@annotated-flows)] + ~@pop-line-meta (pop-meta) (m/return ret#)))) diff --git a/src/state_flow/internals/description.clj b/src/state_flow/internals/description.clj new file mode 100644 index 0000000..34895bb --- /dev/null +++ b/src/state_flow/internals/description.clj @@ -0,0 +1,22 @@ +(ns state-flow.internals.description + (:require [clojure.string :as string])) + +(def ^:private abbr-size 15) +(defn- abbr-list [expr-str ellipse-end] + (let [[head & tail] (string/split expr-str #" ")] + (if (empty? tail) + expr-str + (str head ellipse-end)))) + +(defn- ellipsify [expr-str] + (case (first expr-str) + \( (abbr-list expr-str " ...)") + \[ (abbr-list expr-str " ...]") + expr-str)) + +(defn abbr-sexpr [expr] + (let [expr-str (str expr)] + (if (< abbr-size (count expr-str)) + (ellipsify expr-str) + expr-str))) + diff --git a/test/state_flow/assertions/matcher_combinators_test.clj b/test/state_flow/assertions/matcher_combinators_test.clj index 749b1ff..5cb53f6 100644 --- a/test/state_flow/assertions/matcher_combinators_test.clj +++ b/test/state_flow/assertions/matcher_combinators_test.clj @@ -76,7 +76,7 @@ :match/actual {:n 2}} flow-ret))) (testing "saves assertion report to state with current description stack" - (is (match? {:flow/description-stack [{:description "match?"}] + (is (match? {:flow/description-stack [{:description "match?"} {:description "(cats.core/do-let ...)"}] :match/result :mismatch :mismatch/detail {:n {:expected 1 :actual 2}} :probe/results [{:check-result false :value {:n 2}} diff --git a/test/state_flow/core_test.clj b/test/state_flow/core_test.clj index 2168f18..d1ccf29 100644 --- a/test/state_flow/core_test.clj +++ b/test/state_flow/core_test.clj @@ -161,11 +161,11 @@ (deftest current-description (testing "top level flow" - (is (re-matches #"level 1 \(core_test.clj:\d+\)" + (is (re-matches #"level 1 \(core_test.clj:\d+\) -> \(state-flow\/current-description\) \(line \d+\)" (first (state-flow/run (flow "level 1" (state-flow/current-description))))))) (testing "nested flows" - (is (re-matches #"level 1 \(core_test.clj:\d+\) -> level 2 \(core_test.clj:\d+\)" + (is (re-matches #"level 1 \(core_test.clj:\d+\) -> level 2 \(core_test.clj:\d+\) -> \(state-flow\/current-description\) \(line \d+\)" (first (state-flow/run (flow "level 1" (flow "level 2" (state-flow/current-description))))))) @@ -178,13 +178,14 @@ (flow "level 2" (flow "level 3" (state-flow/current-description)))))] - (is (re-matches #"level 1 \(core_test.clj:\d+\) -> level 2 \(core_test.clj:\d+\) -> level 3 \(core_test.clj:\d+\)" desc)) + (is (re-matches #"level 1 \(core_test.clj:\d+\) -> level 2 \(core_test.clj:\d+\) -> level 3 \(core_test.clj:\d+\) -> \(state-flow\/current-description\) \(line \d+\)" + desc)) (testing "line numbers are correct" (let [[level-1-line level-2-line level-3-line] (->> desc - (re-find #"level 1 \(core_test.clj:(\d+)\) -> level 2 \(core_test.clj:(\d+)\) -> level 3 \(core_test.clj:(\d+)\)") + (re-find #"level 1 \(core_test.clj:(\d+)\) -> level 2 \(core_test.clj:(\d+)\) -> level 3 \(core_test.clj:(\d+)\) -> \(state-flow\/current-description\) \(line \d+\)") (drop 1) (map #(Integer/parseInt %)))] (is (<= line-number-before-flow-invocation @@ -198,7 +199,7 @@ level-2 (flow "level 2" level-3) level-1 (flow "level 1" level-2) [desc _] (state-flow/run level-1)] - (is (re-matches #"level 1 \(core_test.clj:\d+\) -> level 2 \(core_test.clj:\d+\) -> level 3 \(core_test.clj:\d+\)" + (is (re-matches #"level 1 \(core_test.clj:\d+\) -> level 2 \(core_test.clj:\d+\) -> level 3 \(core_test.clj:\d+\) -> \(state-flow\/current-description\) \(line \d+\)" desc)) (testing "line numbers are correct, even when composed" (let [[level-1-line @@ -215,16 +216,17 @@ (testing "after nested flows complete" (testing "within nested flows " - (is (re-matches #"level 1 \(core_test.clj:\d+\)" + (is (re-matches #"level 1 \(core_test.clj:\d+\) -> \(state-flow\/current-description\) \(line \d+\)" (first (state-flow/run (flow "level 1" (flow "level 2") (state-flow/current-description)))))) - (is (re-matches #"level 1 \(core_test.clj:\d+\) -> level 2 \(core_test.clj:\d+\)" + (is (re-matches #"level 1 \(core_test.clj:\d+\) -> level 2 \(core_test.clj:\d+\) -> \(state-flow\/current-description\) \(line \d+\)" (first (state-flow/run (flow "level 1" (flow "level 2" (flow "level 3") (state-flow/current-description))))))) - (is (re-matches #"level 1 \(core_test.clj:\d+\)" + + (is (re-matches #"level 1 \(core_test.clj:\d+\) -> \(state-flow\/current-description\) \(line \d+\)" (first (state-flow/run (flow "level 1" (flow "level 2" (flow "level 3"))