Merge pull request #204 from jolt-lang/feat/ring-defaults-host-interop
Host interop + deps fixes for ring-defaults on jolt
This commit is contained in:
Dmitri Sotnikov
GitHub
commit
19b19fb83f
7 changed files with 84 additions and 14 deletions
|
|
@ -14,6 +14,10 @@ the [examples](https://github.com/jolt-lang/examples), e.g. the
|
|||
* [ring-core](https://github.com/ring-clojure/ring) — via `:deps/root "ring-core"`,
|
||||
on the ring-app example
|
||||
* [ring-codec](https://github.com/ring-clojure/ring-codec) — URL/form encoding
|
||||
* [ring-defaults](https://github.com/ring-clojure/ring-defaults) — the standard
|
||||
middleware stack (params, static resources + content-type, session, security
|
||||
headers); its session/CSRF crypto comes from
|
||||
[jolt-lang/jolt-crypto](https://github.com/jolt-lang/jolt-crypto) (OpenSSL)
|
||||
* [reitit-core](https://github.com/metosin/reitit) — data-driven routing; the
|
||||
`reitit.Trie` Java class is mirrored by
|
||||
[jolt-lang/router](https://github.com/jolt-lang/router). `JOLT_FEATURES` `clj`.
|
||||
|
|
|
|||
|
|
@ -206,13 +206,24 @@
|
|||
(register-class-statics! "NumberFormat" nf-statics)
|
||||
(register-class-statics! "java.text.NumberFormat" nf-statics))
|
||||
|
||||
;; Class.forName: an array descriptor ("[C") is its own class token; a class Jolt
|
||||
;; can back (registered statics/ctor, or a java.*/clojure.* core class) yields a
|
||||
;; class object; anything else throws a catchable ClassNotFoundException, like the
|
||||
;; JVM — so the common `(try (Class/forName "optional.Dep") (catch …))` probe a
|
||||
;; library uses to detect an absent dependency works (e.g. ring's joda-time check).
|
||||
(define (forname-known? nm)
|
||||
(or (lookup-class class-statics-tbl nm)
|
||||
(lookup-class class-ctors-tbl nm)
|
||||
(let ((pre? (lambda (p) (and (>= (string-length nm) (string-length p))
|
||||
(string=? (substring nm 0 (string-length p)) p)))))
|
||||
(or (pre? "java.") (pre? "clojure.") (pre? "jolt.")))))
|
||||
(register-class-statics! "Class"
|
||||
;; an array descriptor ("[C", "[I", …) is its own class token (so instance? and
|
||||
;; class compare equal); other names become a class jhost.
|
||||
(list (cons "forName" (lambda (nm)
|
||||
(if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\[))
|
||||
nm
|
||||
(make-jhost "class" (list (cons 'name nm))))))))
|
||||
(list (cons "forName"
|
||||
(lambda (nm . _)
|
||||
(cond
|
||||
((and (> (string-length nm) 0) (char=? (string-ref nm 0) #\[)) nm)
|
||||
((forname-known? nm) (make-class-obj nm))
|
||||
(else (jolt-throw (jolt-host-throwable "java.lang.ClassNotFoundException" nm))))))))
|
||||
|
||||
;; ---- System helpers (defined before use above via top-level order) ----------
|
||||
;; os.name reflects the actual platform (Chez's machine-type names it): a *osx
|
||||
|
|
|
|||
|
|
@ -296,6 +296,14 @@
|
|||
(let ((port (open-file-output-port (path-of output) (file-options no-fail) (buffer-mode block))))
|
||||
(put-bytevector port bv) (close-port port))
|
||||
(jolt-spit output (input-text input)))))
|
||||
;; a byte-output-stream shim (a host tagged-table with :jolt/output-stream,
|
||||
;; e.g. http-client's ByteArrayOutputStream): write through its .write method,
|
||||
;; byte-exact for a byte source.
|
||||
((and (htable? output) (jolt-truthy? (jolt-ref-get output (keyword "jolt" "output-stream"))))
|
||||
(let ((bv (input-bytes input)))
|
||||
(record-method-dispatch output "write"
|
||||
(list->cseq (list (if bv (make-jolt-array (list->vector (bytevector->u8-list bv)) 'byte)
|
||||
(input-text input)))))))
|
||||
(else (error #f "io/copy: don't know how to write to" output)))
|
||||
jolt-nil)
|
||||
(def-var! "clojure.java.io" "copy" jio-copy)
|
||||
|
|
|
|||
|
|
@ -131,6 +131,11 @@
|
|||
((string=? name "getCanonicalPath")(list (jfile-abs fp)))
|
||||
((string=? name "toURI") (list (string-append "file:" (jfile-abs fp))))
|
||||
((string=? name "toURL") (list (make-url (string-append "file:" (jfile-abs fp)))))
|
||||
;; io/resource returns a File where the JVM returns a file: URL; answer the
|
||||
;; two URL methods resource-serving middleware (ring) calls on the result, so
|
||||
;; it sees a "file" protocol and a path without changing the return type.
|
||||
((string=? name "getProtocol") (list "file"))
|
||||
((string=? name "getFile") (list (jfile-abs fp)))
|
||||
((string=? name "exists") (list (if (file-exists? fp) #t #f)))
|
||||
((string=? name "isDirectory") (list (if (file-directory? fp) #t #f)))
|
||||
((string=? name "isFile") (list (if (and (file-exists? fp) (not (file-directory? fp))) #t #f)))
|
||||
|
|
@ -433,8 +438,19 @@
|
|||
((file-exists? (string-append (car roots) "/" nm))
|
||||
(make-url (string-append "file:" (car roots) "/" nm)))
|
||||
(else (loop (cdr roots)))))))
|
||||
;; getResources: every source root that holds the named resource, as file: URLs
|
||||
;; (enumeration-seq just calls seq, so a list serves). ring's static-resource
|
||||
;; symlink check enumerates these to confirm a served file sits under a root.
|
||||
(define (cl-get-resources self name)
|
||||
(let ((nm (jolt-str-render-one name)))
|
||||
(let loop ((roots (get-source-roots)) (acc '()))
|
||||
(cond ((null? roots) (list->cseq (reverse acc)))
|
||||
((file-exists? (string-append (car roots) "/" nm))
|
||||
(loop (cdr roots) (cons (make-url (string-append "file:" (car roots) "/" nm)) acc)))
|
||||
(else (loop (cdr roots) acc))))))
|
||||
(register-host-methods! "classloader"
|
||||
(list (cons "getResource" cl-get-resource)
|
||||
(cons "getResources" cl-get-resources)
|
||||
(cons "getResourceAsStream"
|
||||
(lambda (self name)
|
||||
(let ((u (cl-get-resource self name)))
|
||||
|
|
|
|||
|
|
@ -303,7 +303,9 @@
|
|||
(define (str-replace-all pat repl s)
|
||||
(if (jolt-regex? pat)
|
||||
(re-replace (regex-t-irx pat) s repl #t)
|
||||
(str-replace-literal s pat repl)))
|
||||
;; literal match: a char/number match or replacement (str/replace s \a \b)
|
||||
;; coerces to a string, as on the JVM.
|
||||
(str-replace-literal s (str-needle pat) (str-needle repl))))
|
||||
(define (str-replace-literal-first s a b)
|
||||
(let ((alen (string-length a)) (i (str-index-of s a 0)))
|
||||
(if (fx<? i 0) s
|
||||
|
|
@ -311,7 +313,7 @@
|
|||
(define (str-replace pat repl s)
|
||||
(if (jolt-regex? pat)
|
||||
(re-replace (regex-t-irx pat) s repl #f)
|
||||
(str-replace-literal-first s pat repl)))
|
||||
(str-replace-literal-first s (str-needle pat) (str-needle repl))))
|
||||
|
||||
(def-var! "clojure.core" "str-upper" str-upper)
|
||||
(def-var! "clojure.core" "str-lower" str-lower)
|
||||
|
|
|
|||
|
|
@ -77,11 +77,35 @@
|
|||
paths (or (:paths edn) ["src"])]
|
||||
(map #(abspath root %) paths)))
|
||||
|
||||
;; --- reconciliation ---------------------------------------------------------
|
||||
;; Dependencies are resolved as a TREE (resolve-deps' BFS, which visits each
|
||||
;; coordinate once) and then reconciled into a definitive, de-duplicated set —
|
||||
;; one place, not ad-hoc per call site. dedup-by keeps the first item per key,
|
||||
;; order preserved; it dedups both source roots (by path) and native libraries
|
||||
;; (by identity), so an app pulling two libs that declare the same shared object
|
||||
;; (e.g. libcrypto via both http-client and the ring adapter) includes and loads
|
||||
;; it ONCE.
|
||||
(defn- dedup-by [key xs]
|
||||
(second (reduce (fn [[seen acc] x]
|
||||
(let [k (key x)]
|
||||
(if (contains? seen k) [seen acc] [(conj seen k) (conj acc x)])))
|
||||
[#{} []] xs)))
|
||||
|
||||
(defn- native-key
|
||||
"Identity of a :jolt/native spec. A :process lib (the running process's own
|
||||
symbols, e.g. libc) keys on that flag; a file lib on its :name, else on its
|
||||
platform candidate paths — two deps naming the same lib reconcile to one load."
|
||||
[spec]
|
||||
(letfn [(cands [k] (let [v (get spec k)] (cond (string? v) [v] (sequential? v) (vec v) :else [])))]
|
||||
(if (:process spec)
|
||||
[:process (:name spec)]
|
||||
[:native (or (:name spec) (vec (sort (concat (cands :darwin) (cands :linux)))))])))
|
||||
|
||||
(defn- resolve-deps
|
||||
"Breadth-first walk of a deps map; returns {:roots [...] :natives [...]} — the
|
||||
ordered, de-duplicated source-root directories and the collected :jolt/native
|
||||
declarations from every dep's deps.edn. `base-dir` resolves :local/root and is
|
||||
replaced by a dep's own root as the walk descends."
|
||||
source-root directories and the collected :jolt/native declarations from every
|
||||
dep's deps.edn (raw, in walk order; reconcile-project dedups them). `base-dir`
|
||||
resolves :local/root and is replaced by a dep's own root as the walk descends."
|
||||
[deps base-dir]
|
||||
;; queue grows by appending children at the tail; an index cursor walks it so
|
||||
;; each dequeue is O(1) (was (subvec (vec queue) 1) per pop -> O(n^2)).
|
||||
|
|
@ -91,7 +115,7 @@
|
|||
roots []
|
||||
natives []]
|
||||
(if (>= i (count queue))
|
||||
{:roots (distinct roots) :natives natives}
|
||||
{:roots roots :natives natives}
|
||||
(let [[coord spec bd] (nth queue i)
|
||||
i (inc i)]
|
||||
(if (contains? seen coord)
|
||||
|
|
@ -125,7 +149,8 @@
|
|||
project-roots (map #(abspath project-dir %) project-paths)
|
||||
all-deps (merge (:deps edn) extra-deps)
|
||||
{dep-roots :roots dep-natives :natives} (resolve-deps all-deps project-dir)]
|
||||
{:roots (vec (distinct (concat project-roots dep-roots)))
|
||||
;; reconcile: the project's own roots/natives + every dep's, deduped once.
|
||||
{:roots (dedup-by identity (concat project-roots dep-roots))
|
||||
:main-opts main-opts
|
||||
;; the project's own paths (relative to project-dir) and absolute resource
|
||||
;; roots, plus its :jolt/build options — `jolt build` uses these to bundle
|
||||
|
|
@ -136,7 +161,7 @@
|
|||
:build (:jolt/build edn)
|
||||
:embed-dirs (mapv #(abspath project-dir %) (:embed (:jolt/build edn)))
|
||||
:tasks (:tasks edn)
|
||||
:natives (vec (distinct (concat (:jolt/native edn) dep-natives)))
|
||||
:natives (dedup-by native-key (concat (:jolt/native edn) dep-natives))
|
||||
;; nREPL middleware a library contributes (jolt.nrepl composes them over its
|
||||
;; built-in handler) — symbols resolving to a middleware fn or a vector of them.
|
||||
:nrepl-middleware (:nrepl/middleware edn)})))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,8 @@
|
|||
[
|
||||
{:suite "interop / Class.forName" :label "unknown class throws ClassNotFoundException" :expected ":nf" :actual "(try (Class/forName \"no.such.Klass\") (catch ClassNotFoundException _ :nf))"}
|
||||
{:suite "interop / Class.forName" :label "known class resolves" :expected "\"java.lang.String\"" :actual "(.getName (Class/forName \"java.lang.String\"))"}
|
||||
{:suite "clojure.string / replace" :label "char match and replacement" :expected "\"a-b-c\"" :actual "(clojure.string/replace \"a/b/c\" \\/ \\-)"}
|
||||
{:suite "clojure.string / replace" :label "char match, string replacement" :expected "\"x_y\"" :actual "(clojure.string/replace \"x.y\" \\. \"_\")"}
|
||||
{:suite "interop-fixes / deprecated #^ metadata reader" :label "#^ type hint on a param" :expected "\"x\"" :actual "(do (defn f1 [#^String s] s) (f1 \"x\"))"}
|
||||
{:suite "interop-fixes / deprecated #^ metadata reader" :label "#^\"[B\" array hint" :expected "[1 2]" :actual "(do (defn f2 [#^\"[B\" b] b) (f2 [1 2]))"}
|
||||
{:suite "interop-fixes / deprecated #^ metadata reader" :label "#^ is equivalent to ^" :expected "true" :actual "(= (meta (with-meta [] {:tag (quote String)})) {:tag (quote String)})"}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue