summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-12-28 08:15:28 -0500
committerDavid Thompson <dthompson2@worcester.edu>2023-12-28 08:49:08 -0500
commit1997825c1f14d7e5215b60f4b8b0060461ebbbbe (patch)
tree33b0c0110227c02916289d1cf70577f9b23de8bb
parent0517bc566058a2667b32871a17f647c34fed18ff (diff)
artifact: Ensure destination file names have a leading '/'.
Also remove the single quotes from the log formatting.
-rw-r--r--haunt/artifact.scm28
1 files 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 <artifact>
- (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
+ (($ <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))))