]> asedeno.scripts.mit.edu Git - cl-protobufs.git/blobdiff - asdf-support.lisp
Update documentation
[cl-protobufs.git] / asdf-support.lisp
index e7a235ada71f0860dc8cad0c3c570ef6f02a070f..31f26f325d5ac95fc3df73ac58d11bae4657b763 100644 (file)
@@ -69,8 +69,8 @@
                  (proto-relative-pathname component)
                  :type "proto")
     ;; No ':proto-pathname', the path of the protobuf file
-    ;; defaults to that of the Lisp file with a ".proto" suffix
-    (make-pathname :type "proto" :defaults (component-pathname component))))
+    ;; defaults to the component-pathname, with its automatic type "proto"
+    (component-pathname component)))
 
 (defun resolve-search-path (component)
   (check-type component protobuf-file)
 
 (defmethod input-files ((op proto-to-lisp) (component protobuf-file))
   "The input file is just the .proto file."
+  (declare (ignorable op))
   (list (protobuf-input-file component)))
 
 (defmethod output-files ((op proto-to-lisp) (component protobuf-file))
-  "The output file gets stored where .fasl files are stored."
-  (values (list (component-pathname component))
-          nil))
+  "The output file is a .lisp file and a .proto-imports file with dependency data,
+   stored where .fasl files are stored"
+  (declare (ignorable op))
+  (let ((lisp-file (lispize-pathname (component-pathname component))))
+    (values (list lisp-file
+                  (make-pathname :type "proto-imports"
+                                 :defaults lisp-file))
+            nil)))
 
 (defmethod perform ((op proto-to-lisp) (component protobuf-file))
   (let* ((input  (protobuf-input-file component))
          (proto-impl:*protobuf-output-path* output))
     (dolist (path paths (error 'compile-failed
                           :component component :operation op))
-      (let ((proto (make-pathname :type "proto" :defaults (merge-pathnames path (pathname input))))
-            (lisp  (make-pathname :type "lisp"  :defaults output)))
-        (when (probe-file proto)
-          (return-from perform
-            (proto-impl:parse-protobuf-file proto lisp
-                                            :conc-name (proto-conc-name component))))))))
+      (let ((proto (make-pathname :type "proto" :defaults (merge-pathnames* path (pathname input)))))
+        (destructuring-bind (lisp imports)
+            (output-files op component)
+          (when (probe-file proto)
+            (return-from perform
+              (proto-impl:parse-protobuf-file proto lisp imports
+                                              :conc-name (proto-conc-name component)))))))))
 
 (defmethod operation-description ((op proto-to-lisp) (component protobuf-file))
   (format nil (compatfmt "~@<proto-compiling ~3i~_~A~@:>")
-          (make-pathname :name (pathname-name (component-pathname component))
-                         :type "proto"
-                         :defaults (first (output-files op component)))))
+          (first (input-files op component))))
+
+(defmethod input-files ((op compile-op) (component protobuf-file))
+  "The input files are the .lisp and .proto-imports files."
+  (declare (ignorable op))
+  (output-files (make-instance 'proto-to-lisp) component))
 
 (defmethod perform ((op compile-op) (component protobuf-file))
   (let* ((input  (protobuf-input-file component))
-         (output (first (output-files op component)))
-         (lisp   (make-pathname :type "lisp"  :defaults output))
+         (output (output-file op component))
+         (lisp   (first (input-files op component)))
          (fasl   output)
          (paths  (cons (directory-namestring input) (resolve-search-path component)))
          (proto-impl:*protobuf-search-path* paths)
          (proto-impl:*protobuf-output-path* output)
          (*compile-file-warnings-behaviour* (operation-on-warnings op))
          (*compile-file-failure-behaviour* (operation-on-failure op)))
+    (proto-impl:process-imports-from-file
+     (make-pathname :type "proto-imports"
+                    :defaults output))
     (multiple-value-bind (output warnings-p failure-p)
         (apply #'compile-file* lisp
                :output-file fasl
         (error 'compile-error
                :component component :operation op)))))
 
+(defmethod input-files ((op load-op) (component protobuf-file))
+  "The input files are the .fasl and .proto-imports files."
+  (declare (ignorable op))
+  (append (output-files (make-instance 'compile-op) component)            ;fasl
+          (cdr (output-files (make-instance 'proto-to-lisp) component)))) ;proto-imports
+
+(defmethod perform ((op load-op) (component protobuf-file))
+  (let* ((input  (protobuf-input-file component))
+         (paths  (cons (directory-namestring input) (resolve-search-path component)))
+         (proto-impl:*protobuf-search-path* paths)
+         (proto-impl:*protobuf-output-path* (first (input-files op component))))
+    (destructuring-bind (fasl proto-imports)
+        (input-files op component)
+      (proto-impl:process-imports-from-file proto-imports)
+      (load fasl))))
+
 (defmethod operation-description ((op compile-op) (component protobuf-file))
   (format nil (compatfmt "~@<compiling ~3i~_~A~@:>")
-          (make-pathname :name (pathname-name (component-pathname component))
-                         :type "lisp"
-                         :defaults (first (output-files op component)))))
+          (first (input-files op component))))
 
 \f
 ;;; Processing of imports
 
 (in-package "PROTO-IMPL")
 
-(defun parse-protobuf-file (protobuf-file lisp-file &key (conc-name ""))
+(defun parse-protobuf-file (protobuf-file lisp-file imports-file &key (conc-name ""))
   (let ((schema (parse-schema-from-file protobuf-file :conc-name conc-name)))
     (with-open-file (stream lisp-file
                      :direction :output
                      :if-exists :supersede
                      :external-format :utf-8
                      :element-type 'character)
-      (write-schema schema :stream stream :type :lisp)))
+      (write-schema schema :stream stream :type :lisp))
+    (with-open-file (stream imports-file
+                     :direction :output
+                     :if-exists :supersede
+                     :external-format :utf-8
+                     :element-type 'character)
+      (with-standard-io-syntax
+        (format stream "~W~%" (proto-imports schema)))))
   lisp-file)
 
 ;; Process 'import' lines
-(defun process-imports (schema imports
-                        &key (search-path *protobuf-search-path*)
-                             (output-path *protobuf-output-path*))
+(defun process-imports (schema imports)
   "Imports all of the files given by 'imports'.
    If the file is a .proto file, it first parses it and writes a .lisp file.
    The .lisp file is the compiled and loaded."
   (dolist (import imports)
     (block import-one
       (let* ((import      (pathname import))
-             (import-dir  (pathname-directory import))
              (import-name (pathname-name import))
              (imported    (find-schema (class-name->proto import-name))))
         ;; If this schema has already been imported somewhere else,
           (setf (proto-imported-schemas schema)
                 (nconc (proto-imported-schemas schema) (list imported)))
           (return-from import-one))
-        (dolist (path search-path (error "Could not import ~S" import))
-          (let* ((base-path  (ecase (car import-dir)
-                               ((:relative)
-                                (merge-pathnames import path))
-                               ((:absolute) import)))
-                 (proto-file (make-pathname :name import-name :type "proto"
-                                            :defaults base-path))
-                 (lisp-file  (if output-path
-                               (make-pathname :name import-name :type "lisp"
-                                              :directory (pathname-directory output-path))
-                               (make-pathname :type "lisp" :defaults base-path)))
-                 (fasl-file  (compile-file-pathname lisp-file))
-                 (proto-date (and (probe-file proto-file)
-                                  (ignore-errors (file-write-date proto-file))))
-                 (lisp-date  (and (probe-file lisp-file)
-                                  (ignore-errors (file-write-date lisp-file))))
-                 (fasl-date  (and (probe-file fasl-file)
-                                  (ignore-errors (file-write-date fasl-file)))))
-            (when (probe-file proto-file)
-              (let ((*protobuf-pathname* proto-file))
-                (when (string= (pathname-type base-path) "proto")
-                  ;; The user asked to import a .proto file
-                  ;; If there's no .lisp file or an older .lisp file, parse the .proto file now
-                  (cond ((not proto-date)
-                         (warn "Could not find the .proto file to be imported: ~A" proto-file))
-                        ((or (not lisp-date)
-                             (< lisp-date proto-date))
-                         (parse-protobuf-file proto-file lisp-file)
-                         (setq lisp-date (file-write-date lisp-file)))))
-                ;; Compile the .lisp file, if necessary
-                (cond ((not lisp-date)
-                       (unless (string= (pathname-type base-path) "proto")
-                         (warn "Could not find the .lisp file to be compiled: ~A" lisp-file)))
-                      (t
-                       (when (or (not fasl-date)
-                                 (< fasl-date lisp-date))
-                         (let ((*compile-file-pathname* lisp-file)
-                               (*load-pathname* nil))
-                           (setq fasl-file (compile-file lisp-file)))
-                         (setq fasl-date (file-write-date fasl-file)))
-                       ;; Now we can load the .fasl file
-                       (let ((*compile-file-pathname* nil)
-                             (*load-pathname* fasl-file))
-                         (load fasl-file)))))
-              (let* ((imported (find-schema base-path)))
-                (when imported
-                  (setf (proto-imported-schemas schema)
-                        (nconc (proto-imported-schemas schema) (list imported))))
-                (return-from import-one)))))))))
+        (do-process-import import import-name)
+        (let* ((imported (find-schema (class-name->proto import-name))))
+          (when imported
+            (setf (proto-imported-schemas schema)
+                  (nconc (proto-imported-schemas schema) (list imported))))
+          (return-from import-one))))))
+
+(defun process-imports-from-file (imports-file)
+  (when (probe-file imports-file)
+    (let ((imports (with-open-file (stream imports-file
+                                    :direction :input
+                                    :external-format :utf-8
+                                    :element-type 'character)
+                     (with-standard-io-syntax (read stream)))))
+      (dolist (import imports)
+        (let* ((import      (pathname import))
+               (import-name (pathname-name import)))
+          ;; If this schema has already been loaded, we're done.
+          (unless (find-schema (class-name->proto import-name))
+            (do-process-import import import-name)))))))
+
+(defun do-process-import (import import-name
+                          &key (search-path *protobuf-search-path*)
+                               (output-path *protobuf-output-path*))
+  (dolist (path search-path (error "Could not import ~S" import))
+    (let* ((base-path  (asdf::merge-pathnames* import path))
+           (proto-file (make-pathname :name import-name :type "proto"
+                                      :defaults base-path))
+           (lisp-file  (asdf::lispize-pathname
+                        (if output-path
+                            (make-pathname :name import-name
+                                           :directory (pathname-directory output-path))
+                            base-path)))
+           (imports-file (make-pathname :type "proto-imports"
+                                        :defaults lisp-file))
+           (fasl-file  (compile-file-pathname lisp-file))
+           (asdf:*asdf-verbose* nil)    ;for safe-file-write-date
+           (proto-date (asdf::safe-file-write-date proto-file))
+           (lisp-date  (asdf::safe-file-write-date lisp-file))
+           (fasl-date  (asdf::safe-file-write-date fasl-file))
+           (imports-date  (asdf::safe-file-write-date imports-file)))
+      (when (probe-file proto-file)
+        (let ((*protobuf-pathname* proto-file))
+          (when (string= (pathname-type base-path) "proto")
+            ;; The user asked to import a .proto file
+            ;; If there's no .lisp file or an older .lisp file, or no
+            ;; .proto-imports file or an older .proto-imports file parse
+            ;; the .proto file now
+            ;; If we did not parse the .proto file, process the generated
+            ;; .proto-imports file now.
+            (cond ((not proto-date)
+                   (warn "Could not find the .proto file to be imported: ~A" proto-file))
+                  ((or (not (and lisp-date imports-date))
+                       (< lisp-date proto-date)
+                       (< imports-date proto-date))
+                   (parse-protobuf-file proto-file lisp-file imports-file)
+                   (setq lisp-date (file-write-date lisp-file))
+                   (setq imports-date (file-write-date imports-file)))
+                  (t
+                   (process-imports-from-file imports-file))))
+          ;; Compile the .lisp file, if necessary
+          (cond ((not lisp-date)
+                 (unless (string= (pathname-type base-path) "proto")
+                   (warn "Could not find the .lisp file to be compiled: ~A" lisp-file)))
+                (t
+                 (when (or (not fasl-date)
+                           (< fasl-date lisp-date))
+                   (let ((*compile-file-pathname* lisp-file)
+                         (*load-pathname* nil))
+                     (setq fasl-file (compile-file lisp-file)))
+                   (setq fasl-date (file-write-date fasl-file)))))
+          ;; Load the .fasl file
+          (cond ((not fasl-date)
+                 (unless (string= (pathname-type base-path) "proto")
+                   (warn "Could not find the .fasl file to be loaded: ~A" fasl-file)))
+                (t
+                 (let ((*compile-file-pathname* nil)
+                       (*load-pathname* fasl-file))
+                   (load fasl-file)))))
+        (return (values))))))