WIP changes for Clay integration

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)" {})

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))