jpkg: auto-transpile installed deps; multicall honors JERBOA_PKG_PATH and auto-discovers .jpkg/lib/*/ in CWD
ober
f32702fbec687ef9da6e06c57cc513f5d864e6b4
--- a/lib/std/pkg/project.ss +++ b/lib/std/pkg/project.ss @@ -28,6 +28,7 @@ (only (jerboa core) def try catch) (only (std pkg util) jpkg-error mkdir-p remove-tree path-concat + path-basename path-dirname read-file-bytevector write-file-bytevector random-suffix string-join-list string-split-char) (only (std pkg manifest) @@ -192,7 +193,7 @@ (mkdir-p ".jpkg/deps") (let ([lnk (path-concat ".jpkg/deps" (env-dir-name name))] [abs-target (if (and (> (string-length target) 0) - (char=? (string-ref target 0) #\/)) + (char=? (string-ref target 0) #\/)) target (path-concat (current-directory) target))]) (when (file-exists? lnk #f) (delete-file lnk)) @@ -201,6 +202,102 @@ (jpkg-error "install: failed to link ~a" name)) lnk)) + ;; ── source transpile cache ───────────────────────────────────────────── + ;; + ;; Jerboa packages ship as jerbuild-style .ss sources (top-level (export ...) + ;; without a wrapping (library ...) form). The multicall runtime loads stock + ;; Chez, so to make `(import (jerboa-ssh api))` work for an installed dep we + ;; transpile its source root into R6RS .sls files under .jpkg/lib/<env-name>/. + ;; + ;; Transpilation is keyed by artifact digest: a marker file records the + ;; digest we transpiled from, and we re-run only when it changes. This keeps + ;; repeat `jpkg install` calls cheap while staying correct across upgrades. + + (def (jerbuild-binary) + ;; Resolve the jerbuild binary path. The multicall sets JERBOA_SELF_EXE + ;; to the absolute path of the jerboa/jerbuild binary it extracted; we + ;; invoke it with JERBOA_MULTICALL_NAME=jerbuild to select the jerbuild + ;; subcommand (the same binary is multi-coalesced). Fall back to a + ;; sibling jerbuild in PATH or dev tree for non-multicall builds. + (let ([self (getenv "JERBOA_SELF_EXE")]) + (cond + [(and self (> (string-length self) 0) (file-exists? self)) self] + [(file-exists? "dist/jerbuild") "dist/jerbuild"] + [(file-exists? "jerbuild") "jerbuild"] + [else #f]))) + + (def (jerbuild-invocation jerb src lib) + ;; Build the shell command to run jerbuild transpile. When jerb is the + ;; multicall binary, the subcommand is selected by argv[1] ("jerbuild") + ;; rather than by JERBOA_MULTICALL_NAME (the C main overwrites that env + ;; var based on argv[0]'s basename and argv[1]). + (let ([self (getenv "JERBOA_SELF_EXE")] + [multi? (getenv "JERBOA_MULTICALL_NAME")]) + (if (and self (string=? self jerb) multi?) + ;; Inside the multicall: invoke as "<self> jerbuild transpile ...". + (string-append + (shell-quote-arg jerb) " jerbuild transpile --force " + (shell-quote-arg src) " " + (shell-quote-arg lib) " > /dev/null") + (string-append + (shell-quote-arg jerb) " transpile --force " + (shell-quote-arg src) " " + (shell-quote-arg lib) " > /dev/null")))) + + (def (transpile-into-env! name unpacked-dir digest) + ;; Transpile unpacked-dir/<modules.root> -> .jpkg/lib/<env-name>/<root>/. + ;; Returns the lib directory on success, #f if jerbuild is unavailable. + ;; + ;; jerbuild names a library by the path relative to the SRC dir, so we + ;; pass the source root (the directory inside unpacked-dir that the + ;; manifest declares as (modules (root "src")), defaulting to "src"). + ;; The output goes to .jpkg/lib/<env>/<root>/... and dep-root-path points + ;; library-directories at .jpkg/lib/<env>/<root> so (import (pkg api)) + ;; resolves correctly. + (let* ([env (env-dir-name name)] + [lib-root ".jpkg/lib"] + [manifest-path (path-concat unpacked-dir "jpkg.sexp")] + [m (if (file-exists? manifest-path) (parse-manifest-file manifest-path) #f)] + [root-leaf (if (and m (manifest-modules m)) + (cdr (assq 'root (manifest-modules m))) + "src")] + [source-root (if (string=? root-leaf ".") + unpacked-dir + (path-concat unpacked-dir root-leaf))] + [lib-dir (path-concat lib-root env)] + [marker (path-concat lib-dir ".jpkg-transpile-marker")] + [jerb (jerbuild-binary)]) + (mkdir-p lib-root) + (cond + [(not jerb) + ;; No jerbuild available; leave a hint and skip. project-env-paths + ;; will fall back to the raw source so power users can pre-transpile. + #f] + [(and (file-exists? marker) + (string=? (utf8->string (read-file-bytevector marker)) digest)) + ;; already transpiled for this exact digest + lib-dir] + [else + (when (file-directory? lib-dir) (remove-tree lib-dir)) + (mkdir-p lib-dir) + (let ([rc (system + (jerbuild-invocation jerb source-root lib-dir))]) + (unless (= rc 0) + (remove-tree lib-dir) + (jpkg-error "install: transpile failed for ~a (jerbuild rc=~a)" + name rc)) + (write-file-bytevector marker (string->utf8 digest)) + lib-dir)]))) + + (def (shell-quote-arg s) + ;; Single-quote, escape internal single-quotes per sh convention. + (string-append + "'" + (apply string-append + (map (lambda (c) (if (char=? c #\') "'\"'\"'" (string c))) + (string->list s))) + "'")) + (def (require-signatures?) (and (getenv "JPKG_REQUIRE_SIGNATURES") #t)) (def (require-provenance?) (and (getenv "JPKG_REQUIRE_PROVENANCE") #t)) @@ -234,10 +331,20 @@ (unless (file-directory? path) (jpkg-error "install: linked path ~a missing for ~a" path (locked-package-name p))) - (link-into-env! (locked-package-name p) path)) + (link-into-env! (locked-package-name p) path) + ;; dev links: transpile the linked checkout in place. + ;; The "digest" for a link is its path so re-linking re-transpiles. + (transpile-into-env! (locked-package-name p) + path + (string-append "link:" path))) (begin (fetch-into-store! p) - (link-into-env! (locked-package-name p) (ensure-unpacked! p))))) + (let* ([unpacked (ensure-unpacked! p)] + [name (locked-package-name p)]) + (link-into-env! name unpacked) + (transpile-into-env! + name unpacked + (locked-package-artifact-sha256 p)))))) pkgs) ;; prune env entries not in the lock (when (file-directory? ".jpkg/deps") @@ -249,6 +356,14 @@ (remove-tree p) (delete-file p))))) (directory-list ".jpkg/deps")))) + (when (file-directory? ".jpkg/lib") + (let ([valid (map (lambda (p) (env-dir-name (locked-package-name p))) pkgs)]) + (for-each (lambda (e) + (unless (member e valid) + (let ([p (path-concat ".jpkg/lib" e)]) + (when (file-directory? p) + (remove-tree p))))) + (directory-list ".jpkg/lib")))) pkgs)) ;; ── manifest editing ─────────────────────────────────────────────────── @@ -390,16 +505,39 @@ ;; ── env paths ────────────────────────────────────────────────────────── (def (dep-root-path name) - ;; library root inside an installed dep: <link>/<modules.root> - (let* ([base (path-concat ".jpkg/deps" (env-dir-name name))] - [mpath (path-concat base "jpkg.sexp")]) - (if (file-exists? mpath) - (let* ([m (parse-manifest-file mpath)] - [root (if (manifest-modules m) - (cdr (assq 'root (manifest-modules m))) - "src")]) - (if (string=? root ".") base (path-concat base root))) - base))) + ;; library root inside an installed dep. Prefer the transpiled .sls cache + ;; (.jpkg/lib/<env-name>/<root>/) when present — those are stock + ;; Chez-loadable. jerbuild preserves the source layout, so the transpiled + ;; .sls files live under the same root the package declares (default + ;; "src"). Fall back to the raw source root if transpile hasn't run. + (let* ([env (env-dir-name name)] + [lib-dir (path-concat ".jpkg/lib" env)]) + (cond + [(file-directory? lib-dir) + ;; Find the root subdir: read the dep manifest if available, + ;; otherwise check common candidates (src, .). + (let* ([deps-manifest (path-concat ".jpkg/deps" env "jpkg.sexp")] + [root-leaf (if (file-exists? deps-manifest) + (let* ([m (parse-manifest-file deps-manifest)]) + (if (manifest-modules m) + (cdr (assq 'root (manifest-modules m))) + "src")) + "src")] + [lib-leaf (path-concat lib-dir root-leaf)]) + (cond + [(file-directory? lib-leaf) lib-leaf] + [(file-directory? lib-dir) lib-dir] + [else lib-dir]))] + [else + (let* ([base (path-concat ".jpkg/deps" env)] + [mpath (path-concat base "jpkg.sexp")]) + (if (file-exists? mpath) + (let* ([m (parse-manifest-file mpath)] + [root (if (manifest-modules m) + (cdr (assq 'root (manifest-modules m))) + "src")]) + (if (string=? root ".") base (path-concat base root))) + base))]))) (def (project-env-paths) ;; absolute-ish (project-relative) library paths for all locked deps --- a/support/build-jerboa-multicall.ss +++ b/support/build-jerboa-multicall.ss @@ -326,28 +326,53 @@ ;; every invocation in `jpkg env --`. The path is colon- ;; separated, same convention Chez uses for library-directories. ;; We import only (scheme) at this point, so use raw Chez primitives. - (let ([pkg-path (getenv "JERBOA_PKG_PATH")]) - (when (and pkg-path (> (string-length pkg-path) 0)) - (let ([char-index - (lambda (s ch) - (let ([n (string-length s)]) - (let loop ([i 0]) - (cond - [(= i n) #f] - [(char=? (string-ref s i) ch) i] - [else (loop (+ i 1))]))))]) - (let split ([rest pkg-path] [acc '()]) - (let ([idx (char-index rest #\:)]) - (if idx - (split (substring rest (+ idx 1) (string-length rest)) - (let ([seg (substring rest 0 idx)]) - (if (> (string-length seg) 0) (cons seg acc) acc))) - (let* ([final (if (> (string-length rest) 0) (cons rest acc) acc)] - [segs (reverse final)]) - (unless (null? segs) - (library-directories - (append (library-directories) - (map (lambda (d) (cons d d)) segs)))))))))))) + (let ([char-index + (lambda (s ch) + (let ([n (string-length s)]) + (let loop ([i 0]) + (cond + [(= i n) #f] + [(char=? (string-ref s i) ch) i] + [else (loop (+ i 1))]))))]) + (let ([split-colon + (lambda (s) + (let loop ([rest s] [acc '()]) + (let ([idx (char-index rest #\:)]) + (if idx + (loop (substring rest (+ idx 1) (string-length rest)) + (let ([seg (substring rest 0 idx)]) + (if (> (string-length seg) 0) (cons seg acc) acc))) + (reverse (if (> (string-length rest) 0) (cons rest acc) acc))))))]) + (let* ([pkg-path (getenv "JERBOA_PKG_PATH")] + [segs (if (and pkg-path (> (string-length pkg-path) 0)) + (split-colon pkg-path) + '())] + ;; Auto-discover project-local dep transpiles: + ;; .jpkg/lib/<env>/src/ (or .jpkg/lib/<env>/) + ;; for every dep in the current working dir. + ;; This means `jerboa app.ss` works after + ;; `jpkg add foo` with no env wrapper. + [auto-segs + (let ([lib-dir ".jpkg/lib"]) + (if (file-directory? lib-dir) + (let loop ([entries (directory-list lib-dir)] + [acc '()]) + (if (null? entries) + (reverse acc) + (let* ([env (car entries)] + [full (string-append lib-dir "/" env)] + [src (string-append full "/src")]) + (loop (cdr entries) + (cond + [(file-directory? src) (cons src acc)] + [(file-directory? full) (cons full acc)] + [else acc]))))) + '()))] + [all-segs (append segs auto-segs)]) + (unless (null? all-segs) + (library-directories + (append (library-directories) + (map (lambda (d) (cons d d)) all-segs)))))))) out) (newline out) (write `(let ([mode (or (getenv "JERBOA_MULTICALL_NAME") "jerboa")]