Skip to content

Commit

Permalink
only print description meta for expr/vars end
Browse files Browse the repository at this point in the history
  • Loading branch information
philomates committed Jun 23, 2021
1 parent 0f2fe13 commit 640e2ee
Show file tree
Hide file tree
Showing 4 changed files with 99 additions and 52 deletions.
109 changes: 66 additions & 43 deletions src/state_flow/core.clj
Original file line number Diff line number Diff line change
Expand Up @@ -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]))

Expand Down Expand Up @@ -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.
Expand All @@ -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.
Expand All @@ -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))

Expand Down Expand Up @@ -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
Expand All @@ -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#))))

Expand Down
22 changes: 22 additions & 0 deletions src/state_flow/internals/description.clj
Original file line number Diff line number Diff line change
@@ -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)))

2 changes: 1 addition & 1 deletion test/state_flow/assertions/matcher_combinators_test.clj
Original file line number Diff line number Diff line change
Expand Up @@ -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}}
Expand Down
18 changes: 10 additions & 8 deletions test/state_flow/core_test.clj
Original file line number Diff line number Diff line change
Expand Up @@ -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)))))))
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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"))
Expand Down

0 comments on commit 640e2ee

Please sign in to comment.