diff options
| -rw-r--r-- | doc/guix.texi | 29 | ||||
| -rw-r--r-- | guix/import/opam.scm | 158 | ||||
| -rw-r--r-- | guix/scripts/import/opam.scm | 8 | ||||
| -rw-r--r-- | tests/opam.scm | 68 |
4 files changed, 159 insertions, 104 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 949d6d4092..5155e67481 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 a35b01d277..fe13d29f03 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 64164e7cc4..834ac34cb0 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 f1e3b70cb0..1536b74339 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 |