manifest.lisp

#+xcvb (module (:depends-on ("macros" "virtual-pathnames" "commands")))

(in-package :xcvb)

(defun manifest-form (specs)
  (flet ((extract-tthsum (property)
           (tthsum-for-files-or-nil
            (mapcar #'(lambda (x) (getf x property)) specs))))
    (loop
      :with tthsums = (extract-tthsum :pathname)
      :with source-tthsums = (extract-tthsum :source-pathname)
      :for spec :in specs
      :for tthsum :in tthsums
      :for source-tthsum :in source-tthsums
      :collect
      (destructuring-bind (&key command pathname source-pathname) spec
        `(:command ,command ;; TODO :build-command ,spec :driver-command ,command
          ,@(when pathname `(:pathname ,(namestring (truename pathname)) :tthsum ,tthsum))
          ,@(when source-pathname
              `(:source-pathname ,(namestring (truename source-pathname)) :source-tthsum ,source-tthsum)))))))

(defun create-manifest (output-path grains)
  (with-user-output-file (o output-path)
    (with-safe-io-syntax ()
      (let ((*print-pretty* nil)
            (*print-case* :downcase))
        (format o "(~{~S~^~% ~})~%" (manifest-form grains)))))
  (values))

(defun command-to-manifest-spec (env command)
  (let* ((fullname (unwrap-load-file-command command))
         (source-fullname (fullname-source fullname)))
    `(:command ,command ;; TODO: :build-command ,command ....
      ,@(when fullname `(:pathname ,(fullname-namestring env fullname)))
      ,@(when source-fullname `(:source-pathname ,(fullname-namestring env source-fullname))))))

(defun commands-to-manifest-spec (env commands)
  (mapcar/ #'command-to-manifest-spec env commands))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Make a load manifest ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-command make-manifest
    (("make-manifest")
     ()
     '((("output" #\o) :type string :optional t :initial-value "-"
        :documentation "Path to manifest file or - for stdout")
       (("spec" #\s) :type string :optional nil
        :documentation "list of plists specifying command and optional pathname, source-pathname"))
     "Create a manifest of files to load (for internal use)"
     "given fullnames and paths, output fullnames, tthsum and paths")
  (create-manifest output (with-safe-io-syntax () (read-from-string spec))))