[bug#49958] [PATCH] More flexibility in opam importer

[Alice BRENON <alice.brenon@ens-lyon.fr>]

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

Hello,

I'd like to submit this patch for review, discussion and hopefully
inclusion to guix' code. I recently tried to import grew[0], a NLP tool
written in ocaml and distributed with opam but from a custom repository.

The current importer prevented me to do so for several reasons:

- the available repositories were hard-coded to be either opam's
  official repository or coq's
- the repositories were expected to be distributed with git: while
  public git repositories do exist for coq and opam's official
  repository, they are not the source of truth for the opam tool one
  can use in an imperative setup like this:
    `opam repo add coq-released https://coq.inria.fr/opam/released`
  it entailed that assumptions were made about the freshness of the git
  repositories and the actual files served to opam, hence differences
  could theoretically be observed
- it appears that the opam tool doesn't enforce as strict a structure on
  its repositories as its current documentation[1] suggests. Grew's own
  repository has all versions of each package directly under
  `/packages/` instead of in a separate subdirectory. While this
  deserves a clarification from opam's part, this patch hardens guix
  opam importer against such exotic layouts.
- the unability to query several repositories at once rendered
  recursive imports inefficient, as some packages on a custom
  opam repository may still need dependencies from the official opam
  repository even if no guix package has been imported for it yet (this
  was the case with ocaml-ANSITerminal in my case)

The current proposal attempts to solve these difficulties, and allowed
me to actually import the guix declaration for grew and its
dependencies. I'm still fixing the imported declaration and intend to
submit a separate patch to add it to guix packages when it works. I
added grew's custom opam repository to the list of known-repositories
because it was my immediate target but this is of course not important
and could be reverted in favour of coq and opam's official repository
only.

I used the emacs scripted auto-indenter to save a little time to my
reviewers and had to discard many changes that weren't related to my
changes to cut the noise. Maybe this file should be reindented in a
separate commit following the approval or rejection of this patch
proposal.

Cheers,


Alice

[0]: https://grew.fr/
[1]: https://opam.ocaml.org/doc/Manual.html#Repositories

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-guix-opam.patch --]
[-- Type: text/x-patch, Size: 11302 bytes --]

From 3beac4d8caf3c6693237bc4f975029e58a20e0f4 Mon Sep 17 00:00:00 2001
From: Alice BRENON <alice.brenon@ens-lyon.fr>
Date: Sat, 7 Aug 2021 19:50:10 +0200
Subject: [PATCH] guix: opam:   - Add support for importing from several
 repositories   - Add support for custom repositories, either from a URL or a
 local     path   - Use actual opam repositories as defined by the opam tool
 as source

* guix/scripts/import/opam.scm: pass all instances of --repo as a list
  to the importer
* guix/import/opam.scm:
    - delay repo resolution (call to get-opam-repository from within
      opam-fetch instead of outside)
    - use the same repository source as CLI opam does (i.e. HTTP-served
      index.tar.gz instead of git repositories)
    - be more flexible on the repositories structure instead of
      expecting packages/PACKAGE-NAME/PACKAGE-NAME.VERSION/
---
 guix/import/opam.scm         | 145 +++++++++++++++++++++--------------
 guix/scripts/import/opam.scm |   5 +-
 2 files changed, 92 insertions(+), 58 deletions(-)

diff --git a/guix/import/opam.scm b/guix/import/opam.scm
index a35b01d277..c3fad7db65 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,13 +23,16 @@
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 peg)
+  #:use-module (ice-9 popen)
   #: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 (srfi srfi-26)
   #:use-module (web uri)
+  #: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)
@@ -121,51 +125,78 @@
 (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 #:ensure? #f) "/opam/" path))
+
+(define known-repositories
+  '((opam . "https://opam.ocaml.org")
+    (coq . "https://coq.inria.fr/opam/released")
+    (grew . "http://opam.grew.fr")))
+
+(define (repo-type repo)
+  (define (get-uri repo-root)
+    (let ((archive-file (string-append repo-root "/index.tar.gz")))
+      (or (string->uri archive-file) (throw 'bad-uri archive-file))))
+  (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-at output-folder input)
+  "Make sure the opam repository at OUTPUT-FOLDER is up-to-date with INPUT"
+  (let ((cached-date (if (file-exists? output-folder)
+                         (stat:mtime (stat output-folder))
+                         (begin (mkdir-p output-folder) 0))))
+    (begin
+      (and (> (stat:mtime (stat input)) cached-date)
+           (call-with-port
+            (open-pipe* OPEN_WRITE "tar" "xz" "-C" output-folder "-f" "-")
+            (cut dump-port input <>)))
+      output-folder)))
+
+(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 source) (let ((cache (opam-cache-directory (uri-host source))))
+                        (call-with-port
+                         (http-fetch/cached source)
+                         (cut update-repository-at cache <>))))))
 
 ;; 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 +297,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
+            (map get-opam-repository repositories-specs))
+      (throw 'package-not-found repositories-specs)))
+
+(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 +345,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 64164e7cc4..837a6ef40f 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.
 ;;;
@@ -81,7 +82,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)
-- 
2.32.0