From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:42037) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dlzzl-0007o0-Eg for guix-patches@gnu.org; Sun, 27 Aug 2017 12:01:06 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dlzzi-0006gj-NW for guix-patches@gnu.org; Sun, 27 Aug 2017 12:01:05 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:49327) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dlzzi-0006gX-L3 for guix-patches@gnu.org; Sun, 27 Aug 2017 12:01:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dlzzi-0001CV-Ce for guix-patches@gnu.org; Sun, 27 Aug 2017 12:01:02 -0400 Subject: [bug#28251] [PATCH 2/3] import: Add generic data to package converter. Resent-Message-ID: From: Ricardo Wurmus Date: Sun, 27 Aug 2017 18:00:45 +0200 Message-Id: <20170827160046.29049-2-rekado@elephly.net> In-Reply-To: <20170827160046.29049-1-rekado@elephly.net> References: <20170827160046.29049-1-rekado@elephly.net> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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: 28251@debbugs.gnu.org Cc: Ricardo Wurmus * guix/import/utils.scm (build-system-modules, guix-modules): New variables. (lookup-build-system-by-name, specs->package-lists, convert-source, data->guix-package): New procedures. --- guix/import/utils.scm | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 76 insertions(+), 1 deletion(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index be1980d08..edc6fda26 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2012, 2013 Ludovic Courtès ;;; Copyright © 2016 Jelle Licht ;;; Copyright © 2016 David Craven +;;; Copyright © 2017 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,10 @@ #:use-module (guix http-client) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (guix discovery) + #:use-module (guix build-system) + #:use-module (gnu packages) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) @@ -45,7 +50,9 @@ license->symbol snake-case - beautify-description)) + beautify-description + + data->guix-package)) (define (factorize-uri uri version) "Factorize URI, a package tarball URI as a string, such that any occurrences @@ -241,3 +248,71 @@ package definition." (('package ('name (? string? name)) _ ...) `(define-public ,(string->symbol name) ,guix-package)))) + +(define build-system-modules + (all-modules (map (lambda (entry) + `(,entry . "guix/build-system")) + %load-path))) + +(define guix-modules + (all-modules (map (lambda (entry) + `(,entry . "guix")) + %load-path))) + +(define (lookup-build-system-by-name name) + (fold-module-public-variables (lambda (obj result) + (if (and (build-system? obj) + (eq? name (build-system-name obj))) + obj result)) + #f + build-system-modules)) + +(define (specs->package-lists specs) + (map (lambda (spec) + (let ((pkg (specification->package spec))) + (list (package-name pkg) pkg))) + specs)) + +(define (convert-source source) + (match source + ((? string? file) (local-file file)) + (#f #f) + (orig (let ((sha (match (car (assoc-ref orig "sha256")) + (("base32" . value) + (base32 value)) + (_ #f)))) + (origin + (method (match (assoc-ref orig "method") + ("url-fetch" (@ (guix download) url-fetch)) + ("git-fetch" (@ (guix git-download) git-fetch)) + ("svn-fetch" (@ (guix svn-download) svn-fetch)) + ("hg-fetch" (@ (guix hg-download) hg-fetch)) + (_ #f))) + (uri (assoc-ref orig "uri")) + (sha256 sha)))))) + +(define (data->guix-package meta) + (package + (name (assoc-ref meta "name")) + (version (assoc-ref meta "version")) + (source (convert-source (assoc-ref meta "source"))) + (build-system + (lookup-build-system-by-name + (string->symbol (assoc-ref meta "build-system")))) + (native-inputs + (specs->package-lists (or (assoc-ref meta "native-inputs") '()))) + (inputs + (specs->package-lists (or (assoc-ref meta "inputs") '()))) + (propagated-inputs + (specs->package-lists (or (assoc-ref meta "propagated-inputs") '()))) + (home-page + (assoc-ref meta "home-page")) + (synopsis + (assoc-ref meta "synopsis")) + (description + (assoc-ref meta "description")) + (license + (let ((l (assoc-ref meta "license"))) + (or (module-ref (resolve-interface '(guix licenses) #:prefix 'license:) + (spdx-string->license l)) + (fsdg-compatible l)))))) -- 2.14.1