From a9e5e92f940381e3a4ee828c6d8ff22a73067e17 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 9 Sep 2016 22:46:36 +0200
Subject: gexp: Add 'file-append'.

* guix/gexp.scm (<file-append>): New record type.
(file-append): New procedure.
(file-append-compiler): New gexp compiler.
* tests/gexp.scm ("file-append", "file-append, output")
("file-append, nested", "gexp->file + file-append"): New tests.
* doc/guix.texi (G-Expressions): Use it in 'nscd' and 'list-files'
examples.  Document 'file-append'.
---
 guix/gexp.scm | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

(limited to 'guix')

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 8d380ec95b..7e2ecf6c33 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -63,6 +63,11 @@
             scheme-file-name
             scheme-file-gexp
 
+            file-append
+            file-append?
+            file-append-base
+            file-append-suffix
+
             gexp->derivation
             gexp->file
             gexp->script
@@ -368,6 +373,30 @@ This is the declarative counterpart of 'gexp->file'."
     (($ <scheme-file> name gexp)
      (gexp->file name gexp))))
 
+;; Appending SUFFIX to BASE's output file name.
+(define-record-type <file-append>
+  (%file-append base suffix)
+  file-append?
+  (base   file-append-base)                    ;<package> | <derivation> | ...
+  (suffix file-append-suffix))                 ;list of strings
+
+(define (file-append base . suffix)
+  "Return a <file-append> object that expands to the concatenation of BASE and
+SUFFIX."
+  (%file-append base suffix))
+
+(define-gexp-compiler file-append-compiler file-append?
+  compiler => (lambda (obj system target)
+                (match obj
+                  (($ <file-append> base _)
+                   (lower-object base system #:target target))))
+  expander => (lambda (obj lowered output)
+                (match obj
+                  (($ <file-append> base suffix)
+                   (let* ((expand (lookup-expander base))
+                          (base   (expand base lowered output)))
+                     (string-append base (string-concatenate suffix)))))))
+
 
 ;;;
 ;;; Inputs & outputs.
-- 
cgit v1.2.3