[gnunet-scheme] 64/324: scripts: download-store: use SRFI-39 parameters for configuration

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit e839528d92ea6f5e9c8b544e03c6df8876b50ef5
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Jan 30 18:05:20 2021 +0100

    scripts: download-store: use SRFI-39 parameters for configuration
    
    Like df784568e6ff2448435ab89da754275b45dfb4ac,
    but for download-store instead of for publish-store.
    
    * gnu/gnunet/scripts/download-store.scm
      (*config*, *anonymity*, no-network*)
      (*parallelism*, *request-parallelism*): new parameters.
      (call-with-options): new procedure, sets these parameters
      from the command line options.
      (inner-main): use new parameters and previous procedure.
      (gnunet-download, gnunet-download/bytvector)
      (download-nar, download-entries!): use new parameters
      instead of keyword arguments.
---
 gnu/gnunet/scripts/download-store.scm | 73 +++++++++++++++++++++--------------
 1 file changed, 43 insertions(+), 30 deletions(-)

diff --git a/gnu/gnunet/scripts/download-store.scm 
b/gnu/gnunet/scripts/download-store.scm
index 1dcba02..4f14242 100644
--- a/gnu/gnunet/scripts/download-store.scm
+++ b/gnu/gnunet/scripts/download-store.scm
@@ -20,7 +20,6 @@
 (library (gnu gnunet scripts download-store)
   (export main)
   (import (gnu gnunet scripts guix-stuff)
-         (ice-9 optargs)
          (ice-9 getopt-long)
          (rnrs base)
          (rnrs io simple)
@@ -40,6 +39,7 @@
          (srfi srfi-1)
          (srfi srfi-1)
          (srfi srfi-26)
+         (srfi srfi-39)
          (srfi srfi-41))
   (begin
     (define %supported-formats
@@ -73,6 +73,31 @@
         (single-char #\r)
         (value #t))))
 
+    (define *config*
+      (make-parameter
+       (string-append (getenv "HOME") "/.config/gnunet.conf")))
+    (define *anonymity* (make-parameter 1))
+    (define *no-network* (make-parameter #f))
+    (define *parallelism* (make-parameter #f))
+    (define *request-parallelism* (make-parameter #f))
+
+    (define (call-with-options options thunk)
+      "Call the thunk @var{thunk} in an environment where
+the options @var{options} are applied."
+      (define opt (cute option-ref options <> <>))
+      (define (num sym default)
+       (let ((value/str (opt sym #f)))
+         (if value/str
+             (string->number value/str)
+             default)))
+      (parameterize ((*config* (opt 'config (*config*)))
+                    (*anonymity* (num 'anonymity (*anonymity*)))
+                    (*no-network* (opt 'no-network (*no-network*)))
+                    (*parallelism* (num 'parallelism (*parallelism*)))
+                    (*request-parallelism* (num 'request-parallelism
+                                                (*request-parallelism*))))
+       (thunk)))
+
     (define %version-string
       "scheme-gnunet download-store v0.0")
 
@@ -113,23 +138,14 @@ GNUnet options
               (newline))
              ((member (option-ref options 'format "gnunet-nix-archive-json/0")
                       '("gnunet-nix-archive-json/0" "any"))
-              (download-nar (option-ref options 'input #f)
-                            (option-ref options 'output #f)
-                            #:config (option-ref options 'config #f)
-                            #:no-network (option-ref options 'no-network #f)
-                            #:anonymity
-                            (string->number
-                             (option-ref options 'anonymity "1"))))
+              (call-with-options options
+                                 (lambda ()
+                                   (download-nar
+                                    (option-ref options 'input #f)
+                                    (option-ref options 'output #f)))))
              (else ???))))
 
-    (define* (gnunet-download uri
-                             output-filename
-                             #:key
-                             (config (string-append
-                                      (getenv "HOME")
-                                      "/.config/gnunet.conf"))
-                             (anonymity 1)
-                             (no-network #f))
+    (define (gnunet-download uri output-filename)
       "Download URI to the file OUTPUT, which is
 created if needed, as a single file."
       (unless (or (string-prefix? "gnunet://fs/chk/" uri)
@@ -139,13 +155,13 @@ created if needed, as a single file."
        (throw 'xxx-invalid-uri uri))
       (let* ((*binary* "gnunet-download")
             (cmd `(,*binary*
-                   ,@(if config
-                         `("-c" ,config)
+                   ,@(if (*config*)
+                         `("-c" ,(*config*))
                          '())
-                   ,@(if no-network
+                   ,@(if (*no-network*)
                          '("-n")
                          '())
-                   "-a" ,(number->string anonymity)
+                   "-a" ,(number->string (*anonymity*))
                    "-o" ,output-filename
                    ,uri))
             (result (apply system* cmd)))
@@ -154,16 +170,16 @@ created if needed, as a single file."
          (throw 'gnunet-download-eep 'gnunet-download-???))
        (values)))
 
-    (define* (gnunet-download/bytevector uri #:rest r)
+    (define (gnunet-download/bytevector uri)
       "Like gnunet-download, but return a bytevector
 instead of writing to a file."
       (call-with-temporary-output-file
        (lambda (filename out)
-        (apply gnunet-download uri filename r)
+        (gnunet-download uri filename)
         (get-bytevector-all out))))
 
-    (define* (download-nar uri output #:rest r)
-      (let* ((container/bv (apply gnunet-download/bytevector uri r))
+    (define (download-nar uri output)
+      (let* ((container/bv (gnunet-download/bytevector uri))
             (container/json (utf8->string container/bv))
             (container/scm (json-string->scm container/json)))
        (unless (equal? (assoc "version" container/scm)
@@ -171,9 +187,9 @@ instead of writing to a file."
          (throw 'download-eep 'xxx-proper-error-message))
        (let ((sorted (sort-entries (cdr (assoc "entries" container/scm)))))
          (verify-entries sorted)
-         (apply download-entries! sorted output r))))
+         (download-entries! sorted output))))
 
-    (define* (download-entries! entries output . rest)
+    (define (download-entries! entries output)
       (define (prefix name)
        (string-append output "/" name))
       (define (download-entry! entry)
@@ -184,10 +200,7 @@ instead of writing to a file."
                 (mkdir output))
                ((or (string=? type "regular")
                     (string=? type "executable"))
-                (apply gnunet-download
-                       (cdr (assoc "hash" entry))
-                       output
-                       rest)
+                (gnunet-download (cdr (assoc "hash" entry)) output)
                 (when (string=? type "executable")
                   (chmod output
                          (logior (stat:mode (stat output))

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.