01/02: graft: Graft files in a deterministic order.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 9c88f655e6533e2f84ebf7ee546596c85031441d
Author: Ludovic Courtès <address@hidden>
Date:   Mon Nov 16 14:16:22 2015 +0100

    graft: Graft files in a deterministic order.
    
    * guix/build/graft.scm (rewrite-directory)[rewrite-leaf]: Change to take
      a single parameter.  Add call to 'lstat'.  Factorize result of
      'destination'.
      Use 'find-files' instead of 'file-system-fold'.
---
 guix/build/graft.scm |   60 +++++++++++++++++++++----------------------------
 1 files changed, 26 insertions(+), 34 deletions(-)

diff --git a/guix/build/graft.scm b/guix/build/graft.scm
index 55f0f94..d29e671 100644
--- a/guix/build/graft.scm
+++ b/guix/build/graft.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014 Ludovic Courtès <address@hidden>
+;;; Copyright © 2014, 2015 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,7 +21,6 @@
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 ftw)
   #:export (replace-store-references
             rewrite-directory))
 
@@ -93,38 +92,31 @@ file name pairs."
   (define (destination file)
     (string-append output (string-drop file prefix-len)))
 
-  (define (rewrite-leaf file stat result)
-    (case (stat:type stat)
-      ((symlink)
-       (let ((target (readlink file)))
-         (symlink (call-with-output-string
-                   (lambda (output)
-                     (replace-store-references (open-input-string target)
-                                               output mapping
-                                               store)))
-                  (destination file))))
-      ((regular)
-       (with-fluids ((%default-port-encoding #f))
-         (call-with-input-file file
-           (lambda (input)
-             (call-with-output-file (destination file)
-               (lambda (output)
-                 (replace-store-references input output mapping
-                                           store)
-                 (chmod output (stat:perms stat))))))))
-      (else
-       (error "unsupported file type" stat))))
+  (define (rewrite-leaf file)
+    (let ((stat (lstat file))
+          (dest (destination file)))
+      (mkdir-p (dirname dest))
+      (case (stat:type stat)
+        ((symlink)
+         (let ((target (readlink file)))
+           (symlink (call-with-output-string
+                      (lambda (output)
+                        (replace-store-references (open-input-string target)
+                                                  output mapping
+                                                  store)))
+                    dest)))
+        ((regular)
+         (with-fluids ((%default-port-encoding #f))
+           (call-with-input-file file
+             (lambda (input)
+               (call-with-output-file dest
+                 (lambda (output)
+                   (replace-store-references input output mapping
+                                             store)
+                   (chmod output (stat:perms stat))))))))
+        (else
+         (error "unsupported file type" stat)))))
 
-  (file-system-fold (const #t)
-                    rewrite-leaf
-                    (lambda (directory stat result) ;down
-                      (mkdir (destination directory)))
-                    (const #t)                      ;up
-                    (const #f)                      ;skip
-                    (lambda (file stat errno result) ;error
-                      (error "read error" file stat errno))
-                    #f
-                    directory
-                    lstat))
+  (for-each rewrite-leaf (find-files directory)))
 
 ;;; graft.scm ends here