guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

05/10: DRAFT gexp: Add 'raw-derivation-closure'.


From: guix-commits
Subject: 05/10: DRAFT gexp: Add 'raw-derivation-closure'.
Date: Sun, 5 Jan 2020 05:51:32 -0500 (EST)

civodul pushed a commit to branch wip-system-bootstrap
in repository guix.

commit ba6390df42a3495a6a68d9a32ddbb3edd090dc0d
Author: Ludovic Court├Ęs <address@hidden>
Date:   Fri Dec 6 23:18:57 2019 +0100

    DRAFT gexp: Add 'raw-derivation-closure'.
    
    DRAFT: Add tests.
    
    * guix/gexp.scm (<raw-derivation-closure>): New record type.
    (sorted-references): New procedure.
    (raw-derivation-closure-compiler): New gexp compiler.
---
 guix/gexp.scm | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index c4f4e80..7bfff07 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -82,6 +82,9 @@
             raw-derivation-file
             raw-derivation-file?
 
+            raw-derivation-closure
+            raw-derivation-closure?
+
             load-path-expression
             gexp-modules
 
@@ -291,6 +294,35 @@ The expander specifies how an object is converted to its 
sexp representation."
                     (derivation-file-name lowered)
                     lowered)))
 
+;; File containing the closure of a raw .drv file, in topological order.  This
+;; works around a deficiency of #:references-graphs that can produce the
+;; reference graph of an output, but not that of a raw .drv file.
+(define-record-type <raw-derivation-closure>
+  (raw-derivation-closure obj)
+  raw-derivation-closure?
+  (obj  raw-derivation-closure-object))
+
+(define sorted-references
+  (store-lift (lambda (store item)
+                (define (fixed-output? file)
+                  (and (string-suffix? ".drv" file)
+                       (let ((drv (read-derivation-from-file file)))
+                         (fixed-output-derivation? drv))))
+
+                (topologically-sorted store (list item)
+                                      #:cut? fixed-output?))))
+
+(define-gexp-compiler (raw-derivation-closure-compiler
+                       (obj <raw-derivation-closure>)
+                       system target)
+  (mlet %store-monad ((obj (lower-object
+                            (raw-derivation-closure-object obj)
+                            system #:target target)))
+    (if (derivation? obj)
+        (mlet %store-monad ((refs (sorted-references (derivation-file-name 
obj))))
+          (text-file "graph" (object->string refs)))
+        (return obj))))
+
 
 ;;;
 ;;; File declarations.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]