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(-)
@@ -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
@@ -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 ...)
@@ -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