ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

pack: Use let-keywords instead of keyword-ref.

Browse source 
* guix/scripts/pack.scm: (debian-archive): Bind extra-options keyword
arguments via let-keywords.
This commit is contained in:
Maxim Cournoyer 2023-02-01 09:52:43 -05:00
parent 068971805a
commit 5c099f496f
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 42 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

93
guix/scripts/pack.scm
View file

@ -678,16 +678,15 @@ (define %valid-compressors '("gzip" "xz" "none"))
(define data-tarball
(computed-file (string-append "data.tar"
(compressor-extension compressor))
(self-contained-tarball/builder
profile
#:profile-name profile-name
#:compressor compressor
#:localstatedir? localstatedir?
#:symlinks symlinks
#:archiver archiver)
#:local-build? #f ;allow offloading
#:options (list #:references-graphs `(("profile" ,profile))
#:target target)))
(self-contained-tarball/builder profile
#:profile-name profile-name
#:compressor compressor
#:localstatedir? localstatedir?
#:symlinks symlinks
#:archiver archiver)
#:local-build? #f ;allow offloading
#:options (list #:references-graphs `(("profile" ,profile))
#:target target)))
(define build
(with-extensions (list guile-gcrypt)
@ -702,6 +701,7 @@ (define build
(guix build utils)
(guix profiles)
(ice-9 match)
(ice-9 optargs)
(srfi srfi-1))
(define machine-type
@ -762,32 +762,23 @@ (define data-tarball-file-name (strip-store-file-name
(copy-file #+data-tarball data-tarball-file-name)
(define (keyword-ref lst keyword)
(match (memq keyword lst)
((_ value . _) value)
(#f #f)))
;; Generate the control archive.
(define control-file
(keyword-ref '#$extra-options #:control-file))
(let-keywords '#$extra-options #f
((control-file #f)
(postinst-file #f)
(triggers-file #f))
(define postinst-file
(keyword-ref '#$extra-options #:postinst-file))
(define control-tarball-file-name
(string-append "control.tar"
#$(compressor-extension compressor)))
(define triggers-file
(keyword-ref '#$extra-options #:triggers-file))
(define control-tarball-file-name
(string-append "control.tar"
#$(compressor-extension compressor)))
;; Write the compressed control tarball. Only the control file is
;; mandatory (see: 'man deb' and 'man deb-control').
(if control-file
(copy-file control-file "control")
(call-with-output-file "control"
(lambda (port)
(format port "\
;; Write the compressed control tarball. Only the control file is
;; mandatory (see: 'man deb' and 'man deb-control').
(if control-file
(copy-file control-file "control")
(call-with-output-file "control"
(lambda (port)
(format port "\
Package: ~a
Version: ~a
Description: Debian archive generated by GNU Guix.
@ -797,28 +788,28 @@ (define control-tarball-file-name
Section: misc
~%" package-name package-version architecture))))
(when postinst-file
(copy-file postinst-file "postinst")
(chmod "postinst" #o755))
(when postinst-file
(copy-file postinst-file "postinst")
(chmod "postinst" #o755))
(when triggers-file
(copy-file triggers-file "triggers"))
(when triggers-file
(copy-file triggers-file "triggers"))
(define tar (string-append #+archiver "/bin/tar"))
(define tar (string-append #+archiver "/bin/tar"))
(apply invoke tar
`(,@(tar-base-options
#:tar tar
#:compressor #+(and=> compressor compressor-command))
"-cvf" ,control-tarball-file-name
"control"
,@(if postinst-file '("postinst") '())
,@(if triggers-file '("triggers") '())))
(apply invoke tar
`(,@(tar-base-options
#:tar tar
#:compressor #+(and=> compressor compressor-command))
"-cvf" ,control-tarball-file-name
"control"
,@(if postinst-file '("postinst") '())
,@(if triggers-file '("triggers") '())))
;; Create the .deb archive using GNU ar.
(invoke (string-append #+binutils "/bin/ar") "-rv" #$output
"debian-binary"
control-tarball-file-name data-tarball-file-name)))))
;; Create the .deb archive using GNU ar.
(invoke (string-append #+binutils "/bin/ar") "-rv" #$output
"debian-binary"
control-tarball-file-name data-tarball-file-name))))))
(gexp->derivation (string-append name ".deb")
build