diff --git a/src/scicloj/read_kinds/notes.clj b/src/scicloj/read_kinds/notes.clj index efaf985..9b2b341 100644 --- a/src/scicloj/read_kinds/notes.clj +++ b/src/scicloj/read_kinds/notes.clj @@ -72,7 +72,8 @@ (defn read-file-as-notes "Reads a clojure source file and returns contexts." [^File file options] - (into [] notebook-xform (read/read-file file options))) + (into [] notebook-xform (-> (read/read-file file options) + (read/eval-ast options)))) (defn relative-path [^File file] (-> (str (.relativize (.toURI (io/file "")) @@ -153,7 +154,8 @@ (defn read-string-as-context "Reads a form and returns a context." [code options] - (maybe-advise (read/read-string code options))) + (maybe-advise (-> (read/read-string code options) + (read/eval-ast options)))) (comment (read-string-as-context "(+ 1 2)" {}) diff --git a/src/scicloj/read_kinds/read.clj b/src/scicloj/read_kinds/read.clj index 8033185..dc96875 100644 --- a/src/scicloj/read_kinds/read.clj +++ b/src/scicloj/read_kinds/read.clj @@ -27,10 +27,85 @@ :context context} ex))) +(def ^:dynamic *capture-pr-context*) +(def ^:dynamic *out-orig* *out*) +(def ^:dynamic *err-orig* *err*) + +(defmacro with-out-err-str [& body] + `(binding [*out* (new StringWriter) + *err* (new StringWriter)] + ~@body)) + +(defn str-and-reset! [w] + (locking w + (let [s (str w)] + (.setLength (.getBuffer ^StringWriter w) 0) + s))) + +;; TODO need to make items of these in notes +(defmacro with-out-err-captured + "Captures `*out*` and `*err*`, with either `:global` or `:local` + `pr-context.` `:global` is used to capture output on all threads + during notebook execution, so should be placed at the \"top\" of a + notebook eval. + + Inside a `:global` capture, `:local` can be used to capture the + output of individual note evaluations. `:local` should be called + with a symbol to bind a fn which returns a map, containing `:out`, + `:err`, `:global-out` and `:global-err` to, for consumption in the + `:local` invocation's body. + + with-out-err-captured :global => executes body, capturing output + with-out-err-captured :local fn-binding => executes body, capturing + output, retrieve captured output with (fn-binding) + " + [pr-context & body] + ;; For a notebook, we capture output globally, and per note. + (case pr-context + ;; Capture global *out* and *err* + :global + ;; Futures will inherit the current binding, + ;; which is not affected by altering the root. + `(with-out-err-str + ;; Threads may inherit only the root binding + (with-redefs [*out* *out* + *err* *err*] + (binding [*capture-pr-context* :global] + ~@body))) + ;; Capture local *out* and *err*, per note + :local + `(let [global-out# *out* + global-err# *err*] + (assert (symbol? '~(first body)) + ":local capture should provide a symbol to bind + captured output") + (assert (= *capture-pr-context* :global) + ":global should be captured before (around) :local") + (with-out-err-str + (let [~(first body) #(into {} + (filter (comp not-empty val)) + {:out (str *out*) + :err (str *err*) + :global-out (str-and-reset! global-out#) + :global-err (str-and-reset! global-err#)})] + ~@(next body)))))) + +(defn print-from-context [context] + (doseq [[captured print-to] (->> (map (fn [k pr-to] + [(k context) pr-to]) + [:out :err :global-out :global-err] + (cycle [*out-orig* *err-orig*])) + (filter first))] + (binding [*out* print-to] + (print captured) + (flush))) + context) + (defn- eval-node "Given an Abstract Syntax Tree node, returns a context. A context represents a top level form evaluation." [node options] + ;; TODO could just move down to let before eval (let [tag (node/tag node) code (node/string node)] (case tag @@ -45,91 +120,81 @@ :kind :kind/comment ;; remove leading semicolons or shebangs, and one non-newline space if present. :value (str/replace-first code #"^(;|#!)*[^\S\r\n]?" "")} + ;; evaluate for value, capturing *out*, *err* and exceptions + ;; TODO doesn't this break namespaced keywords? (sexpr-call + ;; without ns/alias inf) + (with-out-err-captured :local captured + (let [form (node/sexpr node) + {:keys [row col end-row end-col]} (meta node) + context {:line row + :column col + ;; TODO for backwards compatibility with clay + :region [row col end-row end-col] + :code code + :form form} + result (try + ;; TODO: capture `tap` or not? + (let [x (eval form)] + {:value x}) + (catch Throwable ex + (when *on-eval-error* + (*on-eval-error* context ex)) + {:exception ex}))] + (merge context result (captured))))))) - ;; evaluate for value, taking care to capture stderr/stdout and exceptions - (let [form (node/sexpr node) - {:keys [row col]} (meta node) - out (new StringWriter) - err (new StringWriter) - context {:line row - :column col - :code code - :form form} - result (try - ;; TODO: capture `tap` or not? - (let [x (binding [*out* out - *err* err] - (eval form))] - {:value x}) - (catch Throwable ex - (when *on-eval-error* - (*on-eval-error* context ex)) - {:exception ex})) - out-str (str out) - err-str (str err)] - (merge context result - (when (seq out-str) {:out out-str}) - (when (seq err-str) {:err err-str})))))) - -(defn- babashka? [node] +(defn- babashka-shebang? [node] (-> (node/string node) (str/starts-with? "#!/usr/bin/env bb"))) -(defn- eval-ast [ast options] +(defn- eval-ast* "Given the root Abstract Syntax Tree node, returns a vector of contexts that represent evaluation" + [ast options] (let [top-level-nodes (node/children ast) ;; TODO: maybe some people want to include the header? - babashka (some-> (first top-level-nodes) (babashka?)) - nodes (if babashka + babashka-shebang (some-> (first top-level-nodes) (babashka-shebang?)) + nodes (if babashka-shebang (rest top-level-nodes) top-level-nodes)] - ;; Babashka and Clojure can evaluate files with or without the header present, - ;; it is up to the user to specify which evaluator to use in the options. - #_(when (and babashka (not= evaluator :babashka)) - (println "Warning: Babashka header detected while evaluating in Clojure")) ;; must be eager to restore current bindings - (mapv #(eval-node % options) nodes))) + (mapv #(-> % (eval-node options) print-from-context) nodes))) +(defn eval-ast + "Evaluates an ast as retrieved via the `read-`functions." + ([ast] (eval-ast ast {})) + ([ast options] + (with-out-err-captured :global + (binding [;; preserve current bindings (they will be reset to + ;; original) + *ns* *ns* + *warn-on-reflection* *warn-on-reflection* + *unchecked-math* *unchecked-math*] + (eval-ast* ast options))))) -;; TODO: DRY (defn read-string - "Parse and evaluate the first form in a string. + "Parse the first form in a string. The result can be passed to `eval-ast`. Suitable for sending text representing one thing for visualization." ([code] (read-string code {})) ([code options] (validate-options options) - ;; preserve current bindings (they will be reset to original) - (binding [*ns* *ns* - *warn-on-reflection* *warn-on-reflection* - *unchecked-math* *unchecked-math*] - (-> (parser/parse-string code) - (eval-node options))))) + [(parser/parse-string code)])) (defn read-string-all - "Parse and evaluate all forms in a string. + "Parse all forms in a string. The result can be passed to `eval-ast`. Suitable for sending a selection of text for visualization. - When reading a file, prefer using `read-file` to preserve the current ns bindings." + When reading a file, prefer using `read-file` to preserve the + current ns bindings." ([code] (read-string-all code {})) ([code options] (validate-options options) ;; preserve current bindings (they will be reset to original) - (binding [*ns* *ns* - *warn-on-reflection* *warn-on-reflection* - *unchecked-math* *unchecked-math*] - (-> (parser/parse-string-all code) - (eval-ast options))))) + (parser/parse-string-all code))) -;; TODO: DRY (defn read-file - "Similar to `clojure.core/load-file`, - but returns a representation of the forms and results of evaluation. + "Similar to `clojure.core/load-file`, but returns a representation + of the forms, which can be passed to `eval-ast`. Suitable for processing an entire namespace." [file options] (validate-options options) ;; preserve current bindings (they will be reset to original) - (binding [*ns* *ns* - *warn-on-reflection* *warn-on-reflection* - *unchecked-math* *unchecked-math*] - (-> (parser/parse-file-all file) - (eval-ast options)))) + (parser/parse-file-all file))