From d584369dda6ea9f815168bc41b01e44d90dd1772 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Wed, 10 Jun 2026 22:29:53 -0400 Subject: [PATCH] =?UTF-8?q?core:=20java.time=20+=20java.io=20shims=20?= =?UTF-8?q?=E2=80=94=20Selmer=20renders=20end=20to=20end=20(jolt-ea7)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Selmer now loads and renders templates on jolt: variables, filters (upper, date with JVM patterns), if/for tags, nested lookups, HTML escaping, and render-file with its last-modified template cache. New src/jolt/javatime.janet provides the java.time surface Selmer's date filters use (DateTimeFormatter/Instant/ZoneId/LocalDateTime/ FormatStyle/Locale, epoch-ms backed, host-local timezone) plus the java.io/java.lang/java.net shims its template reader needs (StringReader, StringBuilder, URL, File/separator, Class/forName). Everything registers through three new evaluator registries (class-statics, tagged-methods, class-ctors), so the module is data plus an install call. Fixes shaken out along the way, each load-bearing for Selmer and correct on their own: - :refer :all silently referred nothing (it iterated the :all keyword) - ns :import ignored vector specs and didn't share deftype ctor vars - dot calls on deftype/reify instances never consulted the protocol registry, so (.render-node node ctx) failed where (render-node ...) worked - instance? rejected expression type args like (Class/forName "[C") - char-array didn't accept a string - io/resource now searches the loader's source roots (the classpath analog); io/reader handles char arrays, URLs, readers, and returns an in-memory reader with :read-line-fn for file paths - String .split (regex, JVM trailing-empty semantics), file-path methods (.toURI/.toURL/.getPath/.lastModified/.exists) - System/getProperty (os.name & co), the janet/* bridge now works inside env-less fibers, and qualified class names that syntax-quote mangles (selmer.util/StringBuilder) fall back to the ctor registry Spec rows cover the shim surface; test/integration/selmer-test.janet runs the real Selmer from ~/src/selmer (skips cleanly when absent). --- jolt-core/clojure/core/30-macros.clj | 6 +- src/jolt/api.janet | 1 + src/jolt/clojure/java/io.clj | 28 +++- src/jolt/core.janet | 8 +- src/jolt/evaluator.janet | 177 +++++++++++++++++--- src/jolt/javatime.janet | 237 +++++++++++++++++++++++++++ src/jolt/types.janet | 11 ++ test/integration/selmer-test.janet | 61 +++++++ test/spec/host-interop-spec.janet | 48 ++++++ 9 files changed, 548 insertions(+), 29 deletions(-) create mode 100644 src/jolt/javatime.janet create mode 100644 test/integration/selmer-test.janet diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 9a3c501..8747a09 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -52,8 +52,12 @@ ;; instance?: class names don't evaluate to values on jolt, so the type arg is ;; passed quoted to the ctx-capturing checker; the value evaluates normally. +;; A LIST in type position is a class-valued expression (e.g. Selmer's +;; (Class/forName "[C")) — evaluate it instead. (defmacro instance? [t x] - `(instance-check (quote ~t) ~x)) + (if (seq? t) + `(instance-check ~t ~x) + `(instance-check (quote ~t) ~x))) ;; Single-threaded host: evaluate the monitor expr (for its effects, matching ;; Clojure's evaluation order) and the body — no lock to take. diff --git a/src/jolt/api.janet b/src/jolt/api.janet index bbdd3f6..5e48ef2 100644 --- a/src/jolt/api.janet +++ b/src/jolt/api.janet @@ -12,6 +12,7 @@ (import ./backend :as backend) (import ./stdlib_embed :as stdlib-embed) (import ./host_iface :as host) +(import ./javatime) # java.time shims register into the evaluator at load # A defmacro expander compiles to a native fn (built as (fn args body...) and run # through the self-hosted pipeline) so macro expansion is COMPILED code, zero runtime diff --git a/src/jolt/clojure/java/io.clj b/src/jolt/clojure/java/io.clj index 53e587b..4d180dd 100644 --- a/src/jolt/clojure/java/io.clj +++ b/src/jolt/clojure/java/io.clj @@ -12,16 +12,36 @@ (defn as-file [x] (str x)) -(defn reader [x] (janet.file/open (str x) :r)) +(defn reader [x] + (cond + ;; already a reader (java.io shim or janet file handle) — pass through, + ;; like the JVM's io/reader on a Reader + (= :jolt/jio-string-reader (get x :jolt/type)) x + (= :jolt/url (get x :jolt/type)) (java.io.StringReader. (janet/slurp (.getPath x))) + (= :core/file (janet/type x)) x + (sequential? x) (java.io.StringReader. (apply str x)) ; char[] → in-memory reader + ;; a path: an in-memory reader over the file's content — gives the + ;; java.io.Reader surface (.read/.mark/.reset) plus line-seq's + ;; :read-line-fn, which a raw janet file handle has neither of + :else (java.io.StringReader. (janet/slurp (str x))))) (defn writer [x] (janet.file/open (str x) :w)) (defn input-stream [x] (reader x)) (defn output-stream [x] (writer x)) (defn resource - "Returns a slurp-able path for `path` if it exists, else nil. (Clojure returns - a URL; a path works the same with slurp here, since there's no classpath.)" + "Returns a slurp-able path for `path` if it exists, else nil. (Clojure + returns a classpath URL; here the loader's source roots play the classpath + role — the bare path is tried first, then path under each root.)" [path] - (let [p (str path)] (when (janet.os/stat p) p))) + (let [p (str path)] + (if (janet.os/stat p) + p + (loop [roots (seq (__source-roots))] + (when roots + (let [cand (str (first roots) "/" p)] + (if (janet.os/stat cand) + cand + (recur (next roots))))))))) (defn delete-file ([f] (delete-file f false)) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index d1b9fdc..f7fc66b 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -1888,7 +1888,13 @@ (defn core-short-array [a & rest] (make-num-array a rest 0)) (defn core-double-array [a & rest] (make-num-array a rest 0)) (defn core-float-array [a & rest] (make-num-array a rest 0)) -(defn core-char-array [a & rest] (make-num-array a rest (make-char 0))) +(defn core-char-array [a & rest] + # JVM char-array also accepts a STRING/char-seq (char[] of its characters) — + # selmer's parse-str does (char-array template). + (cond + (string? a) (map make-char (string/bytes a)) + (buffer? a) (map make-char (string/bytes (string a))) + (make-num-array a rest (make-char 0)))) (defn core-boolean-array [a & rest] (make-num-array a rest false)) # Byte arrays — Janet buffers (each element a 0..255 byte). diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index bd10c86..5c8f002 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -9,6 +9,10 @@ (use ./reader) (use ./regex) +# The env this module was loaded under — proto-chains to the Janet root env; +# the janet/* interop bridge falls back to it inside env-less fibers. +(def- module-load-env (fiber/getenv (fiber/current))) + (defn- sym-name? [sym-s name-str] (and (struct? sym-s) (= :symbol (sym-s :jolt/type)) (= name-str (sym-s :name)))) @@ -378,13 +382,21 @@ (when refer-syms (let [source-ns (ctx-find-ns ctx ns-name) target-ns (ctx-find-ns ctx (ctx-current-ns ctx))] - (each refer-sym refer-syms - (let [name (if (struct? refer-sym) (refer-sym :name) refer-sym) - v (ns-find source-ns name)] - (when v - # Share the SOURCE var (the Clojure model): macro-ness travels with - # it and source-ns redefinitions propagate to the referer. - (put (target-ns :mappings) name v)))))) + (if (or (= refer-syms :all) + (and (struct? refer-syms) (= :symbol (refer-syms :jolt/type)) + (= "all" (refer-syms :name)))) + # :refer :all — share EVERY var (this used to each over the :all + # keyword itself and silently refer nothing; selmer's + # [selmer.util :refer :all] left *tag-open* & co unresolved) + (eachp [nm v] (source-ns :mappings) + (put (target-ns :mappings) nm v)) + (each refer-sym refer-syms + (let [name (if (struct? refer-sym) (refer-sym :name) refer-sym) + v (ns-find source-ns name)] + (when v + # Share the SOURCE var (the Clojure model): macro-ness travels with + # it and source-ns redefinitions propagate to the referer. + (put (target-ns :mappings) name v))))))) nil)) (defn- bind-put @@ -430,7 +442,18 @@ # realtime clock (sub-ms float epoch seconds) — os/time is whole seconds, # which quantized every elapsed-time measurement to 1000ms. {"currentTimeMillis" (fn [] (math/floor (* 1000 (os/clock :realtime)))) - "nanoTime" (fn [] (math/floor (* 1e9 (os/clock :monotonic))))}) + "nanoTime" (fn [] (math/floor (* 1e9 (os/clock :monotonic)))) + "getProperty" (fn [k &opt dflt] + (case k + "os.name" (case (os/which) + :windows "Windows" :macos "Mac OS X" "Linux") + "line.separator" "\n" + "file.separator" "/" + "user.dir" (os/cwd) + "user.home" (os/getenv "HOME") + "java.io.tmpdir" (or (os/getenv "TMPDIR") "/tmp") + dflt)) + "getenv" (fn [&opt k] (if k (os/getenv k) (os/environ)))}) # Long statics: sentinels portable code compares against. jolt numbers are # doubles, so these are the f64 approximations. @@ -438,6 +461,18 @@ {"MAX_VALUE" 9223372036854775807 "MIN_VALUE" -9223372036854775808}) +# Pluggable host-class shims (java.time etc. register here at module load): +# class-statics: "ClassName" -> {"member" value-or-fn} (Foo/bar resolution) +# tagged-methods: :jolt/tag -> {"method" (fn [self args...])} ((.m obj) dispatch) +(def class-statics @{}) +(def tagged-methods @{}) +(defn register-class-statics! [class-name tbl] (put class-statics class-name tbl)) +(defn register-tagged-methods! [tag tbl] (put tagged-methods tag tbl)) +# Constructor shims: (ClassName. args) resolves ClassName as a value, so the +# 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)) + # 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 @@ -451,6 +486,21 @@ "toLowerCase" (fn [s] (string/ascii-lower s)) "toUpperCase" (fn [s] (string/ascii-upper s)) "trim" (fn [s] (string/trim s)) + # file-path surface: io/file returns plain path strings, so the java.io.File + # / java.net.URL methods selmer's template cache calls land here + "toURI" (fn [s] s) + "toURL" (fn [s] s) + "getPath" (fn [s] s) + "getName" (fn [s] (if-let [i (string/find "/" (string/reverse s))] + (string/slice s (- (length s) i)) s)) + "exists" (fn [s] (not (nil? (os/stat s)))) + "lastModified" (fn [s] (if-let [st (os/stat s)] (math/floor (* 1000 (st :modified))) 0)) + # JVM String.split takes a REGEX string; trailing empties dropped like the JVM + "split" (fn [s re &opt limit] + (def parts (re-split (re-pattern re) s)) + (while (and (> (length parts) 0) (= "" (last parts))) + (array/pop parts)) + parts) "length" (fn [s] (length s)) "isEmpty" (fn [s] (= 0 (length s))) "charAt" (fn [s i] {:jolt/type :jolt/char :ch (s i)}) @@ -487,6 +537,9 @@ (if (= ns "Long") (let [v (get long-statics name)] (if (nil? v) (error (string "Unsupported Long member: Long/" name)) v)) + (if (get class-statics ns) + (let [v (get (get class-statics ns) name)] + (if (nil? v) (error (string "Unsupported member: " ns "/" name)) v)) (if (not (nil? ns)) (let [current-ns (ctx-find-ns ctx (ctx-current-ns ctx)) aliased-ns (or (ns-alias-lookup current-ns ns) (ns-import-lookup current-ns ns)) @@ -502,11 +555,19 @@ # the interop boundary visible at the call site. (if (or (= ns "janet") (string/has-prefix? "janet." ns)) (let [jname (if (= ns "janet") name (string (string/slice ns 6) "/" name)) - entry (in (fiber/getenv (fiber/current)) (symbol jname))] + # 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))] (if (not (nil? entry)) (if (table? entry) (entry :value) entry) (error (string "Unable to resolve Janet symbol: " jname)))) - (error (string "Unable to resolve symbol: " ns "/" name))))) + # 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 + (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) local (if (= local :jolt/not-found-1) (binding-get bindings name) local)] @@ -536,7 +597,7 @@ # No implicit Janet fallback (Stage 3): an unresolved # Clojure symbol is an error. Host access is the explicit # janet/ prefix above. - (error (string "Unable to resolve symbol: " name))))))))))))))))) + (error (string "Unable to resolve symbol: " name)))))))))))))))))) (defn- parse-arg-names "Parse a parameter vector, handling & rest args. Returns {:fixed [names...] :rest name-or-nil :all [names...]}" @@ -887,15 +948,30 @@ qualified name in the current ns. A fn; quoted class symbols arrive evaluated." [ctx & class-specs] (def ns (ctx-find-ns ctx (ctx-current-ns ctx))) + (defn sym-name [x] (if (and (struct? x) (= :symbol (x :jolt/type))) (x :name) (string x))) + (defn import-one [class-name &opt pkg] + (def last-dot (do (var idx -1) (var pos 0) + (while (< pos (length class-name)) + (when (= (class-name pos) 46) (set idx pos)) (++ pos)) + idx)) + (def short-name (if (>= last-dot 0) (string/slice class-name (+ last-dot 1)) class-name)) + (def pkg-name (cond pkg pkg (>= last-dot 0) (string/slice class-name 0 last-dot) nil)) + (ns-import ns short-name class-name) + # a deftype "class" lives as a ctor var in its defining jolt ns — share it + # (the JVM import makes (TextNode. ...) resolvable; this is our analog) + (when pkg-name + (when-let [src-ns (get ((ctx :env) :namespaces) pkg-name) + v (ns-find src-ns short-name)] + (put (ns :mappings) short-name v)))) (each class-spec class-specs - (let [class-name (if (and (struct? class-spec) (= :symbol (class-spec :jolt/type))) - (class-spec :name) (string class-spec)) - last-dot (do (var idx -1) (var pos 0) - (while (< pos (length class-name)) - (when (= (class-name pos) 46) (set idx pos)) (++ pos)) - idx) - short-name (if (>= last-dot 0) (string/slice class-name (+ last-dot 1)) class-name)] - (ns-import ns short-name class-name))) + (if (or (array? class-spec) (tuple? class-spec) + (and (table? class-spec) (= :jolt/pvec (class-spec :jolt/type)))) + # vector spec: [pkg Class1 Class2 ...] + (let [items (if (table? class-spec) (pv->array class-spec) class-spec) + pkg (sym-name (in items 0))] + (for i 1 (length items) + (import-one (string pkg "." (sym-name (in items i))) pkg))) + (import-one (sym-name class-spec)))) nil) (defn refer-clojure-impl @@ -1240,6 +1316,28 @@ "java.util.regex.Pattern" (and (table? val) (= :jolt/regex (val :jolt/type))) "Character" (and (struct? val) (= :jolt/char (get val :jolt/type))) "java.lang.Character" (and (struct? val) (= :jolt/char (get val :jolt/type))) + # java.time shims (javatime.janet); #inst IS java.util.Date in Clojure + "java.util.Date" (and (struct? val) (= :jolt/inst (get val :jolt/type))) + "Date" (and (struct? val) (= :jolt/inst (get val :jolt/type))) + "Instant" (and (table? val) (= :jolt/instant (get val :jolt/type))) + "java.time.Instant" (and (table? val) (= :jolt/instant (get val :jolt/type))) + "LocalDateTime" (and (table? val) (= :jolt/local-dt (get val :jolt/type))) + "java.time.LocalDateTime" (and (table? val) (= :jolt/local-dt (get val :jolt/type))) + "ZonedDateTime" (and (table? val) (= :jolt/zoned-dt (get val :jolt/type))) + "java.time.ZonedDateTime" (and (table? val) (= :jolt/zoned-dt (get val :jolt/type))) + "LocalTime" false + "LocalDate" false + "java.sql.Time" false + "java.sql.Timestamp" false + "java.sql.Date" false + "DateTimeFormatter" (and (table? val) (= :jolt/dt-formatter (get val :jolt/type))) + "URL" (and (table? val) (= :jolt/url (get val :jolt/type))) + "java.net.URL" (and (table? val) (= :jolt/url (get val :jolt/type))) + # JVM char[] class — (Class/forName "[C"); jolt char arrays are Janet + # arrays of char structs + "[C" (and (array? val) + (or (= 0 (length val)) + (and (struct? (val 0)) (= :jolt/char ((val 0) :jolt/type))))) "clojure.lang.Atom" (and (table? val) (= :jolt/atom (val :jolt/type))) "clojure.lang.Volatile" (and (table? val) (= :jolt/volatile (val :jolt/type))) "clojure.lang.Delay" (and (table? val) (= :jolt/delay (val :jolt/type))) @@ -1255,6 +1353,12 @@ # stdin, newline stripped, nil at EOF. __parse-next: one form off a string -> # [form rest-of-string], nil when only whitespace remains. *in*, read-line, # 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)) + (ns-intern core "__source-roots" + (fn [] (tuple ;(get (ctx :env) :source-paths)))) (ns-intern core "__stdin-read-line" (fn [] (let [l (file/read stdin :line)] @@ -1815,9 +1919,26 @@ (if m (m (string target) ;args) (error (string "Unsupported String method ." field-name)))) + # registered shim objects (java.time etc.): tag-keyed method tables + (if (and (or (table? target) (struct? target)) + (get tagged-methods (get target :jolt/type))) + (let [m (get (get tagged-methods (get target :jolt/type)) field-name)] + (if m + (m target ;args) + (error (string "Unsupported method ." field-name " on " (string (get target :jolt/type)))))) (if (target :jolt/deftype) - (let [method-key (keyword field-name)] - (apply (get target method-key) target ;args)) + # deftype/reify methods live in the protocol registry (or the + # instance's reified-fns table), not on the instance + (let [method-key (keyword field-name) + own (get target method-key) + reified (get (get target :jolt/protocol-methods) method-key) + m (cond + (or (function? own) (cfunction? own)) own + (or (function? reified) (cfunction? reified)) reified + (find-method-any-protocol ctx (target :jolt/deftype) field-name))] + (if m + (apply m target args) + (error (string "No method ." field-name " on " (target :jolt/deftype))))) # Janet-native interop: try field lookup + call (if (or (table? target) (struct? target)) (let [method (get target (keyword field-name))] @@ -1830,7 +1951,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 @@ -1840,16 +1961,26 @@ (if m (m (string target)) (error (string "Unsupported String method ." field-name)))) + (if (and (or (table? target) (struct? target)) + (get tagged-methods (get target :jolt/type)) + (get (get tagged-methods (get target :jolt/type)) field-name)) + ((get (get tagged-methods (get target :jolt/type)) field-name) target) (let [v (get target (keyword field-name))] (if (and (struct? member-raw) (= :symbol (member-raw :jolt/type)) (not (string/has-prefix? "-" member-name))) (cond (or (function? v) (cfunction? v)) (v target) + # zero-arg deftype/reify method via the protocol registry + (and (table? target) (target :jolt/deftype)) + (let [reified (get (get target :jolt/protocol-methods) (keyword field-name)) + m (if (or (function? reified) (cfunction? reified)) reified + (find-method-any-protocol ctx (target :jolt/deftype) field-name))] + (if m (m target) v)) # value stored as an unevaluated fn* form: compile then call (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)] diff --git a/src/jolt/javatime.janet b/src/jolt/javatime.janet new file mode 100644 index 0000000..84f2ca5 --- /dev/null +++ b/src/jolt/javatime.janet @@ -0,0 +1,237 @@ +# java.time shims (jolt-ea7): the surface Selmer's date filters use, backed +# by epoch milliseconds (the same representation as :jolt/inst). Local time +# means the HOST's local time (os/date with local=true); zones beyond the +# system default are not modeled. Registered through the evaluator's +# class-statics / tagged-methods registries, so this module is data plus an +# install call — adding another java.* shim follows the same shape. + +(use ./evaluator) + +(defn- chr [s] (get s 0)) + +# --- values ------------------------------------------------------------------- + +(defn- instant [ms] @{:jolt/type :jolt/instant :ms ms}) +(defn- zoned [ms zone] @{:jolt/type :jolt/zoned-dt :ms ms :zone zone}) +(defn- local-dt [ms] @{:jolt/type :jolt/local-dt :ms ms}) +(defn- formatter [pattern &opt locale] @{:jolt/type :jolt/dt-formatter :pattern pattern :locale locale}) + +(def- zone-default @{:jolt/type :jolt/zone-id :id "system"}) + +# ms of any date-ish shim value (or a :jolt/inst) +(defn- ms-of [d] + (cond + (number? d) d + (and (or (table? d) (struct? d)) + (or (= :jolt/inst (get d :jolt/type)) + (= :jolt/instant (get d :jolt/type)) + (= :jolt/zoned-dt (get d :jolt/type)) + (= :jolt/local-dt (get d :jolt/type)))) + (get d :ms) + (error (string "not a date value: " (type d))))) + +# --- formatting ---------------------------------------------------------------- + +(def- month-names ["January" "February" "March" "April" "May" "June" "July" + "August" "September" "October" "November" "December"]) +(def- day-names ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]) + +(defn- pad2 [n] (if (< n 10) (string "0" n) (string n))) + +# Format epoch-ms with a (subset of the) JVM DateTimeFormatter pattern: +# yyyy yy MMMM MMM MM M dd d EEEE EEE HH H hh h mm m ss s a, quoted literals +# with '...'. Unknown letters pass through. +(defn- format-ms [pattern ms] + (def d (os/date (math/floor (/ ms 1000)) true)) + (def out @"") + (var i 0) + (def n (length pattern)) + (defn run-len [c] + (var j i) + (while (and (< j n) (= (pattern j) c)) (++ j)) + (- j i)) + (while (< i n) + (def c (pattern i)) + (def k (run-len c)) + (cond + (= c (chr "'")) + # quoted literal up to the closing quote ('' = literal quote) + (if (and (< (+ i 1) n) (= (pattern (+ i 1)) (chr "'"))) + (do (buffer/push out "'") (+= i 2)) + (let [close (string/find "'" pattern (+ i 1))] + (buffer/push out (string/slice pattern (+ i 1) close)) + (set i (+ close 1)))) + (= c (chr "y")) + (do (buffer/push out (if (>= k 4) (string (d :year)) + (pad2 (mod (d :year) 100)))) + (+= i k)) + (= c (chr "M")) + (do (buffer/push out (case k + 1 (string (+ 1 (d :month))) + 2 (pad2 (+ 1 (d :month))) + 3 (string/slice (in month-names (d :month)) 0 3) + (in month-names (d :month)))) + (+= i k)) + (= c (chr "d")) + (do (buffer/push out (if (= k 1) (string (+ 1 (d :month-day))) (pad2 (+ 1 (d :month-day))))) + (+= i k)) + (= c (chr "E")) + (do (buffer/push out (if (>= k 4) (in day-names (d :week-day)) + (string/slice (in day-names (d :week-day)) 0 3))) + (+= i k)) + (= c (chr "H")) + (do (buffer/push out (if (= k 1) (string (d :hours)) (pad2 (d :hours)))) (+= i k)) + (= c (chr "h")) + (let [h12 (let [h (mod (d :hours) 12)] (if (= h 0) 12 h))] + (buffer/push out (if (= k 1) (string h12) (pad2 h12))) (+= i k)) + (= c (chr "m")) + (do (buffer/push out (if (= k 1) (string (d :minutes)) (pad2 (d :minutes)))) (+= i k)) + (= c (chr "s")) + (do (buffer/push out (if (= k 1) (string (d :seconds)) (pad2 (d :seconds)))) (+= i k)) + (= c (chr "a")) + (do (buffer/push out (if (< (d :hours) 12) "AM" "PM")) (+= i k)) + (do (buffer/push out (string/from-bytes c)) (++ i)))) + (string out)) + +# Localized FormatStyle approximations (no locale database on this host). +(def- style-patterns + {[:date :short] "M/d/yy" [:date :medium] "MMM d, yyyy" + [:date :long] "MMMM d, yyyy" [:date :full] "EEEE, MMMM d, yyyy" + [:time :short] "h:mm a" [:time :medium] "h:mm:ss a" + [:time :long] "h:mm:ss a" [:time :full] "h:mm:ss a" + [:datetime :short] "M/d/yy, h:mm a" + [:datetime :medium] "MMM d, yyyy, h:mm:ss a" + [:datetime :long] "MMMM d, yyyy, h:mm:ss a" + [:datetime :full] "EEEE, MMMM d, yyyy, h:mm:ss a"}) + +(defn- style-fmt [kind style] + (formatter (get style-patterns [kind (get style :style)] "yyyy-MM-dd HH:mm:ss"))) + +# --- registration -------------------------------------------------------------- + +(defn install! [] + (def fs (fn [style] @{:jolt/type :jolt/format-style :style style})) + (register-class-statics! "FormatStyle" + @{"SHORT" (fs :short) "MEDIUM" (fs :medium) "LONG" (fs :long) "FULL" (fs :full)}) + (register-class-statics! "DateTimeFormatter" + @{"ofPattern" (fn [p &opt locale] (formatter p locale)) + "ISO_LOCAL_DATE" (formatter "yyyy-MM-dd") + "ISO_LOCAL_DATE_TIME" (formatter "yyyy-MM-dd'T'HH:mm:ss") + "ofLocalizedDate" (fn [style] (style-fmt :date style)) + "ofLocalizedTime" (fn [style] (style-fmt :time style)) + "ofLocalizedDateTime" (fn [style] (style-fmt :datetime style))}) + (register-class-statics! "Instant" + @{"ofEpochMilli" (fn [ms] (instant ms)) + "now" (fn [] (instant (math/floor (* 1000 (os/clock :realtime)))))}) + (register-class-statics! "ZoneId" + @{"systemDefault" (fn [] zone-default)}) + (register-class-statics! "LocalDateTime" + @{"ofInstant" (fn [inst zone] (local-dt (ms-of inst))) + "now" (fn [] (local-dt (math/floor (* 1000 (os/clock :realtime)))))}) + (register-class-statics! "Locale" + @{"getDefault" (fn [] @{:jolt/type :jolt/locale :id "default"}) + "ENGLISH" @{:jolt/type :jolt/locale :id "en"} + "US" @{:jolt/type :jolt/locale :id "en-US"}}) + (register-tagged-methods! :jolt/instant + @{"atZone" (fn [self zone] (zoned (self :ms) zone)) + "toEpochMilli" (fn [self] (self :ms))}) + (register-tagged-methods! :jolt/zoned-dt + @{"toLocalDateTime" (fn [self] (local-dt (self :ms))) + "toInstant" (fn [self] (instant (self :ms)))}) + (register-tagged-methods! :jolt/local-dt + @{"atZone" (fn [self zone] (zoned (self :ms) zone))}) + # a :jolt/inst (#inst — Clojure's java.util.Date) supports the Date methods + # Selmer's fix-date path calls + (register-tagged-methods! :jolt/inst + @{"toInstant" (fn [self] (instant (self :ms))) + "getTime" (fn [self] (self :ms))}) + (register-tagged-methods! :jolt/dt-formatter + @{"withLocale" (fn [self locale] (formatter (self :pattern) locale)) + "format" (fn [self d] (format-ms (self :pattern) (ms-of d)))})) + +# --- java.io / java.lang shims (Selmer's template reader) --------------------- + +(defn- string-reader [src] + # :close makes with-open's __close happy (it calls (get x :close) when + # present); :read-line-fn matches the 50-io reader convention so line-seq + # works over readers io/reader hands back + (def self @{:jolt/type :jolt/jio-string-reader :s (string src) :pos 0 + :close (fn [] nil)}) + (put self :read-line-fn + (fn [] + (def {:s s :pos pos} self) + (when (< pos (length s)) + (def i (string/find "\n" s pos)) + (if (nil? i) + (do (put self :pos (length s)) (string/slice s pos)) + (do (put self :pos (+ i 1)) (string/slice s pos i)))))) + self) +(defn- string-builder [&opt init] + # a numeric arg is a CAPACITY (java.lang.StringBuilder(int)), not content + @{:jolt/type :jolt/string-builder + :buf (cond (nil? init) @"" (number? init) (buffer/new init) (buffer init))}) + +(defn- render-piece [x] + (cond + (nil? x) "null" + (and (struct? x) (= :jolt/char (get x :jolt/type))) (string/from-bytes (x :ch)) + (string x))) + +(defn install-io! [] + (register-tagged-methods! :jolt/jio-string-reader + @{"read" (fn [self] + (if (>= (self :pos) (length (self :s))) + -1 + (let [b ((self :s) (self :pos))] + (put self :pos (+ 1 (self :pos))) + b))) + "mark" (fn [self &opt limit] (put self :marked (self :pos)) nil) + "reset" (fn [self] (put self :pos (or (self :marked) 0)) nil) + "skip" (fn [self n] (put self :pos (min (length (self :s)) (+ (self :pos) n))) n) + "close" (fn [self] nil)}) + (register-tagged-methods! :jolt/string-builder + @{"append" (fn [self x] (buffer/push (self :buf) (render-piece x)) self) + "toString" (fn [self] (string (self :buf))) + "length" (fn [self] (length (self :buf))) + "setLength" (fn [self n] + (def buf (self :buf)) + (if (< n (length buf)) + (buffer/popn buf (- (length buf) n)) + (while (< (length buf) n) (buffer/push buf "\0"))) + nil) + "charAt" (fn [self i] {:jolt/type :jolt/char :ch ((self :buf) i)})}) + (each nm ["File" "java.io.File"] + (register-class-statics! nm @{"separator" "/" "separatorChar" {:jolt/type :jolt/char :ch 47}})) + (register-class-statics! "Class" + @{"forName" (fn [nm] @{:jolt/type :jolt/class :name nm})}) + (each nm ["StringReader" "java.io.StringReader"] + (register-class-ctor! nm string-reader)) + (each nm ["StringBuilder" "java.lang.StringBuilder"] + (register-class-ctor! nm string-builder)) + # 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. + (defn url-path [spec] + (var p (if (string/has-prefix? "file:" spec) (string/slice spec 5) spec)) + (while (and (> (length p) 1) (string/has-prefix? "//" p)) + (set p (string/slice p 1))) + p) + (register-tagged-methods! :jolt/url + @{"getPath" (fn [self] (url-path (self :spec))) + "getFile" (fn [self] (url-path (self :spec))) + "toString" (fn [self] (self :spec)) + "toExternalForm" (fn [self] (self :spec))}) + (each nm ["URL" "java.net.URL"] + (register-class-ctor! nm + (fn [spec & _] + (def s (string spec)) + (def colon (string/find ":" s)) + (if (or (nil? colon) (= colon 0) + (string/find "/" (string/slice s 0 colon))) + (error (string "MalformedURLException: no protocol: " s)) + @{:jolt/type :jolt/url :spec s})))) + (each nm ["Locale" "java.util.Locale"] + (register-class-ctor! nm (fn [id &opt _country] @{:jolt/type :jolt/locale :id (string id)})))) + +(install!) +(install-io!) diff --git a/src/jolt/types.janet b/src/jolt/types.janet index d394ae4..f859d61 100644 --- a/src/jolt/types.janet +++ b/src/jolt/types.janet @@ -560,6 +560,17 @@ (when proto-impls (get proto-impls method-name)))))) +(defn find-method-any-protocol + "Find a method implementation for a type, searching every protocol it + implements (dot calls name the method but not the protocol)." + [ctx type-tag method-name] + (let [type-impls (get (get (ctx :env) :type-registry) type-tag)] + (when type-impls + (var r nil) + (eachp [_ proto-impls] type-impls + (when (nil? r) (set r (get proto-impls method-name)))) + r))) + (defn type-satisfies? "Check if a type satisfies a protocol." [ctx type-tag protocol-name] diff --git a/test/integration/selmer-test.janet b/test/integration/selmer-test.janet new file mode 100644 index 0000000..c5a646a --- /dev/null +++ b/test/integration/selmer-test.janet @@ -0,0 +1,61 @@ +# Selmer acceptance (jolt-ea7): load the real Selmer template engine from +# ~/src/selmer and render through its full pipeline — the java.time shims +# (DateTimeFormatter/Instant/ZoneId/LocalDateTime), the java.io shims +# (StringReader/StringBuilder + char-array readers), vector :import sharing +# deftype ctors, and :refer :all. SKIPS cleanly if the checkout is absent +# (CI has no ~/src/selmer); the shim surface itself is covered by +# test/spec/host-interop-spec.janet either way. + +(import ../../src/jolt/api :as api) +(use ../../src/jolt/reader) + +(def selmer-src (string (os/getenv "HOME") "/src/selmer/src")) +(def selmer-res (string (os/getenv "HOME") "/src/selmer/resources")) + +(if (nil? (os/stat (string selmer-src "/selmer/parser.clj"))) + (print "selmer-test: ~/src/selmer not present, skipping") + (do + (reader-features-set! ["jolt" "clj" "default"]) + (def ctx (api/init {:paths [selmer-src selmer-res]})) + + (print "loading selmer.parser...") + (api/eval-string ctx "(require (quote [selmer.parser :as sp]))") + (print " ok") + + (defn render [tpl ctx-map-src] + (api/eval-string ctx (string "(sp/render " (describe tpl) " " ctx-map-src ")"))) + + (print "variable + filter...") + (assert (= "Hello WORLD!" (render "Hello {{name|upper}}!" "{:name \"world\"}"))) + (print " ok") + + (print "date filter (java.time path)...") + (def d (render "{{d|date:yyyy-MM-dd}}" "{:d #inst \"2020-03-05T10:00:00Z\"}")) + (assert (peg/match '(* :d :d :d :d "-" :d :d "-" :d :d -1) d) + (string "date filter renders a yyyy-MM-dd date, got: " d)) + (print " ok") + + (print "if / for tags...") + (assert (= "YES" (render "{% if ok %}YES{% else %}NO{% endif %}" "{:ok true}"))) + (assert (= "NO" (render "{% if ok %}YES{% else %}NO{% endif %}" "{:ok false}"))) + (assert (= "1,2,3," (render "{% for x in xs %}{{x}},{% endfor %}" "{:xs [1 2 3]}"))) + (print " ok") + + (print "nested lookup + escaping...") + (assert (= "7" (render "{{m.a.b}}" "{:m {:a {:b 7}}}"))) + (assert (= "<b>&" (render "{{x}}" "{:x \"&\"}"))) + (print " ok") + + (print "file templates (render-file + cache)...") + (def tpl-dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-selmer-test")) + (os/mkdir tpl-dir) + (spit (string tpl-dir "/t.html") "File says {{x|upper}}") + (api/eval-string ctx (string "(selmer.util/set-custom-resource-path! " (describe (string tpl-dir "/")) ")")) + (assert (= "File says HI" + (api/eval-string ctx "(sp/render-file \"t.html\" {:x \"hi\"})"))) + # second render goes through the template cache (last-modified check) + (assert (= "File says AGAIN" + (api/eval-string ctx "(sp/render-file \"t.html\" {:x \"again\"})"))) + (print " ok") + + (print "selmer-test: all passed"))) diff --git a/test/spec/host-interop-spec.janet b/test/spec/host-interop-spec.janet index 42c8590..ad1e0ff 100644 --- a/test/spec/host-interop-spec.janet +++ b/test/spec/host-interop-spec.janet @@ -61,3 +61,51 @@ [".equalsIgnoreCase" "true" "(.equalsIgnoreCase \"AbC\" \"aBc\")"] ["Long/MAX_VALUE" "true" "(pos? Long/MAX_VALUE)"] ["unsupported method throws" :throws "(.frobnicate \"abc\")"]) + +# java.time shims (jolt-ea7): epoch-ms backed values + a DateTimeFormatter +# pattern subset — the surface Selmer's date filters drive. Formatting uses +# the HOST's local timezone, so rows assert structure, not wall-clock values. +(defspec "interop / java.time shims" + ["ofPattern formats #inst" "true" + "(string? (.format (DateTimeFormatter/ofPattern \"yyyy-MM-dd\") #inst \"2020-03-05T13:45:30Z\"))"] + ["pattern shape" "true" + "(boolean (re-matches #\"\\d{4}-\\d{2}-\\d{2}\" (.format (DateTimeFormatter/ofPattern \"yyyy-MM-dd\") #inst \"2020-03-05T13:45:30Z\")))"] + ["month name + ampm" "true" + "(boolean (re-matches #\"[A-Z][a-z]{2} \\d{1,2}, 2020 \\d{1,2}:\\d{2} [AP]M\" (.format (DateTimeFormatter/ofPattern \"MMM d, yyyy h:mm a\") #inst \"2020-03-05T13:45:30Z\")))"] + ["quoted literal" "true" + "(boolean (re-matches #\"\\d{4}-\\d{2}-\\d{2}T\\d{2}:\\d{2}:\\d{2}\" (.format DateTimeFormatter/ISO_LOCAL_DATE_TIME #inst \"2020-03-05T13:45:30Z\")))"] + ["localized style" "true" + "(string? (.format (DateTimeFormatter/ofLocalizedDate FormatStyle/MEDIUM) #inst \"2020-03-05T13:45:30Z\"))"] + ["withLocale chain" "true" + "(string? (.format (.withLocale (DateTimeFormatter/ofPattern \"yyyy\") (java.util.Locale. \"en\")) #inst \"2020-01-01T00:00:00Z\"))"] + ["fix-date chain" "true" + "(instance? LocalDateTime (-> #inst \"2020-03-05T13:45:30Z\" (.toInstant) (.atZone (ZoneId/systemDefault)) (.toLocalDateTime)))"] + ["inst is java.util.Date" "true" "(instance? java.util.Date #inst \"2020-01-01T00:00:00Z\")"] + ["Instant instance" "true" "(instance? java.time.Instant (Instant/ofEpochMilli 0))"] + ["getTime epoch ms" "0" "(.getTime #inst \"1970-01-01T00:00:00Z\")"] + ["toEpochMilli round trip" "1234" "(.toEpochMilli (Instant/ofEpochMilli 1234))"] + ["Instant/now is current" "true" "(> (.toEpochMilli (Instant/now)) 1500000000000)"] + ["sql types are not" "false" "(instance? java.sql.Timestamp #inst \"2020-01-01T00:00:00Z\")"]) + +# java.io / java.lang shims that carry Selmer's char-by-char template reader. +(defspec "interop / StringReader & StringBuilder" + ["StringReader read" "[97 98 -1]" + "(let [r (java.io.StringReader. \"ab\")] [(.read r) (.read r) (.read r)])"] + ["mark/reset" "[97 97]" + "(let [r (StringReader. \"ab\")] (.mark r 1) [(.read r) (do (.reset r) (.read r))])"] + ["StringBuilder append" "\"ab1\"" + "(.toString (-> (StringBuilder.) (.append \"a\") (.append \\b) (.append 1)))"] + ["capacity arg is not content" "\"x\"" + "(.toString (.append (StringBuilder. 16) \"x\"))"] + ["setLength truncates" "\"ab\"" + "(let [sb (StringBuilder.)] (.append sb \"abcd\") (.setLength sb 2) (.toString sb))"] + ["char-array of string" "true" + "(instance? (Class/forName \"[C\") (char-array \"ab\"))"] + ["reader over char[]" "97" + "(do (require (quote clojure.java.io)) (.read (clojure.java.io/reader (char-array \"abc\"))))"] + ["line-seq over file reader" "[\"a\" \"b\"]" + "(do (require (quote clojure.java.io)) (janet/spit \"/tmp/jolt-lineseq-spec.txt\" \"a\\nb\\n\") (vec (line-seq (clojure.java.io/reader \"/tmp/jolt-lineseq-spec.txt\"))))"] + ["with-open closes shim" "97" + "(with-open [r (StringReader. \"a\")] (.read r))"] + ["vector :import shares deftype ctor" "\"hi!\"" + "(do (ns spec.nodea) (defprotocol SpecP (spec-pm [this])) (deftype SpecTN [t] SpecP (spec-pm [this] (str t \"!\"))) (ns spec.nodeb (:import [spec.nodea SpecTN])) (.spec-pm (SpecTN. \"hi\")))"])