diff --git a/README.md b/README.md index 401f260..c74f50a 100644 --- a/README.md +++ b/README.md @@ -138,7 +138,13 @@ function expecting a tuple needs an explicit conversion. The `jolt.interop`, This bridge is what makes networking (and everything else in Janet's stdlib) available to ordinary Clojure — for example, `jolt.nrepl` (below) is plain -Clojure over `janet.net/*`. +Clojure over `janet.net/*`. It also reaches any **jpm-installed module**: +the first reference to `janet./` requires the module from the +janet module path and caches its bindings — so after `jpm install spork`, +`janet.spork.http/*` just works. The `jolt.http` client and the Ring adapter +in [examples/ring-app](https://github.com/jolt-lang/examples/tree/main/ring-app) +are built on spork/http this way, and a project can declare the requirement +in `deps.edn` with a `:jpm/module` coordinate (see docs/tools-deps.md). ```clojure (require '[jolt.interop :as j]) diff --git a/docs/libraries.md b/docs/libraries.md index 574a2b1..522a89e 100644 --- a/docs/libraries.md +++ b/docs/libraries.md @@ -8,3 +8,7 @@ Libraries confirmed to load and pass their conformance checks on Jolt * [Selmer](https://github.com/yogthos/Selmer) * [medley](https://github.com/weavejester/medley) * [cuerdas](https://github.com/funcool/cuerdas) +* [ring-core](https://github.com/ring-clojure/ring) — via `:deps/root "ring-core"`, + on the [ring-app example](https://github.com/jolt-lang/examples/tree/main/ring-app)'s + spork/http adapter +* [ring-codec](https://github.com/ring-clojure/ring-codec) diff --git a/docs/tools-deps.md b/docs/tools-deps.md index ff074bb..04a062b 100644 --- a/docs/tools-deps.md +++ b/docs/tools-deps.md @@ -107,3 +107,23 @@ a regex feature like Unicode property classes (`\p{…}`). - **Compiling deps into a binary image.** `uberscript` already produces a standalone `.clj`; baking a project's dependencies directly into a custom executable image is a heavier variant that isn't implemented. + +## Janet dependencies: `:jpm/module` + +A jolt project can depend on janet libraries. jpm owns their installation; +`deps.edn` declares the requirement and `jolt-deps` verifies it at resolve +time: + +```clojure +:deps {janet/spork-http {:jpm/module "spork/http" + :jpm/install "spork"}} +``` + +- `:jpm/module` — the janet module path that must be importable. +- `:jpm/install` (optional) — the jpm package to install when it isn't; + `jolt-deps` runs `jpm install ` once, then re-checks. Without it the + resolve fails with the install hint. + +A `:jpm/module` dep contributes no source roots. At runtime the `janet.*` +interop bridge autoloads the module on first reference +(`janet.spork.http/server`, …), so nothing else is needed. diff --git a/jolt-core/clojure/core/00-syntax.clj b/jolt-core/clojure/core/00-syntax.clj index 1cd83e8..f3851df 100644 --- a/jolt-core/clojure/core/00-syntax.clj +++ b/jolt-core/clojure/core/00-syntax.clj @@ -293,6 +293,13 @@ (defmacro fn [& raw] (let [nm (if (symbol? (first raw)) (first raw) nil) aftn (if nm (next raw) raw) + ;; a return-type hint (defn f ^bytes [x] ...) reaches us as a + ;; (with-meta [x] {:tag ...}) FORM in params position — unwrap it + ;; (the hint means nothing on jolt; ring-codec carries several). + unhint (fn* [x] + (if (if (seq? x) (= 'with-meta (first x)) false) + (nth x 1) + x)) md (fn* go [ps nps lets] (if (seq ps) (if (symbol? (first ps)) @@ -303,15 +310,21 @@ (go (next ps) (conj nps g) (conj (conj lets (first ps)) g)))) [nps lets])) mk (fn* [sig] - (let [r (md (seq (first sig)) [] [])] - (if (empty? (nth r 1)) + (let [ps (unhint (first sig)) + hinted (not (= ps (first sig))) + r (md (seq ps) [] [])] + (if (if (empty? (nth r 1)) (not hinted) false) sig ;; build the params/let vectors via [~@..] so they are tuple forms ;; (the accumulators are plain seqs, the wrong representation). + ;; A hinted-but-undestructured arity also rebuilds, to shed the + ;; with-meta wrapper without changing the clause representation. (let [pv `[~@(nth r 0)] lv `[~@(nth r 1)]] - `(~pv (let ~lv ~@(rest sig)))))))] - (if (vector? (first aftn)) + (if (empty? (nth r 1)) + `(~pv ~@(rest sig)) + `(~pv (let ~lv ~@(rest sig))))))))] + (if (vector? (unhint (first aftn))) (let [a (mk aftn)] (if nm `(fn* ~nm ~@a) `(fn* ~@a))) (let [as (vec (map mk aftn))] diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 2fd1be6..84de98c 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -252,8 +252,9 @@ ;; Group a flat seq that starts with a head symbol followed by its list specs ;; into [[head spec spec ...] ...] runs. Used by extend-protocol and defrecord. (defn- group-by-head [items] + ;; nil is a valid extension head (extend-protocol P ... nil (m [x] ...)). (reduce (fn [acc x] - (if (symbol? x) + (if (or (symbol? x) (nil? x)) (conj acc [x]) (conj (pop acc) (conj (peek acc) x)))) [] items)) @@ -347,9 +348,10 @@ (defmacro extend-type [tsym psym & impls] ;; register-method is a fn (clojure.core); pass type/protocol/method NAMES as - ;; strings (not the symbols) so the call compiles as a plain invoke. + ;; strings (not the symbols) so the call compiles as a plain invoke. A nil + ;; type extends on nil values (the host tag is the string "nil"). `(do ~@(map (fn [spec] - `(register-method ~(name tsym) ~(name psym) ~(name (first spec)) + `(register-method ~(if (nil? tsym) "nil" (name tsym)) ~(name psym) ~(name (first spec)) (fn* ~(nth spec 1) ~@(drop 2 spec)))) impls))) diff --git a/src/jolt/api.janet b/src/jolt/api.janet index c4c4ee5..08851da 100644 --- a/src/jolt/api.janet +++ b/src/jolt/api.janet @@ -281,7 +281,11 @@ # non-ctx value, so check the shape, not just the throw. (when (and (r 0) (ctx? (r 1))) (r 1))))] - (or loaded + (or (when loaded + # per-PROCESS wiring an image restore skips: the renderer's + # print-method hook lives in module state, not the marshaled ctx + (install-print-method-cb! loaded) + loaded) (let [ctx (init opts) tmp (string path "." (os/getpid) ".tmp")] # Atomic publish so concurrent cold starts never see a torn image. diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 571bd98..50cf35b 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -1108,7 +1108,13 @@ (if (= 0 (length c)) (f) (reduce-with-reduced f (in c 0) (array/slice c 1)))))) 3 (let [f (args 0) val (args 1) coll (args 2)] - (reduce-with-reduced f val coll)) + # reify clojure.lang.IReduceInit: the reified value carries its own + # reduce — call it (ring.util.codec's tokenizer reduces this way) + (if-let [m (and (table? coll) + (get coll :jolt/protocol-methods) + (get (get coll :jolt/protocol-methods) :reduce))] + (m coll f val) + (reduce-with-reduced f val coll))) (error "Wrong number of args passed to: reduce")))) (defn core-take [n & rest] @@ -1723,7 +1729,17 @@ (defn core-current-time-ms [] (* 1000 (os/clock :monotonic))) # Host IO (host-classified in the spec): path-based slurp/spit, *out* flush. -(defn core-slurp [path] (string (slurp path))) +# Opts (:encoding ...) are accepted and ignored — everything is UTF-8 here. +# Reader shims (java.io.StringReader / PushbackReader / anything carrying +# :s + :pos) DRAIN instead of opening a file: Ring middleware slurps request +# bodies, and the jolt Ring adapter hands those over as StringReaders. +(defn core-slurp [src & opts] + (cond + (and (table? src) (string? (get src :s)) (number? (get src :pos))) + (let [s (src :s) p (src :pos)] + (put src :pos (length s)) + (string/slice s p)) + (string (slurp src)))) (defn core-spit [path content & opts] (def append? (do (var a false) (var i 0) diff --git a/src/jolt/deps.janet b/src/jolt/deps.janet index 23ffaba..0473a75 100644 --- a/src/jolt/deps.janet +++ b/src/jolt/deps.janet @@ -73,6 +73,26 @@ (get x :name)) (string x))) + +(defn- ensure-jpm-dep + "A :jpm/module dep declares a janet module installed through jpm (e.g. + spork/http). jolt-deps doesn't manage janet packages — jpm does — so this + just verifies the module is importable, optionally running `jpm install + <:jpm/install>` once when it isn't, and fails with the install hint + otherwise. Contributes no source roots; the janet.* bridge autoloads the + module at first use." + [lib spec] + (def mod (get spec :jpm/module)) + (defn importable? [] ((protect (require mod)) 0)) + (unless (importable?) + (when-let [pkg (get spec :jpm/install)] + (eprintf "jolt-deps: %s: jpm module %s missing — running `jpm install %s`" + (sym-name lib) mod pkg) + (os/execute ["jpm" "install" pkg] :p)) + (unless (importable?) + (errorf "%s: janet module %s is not importable. Install it with `jpm install %s` (jolt-deps leaves janet packages to jpm)." + (sym-name lib) mod (or (get spec :jpm/install) mod))))) + (defn- merge-by-name [a b] # union of symbol-keyed dictionaries, b wins (def out @{}) (each m [a b] (when (dictionary? m) (eachp [k v] m (put out (sym-name k) v)))) @@ -165,7 +185,8 @@ (and (deep= (get a :local/root) (get b :local/root)) (deep= (get a :git/url) (get b :git/url)) (deep= (get a :git/sha) (get b :git/sha)) - (deep= (get a :git/tag) (get b :git/tag)))) + (deep= (get a :git/tag) (get b :git/tag)) + (deep= (get a :jpm/module) (get b :jpm/module)))) (def queue @[]) (defn discover [lib spec base-dir] (def k (sym-name lib)) @@ -175,9 +196,16 @@ k (coord-str prev) (coord-str spec))) (do (put seen k spec) + (when (and (dictionary? spec) (get spec :jpm/module)) + (ensure-jpm-dep lib spec)) (def dir (cond - (and (dictionary? spec) (get spec :git/url)) (clone-git spec) + (and (dictionary? spec) (get spec :git/url)) + # :deps/root (tools.deps): the project lives in a subdirectory + # of the repo — monorepos like ring-clojure/ring. + (let [cloned (clone-git spec) + root (get spec :deps/root)] + (if root (string cloned "/" root) cloned)) (and (dictionary? spec) (get spec :local/root)) (let [lr (get spec :local/root)] (if (string/has-prefix? "/" lr) lr (string base-dir "/" lr))) diff --git a/src/jolt/deps_cli.janet b/src/jolt/deps_cli.janet index 28d9834..0da62fa 100644 --- a/src/jolt/deps_cli.janet +++ b/src/jolt/deps_cli.janet @@ -34,13 +34,28 @@ (defn- roots [aliases] (if (os/stat "deps.edn") (deps/resolve-deps-cached "deps.edn" nil aliases) @[])) +(defn- jolt-bin + "The jolt executable: $JOLT_BIN, else the `jolt` sitting NEXT TO this + jolt-deps binary (the pair is built together — running a checkout's + build/jolt-deps by path must not pick up some other jolt, or fail when + none is on PATH), else `jolt` from PATH." + [] + (or (os/getenv "JOLT_BIN") + (let [self (or (first (dyn :args)) (dyn :executable)) + slashes (when self (string/find-all "/" self)) + dir (when (and slashes (> (length slashes) 0)) + (string/slice self 0 (last slashes))) + sibling (when dir (string dir "/jolt"))] + (when (and sibling (os/stat sibling)) sibling)) + "jolt")) + (defn- exec-jolt [aliases extra-args] # Set JOLT_PATH in our own env and let the child inherit it (os/execute's env # arg isn't honored here; inheriting is reliable). (def rs (string/join (roots aliases) ":")) (def existing (os/getenv "JOLT_PATH")) (os/setenv "JOLT_PATH" (if (and existing (> (length existing) 0)) (string rs ":" existing) rs)) - (os/execute [(os/getenv "JOLT_BIN" "jolt") ;extra-args] :p)) + (os/execute [(jolt-bin) ;extra-args] :p)) (defn- usage [] (print "usage: jolt-deps [-A:alias[:alias]] [path | run FILE [args] | repl | -e EXPR [args]]") diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 4379ba4..767a919 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -13,6 +13,31 @@ # the janet/* interop bridge falls back to it inside env-less fibers. (def- module-load-env (fiber/getenv (fiber/current))) +# jpm-module autoload: a janet./ reference whose module isn't +# in the env is satisfied by requiring it from the jpm module path on first +# use — (janet.spork.http/server ...) just works when spork is installed, +# and the same goes for any jpm module. Loaded bindings are cached here +# (and failures negatively cached, so a missing module errors fast). +(def- janet-bridge-extras @{}) +(def- janet-bridge-failed @{}) +(defn- bridge-autoload + "jname is spork.http/server-shaped: require spork/http, cache its public + bindings under the dotted prefix, return the one asked for (nil when the + module is missing or has no such binding)." + [jname] + (def slash (string/find "/" jname)) + (when slash + (def mod-ns (string/slice jname 0 slash)) + (unless (get janet-bridge-failed mod-ns) + (def mod-path (string/replace-all "." "/" mod-ns)) + (def r (protect (require mod-path))) + (if (r 0) + (eachp [sym entry] (r 1) + (when (and (symbol? sym) (table? entry) (not (get entry :private))) + (put janet-bridge-extras (string mod-ns "/" sym) (get entry :value)))) + (put janet-bridge-failed mod-ns true)))) + (in janet-bridge-extras jname)) + (defn- sym-name? [sym-s name-str] (and (struct? sym-s) (= :symbol (sym-s :jolt/type)) (= name-str (sym-s :name)))) @@ -501,17 +526,60 @@ # ctor fns are interned as clojure.core vars at init (install-stateful-fns!). (def class-ctors @{}) (defn register-class-ctor! [nm f] (put class-ctors nm f)) +# Class names evaluate to their CANONICAL NAME STRING — the same value +# core-class returns — so (defmethod m String ...) keys match a +# (defmulti m (comp class :body)) dispatch (ring.util.request does this). +# `new` resolves the actual constructor from class-ctors by short name. +(def- class-canonical-names + @{"String" "java.lang.String" "Number" "java.lang.Number" + "Boolean" "java.lang.Boolean" "Long" "java.lang.Long" + "Integer" "java.lang.Integer" "Double" "java.lang.Double" + "InputStream" "java.io.InputStream" "OutputStream" "java.io.OutputStream" + "File" "java.io.File" "Reader" "java.io.Reader" "Writer" "java.io.Writer" + "ISeq" "clojure.lang.ISeq" "Keyword" "clojure.lang.Keyword" + "Symbol" "clojure.lang.Symbol" "MapEntry" "clojure.lang.MapEntry" + "StringReader" "java.io.StringReader" "StringWriter" "java.io.StringWriter" + "StringBuilder" "java.lang.StringBuilder" + "StringTokenizer" "java.util.StringTokenizer" + "Charset" "java.nio.charset.Charset" "Base64" "java.util.Base64"}) +(defn- class-value-for + "The value a class-name symbol evaluates to: its canonical name string." + [nm] + (or (get class-canonical-names nm) + # qualified already, or unknown: the name itself is the token + nm)) +(defn- ctor-for-class-token + "Constructor fn for a class token (a canonical-name string): try the full + name, then the short name after the last dot." + [tok] + (or (in class-ctors tok) + (let [parts (string/split "." tok)] + (in class-ctors (last parts))))) # java.lang.String method surface for clj-compat interop: (.toLowerCase s), # (.indexOf s x), ... — the methods portable cljc libraries actually call. # Case mapping is ASCII (the whole engine is byte-based); indexOf returns -1 # on miss, as on the JVM. (defn- str-needle [x] - (if (and (struct? x) (= :jolt/char (get x :jolt/type))) - (string/from-bytes (x :ch)) + (cond + (and (struct? x) (= :jolt/char (get x :jolt/type))) (string/from-bytes (x :ch)) + # (.indexOf s 61): an int needle is a char CODE on the JVM, not its decimal + # text (ring-codec splits k=v pairs this way) + (number? x) (string/from-bytes (math/trunc x)) (string x))) +# java.lang.Number surface (ring-codec: (.byteValue (Integer/valueOf s 16))). +(def- number-methods + {"byteValue" (fn [n] (let [b (band (math/trunc n) 0xff)] (if (> b 127) (- b 256) b))) + "shortValue" (fn [n] (let [v (band (math/trunc n) 0xffff)] (if (> v 32767) (- v 65536) v))) + "intValue" (fn [n] (math/trunc n)) + "longValue" (fn [n] (math/trunc n)) + "floatValue" (fn [n] (* 1.0 n)) + "doubleValue" (fn [n] (* 1.0 n)) + "toString" (fn [n &opt radix] (if (= radix 16) (string/format "%x" (math/trunc n)) (string n)))}) + (def- string-methods - {"toString" (fn [s] s) + {"getBytes" (fn [s &opt charset] (buffer s)) + "toString" (fn [s] s) "toLowerCase" (fn [s] (string/ascii-lower s)) "toUpperCase" (fn [s] (string/ascii-upper s)) "trim" (fn [s] (string/trim s)) @@ -586,16 +654,24 @@ (let [jname (if (= ns "janet") name (string (string/slice ns 6) "/" name)) # worker fibers may carry no env (fiber/new without :e inherit) # — fall back to the env captured at module load - entry (in (or (fiber/getenv (fiber/current)) module-load-env) - (symbol jname))] + # four-step resolution: the runtime fiber's env (when it + # has one), the evaluator's module env (worker/connection + # fibers carry a foreign or empty env — net/server handler + # fibers resolve janet/struct through here), the autoload + # cache, then a jpm-module require on first miss + entry (or (when-let [fe (fiber/getenv (fiber/current))] + (in fe (symbol jname))) + (in module-load-env (symbol jname)) + (in janet-bridge-extras jname) + (bridge-autoload jname))] (if (not (nil? entry)) (if (table? entry) (entry :value) entry) (error (string "Unable to resolve Janet symbol: " jname)))) # syntax-quote ns-qualifies bare class names inside macros # (selmer.util/StringBuilder); class names never belong to an ns — # fall back to the constructor / statics shims before giving up. - (if-let [ctor (in class-ctors name)] - ctor + (if (or (in class-ctors name) (get class-canonical-names name)) + (class-value-for name) (error (string "Unable to resolve symbol: " ns "/" name)))))) # Use :jolt/not-found sentinel to distinguish nil binding from absent binding (let [local (get bindings name :jolt/not-found-1) @@ -846,7 +922,10 @@ "Keyword" true "Symbol" true "Object" true "IFn" true "Fn" true "PersistentVector" true "PersistentList" true "PersistentHashMap" true "PersistentHashSet" true "IPersistentMap" true "IPersistentVector" true - "IPersistentSet" true "IPersistentCollection" true "ISeq" true "Atom" true "nil" true}) + "IPersistentSet" true "IPersistentCollection" true "ISeq" true "Atom" true "nil" true + # java.util interfaces + seq types ring & friends extend on + "Map" true "Set" true "List" true "Collection" true "LazySeq" true + "APersistentMap" true}) (defn- canonical-host-tag "If type-name names a host type (optionally java.*/clojure.lang.* qualified), @@ -869,7 +948,17 @@ (keyword? obj) ["Keyword" "Object"] (and (struct? obj) (= :jolt/char (get obj :jolt/type))) ["Character" "Object"] (and (struct? obj) (= :symbol (get obj :jolt/type))) ["Symbol" "Object"] - (plist? obj) ["PersistentList" "IPersistentList" "IPersistentCollection" "ISeq" "Object"] + (plist? obj) ["PersistentList" "IPersistentList" "IPersistentCollection" "ISeq" "List" "Collection" "Object"] + (lazy-seq? obj) ["LazySeq" "ISeq" "IPersistentCollection" "Collection" "Object"] + # maps: phm / plain struct / sorted / records — java.util.Map covers them + # all in ring-style extend-protocol clauses + (or (phm? obj) + (and (struct? obj) (nil? (get obj :jolt/type))) + (and (table? obj) (or (get obj :jolt/deftype) + (= :jolt/sorted-map (get obj :jolt/type))))) + ["PersistentHashMap" "APersistentMap" "IPersistentMap" "Map" "IPersistentCollection" "Object"] + (or (set? obj) (and (table? obj) (= :jolt/sorted-set (get obj :jolt/type)))) + ["PersistentHashSet" "IPersistentSet" "Set" "IPersistentCollection" "Object"] (or (tuple? obj) (array? obj) (pvec? obj)) ["PersistentVector" "IPersistentVector" "IPersistentCollection" "ISeq" "Object"] (or (function? obj) (cfunction? obj)) ["IFn" "Fn" "Object"] (nil? obj) ["nil" "Object"] @@ -1054,7 +1143,8 @@ (def v-box @[nil]) (def mm-fn (fn [& args] - (let [dv (apply dispatch-fn args) + (let [dv* (apply dispatch-fn args) + dv (if (nil? dv*) :jolt/nil-sentinel dv*) method (get methods dv)] (if method (apply method args) @@ -1137,7 +1227,9 @@ (put v :jolt/methods @{}) v))) (def methods (or (get mm-var :jolt/methods) (let [m @{}] (put mm-var :jolt/methods m) m))) - (put methods dispatch-val impl) + # nil is a legal dispatch value (ring's body-string keys a method on it); + # janet tables can't hold nil keys, so it rides the sentinel + (put methods (if (nil? dispatch-val) :jolt/nil-sentinel dispatch-val) impl) (let [dc (get mm-var :jolt/dispatch-cache)] (when dc (each k (keys dc) (put dc k nil)))) mm-var) @@ -1294,6 +1386,7 @@ mm-var)) (ns-intern core "remove-method-setup" (fn [mm-sym dval] + (def dval (if (nil? dval) :jolt/nil-sentinel dval)) (def mm-var (mm-var-of mm-sym false)) (when mm-var (let [methods (get mm-var :jolt/methods)] @@ -1316,6 +1409,7 @@ (or (and mm-var (get mm-var :jolt/prefers)) {}))) (ns-intern core "get-method-setup" (fn [mm-sym dval] + (def dval (if (nil? dval) :jolt/nil-sentinel dval)) (def mm-var (mm-var-of mm-sym false)) (when mm-var (let [methods (get mm-var :jolt/methods)] @@ -1408,8 +1502,13 @@ # read, with-in-str, and line-seq are Clojure over these (core/50-io.clj). # The loader's registered source roots (the closest thing to a classpath) — # io/resource searches these for relative resource paths. - # registered constructor shims (StringReader., StringBuilder., ...) - (eachp [nm f] class-ctors (ns-intern core nm f)) + # registered constructor shims: the NAME evaluates to the canonical class + # string (so class-dispatch defmultis match); `new` finds the ctor fn. + (eachp [nm f] class-ctors (ns-intern core nm (class-value-for nm))) + # dispatch-only type names (no ctor): InputStream, File, ISeq, ... + (eachp [nm canon] class-canonical-names + (unless (or (in class-ctors nm) (ns-find core nm)) + (ns-intern core nm canon))) (ns-intern core "__source-roots" (fn [] (tuple ;(get (ctx :env) :source-paths)))) (ns-intern core "__stdin-read-line" @@ -1975,7 +2074,8 @@ # compiles as a plain (do …); no special-form arm. "new" (let [type-sym (in form 1) args (map |(eval-form ctx bindings $) (tuple/slice form 2)) - ctor (eval-form ctx bindings type-sym)] + ctor (eval-form ctx bindings type-sym) + ctor (if (string? ctor) (or (ctor-for-class-token ctor) ctor) ctor)] (apply ctor args)) "." (let [target (eval-form ctx bindings (in form 1)) member-raw (in form 2) @@ -1996,6 +2096,8 @@ (if m (m (string target) ;args) (error (string "Unsupported String method ." field-name)))) + (if (and (number? target) (get number-methods field-name)) + ((get number-methods field-name) target ;args) # registered shim objects (java.time etc.): tag-keyed method tables (if (and (or (table? target) (struct? target)) (get tagged-methods (get target :jolt/type))) @@ -2028,7 +2130,7 @@ (method-fn target ;args) (error (string "Cannot call non-function " field-name " on " (type target))))) (error (string "Cannot call non-function " field-name " on " (type target)))))) - (error (string "Cannot call method " field-name " on " (type target)))))))) + (error (string "Cannot call method " field-name " on " (type target))))))))) # (. obj member) with no extra args: a symbol member naming a # function is a zero-arg method call (receiver passed as self); # a keyword or `-field` member is plain field access. Strings get @@ -2038,6 +2140,8 @@ (if m (m (string target)) (error (string "Unsupported String method ." field-name)))) + (if (and (number? target) (get number-methods field-name)) + ((get number-methods field-name) target) (if (and (or (table? target) (struct? target)) (get tagged-methods (get target :jolt/type)) (get (get tagged-methods (get target :jolt/type)) field-name)) @@ -2057,7 +2161,7 @@ (array? v) (let [f (eval-form ctx bindings v)] (if (or (function? f) (cfunction? f)) (f target) f)) v) - v)))))) + v))))))) # default: function application — check for macros (if (and (struct? first-form) (= :symbol (first-form :jolt/type))) (let [sym-name (first-form :name)] @@ -2086,6 +2190,9 @@ (let [type-name (string/slice sym-name 0 (- (length sym-name) 1)) type-sym {:jolt/type :symbol :ns (first-form :ns) :name type-name} ctor (eval-form ctx bindings type-sym) + # class names evaluate to canonical-name STRINGS now; the + # constructor itself comes from the ctor registry + ctor (if (string? ctor) (or (ctor-for-class-token ctor) ctor) ctor) args (map |(eval-form ctx bindings $) (tuple/slice form 1))] (apply ctor args)) (let [v (resolve-var ctx bindings first-form)] diff --git a/src/jolt/javatime.janet b/src/jolt/javatime.janet index d386cfa..431374c 100644 --- a/src/jolt/javatime.janet +++ b/src/jolt/javatime.janet @@ -263,6 +263,131 @@ (register-class-ctor! nm string-builder)) (each nm ["StringWriter" "java.io.StringWriter"] (register-class-ctor! nm make-string-writer)) + # --- java.net / java.util surface for ring-codec (ring-core enablement) --- + # URLEncoder/URLDecoder: www-form-urlencoded (space <-> +, %XX bytes, + # [A-Za-z0-9.*_-] literal). Charset args are accepted and ignored beyond + # the name (everything is UTF-8 bytes here). + (defn- url-unreserved? [b] + (or (and (>= b 48) (<= b 57)) (and (>= b 65) (<= b 90)) + (and (>= b 97) (<= b 122)) (= b 46) (= b 42) (= b 95) (= b 45))) + (defn- url-encode-www [s & _] + (def out @"") + (each b (string/bytes (string s)) + (cond + (url-unreserved? b) (buffer/push-byte out b) + (= b 32) (buffer/push-string out "+") + (buffer/push-string out (string/format "%%%02X" b)))) + (string out)) + (defn- hexv [b] + (cond (and (>= b 48) (<= b 57)) (- b 48) + (and (>= b 65) (<= b 70)) (- b 55) + (and (>= b 97) (<= b 102)) (- b 87) + (error "URLDecoder: malformed escape"))) + (defn- url-decode-www [s & _] + (def bytes (string/bytes (string s))) + (def n (length bytes)) + (def out @"") + (var i 0) + (while (< i n) + (def b (in bytes i)) + (cond + (= b 43) (do (buffer/push-string out " ") (++ i)) + (= b 37) (if (< (+ i 2) n) + (do (buffer/push-byte out (+ (* 16 (hexv (in bytes (+ i 1)))) (hexv (in bytes (+ i 2))))) + (+= i 3)) + (error "URLDecoder: incomplete escape")) + (do (buffer/push-byte out b) (++ i)))) + (string out)) + (each nm ["URLEncoder" "java.net.URLEncoder"] + (register-class-statics! nm @{"encode" url-encode-www})) + (each nm ["URLDecoder" "java.net.URLDecoder"] + (register-class-statics! nm @{"decode" url-decode-www})) + (each nm ["Charset" "java.nio.charset.Charset"] + (register-class-statics! nm @{"forName" (fn [nm*] @{:jolt/type :jolt/charset :name nm*})})) + # Base64 (RFC 4648): encoder/decoder singletons with encode/decode methods. + (def- b64-alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") + (defn- b64-encode [bs] + (def bytes (if (bytes? bs) bs (string bs))) + (def n (length bytes)) + (def out @"") + (var i 0) + (while (< i n) + (def b0 (in bytes i)) + (def b1 (if (< (+ i 1) n) (in bytes (+ i 1)))) + (def b2 (if (< (+ i 2) n) (in bytes (+ i 2)))) + (buffer/push-byte out (in b64-alphabet (brshift b0 2))) + (buffer/push-byte out (in b64-alphabet (bor (blshift (band b0 3) 4) (brshift (or b1 0) 4)))) + (buffer/push-string out (if (nil? b1) "=" (string/from-bytes (in b64-alphabet (bor (blshift (band b1 0xf) 2) (brshift (or b2 0) 6)))))) + (buffer/push-string out (if (nil? b2) "=" (string/from-bytes (in b64-alphabet (band b2 0x3f))))) + (+= i 3)) + (string out)) + (def- b64-rev (do (def t @{}) (eachp [i c] b64-alphabet (put t c i)) t)) + (defn- b64-decode [s] + (def cleaned (string/replace-all "=" "" (string s))) + (def out @"") + (var acc 0) (var bits 0) + (each c (string/bytes cleaned) + (def v (get b64-rev c)) + (when (nil? v) (error "Base64: illegal character")) + (set acc (bor (blshift acc 6) v)) + (+= bits 6) + (when (>= bits 8) + (-= bits 8) + (buffer/push-byte out (band (brshift acc bits) 0xff)))) + out) + (register-tagged-methods! :jolt/base64-encoder @{"encode" (fn [self bs] (b64-encode bs)) "encodeToString" (fn [self bs] (b64-encode bs))}) + (register-tagged-methods! :jolt/base64-decoder @{"decode" (fn [self s] (b64-decode s))}) + (each nm ["Base64" "java.util.Base64"] + (register-class-statics! nm + @{"getEncoder" (fn [] @{:jolt/type :jolt/base64-encoder}) + "getDecoder" (fn [] @{:jolt/type :jolt/base64-decoder})})) + # Integer statics: valueOf with optional radix. Returns a plain number — + # byteValue/intValue live on the number method surface in the evaluator. + (register-class-statics! "Integer" + @{"valueOf" (fn [x &opt radix] + (cond + (number? x) x + (nil? radix) (or (scan-number (string x)) (error (string "NumberFormatException: " x))) + (= radix 16) (or (scan-number (string "16r" x)) (error (string "NumberFormatException: " x))) + (= radix 8) (or (scan-number (string "8r" x)) (error (string "NumberFormatException: " x))) + (= radix 2) (or (scan-number (string "2r" x)) (error (string "NumberFormatException: " x))) + (error (string "Integer/valueOf: unsupported radix " radix)))) + "parseInt" (fn [x &opt radix] + (or (scan-number (string (case radix 16 "16r" 8 "8r" 2 "2r" "") x)) + (error (string "NumberFormatException: " x)))) + "MAX_VALUE" 2147483647 + "MIN_VALUE" -2147483648}) + # StringTokenizer: eager split on any delimiter char, empty tokens skipped. + (defn- tokenize [s delims] + (def dset @{}) + (each b (string/bytes delims) (put dset b true)) + (def toks @[]) + (def cur @"") + (each b (string/bytes (string s)) + (if (get dset b) + (when (> (length cur) 0) (array/push toks (string cur)) (buffer/clear cur)) + (buffer/push-byte cur b))) + (when (> (length cur) 0) (array/push toks (string cur))) + toks) + (register-tagged-methods! :jolt/string-tokenizer + @{"hasMoreTokens" (fn [self] (< (self :pos) (length (self :toks)))) + "countTokens" (fn [self] (- (length (self :toks)) (self :pos))) + "nextToken" (fn [self] + (if (< (self :pos) (length (self :toks))) + (let [t (in (self :toks) (self :pos))] + (put self :pos (+ 1 (self :pos))) t) + (error "NoSuchElementException")))}) + (each nm ["StringTokenizer" "java.util.StringTokenizer"] + (register-class-ctor! nm (fn [s &opt delims] + @{:jolt/type :jolt/string-tokenizer + :toks (tokenize s (or delims " \t\n\r\f")) + :pos 0}))) + # clojure.lang.MapEntry: a 2-tuple, jolt's map-entry representation. + (each nm ["MapEntry" "clojure.lang.MapEntry"] + (register-class-ctor! nm (fn [k v] [k v]))) + # (String. bytes) / (String. bytes charset): UTF-8 bytes to string. + (each nm ["String" "java.lang.String"] + (register-class-ctor! nm (fn [x &opt charset] (string x)))) # java.net.URL: enough for selmer's template cache — file: URLs only. # A protocol-less spec throws (selmer catches MalformedURLException and # prepends file:///), and getPath hands back a stat-able filesystem path. diff --git a/src/jolt/jolt/http.clj b/src/jolt/jolt/http.clj index cbbceb1..2eb61ec 100644 --- a/src/jolt/jolt/http.clj +++ b/src/jolt/jolt/http.clj @@ -1,12 +1,25 @@ ; Jolt Standard Library: jolt.http -; HTTP client using Janet's net/ module. +; HTTP client over spork/http (janet.spork.http/*; requires `jpm install spork`). +; Responses come back as {:status int :headers map :body string}. + +(defn- response->map [r] + ;; clojure.core/get explicitly: this ns defines an http `get` that shadows it + {:status (clojure.core/get r :status) + :body (str (or (janet.spork.http/read-body r) "")) + :headers (reduce (fn [m kv] (assoc m (str (nth kv 0)) (str (nth kv 1)))) + {} + (janet/pairs (or (clojure.core/get r :headers) (janet/struct))))}) + +(defn- header-struct [headers] + (apply janet/struct + (mapcat (fn [kv] [(str (key kv)) (str (val kv))]) (seq (or headers {}))))) (defn get [url & {:keys [headers]}] - (let [result (net/request url :get headers {})] - {:status (result :status) :body (result :body) :headers (result :headers)})) + (response->map + (janet.spork.http/request "GET" url :headers (header-struct headers)))) (defn post [url body & {:keys [headers]}] - (let [result (net/request url :post headers body)] - {:status (result :status) :body (result :body) :headers (result :headers)})) + (response->map + (janet.spork.http/request "POST" url :body body :headers (header-struct headers)))) diff --git a/src/jolt/regex.janet b/src/jolt/regex.janet index 3d1e8dc..7180c14 100644 --- a/src/jolt/regex.janet +++ b/src/jolt/regex.janet @@ -414,6 +414,17 @@ (do (buffer/push-string buf (string/from-bytes c)) (++ i))))) (string buf)) +(defn- replacement-for + "One match's replacement text. A string replacement gets $N expansion; a FN + replacement (Clojure: fn of the match — string, or [whole g1 ...] when the + pattern has groups) is called and its result used literally." + [replacement g ngroups] + (cond + (string? replacement) (expand-replacement replacement g) + (or (function? replacement) (cfunction? replacement)) + (string (replacement (groups->result g ngroups))) + (string replacement))) + (defn re-replace-all [re s replacement] (def re (re-pattern re)) (def buf @"") (var pos 0) (var last 0) @@ -421,7 +432,7 @@ (def g (match-at re s pos)) (if (and g (> (length (in g 0)) 0)) (do (buffer/push-string buf (string/slice s last pos)) - (buffer/push-string buf (if (string? replacement) (expand-replacement replacement g) replacement)) + (buffer/push-string buf (replacement-for replacement g (re :ngroups))) (set pos (+ pos (length (in g 0)))) (set last pos)) (++ pos))) @@ -439,6 +450,6 @@ (if done (let [[p g] done] (string (string/slice s 0 p) - (if (string? replacement) (expand-replacement replacement g) replacement) + (replacement-for replacement g (re :ngroups)) (string/slice s (+ p (length (in g 0)))))) s)) diff --git a/test/integration/deps-resolve-test.janet b/test/integration/deps-resolve-test.janet index 1b308b9..5a22b88 100644 --- a/test/integration/deps-resolve-test.janet +++ b/test/integration/deps-resolve-test.janet @@ -125,6 +125,32 @@ ) (rmrf gbase) +# --- :jpm/module deps: janet libraries installed through jpm ----------------- +# Verification only (jpm owns installation): an importable module passes and +# contributes no roots; a missing one errors with the install hint. jpm/pm is +# always importable wherever jpm itself runs (CI included). +(do + (def jbase (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-jpm-" (os/time))) + (mkdirs (string jbase "/src")) + (spit (string jbase "/deps.edn") + `{:paths ["src"] :deps {janet/jpm-pm {:jpm/module "jpm/pm"}}}`) + (def cwd (os/cwd)) + (os/cd jbase) + (def roots (deps/resolve-deps "deps.edn" (string jbase "/jpm_tree"))) + (os/cd cwd) + (check "jpm module dep resolves" true (not (nil? roots))) + (check "jpm module contributes no roots" 1 (length roots)) + + (spit (string jbase "/deps.edn") + `{:paths ["src"] :deps {janet/nope {:jpm/module "no/such-module-xyz"}}}`) + (os/cd jbase) + (def r (protect (deps/resolve-deps "deps.edn" (string jbase "/jpm_tree")))) + (os/cd cwd) + (check "missing jpm module errors" false (r 0)) + (check "error carries the install hint" true + (not (nil? (string/find "jpm install" (string (r 1)))))) + (rmrf jbase)) + (if (> fails 0) (error (string "deps-resolve-test: " fails " failing check(s)")) (print "\nAll deps-resolve tests passed!")) diff --git a/test/spec/host-interop-spec.janet b/test/spec/host-interop-spec.janet index 5397ef7..e78faf4 100644 --- a/test/spec/host-interop-spec.janet +++ b/test/spec/host-interop-spec.janet @@ -140,3 +140,49 @@ "(string? (get (into {} (map (fn [[k v]] [k v]) (System/getenv))) \"HOME\"))"] ["System/getProperties" "true" "(string? (get (System/getProperties) \"os.name\"))"]) + +# ring-core enablement (host shims + protocol/reduce fixes): the java.net / +# java.util surface ring.util.codec needs, extend-protocol on Map and nil, +# and reduce over a reified clojure.lang.IReduceInit. +(defspec "host-interop / ring-codec surface" + ["URLEncoder www form" "\"a+b%3Dc\"" "(URLEncoder/encode \"a b=c\")"] + ["URLDecoder www form" "\"a b=c\"" "(URLDecoder/decode \"a+b%3Dc\" (Charset/forName \"UTF-8\"))"] + ["url round trip" "\"x &=%?\"" "(URLDecoder/decode (URLEncoder/encode \"x &=%?\"))"] + ["Base64 encode" "\"aGVsbG8=\"" "(String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))"] + ["Base64 round trip" "\"hello\"" "(String. (.decode (Base64/getDecoder) (String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))))"] + ["Integer radix + byteValue" "-1" "(.byteValue (Integer/valueOf \"ff\" 16))"] + ["Integer parseInt" "255" "(Integer/parseInt \"ff\" 16)"] + ["StringTokenizer" "[\"a=1\" \"b=2\"]" "(let [t (StringTokenizer. \"a=1&b=2\" \"&\")] [(.nextToken t) (.nextToken t)])"] + ["MapEntry key/val" "[:a 1]" "(let [e (MapEntry. :a 1)] [(key e) (val e)])"] + ["String ctor from bytes" "\"hi\"" "(String. (.getBytes \"hi\"))"] + ["extend-protocol Map" ":map" + "(do (defprotocol Pe (pe [x])) (extend-protocol Pe Map (pe [m] :map) Object (pe [o] :obj)) (pe {:a 1}))"] + ["extend-protocol nil" ":nil" + "(do (defprotocol Pn (pn [x])) (extend-protocol Pn nil (pn [n] :nil) Object (pn [o] :obj)) (pn nil))"] + ["extend-protocol Map covers sorted" ":map" + "(do (defprotocol Ps (ps [x])) (extend-protocol Ps Map (ps [m] :map) Object (ps [o] :obj)) (ps (sorted-map 1 2)))"] + ["reduce over reified IReduceInit" "42" + "(reduce + 0 (reify clojure.lang.IReduceInit (reduce [_ f init] (f (f init 40) 2))))"]) + +# ring-core enablement, part 2: class-name symbols evaluate to canonical +# class-name strings (so class-dispatch defmultis match), ctor sugar still +# constructs, type-hinted param vectors parse, slurp drains reader shims, +# str/replace takes fn replacements, and int needles are char codes. +(defspec "host-interop / class tokens & readers" + ["class name evaluates to canonical string" "\"java.lang.String\"" "String"] + ["dispatch-only class name" "\"java.io.InputStream\"" "InputStream"] + ["(class x) matches the token" "true" "(= String (class \"abc\"))"] + ["defmulti on class dispatches" ":str" + "(do (defmulti cm (fn [x] (class x))) (defmethod cm String [x] :str) (cm \"a\"))"] + ["defmethod on nil dispatch value" ":nil" + "(do (defmulti cn (fn [x] (class x))) (defmethod cn nil [x] :nil) (defmethod cn String [x] :str) (cn nil))"] + ["ctor sugar still constructs" "\"x\"" "(.toString (StringBuilder. \"x\"))"] + ["return-hinted defn parses" "7" "(do (defn- hb ^bytes [b] b) (hb 7))"] + ["hinted multi-arity parses" ":two" "((fn ([x] :one) (^String [x y] :two)) 1 2)"] + ["slurp drains a StringReader" "\"a=1\"" "(slurp (StringReader. \"a=1\"))"] + ["slurp accepts :encoding opts" "\"b\"" "(slurp (StringReader. \"b\") :encoding \"UTF-8\")"] + ["replace with fn replacement is literal" "\"$0\"" + "(do (require (quote [clojure.string :as s9])) (s9/replace \"x\" #\".\" (fn [m] \"$0\")))"] + ["replace fn gets group vector" "\"v=k\"" + "(do (require (quote [clojure.string :as s9])) (s9/replace \"k=v\" #\"(\\w+)=(\\w+)\" (fn [[_ k v]] (str v \"=\" k))))"] + ["indexOf int needle is a char code" "1" "(.indexOf \"a=b\" 61)"])