abcl-asdf.lisp 6.36 KB
Newer Older
1
;;;; The ABCL specific overrides in ASDF.  
2
;;;;
3
;;;; Extensions to ASDF for use by ABCL
4
(require :asdf)
5
(in-package :asdf)
6

7 8 9 10 11 12
(defclass iri (component) 
  ((schema :initform nil)
   (authority :initform nil)
   (path :initform nil)
   (query :initform nil)
   (fragment :initform nil)))
13

14
(defclass mvn (iri) 
15 16
  ((group-id :initarg :group-id :initform nil)
   (artifact-id :initarg :artifact-id :initform nil)
17
   (repositories :initarg :repositories :initform (list abcl-asdf::*default-repository*))
18
   (resolved-classpath :initform nil :accessor resolved-classpath)
19 20
   (classname :initarg :classname :initform nil)
   (alternate-uri :initarg :alternate-uri :initform nil)
21 22
   ;; inherited from ASDF:COMPONENT ??? what are the CL semantics on overriding -- ME 2012-04-01
   #+nil   (version :initform nil)))
23

24 25 26 27 28 29 30
(defmethod shared-initialize ((mvn mvn) slot-names &rest initargs &key (repository NIL repository-p) repositories &allow-other-keys)
  (if repository-p
      (let ((initargs (list* :repositories (cons repository repositories)
                             (remove-plist-keys '(:repository :repositories) initargs))))
        (apply #'call-next-method mvn slot-names initargs))
      (call-next-method)))

31
;;; We intercept compilation to ensure that load-op will succeed
32
(defmethod perform ((op compile-op) (c mvn))
33 34 35 36
  (unless (resolved-classpath c)
    (setf (resolved-classpath c)
          (abcl-asdf:resolve   
           (ensure-parsed-mvn c)))))
37

38
(defmethod perform ((operation load-op) (c mvn))
39 40 41
  (let ((resolved-classpath (resolved-classpath c)))
    (when (stringp resolved-classpath)
      (java:add-to-classpath (abcl-asdf:as-classpath resolved-classpath)))))
42 43 44

;;; A Maven URI has the form "mvn:group-id/artifact-id/version"
;;;
45 46 47 48
;;; Sometimes people write "group-id:artifact-id:version" to refer to
;;; Maven artifacts.  One can use ABCL-ASDF:RESOLVE directly for
;;; serialized references to artifacts of this form.
;;;
49
;;; Currently we "stuff" the group-id/artifact-id into the 'name' and
50 51 52
;;; use the component 'version' for the version.  Parts of ASDF 
;;; *reallY* want ASDF:VERSION to be a triple of intergers, and never
;;; anything more, so that is part of the motivation behind this effort.
53 54 55
(defparameter *mvn-repositories* nil
  "A list of all Maven repositories encountered in the lifetime of this instance of the implementation.")

56 57 58 59 60 61 62
#+nil
(defmethod slot-missing ((class mvn) object slot-name operation &optional new-value)
  (setf (slot-value object slot-name) 
        (if new-value
            new-value
            nil)))

63
(defun ensure-parsed-mvn (component)
64
  (with-slots (name group-id artifact-id
65
                    version schema path repositories)
66
      component
67
    (when (null asdf::artifact-id) 
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
      (let ((parsed (abcl-asdf::split-string name "/"))
            (asdf-version-p (slot-boundp component 'version))
            (default-version "LATEST"))
        (cond ((= (length parsed) 3)
               (setf 
                group-id (first parsed)
                artifact-id (second parsed)
                version (third parsed)))
              ((= (length parsed) 2)
               (setf 
                group-id (first parsed)
                artifact-id (second parsed)
                version (if asdf-version-p
                            version
                            default-version)))
              (t
               (error "Failed to construct a mvn reference from name '~A' and version '~A'"
                      name version)))
        (setf schema "mvn")
87 88
        (when repositories
          (setf *mvn-repositories* (union repositories *mvn-repositories* :test #'string=)))
89 90 91
        ;;; Always set path to normalized path "on the way out" to
        ;;; contain group-id/artifact-id/version
        ;;; TODO? record repository as well in path of component
92 93 94
        (setf path (format nil "~A/~A/~A" group-id artifact-id version))))
    component))

95 96 97
(eval-when (:compile-toplevel :load-toplevel :execute)
  (export `(mvn iri ensure-parsed-mvn group-id artifact-id version) 
          'asdf))
98 99 100 101 102 103

(defmethod source-file-type ((component iri) (system system))
  nil)

(defmethod component-relative-pathname ((component iri))
  nil)
104

105
(in-package #:abcl-asdf)
106

107
(defgeneric resolve (something)
108
  (:documentation "Returns a string in JVM CLASSPATH format as entries delimited by classpath separator string."))
109

110
(defmethod resolve ((mvn-component asdf::mvn))
111 112
  "Resolve all runtime dependencies of MVN-COMPONENT.

113 114 115 116
Returns either a string in jvm classpath format as entries delimited
by classpath separator string or T.  If the value T is returned, it
denotes that current JVM already has already loaded a given class. Can possibly be a
single entry denoting a remote binary artifact."
117
  (asdf::ensure-parsed-mvn mvn-component)
118 119 120 121 122
  (let ((name (slot-value mvn-component 'asdf::name))
        (group-id (slot-value mvn-component 'asdf::group-id))
        (artifact-id (slot-value mvn-component 'asdf::artifact-id))
        (classname (slot-value mvn-component 'asdf::classname))
        (alternate-uri (slot-value mvn-component 'asdf::alternate-uri))
123
        (repositories (slot-value mvn-component 'asdf::repositories))
124 125 126 127 128
        (version (if (slot-value mvn-component 'asdf::version)
                     (slot-value mvn-component 'asdf::version)
                     "LATEST")))
    (handler-case 
        (when (and classname 
129 130
                   (let ((jss:*muffle-warnings* T))
                     (jss:find-java-class classname)))
131 132 133 134 135 136 137 138
          (warn "Not loading ~A from the network because ~A is present in classpath."
                name classname)
          (return-from resolve t))
      (java:java-exception (e)
        (unless (java:jinstance-of-p (java:java-exception-cause e)
                                     "java.lang.ClassNotFoundException")
          (error "Unexpected Java exception~&~A.~&" e))))
    (if (find-mvn)
139 140
        (resolve-dependencies group-id artifact-id
                              :version version
141
                              :repository NIL
142
                              :repositories repositories)
143
        (if alternate-uri
144
            (values (pathname alternate-uri) alternate-uri) 
145
            (error "Failed to resolve MVN component name ~A." name)))))
146

147 148 149
(defmethod resolve ((uri pathname))
  (warn "Unimplemented."))

150
(defun as-classpath (classpath)
151
  "Break apart the JVM CLASSPATH string into a list of its consituents."
152 153
  (split-string classpath 
                (java:jfield "java.io.File" "pathSeparator")))
154