diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index a12835e..881aeee 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/jolt-core/clojure/core/20-coll.clj @@ -519,7 +519,11 @@ ;; via the host dir primitives. Paths (strings), not File objects. (Lives below ;; tree-seq: forward references are analysis errors now — jolt-2o7.3.) (defn file-seq [root] - (tree-seq __dir? __list-dir root)) + (if (__file? root) + ;; java.io.File tree: walk via the File method surface so leaves are File + ;; values callers can invoke .isFile/.getName/slurp on (jolt-hjw). + (tree-seq (fn [f] (.isDirectory f)) (fn [f] (seq (.listFiles f))) root) + (tree-seq __dir? __list-dir root))) ;; Canonical flatten via tree-seq: the leaves (non-sequential nodes) in order. ;; Flattens lists too (sequential?), matching Clojure/CLJS. diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index db7e113..a786c3b 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -21,8 +21,15 @@ ;; clojure.core fns) so they compile as plain invokes. name/mm are passed quoted; ;; the dispatch fn, options, and dispatch value evaluate normally, and the method ;; body becomes a compiled (fn …). -(defmacro defmulti [name dispatch & opts] - `(defmulti-setup (quote ~name) ~dispatch ~@opts)) +;; Clojure allows (defmulti name docstring? attr-map? dispatch-fn & options); +;; drop a leading docstring and/or attr-map so the dispatch fn isn't mistaken for +;; one (migratus's multimethods carry docstrings). +(defmacro defmulti [name & args] + (let [args (if (string? (first args)) (rest args) args) + args (if (and (map? (first args)) (not (symbol? (first args)))) (rest args) args) + dispatch (first args) + opts (rest args)] + `(defmulti-setup (quote ~name) ~dispatch ~@opts))) (defmacro defmethod [mm dispatch-val & fn-tail] `(defmethod-setup (quote ~mm) ~dispatch-val (fn ~@fn-tail))) @@ -39,11 +46,14 @@ (defmacro remove-all-methods [mm] `(remove-all-methods-setup (quote ~mm))) +;; methods/get-method take the multimethod VALUE (Clojure semantics); the setup +;; maps it back to its var via the registry, so a bare multifn ref works from a +;; compiled fn in any namespace (jolt multimethod table-visibility fix). (defmacro get-method [mm dval] - `(get-method-setup (quote ~mm) ~dval)) + `(get-method-setup ~mm ~dval)) (defmacro methods [mm] - `(methods-setup (quote ~mm))) + `(methods-setup ~mm)) ;; prefers reads the store off the VAR (the multifn value can't carry it) — ;; same symbol-passing shape as the other multimethod table ops. diff --git a/src/jolt/clojure/java/io.clj b/src/jolt/clojure/java/io.clj index 4d180dd..7f87a4c 100644 --- a/src/jolt/clojure/java/io.clj +++ b/src/jolt/clojure/java/io.clj @@ -6,11 +6,13 @@ ; …) won't work, but file/reader/writer/resource/copy/slurp do. (defn file - "A file path. With a parent and child, joins them with '/'." - ([path] (str path)) - ([parent child] (str parent "/" child))) + "A java.io.File. With a parent and child, joins them with '/'. Returns a + :jolt/file value (instance? File true) with the File method surface; str/slurp + and io/reader coerce it back to its path." + ([path] (__make-file path)) + ([parent child] (__make-file parent child))) -(defn as-file [x] (str x)) +(defn as-file [x] (if (__file? x) x (__make-file x))) (defn reader [x] (cond diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 039a37c..555c84f 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -541,7 +541,10 @@ result) (do (var result @{}) (when m (each k (keys m) (put result k (get m k)))) (var i 0) (while (< i (length kvs)) (let [k (kvs i) v (kvs (+ i 1))] (put result k v) (+= i 2))) - (if (struct? m) (table/to-struct result) result)))))) + # nil assocs to a fresh immutable map ((assoc nil :a 1) => {:a 1}); a + # raw table here would not count?/seq like a Clojure map (assoc-in into + # an absent key recurses through nil — migratus's migration maps). + (if (or (struct? m) (nil? m)) (table/to-struct result) result)))))) (defn core-dissoc [m & ks] (cond @@ -1656,6 +1659,8 @@ (if (v :ns) (string (v :ns) "/" (v :name)) (v :name)) (and (struct? v) (= :jolt/uuid (v :jolt/type))) (v :str) (and (struct? v) (= :jolt/inst (v :jolt/type))) (inst->rfc3339 v) + # a java.io.File renders as its path (Clojure's File.toString) + (and (table? v) (= :jolt/file (get v :jolt/type))) (get v :path) (= :jolt/namespace (get v :jolt/type)) (ns-display-name v) (and (table? v) (= :jolt/var (get v :jolt/type))) (var-display v) (number? v) (fmt-number v) @@ -1744,6 +1749,19 @@ (defn core-jdbc-make-stmt [w] @{:jolt/type :jolt/jdbc-stmt :exec (get w :exec) :cmds @[]}) +# java.io.File model (jolt-hjw). io/file and (File. …) build a tagged :jolt/file +# value so (instance? File x) works and migratus's File-vs-jar branching takes +# the filesystem path. The File method surface + nio glob live in javatime; here +# are the constructor/predicate builtins and the path coercion str/slurp use. +(defn core-file-path + "The path string of a :jolt/file, or (string x) for anything else." + [x] + (if (and (table? x) (= :jolt/file (get x :jolt/type))) (get x :path) (string x))) +(defn core-make-file [path &opt child] + (def base (core-file-path path)) + @{:jolt/type :jolt/file :path (if child (string base "/" (core-file-path child)) base)}) +(defn core-file? [x] (and (table? x) (= :jolt/file (get x :jolt/type)))) + # newline lives in the Clojure collection tier (core/20-coll.clj). # Clojure 1.11 string->scalar parsers: nil on malformed input, throw on a @@ -1787,6 +1805,7 @@ # bodies, and the jolt Ring adapter hands those over as StringReaders. (defn core-slurp [src & opts] (cond + (core-file? src) (string (slurp (core-file-path src))) (and (table? src) (string? (get src :s)) (number? (get src :pos))) (let [s (src :s) p (src :pos)] (put src :pos (length s)) @@ -1799,7 +1818,7 @@ (when (and (= :append (in opts i)) (in opts (+ i 1))) (set a true)) (+= i 2)) a)) - (def f (file/open path (if append? :a :w))) + (def f (file/open (core-file-path path) (if append? :a :w))) (file/write f (str-render-one content)) (file/close f) nil) @@ -2731,6 +2750,8 @@ "__jdbc-wrap-conn" core-jdbc-wrap-conn "__jdbc-conn-raw" core-jdbc-conn-raw "__jdbc-make-stmt" core-jdbc-make-stmt + "__make-file" core-make-file + "__file?" core-file? "__pr-str1" core-pr-str1 "__make-uuid" make-uuid "compare" core-compare diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 1c654ac..e55ddf0 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -1197,6 +1197,13 @@ (ns-unmap ns (if (and (struct? sym) (= :symbol (sym :jolt/type))) (sym :name) (string sym)))))) nil) +# Multimethod value -> its var. methods/get-method take the multimethod VALUE +# (Clojure semantics) and recover the var (hence :jolt/methods) through this, +# which works from a compiled fn in any namespace — resolving the symbol at call +# time in the current ns did not (a bare multifn ref in its defining ns saw an +# empty table once defmethods lived in other namespaces; migratus hit this). +(def multi-registry @{}) + (defn defmulti-setup "(defmulti name dispatch & opts) — intern a multimethod var. A fn; name arrives quoted, dispatch + opts (:default key, :hierarchy h) arrive evaluated. The @@ -1292,6 +1299,7 @@ (put v :jolt/dispatch-cache dispatch-cache) (put v :jolt/default default-key) (when hierarchy (put v :jolt/hierarchy hierarchy)) + (put multi-registry mm-fn v) (var-get v)) (defn defmethod-setup @@ -1301,9 +1309,11 @@ [ctx mm-sym dispatch-val impl] (def mm-var (or (resolve-var ctx @{} mm-sym) - (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] - (def v (ns-intern ns (mm-sym :name) (fn [& args] nil))) + (let [ns (ctx-find-ns ctx (ctx-current-ns ctx)) + stub (fn [& args] nil)] + (def v (ns-intern ns (mm-sym :name) stub)) (put v :jolt/methods @{}) + (put multi-registry stub v) v))) (def methods (or (get mm-var :jolt/methods) (let [m @{}] (put mm-var :jolt/methods m) m))) # nil is a legal dispatch value (ring's body-string keys a method on it); @@ -1470,8 +1480,10 @@ found (when auto-create? (def ns (ctx-find-ns ctx (ctx-current-ns ctx))) - (def nv (ns-intern ns (mm-sym :name) (fn [& args] nil))) + (def stub (fn [& args] nil)) + (def nv (ns-intern ns (mm-sym :name) stub)) (put nv :jolt/methods @{}) + (put multi-registry stub nv) nv)))) (def clear-dispatch-cache! (fn [mm-var] (let [dc (get mm-var :jolt/dispatch-cache)] @@ -1510,16 +1522,21 @@ (fn [mm-sym] (def mm-var (mm-var-of mm-sym false)) (or (and mm-var (get mm-var :jolt/prefers)) {}))) + # methods/get-method receive the multimethod VALUE (Clojure semantics): map it + # back to its var via multi-registry. A symbol arg still works (mm-var-of), for + # any caller that passes one. + (def mm-var-of-val (fn [mm] + (if (function? mm) (get multi-registry mm) (mm-var-of mm false)))) (ns-intern core "get-method-setup" - (fn [mm-sym dval] + (fn [mm dval] (def dval (if (nil? dval) :jolt/nil-sentinel dval)) - (def mm-var (mm-var-of mm-sym false)) + (def mm-var (mm-var-of-val mm)) (when mm-var (let [methods (get mm-var :jolt/methods)] (or (get methods dval) (get methods :default)))))) (ns-intern core "methods-setup" - (fn [mm-sym] - (def mm-var (mm-var-of mm-sym false)) + (fn [mm] + (def mm-var (mm-var-of-val mm)) (when mm-var # a jolt map, not the live host table (and phm so vector dispatch # values look up by value, same reason build-eval-map promotes) @@ -1588,6 +1605,10 @@ # branch, so the wrapped conn must answer true here. "Connection" (and (table? val) (= :jolt/jdbc-conn (get val :jolt/type))) "java.sql.Connection" (and (table? val) (= :jolt/jdbc-conn (get val :jolt/type))) + # java.io.File model (jolt-hjw): io/file and (File. …) build :jolt/file, + # so migratus's (instance? File migration-dir) takes the filesystem path. + "File" (and (table? val) (= :jolt/file (get val :jolt/type))) + "java.io.File" (and (table? val) (= :jolt/file (get val :jolt/type))) # JVM char[] class — (Class/forName "[C"); jolt char arrays are Janet # arrays of char structs "[C" (and (array? val) diff --git a/src/jolt/javatime.janet b/src/jolt/javatime.janet index 457de78..d4d718b 100644 --- a/src/jolt/javatime.janet +++ b/src/jolt/javatime.janet @@ -537,6 +537,15 @@ # that walks Thread/currentThread doesn't crash. (register-tagged-methods! :jolt/thread @{"getContextClassLoader" (fn [self] @{:jolt/type :jolt/classloader})}) + # ClassLoader degrade (jolt-hjw): there is no classpath, so getResource returns + # nil and migratus's find-migration-dir falls through to the filesystem branch + # (resources/