source: tags/1.5.0/contrib/abcl-asdf/abcl-asdf.lisp

Last change on this file was 15017, checked in by mevenson, 3 months ago

Refactor out initialization pattern for Maven as WITH-AETHER to be
used by external consumers/manipulators of the Maven Aether libraries.

Unfinished, but can be used now to guarantee that ABCL-ASDF has
located Maven, which will be retrofitted compatible with current

TODO Introduce toplevel handler for finding Maven.

File size: 5.8 KB
1;;;; The ABCL specific overrides in ASDF. 
3;;;; Extensions to ASDF for use by ABCL
4(require :asdf)
5(in-package :asdf)
7(defclass iri (component) 
8  ((schema :initform nil)
9   (authority :initform nil)
10   (path :initform nil)
11   (query :initform nil)
12   (fragment :initform nil)))
14(defclass mvn (iri) 
15  ((group-id :initarg :group-id :initform nil)
16   (artifact-id :initarg :artifact-id :initform nil)
17   (repository :initarg :repository :initform "") ;;; XXX unimplemented
18   (resolved-classpath :initform nil :accessor resolved-classpath)
19   (classname :initarg :classname :initform nil)
20   (alternate-uri :initarg :alternate-uri :initform nil)
21   ;; inherited from ASDF:COMPONENT ??? what are the CL semantics on overriding -- ME 2012-04-01
22   #+nil   (version :initform nil)))
24;;; We intercept compilation to ensure that load-op will succeed
25(defmethod perform ((op compile-op) (c mvn))
26  (unless (resolved-classpath c)
27    (setf (resolved-classpath c)
28          (abcl-asdf:resolve   
29           (ensure-parsed-mvn c)))))
31(defmethod perform ((operation load-op) (c mvn))
32  (let ((resolved-classpath (resolved-classpath c)))
33    (when (stringp resolved-classpath)
34      (java:add-to-classpath (abcl-asdf:as-classpath resolved-classpath)))))
36;;; A Maven URI has the form "mvn:group-id/artifact-id/version"
38;;; Sometimes people write "group-id:artifact-id:version" to refer to
39;;; Maven artifacts.  One can use ABCL-ASDF:RESOLVE directly for
40;;; serialized references to artifacts of this form.
42;;; Currently we "stuff" the group-id/artifact-id into the 'name' and
43;;; use the component 'version' for the version.  Parts of ASDF
44;;; *reallY* want ASDF:VERSION to be a triple of intergers, and never
45;;; anything more, so that is part of the motivation behind this effort.
46(defparameter *mvn-repositories* nil
47  "A list of all Maven repositories encountered in the lifetime of this instance of the implementation.")
50(defmethod slot-missing ((class mvn) object slot-name operation &optional new-value)
51  (setf (slot-value object slot-name) 
52        (if new-value
53            new-value
54            nil)))
56(defun ensure-parsed-mvn (component)
57  (with-slots (name group-id artifact-id
58                    version schema path repository) 
59      component
60    (when (null asdf::artifact-id) 
61      (let ((parsed (abcl-asdf::split-string name "/"))
62            (asdf-version-p (slot-boundp component 'version))
63            (default-version "LATEST"))
64        (cond ((= (length parsed) 3)
65               (setf 
66                group-id (first parsed)
67                artifact-id (second parsed)
68                version (third parsed)))
69              ((= (length parsed) 2)
70               (setf 
71                group-id (first parsed)
72                artifact-id (second parsed)
73                version (if asdf-version-p
74                            version
75                            default-version)))
76              (t
77               (error "Failed to construct a mvn reference from name '~A' and version '~A'"
78                      name version)))
79        (setf schema "mvn")
80        (when repository
81          (pushnew repository *mvn-repositories*))
82        ;;; Always set path to normalized path "on the way out" to
83        ;;; contain group-id/artifact-id/version
84        ;;; TODO? record repository as well in path of component
85        (setf path (format nil "~A/~A/~A" group-id artifact-id version))))
86    component))
88(eval-when (:compile-toplevel :load-toplevel :execute)
89  (export `(mvn iri ensure-parsed-mvn group-id artifact-id version) 
90          'asdf))
92(defmethod source-file-type ((component iri) (system system))
93  nil)
95(defmethod component-relative-pathname ((component iri))
96  nil)
98(in-package #:abcl-asdf)
100(defgeneric resolve (something)
101  (:documentation "Returns a string in JVM CLASSPATH format as entries delimited by classpath separator string."))
103(defmethod resolve ((mvn-component asdf::mvn))
104  "Resolve all runtime dependencies of MVN-COMPONENT.
106Returns either a string in jvm classpath format as entries delimited
107by classpath separator string or T.  If the value T is returned, it
108denotes that current JVM already has already loaded a given class. Can possibly be a
109single entry denoting a remote binary artifact."
110  (asdf:ensure-parsed-mvn mvn-component)
111  (let ((name (slot-value mvn-component 'asdf::name))
112        (group-id (slot-value mvn-component 'asdf::group-id))
113        (artifact-id (slot-value mvn-component 'asdf::artifact-id))
114        (classname (slot-value mvn-component 'asdf::classname))
115        (alternate-uri (slot-value mvn-component 'asdf::alternate-uri))
116        (repository (slot-value mvn-component 'asdf::repository))
117        (version (if (slot-value mvn-component 'asdf::version)
118                     (slot-value mvn-component 'asdf::version)
119                     "LATEST")))
120    (handler-case 
121        (when (and classname 
122                   (jss:find-java-class classname))
123          (warn "Not loading ~A from the network because ~A is present in classpath."
124                name classname)
125          (return-from resolve t))
126      (java:java-exception (e)
127        (unless (java:jinstance-of-p (java:java-exception-cause e)
128                                     "java.lang.ClassNotFoundException")
129          (error "Unexpected Java exception~&~A.~&" e))))
130    (if (find-mvn)
131        (resolve-dependencies group-id artifact-id
132                              :version version
133                              :repository repository)
134        (if alternate-uri
135            (values (pathname alternate-uri) alternate-uri) 
136            (error "Failed to resolve MVN component name ~A." name)))))
138(defmethod resolve ((uri pathname))
139  (warn "Unimplemented."))
141(defun as-classpath (classpath)
142  "Break apart the JVM CLASSPATH string into a list of its consituents."
143  (split-string classpath 
144                (java:jfield "" "pathSeparator")))
Note: See TracBrowser for help on using the repository browser.