From a60e2ca645f4f8a6da72111d047f8cbb41ebe3e6 Mon Sep 17 00:00:00 2001 Message-Id: From: Julien Lepiller 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 | 23 ++++++++++++++++++----- guix/scripts/import/opam.scm | 31 +++++++++++++++++-------------- tests/opam.scm | 2 +- 3 files changed, 36 insertions(+), 20 deletions(-) diff --git a/guix/import/opam.scm b/guix/import/opam.scm index fe13d29f03..aeeab541c1 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -20,6 +20,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix import opam) + #:use-module (ice-9 exceptions) #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 peg) @@ -30,6 +31,8 @@ (define-module (guix import opam) #: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 +50,16 @@ (define-module (guix import opam) 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 +92,7 @@ (define-peg-pattern group-pat all (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 +103,7 @@ (define-peg-pattern multiline-string all 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 +317,10 @@ (define (dependency-list->inputs lst) (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 +329,7 @@ (define* (opam-fetch name #:optional (repositories-specs '("opam"))) (_ others))) #f (filter-map get-opam-repository repositories-specs)) - (leave (G_ "package '~a' not found~%") name))) + (raise-continuable (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 @@ -410,7 +421,9 @@ (define (opam-package? package) (define (latest-release package) "Return an for the latest release of PACKAGE." (and-let* ((opam-name (guix-package->opam-name package)) - (opam-file (opam-fetch opam-name)) + (opam-file (guard* (c ((opam-not-found-error? 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")) 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 @@ (define (guix-import-opam . args) (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 @@ (define (test-opam-syntax name pattern test-cases) ("{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.1