guix/guix
3
4
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

pack: Save provenance information when using '--manifest'.

Browse source 
* guix/scripts/pack.scm (guix-pack)[manifest-from-args]: Remove
'provenance', and add 'with-provenance' procedure.  Wrap 'cond' form in
'with-provenance'.
This commit is contained in:
Ludovic Courtès 2019-12-29 16:51:15 +01:00
parent c48e522fdb
commit 975183a1c4
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 24 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
guix/scripts/pack.scm
View file

@ -974,36 +974,32 @@ Create a bundle of PACKAGE.\n"))
(('manifest . file) file)
(_ #f))
opts)))
(define properties
(define with-provenance
(if (assoc-ref opts 'save-provenance?)
(lambda (package)
(match (package-provenance package)
(#f
(warning (G_ "could not determine provenance of package ~a~%")
(package-full-name package))
'())
(sexp
`((provenance . ,sexp)))))
(const '())))
(lambda (manifest)
(map-manifest-entries
(lambda (entry)
(let ((entry (manifest-entry-with-provenance entry)))
(unless (assq 'provenance (manifest-entry-properties entry))
(warning (G_ "could not determine provenance of package ~a~%")
(manifest-entry-name entry)))
entry))
manifest))
identity))
(cond
((and (not (null? manifests)) (not (null? packages)))
(leave (G_ "both a manifest and a package list were given~%")))
((not (null? manifests))
(concatenate-manifests
(map (lambda (file)
(let ((user-module (make-user-module
'((guix profiles) (gnu)))))
(load* file user-module)))
manifests)))
(else
(manifest
(map (match-lambda
((package output)
(package->manifest-entry package output
#:properties
(properties package))))
packages))))))
(with-provenance
(cond
((and (not (null? manifests)) (not (null? packages)))
(leave (G_ "both a manifest and a package list were given~%")))
((not (null? manifests))
(concatenate-manifests
(map (lambda (file)
(let ((user-module (make-user-module
'((guix profiles) (gnu)))))
(load* file user-module)))
manifests)))
(else
(packages->manifest packages))))))
(with-error-handling
(with-store store