From 774f8804bafbf42a65eca492d1395da57deeb467 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 13 Apr 2022 19:59:03 +0200
Subject: 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.
---
 guix/gexp.scm | 44 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 44 insertions(+)

(limited to 'guix/gexp.scm')

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 @@ (define-module (guix gexp)
             mixed-text-file
             file-union
             directory-union
+            references-file
 
             imported-files
             imported-modules
@@ -2173,6 +2174,49 @@ (define log-port
                                            #: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.
-- 
cgit v1.2.3