add read from read-kinds

deps.edn

@@ -12,9 +12,10 @@
         org.scicloj/tempfiles {:mvn/version "1-beta1"}
         org.scicloj/kind-portal {:mvn/version "1-beta1"}
         org.clojure/tools.reader {:mvn/version "1.3.7"}
+        rewrite-clj/rewrite-clj {:mvn/version "1.1.48"}
         com.nextjournal/beholder {:mvn/version "1.0.2"}
         babashka/fs {:mvn/version "0.4.19"}}
- :aliases {:dev {:extra-paths ["notebooks"]
+ :aliases {:dev {:extra-paths ["notebooks" "test"]
                  :extra-deps {scicloj/tablecloth {:mvn/version "7.029.2"}
                               org.scicloj/tableplot {:mvn/version "1-alpha10"}
                               org.babashka/sci {:mvn/version "0.8.40"}

src/scicloj/clay/v2/read_kinds.clj

@@ -0,0 +1,149 @@
+(ns scicloj.clay.v2.read-kinds
+  "Convert code into contexts.
+  Contexts are maps that contain top-level forms and their evaluated value,
+  which will be further annotated with more information."
+  (:refer-clojure :exclude [read-string])
+  (:require [clojure.string :as str]
+            [rewrite-clj.parser :as parser]
+            [rewrite-clj.node :as node])
+  (:import (java.io StringWriter)))
+
+(def evaluators #{:clojure :babashka})
+
+(defn- validate-options [{:keys [evaluator]}]
+  (when evaluator
+    (assert (contains? evaluators evaluator)
+            (str "evaluator must be one of: " evaluators))))
+
+(defn ^:dynamic *on-eval-error*
+  "By default, eval errors will be rethrown.
+  When *on-eval-error* is bound to nil or a function,
+  The exception will be added to the context as an `:error` instead.
+  *on-eval-error* may be bound to a function to provide alternative behavior like warning.
+  When bound to a function the result will be ignored, but subsequent exceptions will propagate."
+  [context ex]
+  (throw (ex-info (str "Eval failed: " (ex-message ex))
+                  {:id      ::eval-failed
+                   :context context}
+                  ex)))
+
+;; FIXME: Add more test cases to verify that it works as intended.
+(defn read-ns-form [code]
+  (let [form (->> code
+                  parser/parse-string-all
+                  node/sexpr)]
+    (when (= 'ns (first form))
+      form)))
+
+(defn- eval-node
+  "Given an Abstract Syntax Tree node, returns a context.
+  A context represents a top level form evaluation."
+  [node options]
+  (let [tag (node/tag node)
+        code (node/string node)]
+    (case tag
+      (:newline :whitespace) {:code code
+                              :kind :kind/whitespace}
+
+      :uneval {:code code
+               :kind :kind/uneval}
+
+      ;; extract text from comments
+      :comment {:code  code
+                :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, taking care to capture stderr/stdout and exceptions
+      (let [form (node/sexpr node)
+            {:keys [row col end-row end-col]} (meta node)
+            region [row col end-row end-col]
+            meta {:source code
+                  :line row
+                  :column col
+                  :end-line end-row
+                  :end-column end-col}
+            context {:region region
+                     :code code
+                     :meta meta
+                     :form form}
+            out (new StringWriter)
+            err (new StringWriter)
+            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]
+  (-> (node/string node)
+      (str/starts-with? "#!/usr/bin/env bb")))
+
+(defn- eval-ast [ast options]
+  "Given the root Abstract Syntax Tree node,
+  returns a vector of contexts that represent evaluation"
+  (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
+                (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)))
+
+
+;; TODO: DRY
+(defn read-string
+  "Parse and evaluate the first form in a string.
+  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)))))
+
+(defn read-string-all
+  "Parse and evaluate all forms in a string.
+  Suitable for sending a selection of text for visualization.
+  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)))))
+
+;; TODO: DRY
+(defn read-file
+  "Similar to `clojure.core/load-file`,
+  but returns a representation of the forms and results of evaluation.
+  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))))

test/resources/detailed_ns.clj

@@ -0,0 +1,35 @@
+
+
+;; # A notebook
+
+(ns detailed-ns
+  (:require [clojure.core]))
+
+;; ## Intro
+
+;; Let us write a function that adds 9 to numbers.
+;; We will call it `abcd`.
+
+(defn abcd [x]
+  (+ x
+     9))
+
+(abcd 9)
+
+;; ## More examples
+
+;; Form metadata
+
+^:kind/hiccup
+[:div
+  [:p "hello"]]
+
+;; A symbol
+
+:a-symbol
+
+;; Comments using #_ should be ignored:
+
+#_(+ 1 2)
+
+#_#_ (+ 1 2) (+ 3 4)

test/resources/my_namespace.clj

@@ -0,0 +1,3 @@
+
+(ns my-namespace
+  (:require [clojure.core]))

test/resources/simple_ns.clj

@@ -0,0 +1,8 @@
+
+(ns simple-ns
+  (:require [clojure.core]))
+
+;; A function that adds 9 to numbers:
+
+(defn abcd [x]
+  (+ x 9))

test/scicloj/clay/v2/read_kinds_test.clj

@@ -0,0 +1,143 @@
+(ns scicloj.clay.v2.read-kinds-test
+  (:require [scicloj.clay.v2.read-kinds :as sut]
+            [clojure.java.io :as io]
+            [clojure.test :as t]))
+
+(def read-ns-form-code-example
+  (slurp (io/resource "resources/my_namespace.clj")))
+
+(t/deftest read-ns-form-test
+  (t/is (= (sut/read-ns-form
+            read-ns-form-code-example)
+           '(ns my-namespace
+              (:require [clojure.core])))))
+
+(def simple-ns-example
+  (slurp (io/resource "resources/simple_ns.clj")))
+
+(t/deftest read-string-all-test
+  (t/is
+   (=
+    (sut/read-string-all simple-ns-example {})
+    [{:code "\n", :kind :kind/whitespace}
+     {:region [2 1 3 29],
+      :code "(ns simple-ns\n  (:require [clojure.core]))",
+      :meta
+      {:source "(ns simple-ns\n  (:require [clojure.core]))",
+       :line 2,
+       :column 1,
+       :end-line 3,
+       :end-column 29},
+      :form '(ns simple-ns (:require [clojure.core])),
+      :value nil}
+     {:code "\n\n", :kind :kind/whitespace}
+     {:code ";; A function that adds 9 to numbers:\n",
+      :kind :kind/comment,
+      :value "A function that adds 9 to numbers:\n"}
+     {:code "\n", :kind :kind/whitespace}
+     {:region [7 1 8 11],
+      :code "(defn abcd [x]\n  (+ x 9))",
+      :meta
+      {:source "(defn abcd [x]\n  (+ x 9))",
+       :line 7,
+       :column 1,
+       :end-line 8,
+       :end-column 11},
+      :form '(defn abcd [x] (+ x 9)),
+      :value #'simple-ns/abcd}
+     {:code "\n", :kind :kind/whitespace}])))
+
+(def detailed-ns-example
+  (slurp (io/resource "resources/detailed_ns.clj")))
+
+(t/deftest safe-notes-detailed-test
+  (t/is
+   (=
+    (sut/read-string-all detailed-ns-example {})
+    [{:code "\n\n", :kind :kind/whitespace}
+     {:code ";; # A notebook\n",
+      :kind :kind/comment,
+      :value "# A notebook\n"}
+     {:code "\n", :kind :kind/whitespace}
+     {:region [5 1 6 29],
+      :code "(ns detailed-ns\n  (:require [clojure.core]))",
+      :meta
+      {:source "(ns detailed-ns\n  (:require [clojure.core]))",
+       :line 5,
+       :column 1,
+       :end-line 6,
+       :end-column 29},
+      :form '(ns detailed-ns (:require [clojure.core])),
+      :value nil}
+     {:code "\n\n", :kind :kind/whitespace}
+     {:code ";; ## Intro\n", :kind :kind/comment, :value "## Intro\n"}
+     {:code "\n", :kind :kind/whitespace}
+     {:code ";; Let us write a function that adds 9 to numbers.\n",
+      :kind :kind/comment,
+      :value "Let us write a function that adds 9 to numbers.\n"}
+     {:code ";; We will call it `abcd`.\n",
+      :kind :kind/comment,
+      :value "We will call it `abcd`.\n"}
+     {:code "\n", :kind :kind/whitespace}
+     {:region [13 1 15 9],
+      :code "(defn abcd [x]\n  (+ x\n     9))",
+      :meta
+      {:source "(defn abcd [x]\n  (+ x\n     9))",
+       :line 13,
+       :column 1,
+       :end-line 15,
+       :end-column 9},
+      :form '(defn abcd [x] (+ x 9)),
+      :value #'detailed-ns/abcd}
+     {:code "\n\n", :kind :kind/whitespace}
+     {:region [17 1 17 9],
+      :code "(abcd 9)",
+      :meta
+      {:source "(abcd 9)",
+       :line 17,
+       :column 1,
+       :end-line 17,
+       :end-column 9},
+      :form '(abcd 9),
+      :value 18}
+     {:code "\n\n", :kind :kind/whitespace}
+     {:code ";; ## More examples\n",
+      :kind :kind/comment,
+      :value "## More examples\n"}
+     {:code "\n", :kind :kind/whitespace}
+     {:code ";; Form metadata\n",
+      :kind :kind/comment,
+      :value "Form metadata\n"}
+     {:code "\n", :kind :kind/whitespace}
+     {:region [23 1 25 16],
+      :code "^:kind/hiccup\n[:div\n  [:p \"hello\"]]",
+      :meta
+      {:source "^:kind/hiccup\n[:div\n  [:p \"hello\"]]",
+       :line 23,
+       :column 1,
+       :end-line 25,
+       :end-column 16},
+      :form [:div [:p "hello"]],
+      :value [:div [:p "hello"]]}
+     {:code "\n\n", :kind :kind/whitespace}
+     {:code ";; A symbol\n", :kind :kind/comment, :value "A symbol\n"}
+     {:code "\n", :kind :kind/whitespace}
+     {:region [29 1 29 10],
+      :code ":a-symbol",
+      :meta
+      {:source ":a-symbol",
+       :line 29,
+       :column 1,
+       :end-line 29,
+       :end-column 10},
+      :form :a-symbol,
+      :value :a-symbol}
+     {:code "\n\n", :kind :kind/whitespace}
+     {:code ";; Comments using #_ should be ignored:\n",
+      :kind :kind/comment,
+      :value "Comments using #_ should be ignored:\n"}
+     {:code "\n", :kind :kind/whitespace}
+     {:code "#_(+ 1 2)", :kind :kind/uneval}
+     {:code "\n\n", :kind :kind/whitespace}
+     {:code "#_#_ (+ 1 2) (+ 3 4)", :kind :kind/uneval}
+     {:code "\n", :kind :kind/whitespace}])))