Newer
Older
#+xcvb (module (:depends-on ("macros" "virtual-pathnames" "commands")))
(in-package :xcvb)
(defun manifest-form (specs)
Francois-Rene Rideau
committed
(flet ((extract-tthsum (property)
(tthsum-for-files-or-nil
(mapcar #'(lambda (x) (getf x property)) specs))))
Francois-Rene Rideau
committed
(loop
:with tthsums = (extract-tthsum :pathname)
:with source-tthsums = (extract-tthsum :source-pathname)
:for spec :in specs
Francois-Rene Rideau
committed
: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))
Francois-Rene Rideau
committed
,@(when source-pathname
`(:source-pathname ,(namestring (truename source-pathname)) :source-tthsum ,source-tthsum)))))))
(defun create-manifest (output-path grains)
Francois-Rene Rideau
committed
(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))
Francois-Rene Rideau
committed
(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 ....
Francois-Rene Rideau
committed
,@(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))
Francois-Rene Rideau
committed
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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))))