From 8897e419e92fa9e6e5b91c554bf72722b2934953 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/
* tests/opam.scm: update the opam->guix-package test since repo is now
expected to be a list
---
guix/import/opam.scm | 145 +++++++++++++++++++++--------------
guix/scripts/import/opam.scm | 5 +-
tests/opam.scm | 2 +-
3 files changed, 93 insertions(+), 59 deletions(-)
@@ -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)
@@ -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)
@@ -90,7 +90,7 @@ url {
(with-output-to-file (string-append my-package "/opam")
(lambda _
(format #t "~a" test-opam-file))))
- (match (opam->guix-package "foo" #:repo test-repo)
+ (match (opam->guix-package "foo" #:repo `(,test-repo))
(('package
('name "ocaml-foo")
('version "1.0.0")
--
2.32.0