diff options
| -rw-r--r-- | Makefile.am | 3 | ||||
| -rw-r--r-- | doc/guix.texi | 6 | ||||
| -rw-r--r-- | guix/import/opam.scm | 193 | ||||
| -rw-r--r-- | guix/scripts/import.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/import/opam.scm | 92 | ||||
| -rw-r--r-- | tests/opam.scm | 118 |
6 files changed, 413 insertions, 1 deletions
diff --git a/Makefile.am b/Makefile.am index 5dc04de35c..618d1653e4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 diff --git a/doc/guix.texi b/doc/guix.texi index 7ce364b0af..a8e53a5308 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/guix/import/opam.scm b/guix/import/opam.scm new file mode 100644 index 0000000000..f252bdc31a --- /dev/null +++ b/guix/import/opam.scm @@ -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"))))))))))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index f8cb85700d..0b326e1049 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -75,7 +75,7 @@ rather than \\n." ;;; (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 diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm new file mode 100644 index 0000000000..b549878742 --- /dev/null +++ b/guix/scripts/import/opam.scm @@ -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~%")))))) diff --git a/tests/opam.scm b/tests/opam.scm new file mode 100644 index 0000000000..26832174a8 --- /dev/null +++ b/tests/opam.scm @@ -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") |