ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix: opam: More flexibility in the importer.

Browse source 
* 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>
This commit is contained in:
Alice BRENON 2021-08-07 19:50:10 +02:00 committed by Julien Lepiller
parent 6d9d10ae3f
commit fc29c80b96
No known key found for this signature in database
GPG key ID: 53D457B2D636EE82
4 changed files with 157 additions and 102 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
doc/guix.texi
View file

@ -95,6 +95,7 @@ Copyright @copyright{} 2021 Raghav Gururajan@*
Copyright @copyright{} 2021 Domagoj Stolfa@* Copyright @copyright{} 2021 Domagoj Stolfa@*
Copyright @copyright{} 2021 Hui Lu@* Copyright @copyright{} 2021 Hui Lu@*
Copyright @copyright{} 2021 pukkamustard@* Copyright @copyright{} 2021 pukkamustard@*
Copyright @copyright{} 2021 Alice Brenon@*
Permission is granted to copy, distribute and/or modify this document Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or 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 and generate package expressions for all those packages that are not yet
in Guix. in Guix.
@item --repo @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 @itemize
@item @code{opam}, the default opam repository, @item the name of a known repository - can be one of @code{opam},
@item @code{coq} or @code{coq-released}, the stable repository for coq packages, @code{coq} (equivalent to @code{coq-released}),
@item @code{coq-core-dev}, the repository that contains development versions of coq, @code{coq-core-dev}, @code{coq-extra-dev} or @code{grew}.
@item @code{coq-extra-dev}, the repository that contains development versions @item the URL of a repository as expected by the @code{opam repository
of coq packages. 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 @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 @end table
@item go @item go

154
guix/import/opam.scm
View file

@ -2,6 +2,7 @@
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2021 Alice Brenon <alice.brenon@ens-lyon.fr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -22,21 +23,24 @@ (define-module (guix import opam)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 peg) #:use-module (ice-9 peg)
#:use-module ((ice-9 popen) #:select (open-pipe*))
#:use-module (ice-9 receive) #:use-module (ice-9 receive)
#:use-module ((ice-9 rdelim) #:select (read-line))
#:use-module (ice-9 textual-ports) #:use-module (ice-9 textual-ports)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-2) #: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)
#:use-module (guix build-system ocaml) #:use-module (guix build-system ocaml)
#:use-module (guix http-client) #:use-module (guix http-client)
#:use-module (guix git)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix upstream) #: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 import utils)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
#:export (opam->guix-package #:export (opam->guix-package
@ -121,51 +125,83 @@ (define-peg-pattern condition-paren body (and "(" condition-form ")"))
(define-peg-pattern condition-string all (and QUOTE (* STRCHR) QUOTE)) (define-peg-pattern condition-string all (and QUOTE (* STRCHR) QUOTE))
(define-peg-pattern condition-var all (+ (or (range #\a #\z) "-" ":"))) (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 "Update or fetch the latest version of the opam repository and return the
path to the repository." path to the repository."
(let ((url (cond (match (repo-type repo)
((or (not repo) (equal? repo 'opam)) (('local p) p)
"https://github.com/ocaml/opam-repository") (('remote 'bad-repo) #f) ; to weed it out during filter-map in opam-fetch
((string-prefix? "coq-" (symbol->string repo)) (('remote r) (call-with-port (http-fetch/cached r) update-repository))))
"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)))))
;; Prevent Guile 3 from inlining this procedure so we can mock it in tests. ;; Prevent Guile 3 from inlining this procedure so we can mock it in tests.
(set! get-opam-repository get-opam-repository) (set! get-opam-repository get-opam-repository)
(define (latest-version versions) (define (get-version-and-file path)
"Find the most recent version from a list of versions." "Analyse a candidate path and return an list containing information for proper
(fold (lambda (a b) (if (version>? a b) a b)) (car versions) versions)) 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) (define (find-latest-version package repository)
"Get the latest version of a package as described in the given repository." "Get the latest version of a package as described in the given repository."
(let* ((dir (string-append repository "/packages/" package)) (let ((packages (string-append repository "/packages"))
(versions (scandir dir (lambda (name) (not (string-prefix? "." name)))))) (filter (make-regexp (string-append "^" package "\\."))))
(if versions (reduce keep-max-version #f
(let ((versions (map (filter-map
(lambda (dir) get-version-and-file
(string-join (cdr (string-split dir #\.)) ".")) (find-files packages filter #:directories? #t)))))
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))))
(define (get-metadata opam-file) (define (get-metadata opam-file)
(with-input-from-file opam-file (with-input-from-file opam-file
@ -266,28 +302,30 @@ (define (depends->inputs depends)
(define (depends->native-inputs depends) (define (depends->native-inputs depends)
(filter (lambda (name) (not (equal? "" name))) (filter (lambda (name) (not (equal? "" name)))
(map dependency->native-input depends))) (map dependency->native-input depends)))
(define (dependency-list->inputs lst) (define (dependency-list->inputs lst)
(map (map
(lambda (dependency) (lambda (dependency)
(list dependency (list 'unquote (string->symbol dependency)))) (list dependency (list 'unquote (string->symbol dependency))))
(ocaml-names->guix-names lst))) (ocaml-names->guix-names lst)))
(define* (opam-fetch name #:optional (repository (get-opam-repository))) (define* (opam-fetch name #:optional (repositories-specs '("opam")))
(and-let* ((repository repository) (or (fold (lambda (repository others)
(version (find-latest-version name repository)) (match (find-latest-version name repository)
(file (string-append repository "/packages/" name "/" name "." version "/opam"))) ((_ version file) `(("metadata" ,@(get-metadata file))
`(("metadata" ,@(get-metadata file)) ("version" . ,version)))
("version" . ,(if (string-prefix? "v" version) (_ others)))
(substring version 1) #f
version))))) (filter-map get-opam-repository repositories-specs))
(leave (G_ "package '~a' not found~%") name)))
(define* (opam->guix-package name #:key (repo 'opam) version) (define* (opam->guix-package name #:key (repo '()) version)
"Import OPAM package NAME from REPOSITORY (a directory name) or, if "Import OPAM package NAME from REPOSITORIES (a list of names, URLs or local
REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp paths, always including OPAM's official repository). Return a 'package' sexp
or #f on failure." 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")) (version (assoc-ref opam-file "version"))
(opam-content (assoc-ref opam-file "metadata")) (opam-content (assoc-ref opam-file "metadata"))
(url-dict (metadata-ref opam-content "url")) (url-dict (metadata-ref opam-content "url"))
@ -312,9 +350,7 @@ (define* (opam->guix-package name #:key (repo 'opam) version)
(values (values
`(package `(package
(name ,(ocaml-name->guix-name name)) (name ,(ocaml-name->guix-name name))
(version ,(if (string-prefix? "v" version) (version ,version)
(substring version 1)
version))
(source (source
(origin (origin
(method url-fetch) (method url-fetch)

8
guix/scripts/import/opam.scm
View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2021 Alice Brenon <alice.brenon@ens-lyon.fr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -46,7 +47,8 @@ (define (show-help)
(display (G_ " (display (G_ "
-r, --recursive import packages recursively")) -r, --recursive import packages recursively"))
(display (G_ " (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_ " (display (G_ "
-V, --version display version information and exit")) -V, --version display version information and exit"))
(newline) (newline)
@ -81,7 +83,9 @@ (define (parse-options)
#:build-options? #f)) #:build-options? #f))
(let* ((opts (parse-options)) (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 (args (filter-map (match-lambda
(('argument . value) (('argument . value)
value) value)

68
tests/opam.scm
View file

@ -82,41 +82,39 @@ (define test-repo
(set! test-source-hash (set! test-source-hash
(call-with-input-file file-name port-sha256)))) (call-with-input-file file-name port-sha256))))
(_ (error "Unexpected URL: " url))))) (_ (error "Unexpected URL: " url)))))
(mock ((guix import opam) get-opam-repository (let ((my-package (string-append test-repo
(const test-repo)) "/packages/foo/foo.1.0.0")))
(let ((my-package (string-append test-repo (mkdir-p my-package)
"/packages/foo/foo.1.0.0"))) (with-output-to-file (string-append my-package "/opam")
(mkdir-p my-package) (lambda _
(with-output-to-file (string-append my-package "/opam") (format #t "~a" test-opam-file))))
(lambda _ (match (opam->guix-package "foo" #:repo (list test-repo))
(format #t "~a" test-opam-file)))) (('package
(match (opam->guix-package "foo" #:repo test-repo) ('name "ocaml-foo")
(('package ('version "1.0.0")
('name "ocaml-foo") ('source ('origin
('version "1.0.0") ('method 'url-fetch)
('source ('origin ('uri "https://example.org/foo-1.0.0.tar.gz")
('method 'url-fetch) ('sha256
('uri "https://example.org/foo-1.0.0.tar.gz") ('base32
('sha256 (? string? hash)))))
('base32 ('build-system 'ocaml-build-system)
(? string? hash))))) ('propagated-inputs
('build-system 'ocaml-build-system) ('quasiquote
('propagated-inputs (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
('quasiquote ('native-inputs
(("ocaml-zarith" ('unquote 'ocaml-zarith))))) ('quasiquote
('native-inputs (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
('quasiquote ("ocamlbuild" ('unquote 'ocamlbuild)))))
(("ocaml-alcotest" ('unquote 'ocaml-alcotest)) ('home-page "https://example.org/")
("ocamlbuild" ('unquote 'ocamlbuild))))) ('synopsis "Some example package")
('home-page "https://example.org/") ('description "This package is just an example.")
('synopsis "Some example package") ('license 'license:bsd-3))
('description "This package is just an example.") (string=? (bytevector->nix-base32-string
('license 'license:bsd-3)) test-source-hash)
(string=? (bytevector->nix-base32-string hash))
test-source-hash) (x
hash)) (pk 'fail x #f)))))
(x
(pk 'fail x #f))))))
;; Test the opam file parser ;; Test the opam file parser
;; We fold over some test cases. Each case is a pair of the string to parse and the ;; We fold over some test cases. Each case is a pair of the string to parse and the