From b24443bff9f9f3f36353eea2ef35e6dc3745a417 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Wed, 6 Jun 2018 19:14:39 +0200 Subject: guix: Add opam importer. * 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. --- guix/import/opam.scm | 193 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 193 insertions(+) create mode 100644 guix/import/opam.scm (limited to 'guix/import') 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 +;;; +;;; 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 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"))))))))))) -- cgit v1.2.3