From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:47774) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fQcOp-0008Na-3z for guix-patches@gnu.org; Wed, 06 Jun 2018 13:39:09 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fQcOk-0004I4-M2 for guix-patches@gnu.org; Wed, 06 Jun 2018 13:39:07 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:57345) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fQcOk-0004Hn-Fc for guix-patches@gnu.org; Wed, 06 Jun 2018 13:39:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fQcOk-00010M-6M for guix-patches@gnu.org; Wed, 06 Jun 2018 13:39:02 -0400 Subject: [bug#31736] [PATCH] Add an opam importer Resent-Message-ID: Received: from eggs.gnu.org ([2001:4830:134:3::10]:47468) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fQcNb-00083U-SL for guix-patches@gnu.org; Wed, 06 Jun 2018 13:37:54 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fQcNX-0003Yc-IW for guix-patches@gnu.org; Wed, 06 Jun 2018 13:37:51 -0400 Received: from lepiller.eu ([2a00:5884:8208::1]:45402) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1fQcNX-0003XQ-7J for guix-patches@gnu.org; Wed, 06 Jun 2018 13:37:47 -0400 Received: from localhost (static-176-182-42-79.ncc.abo.bbox.fr [176.182.42.79]) by lepiller.eu (OpenSMTPD) with ESMTPSA id 03ccc4ed (TLSv1.2:ECDHE-RSA-CHACHA20-POLY1305:256:NO) for ; Wed, 6 Jun 2018 17:40:04 +0000 (UTC) Date: Wed, 6 Jun 2018 19:37:40 +0200 From: Julien Lepiller Message-ID: <20180606193740.44bef2ea@lepiller.eu> In-Reply-To: <20180606192329.255ade5e@lepiller.eu> References: <20180606192329.255ade5e@lepiller.eu> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/6nCm7G/c9d=U6g=LpsmRvjI" List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 31736@debbugs.gnu.org --MP_/6nCm7G/c9d=U6g=LpsmRvjI Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Le Wed, 6 Jun 2018 19:23:29 +0200, Julien Lepiller a =C3=A9crit : > Hi, this patch adds an importer for ocaml packages from the opam > repository. Whoops, the copyright lines and part of the code was wrong. This version should be better :) --MP_/6nCm7G/c9d=U6g=LpsmRvjI Content-Type: text/x-patch Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=0001-guix-Add-opam-importer.patch =46rom a5250186722305961f0a5d77cb8f7f36cdae0da0 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Wed, 6 Jun 2018 19:14:39 +0200 Subject: [PATCH] guix: Add opam importer. * guix/scripts/import.scm (importers): Add opam. * guix/scripts/import/opam.scm: New file. * guix/import/opam.scm: New file. * Makefile.am: Add them. --- Makefile.am | 2 + guix/import/opam.scm | 188 +++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/opam.scm | 92 +++++++++++++++++ 4 files changed, 283 insertions(+), 1 deletion(-) create mode 100644 guix/import/opam.scm create mode 100644 guix/scripts/import/opam.scm diff --git a/Makefile.am b/Makefile.am index 7898a3648..6bf077d1b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -230,11 +230,13 @@ MODULES +=3D \ 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 diff --git a/guix/import/opam.scm b/guix/import/opam.scm new file mode 100644 index 000000000..608f8b449 --- /dev/null +++ b/guix/import/opam.scm @@ -0,0 +1,188 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2018 Julien Lepiller +;;; +;;; 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 . + +(define-module (guix import opam) + #:use-module (ice-9 match) + #: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 (htable-update htable line) + "Parse @var{line} to get the name and version of the package and adds th= em +to the hashtable." + (let* ((line (string-split line #\ )) + (url (car line))) + (unless (equal? url "repo") + (let ((sp (string-split url #\/))) + (when (equal? (car sp) "packages") + (let* ((versionstr (car (cdr (cdr sp)))) + (name1 (car (cdr sp))) + (name2 (car (string-split versionstr #\.))) + (version (string-join (cdr (string-split versionstr #\.))= "."))) + (when (equal? name1 name2) + (let ((curr (hash-ref htable name1 '()))) + (hash-set! htable name1 (cons version curr)))))))))) + +(define (urls->htable urls) + "Transform urls.txt in a hashtable whose keys are package names and valu= es +the list of available versions." + (let ((htable (make-hash-table))) + (let loop ((urls urls)) + (if (eq? (length urls) 0) + htable + (begin + (htable-update htable (car urls)) + (loop (cdr urls))))))) + +(define (latest-version versions) + "Find the most recent version from a list of versions." + (let loop ((versions (cdr versions)) (m (car versions))) + (if (eq? (length versions) 0) + m + (loop (cdr versions) (if (version>? m (car versions)) m (car version= s)))))) + +(define (fetch-url uri) + "Fetch and parse the url file. Return the URL the package can be downlo= aded +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 #\ )) + (key (car line))) + (if (equal? key "archive:") + (loop (string-trim-both (car (cdr line)) #\")) + (loop result)))))))) + +(define (fetch-metadata uri) + "Fetch and parse the opam file. Return an association list containing t= he +homepage, the license and the list of inputs." + (let ((port (http-fetch uri))) + (let loop ((result '()) (deps? #f)) + (let ((line (read-line port))) + (if (eof-object? line) + (begin + (close port) + result) + (let* ((line (string-split line #\ )) + (key (car line)) + (deps? (if deps? (not (equal? key "]")) (equal? key "depe= nds:"))) + (val (string-trim-both (string-join (cdr line) "") #\"))) + (cond + ((equal? key "homepage:") + (loop (cons `("homepage" . ,val) result) deps?)) + ((equal? key "license:") + (loop (cons `("license" . ,val) result) deps?)) + ((and deps? (not (equal? val "["))) + (let ((curr (assoc-ref result "inputs")) + (new (string-trim-both (car (string-split val #\{)) (= list->char-set '(#\] #\[ #\"))))) + (loop (cons `("inputs" . ,(cons new (if curr curr '()))) = result) + (if (string-contains val "]") #f deps?)))) + (else (loop result deps?))))))))) + +(define (string->license str) + (cond + ((equal? str "MIT") '(license:expat)) + ((equal? str "GPL2") '(license:gpl2)) + ((equal? str "LGPLv2") '(license:lgpl2)) + (else `()))) + +(define (deps->inputs deps) + "Transform the list of dependencies in a list of inputs. Filter out any= thing +that looks like a native-input." + (if (eq? deps #f) + '() + (let ((inputs + (map (lambda (input) + (list input (list 'unquote (string->symbol input)))) + (map (lambda (input) + (cond + ((equal? input "ocamlfind") "ocaml-findlib") + ((string-prefix? "ocaml" input) input) + (else (string-append "ocaml-" input)))) + (filter (lambda (input) (not (string-prefix? "conf-" input= ))) deps))))) + (if (eq? (length inputs) 0) '() inputs)))) + +(define (deps->native-inputs deps) + "Transform the list of dependencies in a list of native-inputs. Filter = out +anything that doesn't look like a native-input." + (if (eq? deps #f) + '() + (let ((inputs + (map (lambda (input) + (list input (list 'unquote (string->symbol input)))) + (map (lambda (input) (substring input 5)) + (filter (lambda (input) (string-prefix? "conf-" input)) de= ps))))) + (if (eq? (length inputs) 0) '() inputs)))) + +(define (opam->guix-package name) + (let* ((htable (urls->htable (opam-urls))) + (versions (hash-ref htable name))) + (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-url url-url)) + (metadata (fetch-metadata opam-url)) + (deps (assoc-ref metadata "inputs")) + (native-inputs (deps->native-inputs deps)) + (inputs (deps->inputs deps))) + (call-with-temporary-output-file + (lambda (temp port) + (and (url-fetch source-url temp) + `(package + (name ,name) + (version ,version) + (source + (origin + (method url-fetch) + (uri ,source-url) + (sha256 (base32 ,(guix-hash-url temp))))) + (build-system ocaml-build-system) + ,@(if (eq? (length inputs) 0) + '() + `((inputs ,(list 'quasiquote inputs)))) + ,@(if (eq? (length native-inputs) 0) + '() + `((native-inputs ,(list 'quasiquote native-inputs)= ))) + (home-page ,(assoc-ref metadata "homepage")) + (synopsis "") + (description "") + (license ,@(string->license (assoc-ref metadata "licen= se"))))))))))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 67bc7a755..bc03179e5 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -74,7 +74,7 @@ rather than \\n." ;;; =20 (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" = "gem" - "cran" "crate" "texlive" "json")) + "cran" "crate" "texlive" "json" "opam")) =20 (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 000000000..b54987874 --- /dev/null +++ b/guix/scripts/import/opam.scm @@ -0,0 +1,92 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2018 Julien Lepiller +;;; +;;; 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 . + +(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)) + +=0C +;;; +;;; 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)) + +=0C +;;; +;;; 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~%")))))) --=20 2.17.1 --MP_/6nCm7G/c9d=U6g=LpsmRvjI--