From 1997825c1f14d7e5215b60f4b8b0060461ebbbbe Mon Sep 17 00:00:00 2001 From: David Thompson Date: Thu, 28 Dec 2023 08:15:28 -0500 Subject: artifact: Ensure destination file names have a leading '/'. Also remove the single quotes from the log formatting. --- haunt/artifact.scm | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/haunt/artifact.scm b/haunt/artifact.scm index 7785a20..2dde6b4 100644 --- a/haunt/artifact.scm +++ b/haunt/artifact.scm @@ -37,22 +37,33 @@ external-artifact)) (define-record-type - (make-artifact file-name writer) + (%make-artifact file-name writer) artifact? (file-name artifact-file-name) (writer artifact-writer)) +(define (absolutify file-name) + (if (string-prefix? "/" file-name) + file-name + (string-append "/" file-name))) + +(define (make-artifact file-name writer) + (%make-artifact (absolutify file-name) writer)) + (define (create-artifact artifact prefix) - (let ((output (string-append prefix "/" (artifact-file-name artifact)))) - (mkdir-p (dirname output)) - ((artifact-writer artifact) output) - (unless (file-exists? output) - (error "failed to create artifact output file" output)))) + (match artifact + (($ file-name write) + (let ((output (string-append prefix file-name))) + (mkdir-p (dirname output)) + (write output) + (unless (file-exists? output) + (error "failed to create artifact output file" output)))))) (define (serialized-artifact destination obj serialize) (make-artifact destination (lambda (output) - (format #t "write '~a'~%" destination) + (format #t "write ~a~%" + (absolutify destination)) (call-with-output-file output (lambda (port) (serialize obj port)))))) @@ -62,5 +73,6 @@ (error "verbatim artifact source file does not exist" source)) (make-artifact destination (lambda (output) - (format #t "copy '~a' → '~a'~%" source destination) + (format #t "copy ~a → ~a~%" + source (absolutify destination)) (copy-file source output)))) -- cgit v1.2.3