ABCL Java dependency support

.gitignore

@@ -1,3 +1,5 @@
 *.fas
 vend
 deps.dot
+vendored/java/
+*.abcl

src/abcl.lisp

@@ -0,0 +1,154 @@
+;;; Integrations custom to ABCL and the provisioning of JVM packages from Maven
+;;; Central. Compatible with the syntax expected by `abcl-asdf', namely:
+;;;
+;;; ```
+;;; (asdf:defsystem :log4j
+;;;   :components ((:mvn "log4j/log4j" :version "1.4.9"))
+;;; ```
+;;;
+;;; Many functions here thus operate on a `dep' plist of the shape:
+;;;
+;;; ```
+;;; (:group ... :artifact ... :version ...)
+;;; ```
+
+(in-package :vend)
+
+(defun maven-deps (system)
+  "Given a `defsystem' sexp, extract its Maven Central dependencies, if any."
+  (t:transduce
+   (t:comp (t:filter (lambda (pl) (and (getf pl :mvn) (getf pl :version))))
+           (t:map (lambda (pl)
+                    (destructuring-bind (group artifact)
+                        (t::string-split (getf pl :mvn) :separator #\/)
+                      (list :group group
+                            :artifact artifact
+                            :version (getf pl :version))))))
+   #'t:cons
+   (getf system :components)))
+
+#+nil
+(maven-deps '(asdf:defsystem :log4j
+              :components ((:mvn "log4j/log4j" :version "1.4.9"))))
+
+(defun jar-download-command (dep)
+  "Produce the command necessary to download something from Maven Central."
+  (list "mvn" "dependency:get"
+        (format nil "-DgroupId=~a" (getf dep :group))
+        (format nil "-DartifactId=~a" (getf dep :artifact))
+        (format nil "-Dversion=~a" (getf dep :version))
+        "-Dmaven.repo.local=vendored/java/"))
+
+#+nil
+(jar-download-command
+ (car (maven-deps '(asdf:defsystem :log4j
+                    :components ((:mvn "log4j/log4j" :version "1.4.9"))))))
+
+(defun download-from-maven (dep)
+  (let ((cmd (jar-download-command dep)))
+    (multiple-value-bind (stream code obj)
+        (ext:run-program (car cmd) (cdr cmd) :output *standard-output*)
+      (declare (ignore stream obj))
+      (assert (= 0 code) nil "Pulling ~a from Maven Central failed" (getf dep :mvn)))))
+
+#+nil
+(download-from-maven '(:mvn "org.apache.commons/commons-text" :version "1.13.1"))
+
+(defun java-dep-dir (dep)
+  "Rederive a directory path in which a JAR and POM can be found."
+  (let* ((group    (getf dep :group))
+         (artifact (getf dep :artifact))
+         (version  (getf dep :version))
+         (parts    (t::string-split group :separator #\.)))
+    (p:ensure-directory (apply #'p:join "vendored" "java" (append parts (list artifact version))))))
+
+#+nil
+(java-dep-dir '(:group "org.apache.commons" :artifact "commons-text" :version "1.13.1"))
+
+(defun java-jar-path (dep)
+  "The expected path to a downloaded JAR of this dep."
+  (let ((jar (format nil "~a-~a.jar" (getf dep :artifact) (getf dep :version))))
+    (p:join (java-dep-dir dep) jar)))
+
+#+nil
+(java-jar-path '(:group "org.apache.commons" :artifact "commons-text" :version "1.13.1"))
+
+(defun java-pom-path (dep)
+  "The expected path to a downloaded POM of this dep."
+  (let ((pom (format nil "~a-~a.pom" (getf dep :artifact) (getf dep :version))))
+    (p:join (java-dep-dir dep) pom)))
+
+#+nil
+(java-pom-path '(:group "org.apache.commons" :artifact "commons-text" :version "1.13.1"))
+
+;; NOTE: 2025-05-25 This is about 2x faster than `uiop:read-file-string', and
+;; much, much faster than reading it in line-by-line and re-fusing via
+;; transducers.
+(declaim (ftype (function (pathname) (simple-array character *)) string-from-file))
+(defun string-from-file (path)
+  "Read some given file into a single string."
+  (with-open-file (stream path :direction :input :element-type 'character)
+    (let* ((len (file-length stream))
+           (str (make-string len)))
+      (read-sequence str stream)
+      str)))
+
+#+nil
+(x:parse (string-from-file (java-pom-path '(:group "org.apache.commons" :artifact "commons-text" :version "1.13.1"))))
+
+(defun deps-from-xml (xml)
+  "Extract the non-test dependencies from some parsed XML."
+  (let* ((content (x:content xml))
+         (deps    (gethash "dependency" (x:content (gethash "dependencies" content))))
+         (props   (x:content (gethash "properties" content))))
+    (t:transduce
+     (t:comp (t:map #'x:content)
+             (t:filter (lambda (ht) (gethash "version" ht)))
+             (t:filter (lambda (ht) (not (gethash "scope" ht))))
+             (t:map (lambda (ht)
+                      (list :group    (x:content (gethash "groupId" ht))
+                            :artifact (x:content (gethash "artifactId" ht))
+                            :version  (dep-version props ht)))))
+     #'t:cons
+     deps)))
+
+#+nil
+(let* ((path (java-pom-path '(:group "org.apache.commons" :artifact "commons-text" :version "1.13.1")))
+       (xml  (x:parse (string-from-file path))))
+  (deps-from-xml xml))
+
+(defun dep-version (props dep)
+  "For a particular dependency, discover its true version."
+  (let ((ver (x:content (gethash "version" dep))))
+    (if (eql #\$ (schar ver 0))
+        (x:content (gethash (extract-prop-name ver) props))
+        ver)))
+
+(defun extract-prop-name (s)
+  "Pull the inner property name from a ${} fence."
+  (let ((len (length s)))
+    (subseq s 2 (1- len))))
+
+#+nil
+(extract-prop-name "${commons.lang3.version}")
+
+(defun classpath (dep)
+  "Build a collection of names matched to JAR locations on disk."
+  (labels ((recurse (ht curr)
+             ;; FIXME: 2025-05-25 This condition may be incorrect. It might be
+             ;; better to both the group and artifact together as the key.
+             (let ((name (getf curr :artifact)))
+               (if (gethash name ht)
+                   ht
+                   (let* ((jar (java-jar-path curr))
+                          (pom (java-pom-path curr))
+                          (xml (x:parse (string-from-file pom))))
+                     (setf (gethash name ht) jar)
+                     (dolist (dep (deps-from-xml xml))
+                       (recurse ht dep))
+                     ht)))))
+    (recurse (make-hash-table :test #'equal :size 64) dep)))
+
+#+nil
+(classpath '(:group "org.apache.commons" :artifact "commons-text" :version "1.13.1"))
+

src/asd.lisp

@@ -74,7 +74,7 @@
 #++
 (chipz? "#+chipz-system:gray-streams")
 
-(defun string-from-file (path)
+(defun string-from-asd-file (path)
   "Preserves newlines but removes whole-line comments."
   (t:transduce (t:comp (t:filter (lambda (line) (not (comment? line))))
                        (t:filter (lambda (line) (not (chipz? (string-left-trim " " line)))))
@@ -83,15 +83,15 @@
                #'t:string path))
 
 #++
-(string-from-file #p"vend.asd")
+(string-from-asd-file #p"vend.asd")
 
 (defun systems-from-file (path)
   "Extract all `defsystem' forms as proper sexp from a file."
   (t:transduce (t:map (lambda (sys)
                         (let* ((clean (sanitize sys))
                                (stream (make-string-input-stream clean)))
                           (read stream nil :eof))))
-               #'t:cons (all-system-strings (string-from-file path))))
+               #'t:cons (all-system-strings (string-from-asd-file path))))
 
 #++
 (systems-from-file (car (asd-files "./")))

src/package.lisp

@@ -2,7 +2,8 @@
   (:use :cl)
   (:local-nicknames (#:g #:simple-graph)
                     (#:p #:filepaths)
-                    (#:t #:transducers))
+                    (#:t #:transducers)
+                    (#:x #:parcom/xml))
   (:export #:main)
   (:documentation "Simply vendor your Common Lisp project dependencies."))
 

src/registry.lisp

@@ -127,6 +127,8 @@ map back to the parent, such that later only one git clone is performed.")
   "Repositories marked as deprecated or archived by their authors.")
 
 ;; TODO: 2024-01-11 Make this a HashTable.
+;;
+;; 2025-05-26 Maybe.
 (defparameter +sources+
   '(:3b-bmfont       "https://github.com/3b/3b-bmfont.git"
     :3b-hdr          "https://github.com/3b/3b-hdr.git"
@@ -135,6 +137,7 @@ map back to the parent, such that later only one git clone is performed.")
     :3d-math         "https://github.com/Shinmera/3d-math.git"
     :3d-spaces       "https://github.com/Shirakumo/3d-spaces.git"
     :40ants-doc      "https://github.com/40ants/doc.git"
+    :abcl-memory-compiler "https://github.com/alejandrozf/abcl-memory-compiler.git"
     :access          "https://github.com/AccelerationNet/access.git"
     :acclimation     "https://github.com/robert-strandh/Acclimation.git"
     :action-list     "https://github.com/Shinmera/action-list.git"

vend.asd

@@ -3,11 +3,12 @@
   :author "Colin Woodbury <colin@fosskers.ca>"
   :license "MPL-2.0"
   :homepage "https://github.com/fosskers/vend"
-  :depends-on (:filepaths :simple-graph :transducers)
+  :depends-on (:filepaths :simple-graph :transducers :parcom/xml)
   :serial t
   :components ((:module "src"
                 :components ((:file "package")
                              (:file "registry")
+                             (:file "abcl")
                              (:file "asd")
                              (:file "vend"))))
   :description "Simply vendor your Common Lisp project dependencies.")

vendored/transducers/CHANGELOG.md

@@ -2,9 +2,21 @@
 
 ### Unreleased
 
+#### Fixed
+
+- A forgotten `all?` export.
+
+### 1.4.0 (2025-02-15)
+
 #### Added
 
 - `unique-by` for more control over how uniqueness is determined.
+- `for` as a better pattern for doing something effectful over the stream.
+- `any?`, `all?`, and `reduced?` as modern aliases.
+
+#### Deprecated
+
+- `for-each`: use `for` instead.
 
 ### 1.3.1 (2025-01-13)