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: Add opam importer.

Browse source 
* guix/scripts/import.scm (importers): Add opam.
* guix/scripts/import/opam.scm: New file.
* guix/import/opam.scm: New file.
* tests/opam.scm: New file.
* Makefile.am: Add them.
* doc/guix.texi (Invoking guix import): Document it.
This commit is contained in:
Julien Lepiller 2018-06-06 19:14:39 +02:00
parent 4f6afde9b4
commit b24443bff9
No known key found for this signature in database
GPG key ID: 43111F4520086A0C
6 changed files with 413 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile.am
View file

@ -231,11 +231,13 @@ MODULES += \
guix/import/github.scm \
guix/import/gnome.scm \
guix/import/json.scm \
guix/import/opam.scm \
guix/import/pypi.scm \
guix/import/stackage.scm \
guix/scripts/import/crate.scm \
guix/scripts/import/gem.scm \
guix/scripts/import/json.scm \
guix/scripts/import/opam.scm \
guix/scripts/import/pypi.scm \
guix/scripts/import/stackage.scm \
guix/scripts/weather.scm
@ -382,6 +384,7 @@ if HAVE_GUILE_JSON
SCM_TESTS += \
tests/pypi.scm \
tests/opam.scm \
tests/cpan.scm \
tests/gem.scm \
tests/crate.scm

6
doc/guix.texi
View file

@ -6661,6 +6661,12 @@ in Guix.
@cindex crate
Import metadata from the crates.io Rust package repository
@uref{https://crates.io, crates.io}.
@item opam
@cindex OPAM
@cindex OCaml
Import metadata from the @uref{https://opam.ocaml.org/, OPAM} package
repository used by the OCaml community.
@end table
The structure of the @command{guix import} code is modular. It would be

193
guix/import/opam.scm Normal file
View file

@ -0,0 +1,193 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import opam)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module ((ice-9 rdelim) #:select (read-line))
#:use-module (srfi srfi-1)
#:use-module (web uri)
#:use-module (guix http-client)
#:use-module (guix utils)
#:use-module (guix import utils)
#:use-module ((guix licenses) #:prefix license:)
#:export (opam->guix-package))
(define (opam-urls)
"Fetch the urls.txt file from the opam repository and returns the list of
URLs it contains."
(let ((port (http-fetch/cached (string->uri "https://opam.ocaml.org/urls.txt"))))
(let loop ((result '()))
(let ((line (read-line port)))
(if (eof-object? line)
(begin
(close port)
result)
(loop (cons line result)))))))
(define (vhash-ref hashtable key default)
(match (vhash-assoc key hashtable)
(#f default)
((_ . x) x)))
(define (hashtable-update hashtable line)
"Parse @var{line} to get the name and version of the package and adds them
to the hashtable."
(let* ((line (string-split line #\ )))
(match line
((url foo ...)
(if (equal? url "repo")
hashtable
(match (string-split url #\/)
((type name1 versionstr foo ...)
(if (equal? type "packages")
(match (string-split versionstr #\.)
((name2 versions ...)
(let ((version (string-join versions ".")))
(if (equal? name1 name2)
(let ((curr (vhash-ref hashtable name1 '())))
(vhash-cons name1 (cons version curr) hashtable))
hashtable)))
(_ hashtable))
hashtable))
(_ hashtable))))
(_ hashtable))))
(define (urls->hashtable urls)
"Transform urls.txt in a hashtable whose keys are package names and values
the list of available versions."
(let ((hashtable vlist-null))
(let loop ((urls urls) (hashtable hashtable))
(match urls
(() hashtable)
((url rest ...) (loop rest (hashtable-update hashtable url)))))))
(define (latest-version versions)
"Find the most recent version from a list of versions."
(match versions
((first rest ...)
(let loop ((versions rest) (m first))
(match versions
(() m)
((first rest ...)
(loop rest (if (version>? m first) m first))))))))
(define (fetch-package-url uri)
"Fetch and parse the url file. Return the URL the package can be downloaded
from."
(let ((port (http-fetch uri)))
(let loop ((result #f))
(let ((line (read-line port)))
(if (eof-object? line)
(begin
(close port)
result)
(let* ((line (string-split line #\ )))
(match line
((key value rest ...)
(if (member key '("archive:" "http:"))
(loop (string-trim-both value #\"))
(loop result))))))))))
(define (fetch-package-metadata uri)
"Fetch and parse the opam file. Return an association list containing the
homepage, the license and the list of inputs."
(let ((port (http-fetch uri)))
(let loop ((result '()) (dependencies? #f))
(let ((line (read-line port)))
(if (eof-object? line)
(begin
(close port)
result)
(let* ((line (string-split line #\ )))
(match line
((key value ...)
(let ((dependencies?
(if dependencies?
(not (equal? key "]"))
(equal? key "depends:")))
(val (string-trim-both (string-join value "") #\")))
(cond
((equal? key "homepage:")
(loop (cons `("homepage" . ,val) result) dependencies?))
((equal? key "license:")
(loop (cons `("license" . ,val) result) dependencies?))
((and dependencies? (not (equal? val "[")))
(match (string-split val #\{)
((val rest ...)
(let ((curr (assoc-ref result "inputs"))
(new (string-trim-both
val (list->char-set '(#\] #\[ #\")))))
(loop (cons `("inputs" . ,(cons new (if curr curr '()))) result)
(if (string-contains val "]") #f dependencies?))))))
(else (loop result dependencies?))))))))))))
(define (string->license str)
(cond
((equal? str "MIT") '(license:expat))
((equal? str "GPL2") '(license:gpl2))
((equal? str "LGPLv2") '(license:lgpl2))
(else `())))
(define (ocaml-name->guix-name name)
(cond
((equal? name "ocamlfind") "ocaml-findlib")
((string-prefix? "ocaml" name) name)
((string-prefix? "conf-" name) (substring name 5))
(else (string-append "ocaml-" name))))
(define (dependencies->inputs dependencies)
"Transform the list of dependencies in a list of inputs."
(if (not dependencies)
'()
(map (lambda (input)
(list input (list 'unquote (string->symbol input))))
(map ocaml-name->guix-name dependencies))))
(define (opam->guix-package name)
(let* ((hashtable (urls->hashtable (opam-urls)))
(versions (vhash-ref hashtable name #f)))
(unless (eq? versions #f)
(let* ((version (latest-version versions))
(package-url (string-append "https://opam.ocaml.org/packages/" name
"/" name "." version "/"))
(url-url (string-append package-url "url"))
(opam-url (string-append package-url "opam"))
(source-url (fetch-package-url url-url))
(metadata (fetch-package-metadata opam-url))
(dependencies (assoc-ref metadata "inputs"))
(inputs (dependencies->inputs dependencies)))
(call-with-temporary-output-file
(lambda (temp port)
(and (url-fetch source-url temp)
`(package
(name ,(ocaml-name->guix-name name))
(version ,version)
(source
(origin
(method url-fetch)
(uri ,source-url)
(sha256 (base32 ,(guix-hash-url temp)))))
(build-system ocaml-build-system)
,@(if (null? inputs)
'()
`((inputs ,(list 'quasiquote inputs))))
(home-page ,(assoc-ref metadata "homepage"))
(synopsis "")
(description "")
(license ,@(string->license (assoc-ref metadata "license")))))))))))

2
guix/scripts/import.scm
View file

@ -75,7 +75,7 @@ (define %standard-import-options '())
;;;
(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem"
"cran" "crate" "texlive" "json"))
"cran" "crate" "texlive" "json" "opam"))
(define (resolve-importer name)
(let ((module (resolve-interface

92
guix/scripts/import/opam.scm Normal file
View file

@ -0,0 +1,92 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts import opam)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import opam)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-import-opam))
;;;
;;; Command-line options.
;;;
(define %default-options
'())
(define (show-help)
(display (G_ "Usage: guix import opam PACKAGE-NAME
Import and convert the opam package for PACKAGE-NAME.\n"))
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define %options
;; Specification of the command-line options.
(cons* (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix import opam")))
%standard-import-options))
;;;
;;; Entry point.
;;;
(define (guix-import-opam . args)
(define (parse-options)
;; Return the alist of option values.
(args-fold* args %options
(lambda (opt name arg result)
(leave (G_ "~A: unrecognized option~%") name))
(lambda (arg result)
(alist-cons 'argument arg result))
%default-options))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
value)
(_ #f))
(reverse opts))))
(match args
((package-name)
(let ((sexp (opam->guix-package package-name)))
(unless sexp
(leave (G_ "failed to download meta-data for package '~a'~%")
package-name))
sexp))
(()
(leave (G_ "too few arguments~%")))
((many ...)
(leave (G_ "too many arguments~%"))))))

118
tests/opam.scm Normal file
View file

@ -0,0 +1,118 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-opam)
#:use-module (guix import opam)
#:use-module (guix base32)
#:use-module (guix hash)
#:use-module (guix tests)
#:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which))
#:use-module (srfi srfi-64)
#:use-module (web uri)
#:use-module (ice-9 match))
(define test-url-file
"http: \"https://example.org/foo-1.0.0.tar.gz\"
checksum: \"ac8920f39a8100b94820659bc2c20817\"")
(define test-source-hash
"")
(define test-urls
"repo ac8920f39a8100b94820659bc2c20817 0o644
packages/foo/foo.1.0.0/url ac8920f39a8100b94820659bc2c20817 0o644
packages/foo/foo.1.0.0/opam ac8920f39a8100b94820659bc2c20817 0o644
packages/foo/foo.1.0.0/descr ac8920f39a8100b94820659bc2c20817 0o644")
(define test-opam-file
"opam-version: 1.2
maintainer: \"Alice Doe\"
authors: \"Alice Doe, John Doe\"
homepage: \"https://example.org/\"
bug-reports: \"https://example.org/bugs\"
license: \"MIT\"
dev-repo: \"https://example.org/git\"
build: [
\"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\"
]
build-test: [
\"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\" \"--tests\" \"true\"
]
depends: [
\"alcotest\" {test & >= \"0.7.2\"}
\"ocamlbuild\" {build & >= \"0.9.2\"}
]")
(test-begin "opam")
(test-assert "opam->guix-package"
;; Replace network resources with sample data.
(mock ((guix import utils) url-fetch
(lambda (url file-name)
(match url
("https://example.org/foo-1.0.0.tar.gz"
(begin
(mkdir-p "foo-1.0.0")
(system* "tar" "czvf" file-name "foo-1.0.0/")
(delete-file-recursively "foo-1.0.0")
(set! test-source-hash
(call-with-input-file file-name port-sha256))))
(_ (error "Unexpected URL: " url)))))
(mock ((guix http-client) http-fetch/cached
(lambda (url . rest)
(match (uri->string url)
("https://opam.ocaml.org/urls.txt"
(values (open-input-string test-urls)
(string-length test-urls)))
(_ (error "Unexpected URL: " url)))))
(mock ((guix http-client) http-fetch
(lambda (url . rest)
(match url
("https://opam.ocaml.org/packages/foo/foo.1.0.0/url"
(values (open-input-string test-url-file)
(string-length test-url-file)))
("https://opam.ocaml.org/packages/foo/foo.1.0.0/opam"
(values (open-input-string test-opam-file)
(string-length test-opam-file)))
(_ (error "Unexpected URL: " url)))))
(match (opam->guix-package "foo")
(('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)
('inputs
('quasiquote
(("ocamlbuild" ('unquote 'ocamlbuild))
("ocaml-alcotest" ('unquote 'ocaml-alcotest)))))
('home-page "https://example.org/")
('synopsis "")
('description "")
('license 'license:expat))
(string=? (bytevector->nix-base32-string
test-source-hash)
hash))
(x
(pk 'fail x #f)))))))
(test-end "opam")