Merge pull request #86 from jolt-lang/reitit-enablement
host: enable reitit routing — runtime JOLT_FEATURES, class-shim hooks, get-on-strings
This commit is contained in:
Dmitri Sotnikov
GitHub
commit
a40c715ade
8 changed files with 165 additions and 11 deletions
|
|
@ -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
|
||||
|
|
|
|||
33
src/jolt/clojure/template.clj
Normal file
33
src/jolt/clojure/template.clj
Normal file
|
|
@ -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)))))
|
||||
|
|
@ -563,9 +563,14 @@
|
|||
(if (or (struct? m) (table? m))
|
||||
(let [v (m k)]
|
||||
(if (nil? v) default v))
|
||||
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
|
||||
(in m k)
|
||||
default)))))))))
|
||||
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
|
||||
(in m k)
|
||||
# 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.
|
||||
|
|
|
|||
|
|
@ -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)]
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
@{"getDefault" (fn [] @{:jolt/type :jolt/locale :id "default"})
|
||||
"ENGLISH" @{:jolt/type :jolt/locale :id "en"}
|
||||
"US" @{:jolt/type :jolt/locale :id "en-US"}})
|
||||
(let [locale-statics @{"getDefault" (fn [] @{:jolt/type :jolt/locale :id "default"})
|
||||
"ENGLISH" @{:jolt/type :jolt/locale :id "en"}
|
||||
"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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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\"))"])
|
||||
|
|
|
|||
|
|
@ -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)"])
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue