[bug#51091] [PATCH v2] guix: opam: Do not fail when refreshing.

[Julien Lepiller <julien@lepiller.eu>]

[-- Attachment #1: Type: text/plain, Size: 210 bytes --]

Thanks for the reviews! I've managed to use conditions, which was not
easy because I didn't notice there was already a "condition" defined,
and that lead to weird error messages. Attached is the updated patch.

[-- Attachment #2: 0001-import-opam-Do-not-fail-when-refreshing.patch --]
[-- Type: text/x-patch, Size: 7923 bytes --]

From 0cadac6c3dabea8b986cd59d97c84beaf7a33325 Mon Sep 17 00:00:00 2001
Message-Id: <0cadac6c3dabea8b986cd59d97c84beaf7a33325.1634350078.git.julien@lepiller.eu>
From: Julien Lepiller <julien@lepiller.eu>
Date: Fri, 8 Oct 2021 04:58:27 +0200
Subject: [PATCH] import: opam: Do not fail when refreshing.

Because we throw an error when a package is not in the opam repository,
the updater would crash when encountering a package that is not in opam
but uses the ocaml-build-system, such as opam itself.  This catches the
error and continues without updating said package, and lets us update
the rest of the packages.

* guix/scripts/import/opam.scm (guix-import-opam): Catch not-found
condition and leave.
* guix/import/opam.scm (&opam-not-found-error): New condition type.
(opam-fetch): Raise condition instead of leaving.
(latest-release): Catch not-found condition and warn.
(conditional): Rename from `condition'.
* tests/opam.scm (parse-conditions): Change accordingly.
---
 guix/import/opam.scm         | 45 +++++++++++++++++++++++++-----------
 guix/scripts/import/opam.scm | 31 ++++++++++++++-----------
 tests/opam.scm               |  2 +-
 3 files changed, 49 insertions(+), 29 deletions(-)

diff --git a/guix/import/opam.scm b/guix/import/opam.scm
index fe13d29f03..cd746f6dc6 100644
--- a/guix/import/opam.scm
+++ b/guix/import/opam.scm
@@ -30,6 +30,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
   #:use-module ((srfi srfi-26) #:select (cut))
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module ((web uri) #:select (string->uri uri->string))
   #:use-module ((guix build utils) #:select (dump-port find-files mkdir-p))
   #:use-module (guix build-system)
@@ -47,12 +49,16 @@
             opam-recursive-import
             %opam-updater
 
+            &opam-not-found-error
+            opam-not-found-error?
+            opam-not-found-error-package
+
             ;; The following patterns are exported for testing purposes.
             string-pat
             multiline-string
             list-pat
             dict
-            condition))
+            conditional))
 
 ;; Define a PEG parser for the opam format
 (define-peg-pattern comment none (and "#" (* COMMCHR) "\n"))
@@ -85,7 +91,7 @@
                     (and (or conditional-value ground-value) (* SP) (ignore "&") (* SP)
                          (or group-pat conditional-value ground-value)))
 (define-peg-pattern ground-value body (and (or multiline-string string-pat choice-pat list-pat var) (* SP)))
-(define-peg-pattern conditional-value all (and ground-value (* SP) condition))
+(define-peg-pattern conditional-value all (and ground-value (* SP) conditional))
 (define-peg-pattern string-pat all (and QUOTE (* STRCHR) QUOTE))
 (define-peg-pattern list-pat all (and (ignore "[") (* SP) (* (and value (* SP))) (ignore "]")))
 (define-peg-pattern var all (+ (or (range #\a #\z) "-")))
@@ -96,7 +102,7 @@
                          QUOTE QUOTE QUOTE))
 (define-peg-pattern dict all (and (ignore "{") (* SP) records (* SP) (ignore "}")))
 
-(define-peg-pattern condition body (and (ignore "{") condition-form (ignore "}")))
+(define-peg-pattern conditional body (and (ignore "{") condition-form (ignore "}")))
 
 (define-peg-pattern condition-form body
                     (and
@@ -310,6 +316,10 @@ path to the repository."
      (list dependency (list 'unquote (string->symbol dependency))))
    (ocaml-names->guix-names lst)))
 
+(define-condition-type &opam-not-found-error &error
+  opam-not-found-error?
+  (package opam-not-found-error-package))
+
 (define* (opam-fetch name #:optional (repositories-specs '("opam")))
   (or (fold (lambda (repository others)
               (match (find-latest-version name repository)
@@ -318,7 +328,7 @@ path to the repository."
                 (_ others)))
             #f
             (filter-map get-opam-repository repositories-specs))
-      (leave (G_ "package '~a' not found~%") name)))
+      (raise (condition (&opam-not-found-error (package name))))))
 
 (define* (opam->guix-package name #:key (repo '()) version)
   "Import OPAM package NAME from REPOSITORIES (a list of names, URLs or local
@@ -409,16 +419,23 @@ package in OPAM."
 
 (define (latest-release package)
   "Return an <upstream-source> for the latest release of PACKAGE."
-  (and-let* ((opam-name (guix-package->opam-name package))
-             (opam-file (opam-fetch opam-name))
-             (version (assoc-ref opam-file "version"))
-             (opam-content (assoc-ref opam-file "metadata"))
-             (url-dict (metadata-ref opam-content "url"))
-             (source-url (metadata-ref url-dict "src")))
-    (upstream-source
-      (package (package-name package))
-      (version version)
-      (urls (list source-url)))))
+  (catch #t
+    (lambda _
+      (and-let* ((opam-name (guix-package->opam-name package))
+                 (opam-file (guard* (c ((opam-not-found-error? c)
+                                        (warning (G_ "package '~a' not found~%")
+                                                 (opam-not-found-error-package c))
+                                        #f))
+                              (opam-fetch opam-name)))
+                 (version (assoc-ref opam-file "version"))
+                 (opam-content (assoc-ref opam-file "metadata"))
+                 (url-dict (metadata-ref opam-content "url"))
+                 (source-url (metadata-ref url-dict "src")))
+        (upstream-source
+          (package (package-name package))
+          (version version)
+          (urls (list source-url)))))
+    (const #f)))
 
 (define %opam-updater
   (upstream-updater
diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm
index 834ac34cb0..043d05d717 100644
--- a/guix/scripts/import/opam.scm
+++ b/guix/scripts/import/opam.scm
@@ -93,20 +93,23 @@ Import and convert the opam package for PACKAGE-NAME.\n"))
                            (reverse opts))))
     (match args
       ((package-name)
-       (if (assoc-ref opts 'recursive)
-           ;; Recursive import
-           (map (match-lambda
-                  ((and ('package ('name name) . rest) pkg)
-                   `(define-public ,(string->symbol name)
-                      ,pkg))
-                  (_ #f))
-                (opam-recursive-import package-name #:repo repo))
-           ;; Single import
-           (let ((sexp (opam->guix-package package-name #:repo repo)))
-             (unless sexp
-               (leave (G_ "failed to download meta-data for package '~a'~%")
-                      package-name))
-             sexp)))
+       (guard* (c ((opam-not-found-error? c)
+                  (leave (G_ "package '~a' not found~%")
+                         (opam-not-found-error-package c))))
+         (if (assoc-ref opts 'recursive)
+             ;; Recursive import
+             (map (match-lambda
+                    ((and ('package ('name name) . rest) pkg)
+                     `(define-public ,(string->symbol name)
+                        ,pkg))
+                    (_ #f))
+                  (opam-recursive-import package-name #:repo repo))
+             ;; Single import
+             (let ((sexp (opam->guix-package package-name #:repo repo)))
+               (unless sexp
+                 (leave (G_ "failed to download meta-data for package '~a'~%")
+                        package-name))
+               sexp))))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)
diff --git a/tests/opam.scm b/tests/opam.scm
index 31b4ea41ff..96b748bcd9 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -171,7 +171,7 @@ url {
     ("{a: \"b\"\nc: \"d\"}" . (dict (record "a" (string-pat "b")) (record "c" (string-pat "d"))))))
 
 (test-opam-syntax
-  "parse-conditions" condition
+  "parse-conditions" conditional
   '(("" . #f)
     ("{}" . #f)
     ("{build}" . (condition-var "build"))
-- 
2.33.0