summaryrefslogtreecommitdiff
path: root/guix/gexp.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-04-13 19:59:03 +0200
committerLudovic Courtès <ludo@gnu.org>2022-05-01 21:30:34 +0200
commit774f8804bafbf42a65eca492d1395da57deeb467 (patch)
tree86e5c4430f4ee33478023824e4d942e3b7f25b37 /guix/gexp.scm
parent6b4124cdcc203d47dc40158062afa1497d73d592 (diff)
gexp: Add 'references-file'.
* gnu/services/base.scm (references-file): Remove. * guix/gexp.scm (references-file): New procedure. * tests/gexp.scm ("references-file"): New test.
Diffstat (limited to 'guix/gexp.scm')
-rw-r--r--guix/gexp.scm44
1 files changed, 44 insertions, 0 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 9fdb7a30be..ef92223048 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -118,6 +118,7 @@
mixed-text-file
file-union
directory-union
+ references-file
imported-files
imported-modules
@@ -2173,6 +2174,49 @@ is true, the derivation will not print anything."
#:resolve-collision
(ungexp resolve-collision)))))))))
+(define* (references-file item #:optional (name "references")
+ #:key guile)
+ "Return a file that contains the list of direct and indirect references (the
+closure) of ITEM."
+ (if (struct? item) ;lowerable object
+ (computed-file name
+ (gexp (begin
+ (use-modules (srfi srfi-1)
+ (ice-9 rdelim)
+ (ice-9 match))
+
+ (define (drop-lines port n)
+ ;; Drop N lines read from PORT.
+ (let loop ((n n))
+ (unless (zero? n)
+ (read-line port)
+ (loop (- n 1)))))
+
+ (define (read-graph port)
+ ;; Return the list of references read from
+ ;; PORT. This is a stripped-down version of
+ ;; 'read-reference-graph'.
+ (let loop ((items '()))
+ (match (read-line port)
+ ((? eof-object?)
+ (delete-duplicates items))
+ ((? string? item)
+ (let ((deriver (read-line port))
+ (count
+ (string->number (read-line port))))
+ (drop-lines port count)
+ (loop (cons item items)))))))
+
+ (call-with-output-file (ungexp output)
+ (lambda (port)
+ (write (call-with-input-file "graph"
+ read-graph)
+ port)))))
+ #:guile guile
+ #:options `(#:local-build? #t
+ #:references-graphs (("graph" ,item))))
+ (plain-file name "()")))
+
;;;
;;; Syntactic sugar.