[gnunet-scheme] 58/324: scripts: publish-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 46594066edcdb7293d87d0bba991c7340151deff
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Jan 29 18:43:12 2021 +0100

    scripts: publish-store: use SRFI-39 parameters for configuration
    
    * README.org (Conventions): document this convention,
      and its rationale.
    * gnu/gnunet/scripts/publish-store.scm
      (*simulate*, *display-json*, *config*, *anonymity*)
      (*priority*, *replication*, *no-index*): new parameters.
      (call-with-options): new procedure for setting these
      parameters from command-line arguments.
      (inner-main): use new parameters instead of keyword arguments.
      (gnunet-publish, publish-sxml->json, publish-object): likewise.
---
 README.org                           |   6 ++
 gnu/gnunet/scripts/publish-store.scm | 106 +++++++++++++++++------------------
 2 files changed, 56 insertions(+), 56 deletions(-)

diff --git a/README.org b/README.org
index 2868228..40df17b 100644
--- a/README.org
+++ b/README.org
@@ -27,6 +27,12 @@
   + bit-for-bit reproducibility in directory creation
 * Modules
   + gnu/gnunet/directory.scm: directory construction
+* Conventions
+** Fiddling with options
+   Options like ‘priority’, ‘anonymity’, ‘replication’
+   and ‘no-index’ should be ‘passed’ using SRFI-39 parameters,
+   and not with positional or keyword arguments,
+   as they are just passed through unchanged most of the time.
 * Wishlist
   + Schemification
 
diff --git a/gnu/gnunet/scripts/publish-store.scm 
b/gnu/gnunet/scripts/publish-store.scm
index a3f2f20..ca5c2af 100644
--- a/gnu/gnunet/scripts/publish-store.scm
+++ b/gnu/gnunet/scripts/publish-store.scm
@@ -48,6 +48,7 @@
          (only (srfi srfi-1)
                concatenate)
          (srfi srfi-26)
+         (srfi srfi-39)
          (rnrs bytevectors)
          (ice-9 binary-ports)
          (ice-9 textual-ports)
@@ -81,6 +82,34 @@
        (replication (single-char #\r)
                     (value #t))))
 
+    (define *simulate* (make-parameter #f))
+    (define *display-json* (make-parameter #f))
+    (define *config*
+      (make-parameter (string-append (getenv "HOME")
+                                    "/.config/gnunet.conf")))
+    (define *anonymity* (make-parameter 1))
+    (define *priority* (make-parameter 360))
+    (define *replication* (make-parameter 0))
+    (define *no-index* (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 ((*simulate* (opt 'simulate (*simulate*)))
+                    (*display-json* (opt 'display-json (*display-json*)))
+                    (*config* (opt 'config (*config*)))
+                    (*anonymity* (num 'anonymity (*anonymity*)))
+                    (*priority* (num 'priority (*priority*)))
+                    (*replication* (num 'replication (*replication*)))
+                    (*no-index* (opt 'noindex (*no-index*))))
+       (thunk)))
+
     (define %help
       "Usage: publish-store --input=INPUT --config=CONFIG [OPTION]...
 Publish a (GNU Guix, or Nix) store item INPUT into GNUnet.
@@ -119,37 +148,18 @@ GNUnet options
              ((equal? (option-ref options 'format "gnunet-nix-archive-json/0")
                       "gnunet-nix-archive-json/0")
               (let ((result
-                     (publish-nar #:input (option-ref options 'input #f)
-                                  #:simulate (option-ref options 'simulate #f)
-                                  #:display-json
-                                  (option-ref options 'display-json #f)
-                                  #:config (option-ref options 'config #f)
-                                  #:anonymity
-                                  (string->number
-                                   (option-ref options 'anonymity "1"))
-                                  #:priority
-                                  (string->number
-                                   (option-ref options 'priority "360"))
-                                  #:replication
-                                  (string->number
-                                   (option-ref options 'replication "0"))
-                                  #:no-index
-                                  (option-ref options 'noindex #f))))
+                     (call-with-options
+                      options (cute publish-nar
+                                #:input (option-ref options 'input #f)))))
                 (format (current-output-port)
                         "Published at ~a in ~a format~%"
                         result "gnunet-nix-archive-json/0")))
              (else ???))))
 
-    (define* (publish-nar #:key input
-                         display-json
-                         #:allow-other-keys
-                         #:rest r)
+    (define* (publish-nar #:key input)
       (let* ((sxml (store-item->sxml input))
-            (publish-object
-             (lambda (object)
-               (apply publish-object object r)))
-            (json (apply publish-sxml->json sxml r)))
-       (when display-json
+            (json (publish-sxml->json sxml)))
+       (when (*display-json*)
          (display (current-output-port) json))
        (publish-object (string->utf8 json))))
 
@@ -158,19 +168,7 @@ GNUnet options
     (define (extract-uri output)
       (match:substring (regexp-exec gnunet-publish-uri-regexp output) 1))
 
-    (define* (gnunet-publish file
-                            #:key
-                            ;; FIXME this shouldn't matter
-                            input
-                            display-json
-                            (config (string-append
-                                     (getenv "HOME")
-                                     "/.config/gnunet.conf"))
-                            (simulate #f)
-                            (anonymity 1)
-                            (priority 360)
-                            (replication 0)
-                            (no-index #f))
+    (define (gnunet-publish file)
       "Run the GNUnet publish binary, and return the computed hash
 as a string."
       (setenv "LC_ALL" "C")
@@ -178,21 +176,21 @@ as a string."
             ;; FIXME for some reason
             ;; setting anonymity to 0
             ;; causes a hang
-            (anonymity (if (= anonymity 0)
+            (anonymity (if (= (*anonymity*) 0)
                            1
-                           anonymity))
+                           (*anonymity*)))
             (cmd `(,*binary*
                    "--disable-extractor"
                    "-a" ,(number->string anonymity)
-                   "-p" ,(number->string priority)
-                   "-r" ,(number->string replication)
-                   ,@(if config
-                         `("-c" ,config)
+                   "-p" ,(number->string (*priority*))
+                   "-r" ,(number->string (*replication*))
+                   ,@(if (*config*)
+                         `("-c" ,(*config*))
                          '())
-                   ,@(if simulate
+                   ,@(if (*simulate*)
                          '("-s")
                          '())
-                   ,@(if no-index
+                   ,@(if (*no-index*)
                          '("-n")
                          '())
                    "--"
@@ -206,10 +204,7 @@ as a string."
          (throw 'gnunet-publish-eep 'gnunet-publish-???))
        (extract-uri text-1)))
 
-    (define* (publish-sxml->json sxml
-                                #:key
-                                #:allow-other-keys
-                                #:rest r)
+    (define (publish-sxml->json sxml)
       "Publish SXML, an SXML as returned by store-item->sxml,
 and return a JSON string representing it, with individual files
 referred to by their hash."
@@ -226,7 +221,7 @@ referred to by their hash."
                        (type . ,(if executable?
                                       "executable"
                                       "regular"))
-                       (hash . ,(apply publish-object filename r)))))
+                       (hash . ,(publish-object filename)))))
                    ((symlink (@ (name ,name)
                                 (target ,target)))
                     `(((name . ,(path-append prefix name))
@@ -248,7 +243,7 @@ referred to by their hash."
             (wrapped/string (scm->json-string wrapped)))
        wrapped/string))
 
-    (define* (publish-object data #:rest r)
+    (define (publish-object data)
       "Publish DATA, a bytevector or filename, and return
 the resulting GNUnet FS URI. If SIMULATE is #t, do not
 actually publish the file, only compute its hash."
@@ -257,10 +252,9 @@ actually publish the file, only compute its hash."
              (lambda (name port)
                (put-bytevector port data)
                (close-port port)
-               (apply gnunet-publish name
-                      (append r `(#:no-index #t))))))
-           ((string? data)
-            (apply gnunet-publish data r))))
+               (parameterize ((*no-index* #t))
+                 (gnunet-publish name)))))
+           ((string? data) (gnunet-publish data))))
 
     (define (store-item->sxml filename)
       (let* ((name  (basename filename))

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