diff --git a/.gitignore b/.gitignore index b94bdc6f..5610bfcd 100644 --- a/.gitignore +++ b/.gitignore @@ -34,3 +34,4 @@ docs/*qmd _quarto.yml book +/read-kinds-diffs diff --git a/deps.edn b/deps.edn index c3834cc3..28a6951f 100644 --- a/deps.edn +++ b/deps.edn @@ -4,6 +4,9 @@ nrepl/nrepl {:mvn/version "1.3.1"} com.cnuernber/charred {:mvn/version "1.037"} read-kinds/read-kinds {:local/root "../read-kinds"} + ;; TODO back to lambdaisland/deep-diff2 once fix merged + io.github.onbreath/deep-diff2 {:git/sha "1f969521b68ce9dd9feed9b51a99a4569482b6ad"} + carocad/parcera {:mvn/version "0.11.6"} org.antlr/antlr4-runtime {:mvn/version "4.7.1"} http-kit/http-kit {:mvn/version "2.8.0"} ring/ring-core {:mvn/version "1.14.1"} diff --git a/src/scicloj/clay/v2/make.clj b/src/scicloj/clay/v2/make.clj index ba11a905..17715f5e 100644 --- a/src/scicloj/clay/v2/make.clj +++ b/src/scicloj/clay/v2/make.clj @@ -17,7 +17,9 @@ [clojure.pprint :as pp] [scicloj.kindly-render.notes.to-html-page :as to-html-page] ;; [hashp.preload] - [scicloj.kindly.v4.api :as kindly])) + [scicloj.kindly.v4.api :as kindly]) + (:import java.time.LocalDateTime + java.time.format.DateTimeFormatter)) (defn spec->source-type [{:keys [source-path]}] (some-> source-path (fs/extension))) @@ -471,8 +473,12 @@ (fs/delete-tree target)) (util.fs/copy-tree-no-clj subdir target))))))) +(defn ts [] + (.format (LocalDateTime/now) + (DateTimeFormatter/ofPattern "yyyy-MM-dd-HH-mm-ss~N"))) + (defn make! [spec] - (let [config (config/config spec) + (let [config (config/config (assoc spec :diff/timestamp (ts))) {:keys [single-form single-value]} spec {:keys [main-spec single-ns-specs]} (extract-specs config spec) {:keys [ide browse show book base-target-path clean-up-target-dir live-reload]} main-spec diff --git a/src/scicloj/clay/v2/notebook.clj b/src/scicloj/clay/v2/notebook.clj index 25447a88..be70259b 100644 --- a/src/scicloj/clay/v2/notebook.clj +++ b/src/scicloj/clay/v2/notebook.clj @@ -5,10 +5,10 @@ [scicloj.clay.v2.util.path :as path] [scicloj.clay.v2.item :as item] [scicloj.clay.v2.prepare :as prepare] + [scicloj.clay.v2.notebook-old :as notebook-old] [scicloj.clay.v2.read :as read] [scicloj.kindly.v4.api :as kindly] - [scicloj.kindly-advice.v1.api :as kindly-advice]) - (:import (java.io StringWriter))) + [scicloj.clay.v2.util.diff :as diff])) (set! *warn-on-reflection* true) @@ -42,29 +42,6 @@ (and (sequential? form) (-> form first (= 'ns)))) -(defn str-and-reset! [w] - (when (instance? StringWriter *out*) - (locking w - (let [s (str w)] - (.setLength (.getBuffer ^StringWriter w) 0) - s)))) - -(def ^:dynamic *out-orig* *out*) - -(defn maybe-println-orig [s] - (when (seq s) - (binding [*out* *out-orig*] - (print s) - (flush)))) - -(def ^:dynamic *err-orig* *err*) - -(defn maybe-err-orig [s] - (when (seq s) - (binding [*out* *err-orig*] - (print s) - (flush)))) - ;; Babashka ;; - Make Clay runnable in Babashka ;; - The way Clay reads - dependency of `carocad/parcera`, maybe we just remove it. @@ -94,56 +71,6 @@ ;; - Can we frame the stack around eval? ;; - Is output being done right? -(defn read-eval-capture - "Captures stdout and stderr while evaluating a note" - [{:as note - :keys [code form]}] - note - #_ - (let [out (StringWriter.) - err (StringWriter.) - note (try - (let [x (binding [*out* out - *err* err] - (cond form (-> form - eval - deref-if-needed) - code (-> code - read-string - eval - deref-if-needed)))] - (assoc note :value x)) - (catch Throwable ex - (assoc note :exception ex))) - out-str (str out) - err-str (str err) - ;; A notebook may have also printed from a thread, - ;; *out* and *err* are replaced with StringWriters in with-out-err-capture - global-out (str-and-reset! *out*) - global-err (str-and-reset! *err*) - ;; Don't show output from requiring other namespaces - show (not (ns-form? form))] - (maybe-println-orig out-str) - (maybe-err-orig err-str) - (maybe-println-orig global-out) - (maybe-err-orig global-err) - (if show - (cond-> note - (seq out-str) (assoc :out out-str) - (seq err-str) (assoc :err err-str) - (seq global-out) (assoc :global-out global-out) - (seq global-err) (assoc :global-err global-err)) - note))) - -(defn complete [{:as note - :keys [comment?]}] - (let [completed (cond-> note - (not (or comment? (contains? note :value))) - (read-eval-capture))] - (cond-> completed - (and (not comment?) (contains? completed :value)) - (kindly-advice/advise)))) - (defn comment->item [comment] (-> comment (str/split #"\n") @@ -323,22 +250,6 @@ code new-code)}))) (@*path->last path)) -(defmacro with-out-err-captured - "Evaluates and computes the items for a notebook of notes" - [& body] - ;; For a notebook, we capture output globally, and per note. - ;; see read-eval-capture for why this is relevant. - `(let [out# (StringWriter.) - err# (StringWriter.)] - ;; Threads may inherit only the root binding - (with-redefs [*out* out# - *err* err#] - ;; Futures will inherit the current binding, - ;; which was not affected by altering the root. - (binding [*out* out# - *err* err#] - ~@body)))) - (defn itemize-notes "Evaluates and computes the items for a notebook of notes" [relevant-notes some-narrowed options] @@ -409,22 +320,18 @@ :format])] (doall (for [note notes] - (complete (kindly/deep-merge opts note)))))) + (kindly/deep-merge opts note))))) (defn relevant-notes [{:keys [full-source-path - single-form - single-value - smart-sync - pprint-margin] - :or {pprint-margin pp/*print-right-margin*}}] - (let [{:keys [code first-line-of-change]} (some-> full-source-path slurp-and-compare) - notes (->> (cond single-value (conj (when code - [{:form (read/read-ns-form code)}]) - {:value single-value}) - single-form (conj (when code - [{:form (read/read-ns-form code)}]) - {:form single-form}) - :else (read/->notes code)) + single-form + single-value + smart-sync + pprint-margin] + :or {pprint-margin pp/*print-right-margin*} + :as spec}] + (let [{:keys [code first-line-of-change]} (some-> full-source-path + slurp-and-compare) + notes (->> (read/->notes (assoc spec :code code)) (map-indexed (fn [i {:as note :keys [code]}] (merge note @@ -464,6 +371,36 @@ "seconds") result#)) +(defn ->old-comment [note] + (let [comment-item (-> note :code notebook-old/comment->item)] + (-> note + (assoc :value (str/replace (:md comment-item) + ;; TODO stripping extra space added + ;; in front of headline Do we want + ;; to add this for read-kinds? + #"\n#" "#") + :kind :kind/md) + (dissoc :code :comment? :region)))) + +(defn ->old-notes-approx [notes] + (->> notes + (into [] + (map #(-> % + (cond-> (and (:comment? %) + (:code %)) + ->old-comment) + (dissoc :gen)))))) + +(defn ->new-notes-approx [notes] + (->> notes + (into [] + (map #(-> % + (dissoc :line :column) + (cond-> (-> % :narrowed nil?) + (dissoc :narrowed) + (-> % :narrower nil?) + (dissoc :narrower))))))) + (defn spec-notes [{:as spec :keys [pprint-margin ns-form full-source-path] :or {pprint-margin pp/*print-right-margin*}}] @@ -471,12 +408,47 @@ *warn-on-reflection* *warn-on-reflection* *unchecked-math* *unchecked-math* pp/*print-right-margin* pprint-margin] - (-> (relevant-notes spec) - (complete-notes spec) - (with-out-err-captured) - (log-time (str "Evaluated " - (or (some-> ns-form second name) - (some-> full-source-path fs/file-name))))))) + (let [old (-> (notebook-old/spec-notes spec) + (->old-notes-approx)) + new (-> (assoc spec :collapse-comments-ws? true) + (relevant-notes) + (complete-notes spec) + (->new-notes-approx) + (log-time (str "Evaluated notebook with read-kinds " + (or (some-> ns-form second name) + (some-> full-source-path fs/file-name)))))] + ;; We can print the plain new and old notes.. + #_(diff/notes old new + :diff/to-repl :clojure/pprint + spec) + ;; ..or only differences + (diff/notes old new + :diff/to-repl :deep-diff2/minimal + spec) + ;; ..or only one difference + #_(diff/notes (take 1 old) (take 1 new) + :diff/to-repl :deep-diff2/minimal + spec) + ;; ..or write old and new files + #_(diff/notes old new + :diff/to-files :clojure/pprint + spec) + ;; ..or old, new and full diff files + #_(diff/notes old new + :diff/to-files :deep-diff2/full + spec) + ;; ..or old, new and minimal diffs, keeping only the last three runs + #_(diff/notes old new + :diff/to-files :deep-diff2/minimal + :diff/keep-dirs 3 + spec) + ;; ..or any combination of the above + #_(diff/notes old new + :diff/to-repl :deep-diff2/minimal + :diff/to-files :deep-diff2/full + :diff/keep-dirs 3 + spec) + new))) (defn items-and-test-forms [notes spec] diff --git a/src/scicloj/clay/v2/notebook_old.clj b/src/scicloj/clay/v2/notebook_old.clj new file mode 100644 index 00000000..2010b644 --- /dev/null +++ b/src/scicloj/clay/v2/notebook_old.clj @@ -0,0 +1,490 @@ +(ns scicloj.clay.v2.notebook-old + (:require [clojure.string :as str] + [clojure.pprint :as pp] + [babashka.fs :as fs] + [scicloj.clay.v2.util.path :as path] + [scicloj.clay.v2.item :as item] + [scicloj.clay.v2.prepare :as prepare] + [scicloj.clay.v2.read-old :as read] + [scicloj.kindly.v4.api :as kindly] + [scicloj.kindly-advice.v1.api :as kindly-advice]) + (:import (java.io StringWriter))) + +(set! *warn-on-reflection* true) + +(defn deref-if-needed [v] + (if (delay? v) + @v + v)) + +(def hidden-form-starters + #{'ns 'comment + 'def 'defonce 'defn 'defmacro + 'defrecord 'defprotocol 'deftype + 'extend-protocol 'extend + 'require}) + +(defn info-line [{:keys [full-source-path + remote-repo]}] + (let [relative-file-path (path/path-relative-to-repo full-source-path)] + (item/info-line {:path relative-file-path + :url (some-> remote-repo (path/file-git-url relative-file-path))}))) + +(defn narrowed? [code] + (some-> code + (str/includes? ",,"))) + +(defn narrower? [code] + (some-> code + (str/includes? ",,,"))) + +(defn ns-form? [form] + (and (sequential? form) + (-> form first (= 'ns)))) + +(defn str-and-reset! [w] + (when (instance? StringWriter *out*) + (locking w + (let [s (str w)] + (.setLength (.getBuffer ^StringWriter w) 0) + s)))) + +(def ^:dynamic *out-orig* *out*) + +(defn maybe-println-orig [s] + (when (seq s) + (binding [*out* *out-orig*] + (print s) + (flush)))) + +(def ^:dynamic *err-orig* *err*) + +(defn maybe-err-orig [s] + (when (seq s) + (binding [*out* *err-orig*] + (print s) + (flush)))) + +(defn read-eval-capture + "Captures stdout and stderr while evaluating a note" + [{:as note + :keys [code form]}] + (let [out (StringWriter.) + err (StringWriter.) + note (try + (let [x (binding [*out* out + *err* err] + (cond form (-> form + eval + deref-if-needed) + code (-> code + read-string + eval + deref-if-needed)))] + (assoc note :value x)) + (catch Throwable ex + (assoc note :exception ex))) + out-str (str out) + err-str (str err) + ;; A notebook may have also printed from a thread, + ;; *out* and *err* are replaced with StringWriters in with-out-err-capture + global-out (str-and-reset! *out*) + global-err (str-and-reset! *err*) + ;; Don't show output from requiring other namespaces + show (not (ns-form? form))] + (maybe-println-orig out-str) + (maybe-err-orig err-str) + (maybe-println-orig global-out) + (maybe-err-orig global-err) + (if show + (cond-> note + (seq out-str) (assoc :out out-str) + (seq err-str) (assoc :err err-str) + (seq global-out) (assoc :global-out global-out) + (seq global-err) (assoc :global-err global-err)) + note))) + +(defn complete [{:as note + :keys [comment?]}] + (let [completed (cond-> note + (not (or comment? (contains? note :value))) + (read-eval-capture))] + (cond-> completed + (and (not comment?) (contains? completed :value)) + (kindly-advice/advise)))) + +(defn comment->item [comment] + (-> comment + (str/split #"\n") + (->> (map #(-> % + (str/replace + #"^;+\s?" "") + (str/replace + #"^#" "\n#"))) + (str/join "\n")) + item/md)) + +(defn hide-code? [{:as note :keys [code form value kind narrowed]} {:as opts :keys [hide-code]}] + (or hide-code + narrowed + (-> form meta :kindly/hide-code) + (-> form meta :kindly/hide-code?) ; legacy convention + (-> value meta :kindly/hide-code) + (-> value meta :kindly/hide-code?) ; legacy convention + (when kind + (some-> note + :kindly/options + :kinds-that-hide-code + kind)) + (nil? code))) + +(defn hide-value? [{:as complete-note :keys [form value kind]} + {:as opts :keys [hide-nils hide-vars]}] + (or (and (sequential? form) + (-> form first hidden-form-starters)) + (= kind :kind/hidden) + (and hide-nils (nil? value)) + (and hide-vars (var? value)))) + +(defn side-by-side-items [{:as spec :keys [format]} code-item value-items] + ;; markdown grids are not structurally nested, but hiccup grids are + (if (= :quarto (first format)) + `[{:md "::: {.grid .clay-side-by-side}"} + {:md "::: {.g-col-6}"} + ~code-item + {:md ":::"} + {:md "::: {.g-col-6}"} + ~@value-items + {:md ":::"} + {:md ":::"}] + [{:hiccup [:div.grid + [:div.g-col-6 (:hiccup code-item)] + (->> (map #(prepare/item->hiccup % spec) value-items) + (into [:div.g-col-6]))] + :deps (set (mapcat :deps value-items))}])) + +(defn note-to-items [{:as note + :keys [comment? + code + exception + err + out + global-err + global-out + kindly/options]} + {:as opts}] + (if (and comment? code) + [(comment->item code)] + (let [code-item (when-not (hide-code? note opts) + (item/source-clojure code)) + {:keys [exception-continue]} opts + value-items (cond-> [] + err (conj (item/print-output "ERR" err)) + out (conj (item/print-output "OUT" out)) + global-err (conj (item/print-output "THREAD ERR" global-err)) + global-out (conj (item/print-output "THREAD OUT" global-out)) + exception (conj (item/print-throwable exception exception-continue)) + (and (contains? note :value) + (not (hide-value? note opts))) + (into (-> note + (update :value deref-if-needed) + (prepare/prepare-or-pprint))))] + (cond (and (not code-item) (empty? value-items)) + [] + + (not code-item) + value-items + + (empty? value-items) + [code-item] + + (= :horizontal (or (:code-and-value opts) + (:code-and-value options))) + (side-by-side-items opts code-item value-items) + + :else + (into [code-item] value-items))))) + +(defn add-info-line [items {:as spec :keys [hide-info-line]}] + (if hide-info-line + items + (let [il (info-line spec)] + (into items [item/separator il])))) + +(defn ->var-name [i line-number] + (symbol (str "v" i + "_l" line-number))) + +(defn ->test-name [i line-number] + (symbol (str "t" i + "_l" line-number))) + +(defn test-last? [complete-note] + (and (-> complete-note + :comment? + not) + (-> complete-note + :kind + (= :kind/test-last)))) + +(defn def-form [var-name form] + (list 'def + var-name + form)) + +(defn clean-test-last-form [form] + (case (str (first form)) + "kind/test-last" (second form) + "kindly/check" (rest form) + ;; else + form)) + +(defn var-based-deftest-form [test-name var-name form] + (let [[f-symbol & args] form] + (list 'deftest + test-name + (concat (list 'is + (concat (list f-symbol + var-name) + args)))))) + +(defn simple-deftest-form [test-name last-form form] + (let [[f-symbol & args] form] + (list 'deftest + test-name + (concat (list 'is + (concat (list f-symbol + last-form) + args)))))) + +(defn test-ns-form [[_ ns-symbol & rest-ns-form]] + (concat (list 'ns + (-> ns-symbol + (str "-generated-test") + symbol)) + (->> rest-ns-form + (map (fn [part] + (if (and (list? part) + (-> part first (= :require))) + (concat part + '[[clojure.test :refer [deftest is]]]) + part)))))) + +(defn first-line-of-change [code new-code] + (if code + (->> [code new-code] + (map str/split-lines) + (apply map =) + (take-while true?) + count) + 0)) + +(def *path->last (atom {})) + +(defn slurp-and-compare [path] + (swap! *path->last + update + path + (fn [{:keys [code]}] + (let [new-code (slurp path)] + {:code new-code + :first-line-of-change (first-line-of-change + code new-code)}))) + (@*path->last path)) + +(defmacro with-out-err-captured + "Evaluates and computes the items for a notebook of notes" + [& body] + ;; For a notebook, we capture output globally, and per note. + ;; see read-eval-capture for why this is relevant. + `(let [out# (StringWriter.) + err# (StringWriter.)] + ;; Threads may inherit only the root binding + (with-redefs [*out* out# + *err* err#] + ;; Futures will inherit the current binding, + ;; which was not affected by altering the root. + (binding [*out* out# + *err* err#] + ~@body)))) + +(defn itemize-notes + "Evaluates and computes the items for a notebook of notes" + [relevant-notes some-narrowed options] + (reduce (fn [{:as aggregation :keys [i + items + test-forms + last-nontest-varname + last-nontest-form]} + complete-note] + (let [{:keys [form region narrowed exception comment?]} complete-note + {:keys [test-mode]} (:kindly/options complete-note) + test-note (test-last? complete-note) + new-items (when (or (not some-narrowed) + narrowed) + (when-not test-note + (note-to-items complete-note options))) + line-number (first region) + varname (->var-name i line-number) + test-form (cond + ;; a deftest form + test-note (vary-meta + (let [test-name (->test-name i line-number) + ctlf (clean-test-last-form form)] + (case test-mode + :sequential (var-based-deftest-form + test-name + last-nontest-varname + ctlf) + :simple (simple-deftest-form + test-name + last-nontest-form + ctlf))) + assoc :test-mode test-mode) + ;; the test ns form + (ns-form? form) (test-ns-form form) + ;; a comment + comment? nil + ;; the regular case, just a def + :else (def-form varname form)) + step {:i (inc i) + :items (into items (remove nil?) new-items) + :test-forms (if test-form + (conj test-forms test-form) + test-forms) + :last-nontest-varname (if (or comment? test-note) + last-nontest-varname + varname) + :last-nontest-form (if (or comment? test-note) + last-nontest-form + form)}] + (if (and exception (not (:exception-continue options))) + (reduced (assoc step :exception exception)) + step))) + ;; initial value + {:i 0 + :items [] + :test-forms [] + :last-nontest-i nil} + ;; sequence + relevant-notes)) + +(defn complete-notes [notes options] + (let [opts (select-keys options + [:base-target-path + :full-target-path + :qmd-target-path + :kindly/options + :format])] + (doall + (for [note notes] + (complete (kindly/deep-merge opts note)))))) + +(defn relevant-notes [{:keys [full-source-path + single-form + single-value + smart-sync + pprint-margin] + :or {pprint-margin pp/*print-right-margin*}}] + (let [{:keys [code first-line-of-change]} (some-> full-source-path slurp-and-compare) + notes (->> (cond single-value (conj (when code + [{:form (read/read-ns-form code)}]) + {:value single-value}) + single-form (conj (when code + [{:form (read/read-ns-form code)}]) + {:form single-form}) + :else (read/->notes code)) + (map-indexed (fn [i {:as note + :keys [code]}] + (merge note + {:i i} + (when-not (:comment? note) + {:narrowed (narrowed? code) + :narrower (narrower? code)}))))) + some-narrowed (some :narrowed notes) + some-narrower (some :narrower notes) + narrowed-indices (when some-narrowed + (->> notes + (map (fn [{:keys [i narrowed]}] + (when narrowed i))) + (remove nil?))) + first-narrowed-index (first narrowed-indices) + last-narrowed-index (last narrowed-indices)] + (cond-> notes + some-narrower + (->> (filter (fn [{:keys [narrower form]}] + (or narrower + (ns-form? form))))) + + (and some-narrowed smart-sync) + (->> (take (inc last-narrowed-index)) + (filter (fn [{:keys [i code form region]}] + (or (ns-form? form) + (>= i first-narrowed-index) + (-> region + (nth 2) ;last region line + (> first-line-of-change))))))))) + +(defmacro log-time [expr msg] + `(let [start# (System/currentTimeMillis) + result# ~expr] + (println "Clay: " ~msg + "in" (/ (- (System/currentTimeMillis) start#) 1000.0) + "seconds") + result#)) + +(defn spec-notes [{:as spec + :keys [pprint-margin ns-form full-source-path] + :or {pprint-margin pp/*print-right-margin*}}] + (binding [*ns* *ns* + *warn-on-reflection* *warn-on-reflection* + *unchecked-math* *unchecked-math* + pp/*print-right-margin* pprint-margin] + (-> (relevant-notes spec) + (complete-notes spec) + (with-out-err-captured) + (log-time (str "Evaluated notebook old " + (or (some-> ns-form second name) + (some-> full-source-path fs/file-name))))))) + +(defn items-and-test-forms + [notes spec] + (let [some-narrowed (some :narrowed notes)] + (-> notes + (itemize-notes some-narrowed spec) + (update :items add-info-line spec) + (update :test-forms + ;; Leave the test-form only when + ;; at least one of them is a `deftest`. + (if some-narrowed + (constantly nil) + (fn [test-forms] + (let [deftest-forms (->> test-forms + (filter #(-> % first (= 'deftest))))] + (when ;; there are some actual test forms + (seq deftest-forms) + #_(prn [:test-forms test-forms + :deftest-forms deftest-forms + :check (->> deftest-forms + (map (comp :test-mode meta)) + (some #(= % :sequential)))]) + (if (->> deftest-forms + (map (comp :test-mode meta)) + (some #(= % :sequential))) + ;; Some tests are of `:sequential` mode, + ;; so we need all the intermediate `def` forms, + ;; not just the `deftest` forms. + test-forms + ;; Else - all tests are of `:simple` mode, + ;; so we only need the `ns` definition and the `deftest` forms. + (cons (first test-forms) + deftest-forms)))))))))) + + +(comment + (-> "notebooks/scratch.clj" + (notebook-items {:full-target-path "docs/scratch.html"})) + + (-> "notebooks/scratch.clj" + (notebook-items {:full-target-path "docs/scratch.html" + :single-form '(+ 1 2)}))) diff --git a/src/scicloj/clay/v2/read.clj b/src/scicloj/clay/v2/read.clj index 42873097..7c86b5c5 100644 --- a/src/scicloj/clay/v2/read.clj +++ b/src/scicloj/clay/v2/read.clj @@ -1,6 +1,9 @@ (ns scicloj.clay.v2.read (:require [scicloj.read-kinds.notes :as notes] - [scicloj.read-kinds.read :as read])) + [scicloj.read-kinds.read :as read] + [clojure.tools.reader] + [clojure.tools.reader.reader-types] + [clojure.string :as str])) ;; TODO: not sure if generation is necessary??? @@ -26,9 +29,44 @@ (-> form first (= 'ns))))) first)) -(defn ->notes [code] - (->> (read/read-string-all code) - (into [] notes/notebook-xform))) +(defn collapse-comments-ws [collapse-comments-ws? notes] + (if collapse-comments-ws? + (let [collapse (comp #{:kind/whitespace :kind/comment} :kind) + comment? (comp #{:kind/comment} :kind)] + (->> notes + (partition-by (comp boolean collapse)) + (mapcat + (fn [notes*] + (if (some comment? notes*) + ;; TODO Pulling in all comments and whitespace + ;; This is only done to easily get equality with old comments + [{:value (let [comment* (->> notes* + (map #(get % :value (:code %))) + str/join)] + (-> comment* + (str/replace #"^\s+" "") + (str/trim-newline))) + :kind :kind/comment}] + notes*))))) + notes)) + +;; TODO keep this or something like it +(defn ->notes [{:keys [single-form + single-value + code + collapse-comments-ws?]}] + (cond single-value (conj (when code + [{:form (read-ns-form code)}]) + {:value single-value}) + ;; TODO Doesn't actually eval the form + single-form (conj (when code + [{:form (read-ns-form code)}]) + {:form single-form}) + :else (->> code + (read/read-string-all) + (read/eval-ast) + (collapse-comments-ws collapse-comments-ws?) + (into [] notes/notebook-xform)))) ;; TODO: Not needed? read-kinds has a safe-notes wrapper already... (defn ->safe-notes [code] diff --git a/src/scicloj/clay/v2/read_old.clj b/src/scicloj/clay/v2/read_old.clj new file mode 100644 index 00000000..6fd6bcce --- /dev/null +++ b/src/scicloj/clay/v2/read_old.clj @@ -0,0 +1,135 @@ +(ns scicloj.clay.v2.read-old + (:require [clojure.tools.reader] + [clojure.tools.reader.reader-types] + [parcera.core :as parcera] + [clojure.string :as str])) + +(def *generation (atom 0)) + +(defn generation [] + (swap! *generation inc) + @*generation) + +(defn read-forms [code] + (->> code + clojure.tools.reader.reader-types/source-logging-push-back-reader + repeat + (map #(clojure.tools.reader/read % false ::EOF)) + (take-while (partial not= ::EOF)))) + + +(defn read-ns-form [code] + (->> code + read-forms + (filter (fn [form] + (and (sequential? form) + (-> form first (= 'ns))))) + first)) + +(defn read-by-tools-reader [code] + (-> code + ;; avoiding a tools.reader bug -- see: + ;; https://github.com/scicloj/clay/issues/151#issuecomment-2373488031 + (str/replace #"\r\n" "\n") + (->> read-forms + (map (fn [form] + (let [{:keys [line column + end-line end-column + code]} + (meta form)] + (when line ; skip forms with no location info + {:method :tools-reader + :region [line column + end-line end-column] + :code (-> form meta :source) + :form form})))) + (filter some?)))) + +(defn read-by-parcera [code] + (->> code + parcera/ast + rest + (map (fn [node] + (let [node-type (first node) + node-contents (rest node)] + ;; We use parcera only for specific types of + ;; code blocks, that tools.reader does not + ;; provide location info for. + (some->> (when (#{:number :string :symbol :keyword :comment} + node-type) + {:code (first node-contents)}) + (merge {:method :parcera + :region (->> node + meta + ((juxt :parcera.core/start + :parcera.core/end)) + (mapcat (juxt :row + (comp inc + :column))) + vec)} + (when (= :comment node-type) + {:comment? true})))))) + (filter some?))) + +(defn unified-cleaned-comment-block [comment-blocks-sorted-by-region] + {:region (vec (concat (->> comment-blocks-sorted-by-region + first + :region + (take 2)) + (->> comment-blocks-sorted-by-region + last + :region + (drop 2)))) + :code (->> comment-blocks-sorted-by-region + (reduce (fn [{:keys [generated-string max-line]} + {:keys [region code]}] + {:generated-string (str generated-string + (apply str (-> region + first + (- max-line) + (repeat "\n"))) + code) + :max-line (-> region + (nth 2) + (max max-line))}) + {:generated-string "" + :max-line (->> comment-blocks-sorted-by-region + first + :region + first)}) + :generated-string) + :comment? true}) + +(defn ->notes [code] + (->> code + ((juxt read-by-tools-reader read-by-parcera)) + (apply concat) + (group-by :region) + (map (fn [[region results]] + (if (-> results count (= 1)) + (first results) + ;; prefer tools.reader over parcera + (->> results + (filter #(-> % :method (= :tools-reader))) + first)))) + (sort-by :region) + (map #(dissoc % :method)) + (partition-by :comment?) + (mapcat (fn [part] + (if (-> part first :comment?) + [(unified-cleaned-comment-block part)] + part))) + (mapv (let [g (generation)] + (fn [note-data] + (-> note-data + (assoc :gen g))))))) + + +(defn ->safe-notes [code] + (try + (->notes code) + (catch Exception e + (println :invalid-notes (-> e + Throwable->map + (select-keys [:cause :data]))) + nil))) diff --git a/src/scicloj/clay/v2/util/diff.clj b/src/scicloj/clay/v2/util/diff.clj new file mode 100644 index 00000000..d4513355 --- /dev/null +++ b/src/scicloj/clay/v2/util/diff.clj @@ -0,0 +1,102 @@ +(ns scicloj.clay.v2.util.diff + (:require [clojure.string :as str] + [clojure.pprint :as pp] + [babashka.fs :as fs] + [lambdaisland.deep-diff2 :as ddiff] + [scicloj.clay.v2.util.diff.prep :as prep-diff])) + +(defn- print-diffs [diff-print-fn note-diffs] + (doseq [diff note-diffs] + (when (some-> diff ddiff/minimize not-empty) + (diff-print-fn diff)))) + +(defn- diff-print-fn [k] + (case k + :deep-diff2/full ddiff/pretty-print + :deep-diff2/minimal (comp ddiff/pretty-print + ddiff/minimize) + nil)) + +(defn- write-diff-files [old new note-diffs diff-print-fn print-fn + {:diff/keys [keep-dirs + timestamp] + :keys [full-source-path] + :as spec}] + (let [diffs-base-path (fs/absolutize "read-kinds-diffs") + source-name (-> full-source-path (str/replace "/" ".")) + diffs-path (-> diffs-base-path + (fs/path (str source-name "~" timestamp))) + diff-base-file (->> source-name + (fs/path diffs-path) + str) + no-diff-file (str diff-base-file ".no-diff") + diff-file (str diff-base-file ".diff.edn") + old-file (str diff-base-file ".old.edn") + new-file (str diff-base-file ".new.edn")] + (fs/create-dirs diffs-path) + (when (number? keep-dirs) + (let [diff-dirs (->> (fs/list-dir diffs-base-path + #(fs/directory? % {:nofollow-links true})) + (sort-by fs/last-modified-time))] + (doseq [dir (take (max 0 (inc (- (count diff-dirs) keep-dirs))) + diff-dirs)] + (when (= (fs/parent dir) diffs-base-path) + (fs/delete-tree dir))))) + (if (some not-empty (ddiff/minimize note-diffs)) + (when diff-print-fn + (println "Clay: Creating diff file" diff-file "& old/new") + (spit diff-file (with-out-str + (print-diffs diff-print-fn note-diffs)))) + (do (println "Clay: Creating no-diff file" no-diff-file "& old/new") + (spit no-diff-file "no difference"))) + (spit old-file (with-out-str (print-fn old))) + (spit new-file (with-out-str (print-fn new))) + (println "Clay: Copying latest diff files to" (str diffs-base-path)) + (doseq [file (fs/list-dir diffs-base-path + #(fs/regular-file? % {:nofollow-links true}))] + (fs/delete file)) + (doseq [file (fs/list-dir diffs-path + #(fs/regular-file? % {:nofollow-links true}))] + (fs/copy file diffs-base-path)))) + +(defn- pad-notes [old new] + (let [pad-to #(take (max 0 (- (count %1) (count %2))) (repeat {}))] + [(into [] (concat old (pad-to new old))) + (into [] (concat new (pad-to old new)))])) + +(defn notes [old new & {:diff/keys [to-files + to-repl + timestamp] + :as spec}] + (assert (or to-files to-repl) "Please pick an output option") + (assert timestamp "Should be assoc'd to spec in scicloj.clay.v2.make/make!") + (let [[old new] (prep-diff/replace-undiffable (pad-notes old new)) + note-diffs (mapv ddiff/diff old new) + file-diff-print-fn (case to-files + (:deep-diff2/full :deep-diff2/minimal) + (diff-print-fn to-files) + ;; No diff, but we always write old/new + ;; when to-files is specified + (:clojure/pprint nil) nil) + print-fn pp/pprint + repl-print-fn (case to-repl + (:deep-diff2/full :deep-diff2/minimal) + #(print-diffs (diff-print-fn to-repl) note-diffs) + :clojure/pprint #(doseq [[old* new*] (map vector old new)] + (println "--------- old: ") + (print-fn old*) + (println "--------- new: ") + (print-fn new*)) + nil nil)] + (when to-repl + (println "Clay: Notes diff start") + (let [diff (some not-empty (ddiff/minimize note-diffs))] + (when-not diff + (println "Clay: >>>> No difference!")) + (repl-print-fn) + ;; Add note on no difference at the end too when printing all data + (when (and (= to-repl :clojure/pprint) (not diff)) + (println "Clay: >>>> No difference!"))) + (println "Clay: Notes diff end")) + (when to-files + (write-diff-files old new note-diffs file-diff-print-fn print-fn spec)))) diff --git a/src/scicloj/clay/v2/util/diff/prep.clj b/src/scicloj/clay/v2/util/diff/prep.clj new file mode 100644 index 00000000..13b7d309 --- /dev/null +++ b/src/scicloj/clay/v2/util/diff/prep.clj @@ -0,0 +1,65 @@ +(ns scicloj.clay.v2.util.diff.prep + (:require [clojure.walk :as walk] + [clojure.string :as str])) + +(defprotocol DiffableBaseType + (diffable-base-type? [this])) + +(extend-protocol DiffableBaseType + java.util.Set + (diffable-base-type? [_] true) + java.util.Map + (diffable-base-type? [_] true) + java.util.List + (diffable-base-type? [_] true)) + +(defn type-str [x] + (-> x type pr-str)) + +(defn describe-type [t] + (type-str t)) + +(declare replaced-value=) + +(defprotocol PReplacedValue + (value? [this])) + +(deftype ReplacedValue [value value-type] + PReplacedValue + (value? [_] + (= (describe-type value) value-type)) + + Object + (equals [this other] + (or (not (value? this)) + (replaced-value= this other))) + (hashCode [this] + (hash-combine (hash value-type) + (if (value? this) + (hash value) + value))) + (toString [this] + (pr-str (.hashCode this) + value-type))) + +(defn replaced-value= [^ReplacedValue this other] + (and (instance? ReplacedValue this) + (instance? ReplacedValue other) + (= (.-value-type this) (.-value-type ^ReplacedValue other)) + (= (.-value this) (.-value ^ReplacedValue other)))) + +(defn diffable-type? [x] + (let [x-type-str (type-str x)] + (some (partial String/.startsWith x-type-str) + ["java.util" + "clojure.lang"]))) + +(defn replace-undiffable* [x] + (if (and (satisfies? DiffableBaseType x) + (diffable-base-type? x) + (not (diffable-type? x))) + (->ReplacedValue x (describe-type x)) + x)) + +(defn replace-undiffable [notes] + (walk/prewalk replace-undiffable* notes))