me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2022-04-13 19:59:03 +02:00
parent 6b4124cdcc
commit 774f8804ba
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 62 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gnu/services/base.scm
View File

@ -219,8 +219,6 @@
pam-limits-service-type
pam-limits-service
references-file
%base-services))
;;; Commentary:
@ -1768,26 +1766,6 @@ proxy of 'guix-daemon'...~%")
(substitute-key-authorization authorized-keys guix)
#~#f))))
(define* (references-file item #:optional (name "references"))
"Return a file that contains the list of references of ITEM."
(if (struct? item) ;lowerable object
(computed-file name
(with-extensions (list guile-gcrypt) ;for store-copy
(with-imported-modules (source-module-closure
'((guix build store-copy)))
#~(begin
(use-modules (guix build store-copy))
(call-with-output-file #$output
(lambda (port)
(write (map store-info-item
(call-with-input-file "graph"
read-reference-graph))
port))))))
#:options `(#:local-build? #f
#:references-graphs (("graph" ,item))))
(plain-file name "()")))
(define guix-service-type
(service-type
(name 'guix)

44
guix/gexp.scm
View File

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

18
tests/gexp.scm
View File

@ -1606,6 +1606,24 @@ importing.* \\(guix config\\) from the host"
(not (member (derivation-file-name native) refs))
(member (derivation-file-name cross) refs))))))
(test-assertm "references-file"
(let* ((exp #~(symlink #$%bootstrap-guile #$output))
(computed (computed-file "computed" exp
#:guile %bootstrap-guile))
(refs (references-file computed "refs"
#:guile %bootstrap-guile)))
(mlet* %store-monad ((drv0 (lower-object %bootstrap-guile))
(drv1 (lower-object computed))
(drv2 (lower-object refs)))
(mbegin %store-monad
(built-derivations (list drv2))
(mlet %store-monad ((refs ((store-lift requisites)
(list (derivation->output-path drv1)))))
(return (lset= string=?
(call-with-input-file (derivation->output-path drv2)
read)
refs)))))))
(test-assert "lower-object & gexp-input-error?"
(guard (c ((gexp-input-error? c)
(gexp-error-invalid-input c)))