02/08: pack: Use let-keywords instead of keyword-ref.

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit 5c099f496f214ccc17ae0fb7c8df63a8e7f46af0
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Wed Feb 1 09:52:43 2023 -0500

    pack: Use let-keywords instead of keyword-ref.
    
    * guix/scripts/pack.scm: (debian-archive): Bind extra-options keyword
    arguments via let-keywords.
---
 guix/scripts/pack.scm | 97 +++++++++++++++++++++++----------------------------
 1 file changed, 44 insertions(+), 53 deletions(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index f65642fb85..e552cb108a 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -678,16 +678,15 @@ Valid compressors are: ~a~%") compressor-name 
%valid-compressors)))
   (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 @@ Valid compressors are: ~a~%") compressor-name 
%valid-compressors)))
                          (guix build utils)
                          (guix profiles)
                          (ice-9 match)
+                         (ice-9 optargs)
                          (srfi srfi-1))
 
             (define machine-type
@@ -762,32 +762,23 @@ Valid compressors are: ~a~%") compressor-name 
%valid-compressors)))
 
             (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))
-
-            (define postinst-file
-              (keyword-ref '#$extra-options #:postinst-file))
-
-            (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 "\
+            (let-keywords '#$extra-options #f
+                          ((control-file #f)
+                           (postinst-file #f)
+                           (triggers-file #f))
+
+              (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 "\
 Package: ~a
 Version: ~a
 Description: Debian archive generated by GNU Guix.
@@ -797,28 +788,28 @@ Priority: optional
 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