branch master updated: guix: opam: More flexibility in the importer.

[guix-commits]

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

roptat pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new fc29c80  guix: opam: More flexibility in the importer.
fc29c80 is described below

commit fc29c80b9635ff490bcc768c774442043cb1e231
Author: Alice BRENON <alice.brenon@ens-lyon.fr>
AuthorDate: Sat Aug 7 19:50:10 2021 +0200

    guix: opam: More flexibility in the importer.
    
    * guix/scripts/import/opam.scm: Pass all instances of --repo as a list
      to the importer.
    * guix/import/opam.scm (opam-fetch): Stop expecting "expanded"
      repositories and call get-opam-repository instead to keep values
      "symbolic" as long as possible and factorize.
      (get-opam-repository): Use the same repository source as CLI opam does
      (i.e. HTTP-served index.tar.gz instead of git repositories).
      (find-latest-version): Be more flexible on the repositories structure
      instead of expecting packages/PACKAGE-NAME/PACKAGE-NAME.VERSION/.
    * tests/opam.scm: Update the call to opam->guix-package since repo is
      now expected to be a list and remove the mocked get-opam-repository
      deprecated by the support for local folders by the actual
      implementation.
    * doc/guix.texi: Document the new semantics and valid arguments for the
      --repo option.
    
    Signed-off-by: Julien Lepiller <julien@lepiller.eu>
---
 doc/guix.texi                |  29 ++++++--
 guix/import/opam.scm         | 158 ++++++++++++++++++++++++++-----------------
 guix/scripts/import/opam.scm |   8 ++-
 tests/opam.scm               |  68 +++++++++----------
 4 files changed, 159 insertions(+), 104 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 949d6d4..5155e67 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -95,6 +95,7 @@ Copyright @copyright{} 2021 Raghav Gururajan@*
 Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
 Copyright @copyright{} 2021 pukkamustard@*
+Copyright @copyright{} 2021 Alice Brenon@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -11659,14 +11660,30 @@ Traverse the dependency graph of the given upstream 
package recursively
 and generate package expressions for all those packages that are not yet
 in Guix.
 @item --repo
-Select the given repository (a repository name).  Possible values include:
+By default, packages are searched in the official OPAM repository.  This
+option, which can be used more than once, lets you add other repositories
+which will be searched for packages.  It accepts as valid arguments:
+
 @itemize
-@item @code{opam}, the default opam repository,
-@item @code{coq} or @code{coq-released}, the stable repository for coq 
packages,
-@item @code{coq-core-dev}, the repository that contains development versions 
of coq,
-@item @code{coq-extra-dev}, the repository that contains development versions
-      of coq packages.
+@item the name of a known repository - can be one of @code{opam},
+      @code{coq} (equivalent to @code{coq-released}),
+         @code{coq-core-dev}, @code{coq-extra-dev} or @code{grew}.
+@item the URL of a repository as expected by the @code{opam repository
+      add} command (for instance, the URL equivalent of the above
+         @code{opam} name would be @uref{https://opam.ocaml.org}).
+@item the path to a local copy of a repository (a directory containing a
+      @file{packages/} sub-directory).
 @end itemize
+
+Repositories are assumed to be passed to this option by order of
+preference.  The additional repositories will not replace the default
+@code{opam} repository, which is always kept as a fallback.
+
+Also, please note that versions are not compared accross repositories.
+The first repository (from left to right) that has at least one version
+of a given package will prevail over any others, and the version
+imported will be the latest one found @emph{in this repository only}.
+
 @end table
 
 @item go
diff --git a/guix/import/opam.scm b/guix/import/opam.scm
index a35b01d..fe13d29 100644
--- a/guix/import/opam.scm
+++ b/guix/import/opam.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Alice Brenon <alice.brenon@ens-lyon.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,21 +23,24 @@
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 peg)
+  #:use-module ((ice-9 popen) #:select (open-pipe*))
   #:use-module (ice-9 receive)
-  #:use-module ((ice-9 rdelim) #:select (read-line))
   #:use-module (ice-9 textual-ports)
   #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
-  #:use-module (web uri)
+  #:use-module ((srfi srfi-26) #:select (cut))
+  #: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)
   #:use-module (guix build-system ocaml)
   #:use-module (guix http-client)
-  #:use-module (guix git)
   #:use-module (guix ui)
   #:use-module (guix packages)
   #:use-module (guix upstream)
-  #:use-module (guix utils)
+  #:use-module ((guix utils) #:select (cache-directory
+                                       version>?
+                                       call-with-temporary-output-file))
   #:use-module (guix import utils)
   #:use-module ((guix licenses) #:prefix license:)
   #:export (opam->guix-package
@@ -121,51 +125,83 @@
 (define-peg-pattern condition-string all (and QUOTE (* STRCHR) QUOTE))
 (define-peg-pattern condition-var all (+ (or (range #\a #\z) "-" ":")))
 
-(define* (get-opam-repository #:optional repo)
+(define (opam-cache-directory path)
+  (string-append (cache-directory) "/opam/" path))
+
+(define known-repositories
+  '((opam . "https://opam.ocaml.org";)
+    (coq . "https://coq.inria.fr/opam/released";)
+    (coq-released . "https://coq.inria.fr/opam/released";)
+    (coq-core-dev . "https://coq.inria.fr/opam/core-dev";)
+    (coq-extra-dev . "https://coq.inria.fr/opam/extra-dev";)
+    (grew . "http://opam.grew.fr";)))
+
+(define (get-uri repo-root)
+  (let ((archive-file (string-append repo-root "/index.tar.gz")))
+    (or (string->uri archive-file)
+        (begin
+          (warning (G_ "'~a' is not a valid URI~%") archive-file)
+          'bad-repo))))
+
+(define (repo-type repo)
+  (match (assoc-ref known-repositories (string->symbol repo))
+    (#f (if (file-exists? repo)
+            `(local ,repo)
+            `(remote ,(get-uri repo))))
+    (url `(remote ,(get-uri url)))))
+
+(define (update-repository input)
+  "Make sure the cache for opam repository INPUT is up-to-date"
+  (let* ((output (opam-cache-directory (basename (port-filename input))))
+         (cached-date (if (file-exists? output)
+                          (stat:mtime (stat output))
+                          (begin (mkdir-p output) 0))))
+    (when (> (stat:mtime (stat input)) cached-date)
+      (call-with-port
+       (open-pipe* OPEN_WRITE "tar" "xz" "-C" output "-f" "-")
+       (cut dump-port input <>)))
+    output))
+
+(define* (get-opam-repository #:optional (repo "opam"))
   "Update or fetch the latest version of the opam repository and return the
 path to the repository."
-  (let ((url (cond
-               ((or (not repo) (equal? repo 'opam))
-                "https://github.com/ocaml/opam-repository";)
-               ((string-prefix? "coq-" (symbol->string repo))
-                "https://github.com/coq/opam-coq-archive";)
-               ((equal? repo 'coq) "https://github.com/coq/opam-coq-archive";)
-               (else (throw 'unknown-repository repo)))))
-    (receive (location commit _)
-      (update-cached-checkout url)
-      (cond
-        ((or (not repo) (equal? repo 'opam))
-         location)
-        ((equal? repo 'coq)
-         (string-append location "/released"))
-        ((string-prefix? "coq-" (symbol->string repo))
-         (string-append location "/" (substring (symbol->string repo) 4)))
-        (else location)))))
+  (match (repo-type repo)
+    (('local p) p)
+    (('remote 'bad-repo) #f) ; to weed it out during filter-map in opam-fetch
+    (('remote r) (call-with-port (http-fetch/cached r) update-repository))))
 
 ;; Prevent Guile 3 from inlining this procedure so we can mock it in tests.
 (set! get-opam-repository get-opam-repository)
 
-(define (latest-version versions)
-  "Find the most recent version from a list of versions."
-  (fold (lambda (a b) (if (version>? a b) a b)) (car versions) versions))
+(define (get-version-and-file path)
+  "Analyse a candidate path and return an list containing information for 
proper
+  version comparison as well as the source path for metadata."
+  (and-let* ((metadata-file (string-append path "/opam"))
+             (filename (basename path))
+             (version (string-join (cdr (string-split filename #\.)) ".")))
+    (and (file-exists? metadata-file)
+         (eq? 'regular (stat:type (stat metadata-file)))
+         (if (string-prefix? "v" version)
+             `(V ,(substring version 1) ,metadata-file)
+             `(digits ,version ,metadata-file)))))
+
+(define (keep-max-version a b)
+  "Version comparison on the lists returned by the previous function taking the
+  janestreet re-versioning into account (v-prefixed come first)."
+  (match (cons a b)
+    ((('V va _) . ('V vb _)) (if (version>? va vb) a b))
+    ((('V _ _) . _) a)
+    ((_ . ('V _ _)) b)
+    ((('digits va _) . ('digits vb _)) (if (version>? va vb) a b))))
 
 (define (find-latest-version package repository)
   "Get the latest version of a package as described in the given repository."
-  (let* ((dir (string-append repository "/packages/" package))
-         (versions (scandir dir (lambda (name) (not (string-prefix? "." 
name))))))
-    (if versions
-      (let ((versions (map
-                        (lambda (dir)
-                          (string-join (cdr (string-split dir #\.)) "."))
-                        versions)))
-        ;; Workaround for janestreet re-versionning
-        (let ((v-versions (filter (lambda (version) (string-prefix? "v" 
version)) versions)))
-          (if (null? v-versions)
-            (latest-version versions)
-            (string-append "v" (latest-version (map (lambda (version) 
(substring version 1)) v-versions))))))
-      (begin
-        (format #t (G_ "Package not found in opam repository: ~a~%") package)
-        #f))))
+  (let ((packages (string-append repository "/packages"))
+        (filter (make-regexp (string-append "^" package "\\."))))
+    (reduce keep-max-version #f
+            (filter-map
+             get-version-and-file
+             (find-files packages filter #:directories? #t)))))
 
 (define (get-metadata opam-file)
   (with-input-from-file opam-file
@@ -266,28 +302,30 @@ path to the repository."
 
 (define (depends->native-inputs depends)
   (filter (lambda (name) (not (equal? "" name)))
-    (map dependency->native-input depends)))
+          (map dependency->native-input depends)))
 
 (define (dependency-list->inputs lst)
   (map
-    (lambda (dependency)
-      (list dependency (list 'unquote (string->symbol dependency))))
-    (ocaml-names->guix-names lst)))
-
-(define* (opam-fetch name #:optional (repository (get-opam-repository)))
-  (and-let* ((repository repository)
-             (version (find-latest-version name repository))
-             (file (string-append repository "/packages/" name "/" name "." 
version "/opam")))
-    `(("metadata" ,@(get-metadata file))
-      ("version" . ,(if (string-prefix? "v" version)
-                        (substring version 1)
-                        version)))))
-
-(define* (opam->guix-package name #:key (repo 'opam) version)
-  "Import OPAM package NAME from REPOSITORY (a directory name) or, if
-REPOSITORY is #f, from the official OPAM repository.  Return a 'package' sexp
+   (lambda (dependency)
+     (list dependency (list 'unquote (string->symbol dependency))))
+   (ocaml-names->guix-names lst)))
+
+(define* (opam-fetch name #:optional (repositories-specs '("opam")))
+  (or (fold (lambda (repository others)
+              (match (find-latest-version name repository)
+                ((_ version file) `(("metadata" ,@(get-metadata file))
+                                    ("version" . ,version)))
+                (_ others)))
+            #f
+            (filter-map get-opam-repository repositories-specs))
+      (leave (G_ "package '~a' not found~%") name)))
+
+(define* (opam->guix-package name #:key (repo '()) version)
+  "Import OPAM package NAME from REPOSITORIES (a list of names, URLs or local
+paths, always including OPAM's official repository).  Return a 'package' sexp
 or #f on failure."
-  (and-let* ((opam-file (opam-fetch name (get-opam-repository repo)))
+  (and-let* ((with-opam (if (member "opam" repo) repo (cons "opam" repo)))
+             (opam-file (opam-fetch name with-opam))
              (version (assoc-ref opam-file "version"))
              (opam-content (assoc-ref opam-file "metadata"))
              (url-dict (metadata-ref opam-content "url"))
@@ -312,9 +350,7 @@ or #f on failure."
                    (values
                     `(package
                        (name ,(ocaml-name->guix-name name))
-                       (version ,(if (string-prefix? "v" version)
-                                   (substring version 1)
-                                   version))
+                       (version ,version)
                        (source
                          (origin
                            (method url-fetch)
diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm
index 64164e7..834ac34 100644
--- a/guix/scripts/import/opam.scm
+++ b/guix/scripts/import/opam.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021 Alice Brenon <alice.brenon@ens-lyon.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -46,7 +47,8 @@ Import and convert the opam package for PACKAGE-NAME.\n"))
   (display (G_ "
   -r, --recursive        import packages recursively"))
   (display (G_ "
-      --repo             import packages from this opam repository"))
+      --repo             import packages from this opam repository (name, URL 
or local path)
+                         can be used more than once"))
   (display (G_ "
   -V, --version          display version information and exit"))
   (newline)
@@ -81,7 +83,9 @@ Import and convert the opam package for PACKAGE-NAME.\n"))
                         #:build-options? #f))
 
   (let* ((opts (parse-options))
-         (repo (and=> (assoc-ref opts 'repo) string->symbol))
+         (repo (filter-map (match-lambda
+                             (('repo . name) name)
+                             (_ #f)) opts))
          (args (filter-map (match-lambda
                             (('argument . value)
                              value)
diff --git a/tests/opam.scm b/tests/opam.scm
index f1e3b70..1536b74 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -82,41 +82,39 @@ url {
                 (set! test-source-hash
                   (call-with-input-file file-name port-sha256))))
              (_ (error "Unexpected URL: " url)))))
-        (mock ((guix import opam) get-opam-repository
-               (const test-repo))
-              (let ((my-package (string-append test-repo
-                                               "/packages/foo/foo.1.0.0")))
-                (mkdir-p my-package)
-                (with-output-to-file (string-append my-package "/opam")
-                  (lambda _
-                    (format #t "~a" test-opam-file))))
-              (match (opam->guix-package "foo" #:repo test-repo)
-                (('package
-                   ('name "ocaml-foo")
-                   ('version "1.0.0")
-                   ('source ('origin
-                              ('method 'url-fetch)
-                              ('uri "https://example.org/foo-1.0.0.tar.gz";)
-                              ('sha256
-                               ('base32
-                                (? string? hash)))))
-                   ('build-system 'ocaml-build-system)
-                   ('propagated-inputs
-                    ('quasiquote
-                     (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
-                   ('native-inputs
-                    ('quasiquote
-                     (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
-                      ("ocamlbuild" ('unquote 'ocamlbuild)))))
-                   ('home-page "https://example.org/";)
-                   ('synopsis "Some example package")
-                   ('description "This package is just an example.")
-                   ('license 'license:bsd-3))
-                 (string=? (bytevector->nix-base32-string
-                            test-source-hash)
-                           hash))
-                (x
-                 (pk 'fail x #f))))))
+        (let ((my-package (string-append test-repo
+                                         "/packages/foo/foo.1.0.0")))
+          (mkdir-p my-package)
+          (with-output-to-file (string-append my-package "/opam")
+            (lambda _
+              (format #t "~a" test-opam-file))))
+        (match (opam->guix-package "foo" #:repo (list test-repo))
+          (('package
+             ('name "ocaml-foo")
+             ('version "1.0.0")
+             ('source ('origin
+                        ('method 'url-fetch)
+                        ('uri "https://example.org/foo-1.0.0.tar.gz";)
+                        ('sha256
+                         ('base32
+                          (? string? hash)))))
+             ('build-system 'ocaml-build-system)
+             ('propagated-inputs
+              ('quasiquote
+               (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
+             ('native-inputs
+              ('quasiquote
+               (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
+                ("ocamlbuild" ('unquote 'ocamlbuild)))))
+             ('home-page "https://example.org/";)
+             ('synopsis "Some example package")
+             ('description "This package is just an example.")
+             ('license 'license:bsd-3))
+           (string=? (bytevector->nix-base32-string
+                      test-source-hash)
+                     hash))
+          (x
+           (pk 'fail x #f)))))
 
 ;; Test the opam file parser
 ;; We fold over some test cases. Each case is a pair of the string to parse 
and the