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.
This commit is contained in:
Ludovic Courtès 2019-12-06 23:18:57 +01:00
parent 09763444ce
commit ba6390df42
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -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.