Merge pull request #86 from jolt-lang/reitit-enablement

host: enable reitit routing — runtime JOLT_FEATURES, class-shim hooks, get-on-strings

docs/libraries.md

@@ -12,6 +12,10 @@ Libraries confirmed to load and pass their conformance checks on Jolt
   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)
+* [reitit-core](https://github.com/metosin/reitit) — data-driven routing; the
+  reitit.Trie Java class is mirrored in Clojure by
+  [jolt-lang/router](https://github.com/jolt-lang/router). Load with
+  `JOLT_FEATURES` including `clj`.
 * [honeysql](https://github.com/seancorfield/honeysql) — full formatter + helpers
   (select/insert/update/delete/joins/:inline), loaded unmodified from git
 * [clojure.jdbc](https://github.com/yogthos/clojure.jdbc) — as [jolt-lang/db](https://github.com/jolt-lang/db)'s

src/jolt/clojure/template.clj

@@ -0,0 +1,33 @@
+;; Verbatim from clojure.template (Stuart Sierra) — pure Clojure over
+;; clojure.walk, which jolt ships. Added so honeysql's :clj branch (which
+;; requires clojure.template) loads under JOLT_FEATURES including clj.
+(ns clojure.template
+  "Macros that expand to repeated copies of a template expression."
+  (:require [clojure.walk :as walk]))
+
+(defn apply-template
+  "For use in macros.  argv is an argument list, as in defn.  expr is
+  a quoted expression using the symbols in argv.  values is a sequence
+  of values to be used for the arguments.
+
+  apply-template will recursively replace argument symbols in expr
+  with their corresponding values, returning a modified expr.
+
+  Example: (apply-template '[x] '(+ x x) '[2])
+           ;=> (+ 2 2)"
+  [argv expr values]
+  (assert (vector? argv))
+  (assert (every? symbol? argv))
+  (walk/postwalk-replace (zipmap argv values) expr))
+
+(defmacro do-template
+  "Repeatedly copies expr (in a do block) for each group of arguments
+  in values.  values are automatically partitioned by the number of
+  arguments in argv, an argument vector as in defn.
+
+  Example: (macroexpand '(do-template [x y] (+ y x) 2 4 3 5))
+           ;=> (do (+ 4 2) (+ 5 3))"
+  [argv expr & values]
+  (let [c (count argv)]
+    `(do ~@(map (fn [a] (apply-template argv expr a))
+                (partition c values)))))

src/jolt/core.janet

@@ -565,7 +565,12 @@
             (if (nil? v) default v))
         (if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
           (in m k)
-            default)))))))))
+        # Clojure's get indexes strings too (returns the char) — reitit's path
+        # parser relies on (get path i). nth already did; get did not, so
+        # (get "a:b" 1) was nil.
+        (if (and (or (string? m) (buffer? m)) (number? k) (>= k 0) (< k (length m)))
+          (make-char (in m k))
+          default))))))))))
 
 # Runtime invoke dispatch for COMPILED code (interpreter uses evaluator's
 # jolt-invoke). Handles real functions plus Clojure IFn collections.

src/jolt/evaluator.janet

@@ -596,12 +596,25 @@
    "doubleValue" (fn [n] (* 1.0 n))
    "toString"    (fn [n &opt radix] (if (= radix 16) (string/format "%x" (math/trunc n)) (string n)))})
 
+# Universal java.lang.Object / exception / persistent-collection methods that
+# reitit's :clj branches call on non-string targets: (.getMessage e),
+# (.assoc m k v), (.get m k). Consulted in the method-dispatch fallthrough.
+(def- object-methods
+  {"getMessage"  (fn [e] (cond (and (table? e) (= :jolt/ex-info (get e :jolt/type))) (get e :message)
+                               (string? e) e
+                               (string e)))
+   "getCause"    (fn [e] (and (table? e) (get e :cause)))
+   "toString"    (fn [x] (string x))
+   "equals"      (fn [a b] (deep= a b))
+   "hashCode"    (fn [x] (hash x))})
+
 (def- string-methods
   {"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))
+   "intern"      (fn [s] 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)
@@ -1294,6 +1307,30 @@
       (register-method-impl ctx type-name proto-name method-name f)))
   (ns-intern core "make-reified"
     (fn [proto-name methods-map] (make-reified-impl ctx proto-name methods-map)))
+  # Host-class shim registration, exposed to Clojure so a library can mirror a
+  # Java class jolt doesn't ship (e.g. reitit.Trie). __register-class-statics!
+  # makes (Class/method ...) resolve; __register-class-methods! makes (.method
+  # tagged-value ...) dispatch; __register-class-ctor! makes (Class. ...) build.
+  # Reader-conditional feature toggle, exposed to Clojure so a namespace can
+  # load a clj-targeted library (e.g. reitit, under :clj) WITHOUT forcing the
+  # whole process to :clj — set features, require the lib, restore. Returns the
+  # previous feature set (a list of name strings) for restoration.
+  (ns-intern core "__reader-features"
+    (fn [] (tuple ;(map (fn [k] (string k)) (keys reader-features)))))
+  (ns-intern core "__reader-features-set!"
+    (fn [names]
+      # names arrives as a jolt vector (pvec) or list — coerce to a janet array
+      (def arr (cond (pvec? names) (pv->array names)
+                     (or (tuple? names) (array? names)) names
+                     @[names]))
+      (reader-features-set! (map (fn [n] (if (keyword? n) n (string n))) arr))
+      nil))
+  (ns-intern core "__register-class-statics!"
+    (fn [nm tbl] (register-class-statics! nm tbl) nil))
+  (ns-intern core "__register-class-methods!"
+    (fn [tag tbl] (register-tagged-methods! tag tbl) nil))
+  (ns-intern core "__register-class-ctor!"
+    (fn [nm f] (register-class-ctor! nm f) (ns-intern core nm (class-value-for nm)) nil))
   (ns-intern core "require" (fn [& specs] (require-impl ctx ;specs)))
   (ns-intern core "in-ns" (fn [sym] (in-ns-impl ctx sym)))
   (ns-intern core "use" (fn [& specs] (use-impl ctx ;specs)))
@@ -2114,9 +2151,14 @@
                 (let [m (get string-methods field-name)]
                   (if m
                     (m (string target) ;args)
-                    (error (string "Unsupported String method ." field-name))))
+                    (if-let [om (get object-methods field-name)]
+                      (om (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)
+              (if (and (get object-methods field-name)
+                       (not (and (table? target) (get tagged-methods (get target :jolt/type)))))
+                ((get object-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)))
@@ -2149,7 +2191,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
@@ -2158,9 +2200,15 @@
               (let [m (get string-methods field-name)]
                 (if m
                   (m (string target))
-                  (error (string "Unsupported String method ." field-name))))
+                  (if-let [om (get object-methods field-name)]
+                    (om (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 (get object-methods field-name)
+                     (not (and (table? target) (get tagged-methods (get target :jolt/type))
+                               (get (get tagged-methods (get target :jolt/type)) field-name))))
+              ((get object-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))
@@ -2180,7 +2228,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)]

src/jolt/javatime.janet

@@ -6,6 +6,7 @@
 # install call — adding another java.* shim follows the same shape.
 
 (use ./evaluator)
+(import ./phm)
 
 (defn- chr [s] (get s 0))
 
@@ -128,10 +129,12 @@
   (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"
+  (let [locale-statics @{"getDefault" (fn [] @{:jolt/type :jolt/locale :id "default"})
-    @{"getDefault" (fn [] @{:jolt/type :jolt/locale :id "default"})
                          "ENGLISH" @{:jolt/type :jolt/locale :id "en"}
-      "US" @{:jolt/type :jolt/locale :id "en-US"}})
+                         "US" @{:jolt/type :jolt/locale :id "en-US"}
+                         "ROOT" @{:jolt/type :jolt/locale :id "root"}}]
+    (each nm ["Locale" "java.util.Locale"]
+      (register-class-statics! nm locale-statics)))
   (register-tagged-methods! :jolt/instant
     @{"atZone" (fn [self zone] (zoned (self :ms) zone))
       "toEpochMilli" (fn [self] (self :ms))})
@@ -383,6 +386,27 @@
                                  :toks (tokenize s (or delims " \t\n\r\f"))
                                  :pos 0})))
   # clojure.lang.MapEntry: a 2-tuple, jolt's map-entry representation.
+  # java.util.HashMap: a mutable wrapper over a janet table, keyed by canonical
+  # key (so jolt collection keys compare by value). reitit uses it as a fast
+  # read cache: (HashMap. m) copies a map's entries, (.get hm k) reads.
+  # raw value-keys: reitit's HashMap keys are strings/keywords/tuples, all of
+  # which janet tables key by value — no canonicalization needed here.
+  (defn- hm-entries [m]
+    (cond (phm/phm? m) (phm/phm-entries m)
+          (struct? m) (pairs m)
+          (table? m) (pairs m)
+          @[]))
+  (register-tagged-methods! :jolt/hashmap
+    @{"get"         (fn [self k] (get (self :tbl) k))
+      "put"         (fn [self k v] (put (self :tbl) k v) v)
+      "containsKey" (fn [self k] (not (nil? (get (self :tbl) k))))
+      "size"        (fn [self] (length (self :tbl)))})
+  (each nm ["HashMap" "java.util.HashMap"]
+    (register-class-ctor! nm
+      (fn [&opt init]
+        (def tbl @{})
+        (when init (each pair (hm-entries init) (put tbl (in pair 0) (in pair 1))))
+        @{:jolt/type :jolt/hashmap :tbl tbl})))
   (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.

src/jolt/main.janet

@@ -379,6 +379,13 @@
   (when-let [jp (os/getenv "JOLT_PATH")]
     (each p (string/split ":" jp)
       (when (> (length p) 0) (array/push (get (ctx :env) :source-paths) p))))
+  # JOLT_FEATURES, likewise, must be applied at runtime: reader-features-set!
+  # runs at module load, which for a baked binary is BUILD time — so a process
+  # that sets JOLT_FEATURES (e.g. to read a clj-targeted lib's :clj branches)
+  # would otherwise be ignored, and unmatched #?(...) forms silently splice to
+  # nothing. Re-read it here so the env wins in the running process.
+  (when-let [jf (os/getenv "JOLT_FEATURES")]
+    (reader-features-set! (filter |(> (length $) 0) (string/split "," jf))))
   (cond
     (empty? argv) (run-repl)
     (help-flags (argv 0)) (print-help)

test/spec/host-interop-spec.janet

@@ -199,3 +199,27 @@
    "(do (janet.os/setenv \"JOLT_BAKE_ENV_ALLOWLIST\" \"HOME\") (let [e (System/getenv)] (janet.os/setenv \"JOLT_BAKE_ENV_ALLOWLIST\" nil) (and (contains? (set (keys e)) \"HOME\") (= 1 (count (keys e))))))"]
   ["no allowlist: unfiltered live reads" "true"
    "(string? (System/getenv \"HOME\"))"])
+
+# Host-class shim registration exposed to Clojure (reitit.Trie mirror, etc.):
+# statics resolve as (Class/method ...), ctors as (Class. ...), and registered
+# tag methods dispatch. Also: .getMessage on an exception/string, HashMap.
+(defspec "host-interop / exception + HashMap shims"
+  ["getMessage on a thrown string" "\"boom\""
+   "(try (throw \"boom\") (catch Throwable e (.getMessage e)))"]
+  ["getMessage on ex-info" "\"bad\""
+   "(try (throw (ex-info \"bad\" {})) (catch Throwable e (.getMessage e)))"]
+  ["HashMap get" "2"
+   "(let [m (HashMap. {:a 1 :b 2})] (.get m :b))"]
+  ["HashMap put + size" "2"
+   "(let [m (HashMap. {})] (.put m :x 1) (.put m :y 2) (.size m))"])
+
+# Reader-feature toggle exposed to Clojure (scoped clj-lib loading): a
+# namespace can load a clj-targeted library under :clj without forcing the
+# whole process — set features, require, restore.
+(defspec "host-interop / reader-feature toggle"
+  ["features default to jolt+default" "true"
+   "(contains? (set (__reader-features)) \"jolt\")"]
+  ["set + read back" "true"
+   "(do (def prev (__reader-features)) (__reader-features-set! [\"clj\" \"jolt\" \"default\"]) (def r (contains? (set (__reader-features)) \"clj\")) (__reader-features-set! prev) r)"]
+  ["restore returns to default" "false"
+   "(do (def prev (__reader-features)) (__reader-features-set! [\"clj\"]) (__reader-features-set! prev) (contains? (set (__reader-features)) \"clj\"))"])

test/spec/strings-spec.janet

@@ -53,3 +53,12 @@
   ["hyphens to underscores" "\"a_b_c\"" "(namespace-munge \"a-b-c\")"]
   ["from a symbol"          "\"foo_bar\"" "(namespace-munge (quote foo-bar))"]
   ["no hyphens unchanged"   "\"ok\""    "(namespace-munge \"ok\")"])
+
+# (get s i) indexes a string and returns the char, like Clojure (nth already
+# did; get did not — reitit's path parser relies on it).
+(defspec "strings / get indexes a string"
+  ["get returns the char"  "true"  "(= (get \"a:b\" 1) \\:)"]
+  ["get first char"        "\\a"    "(get \"abc\" 0)"]
+  ["get out of range nil"  "nil"   "(get \"abc\" 9)"]
+  ["get negative nil"      "nil"   "(get \"abc\" -1)"]
+  ["get default honored"   ":none" "(get \"abc\" 9 :none)"])