From: Ricardo Wurmus <rekado@elephly.net>
To: 28251@debbugs.gnu.org
Cc: Ricardo Wurmus <rekado@elephly.net>
Subject: [bug#28251] [PATCH 2/3] import: Add generic data to package converter.
Date: Sun, 27 Aug 2017 18:00:45 +0200 [thread overview]
Message-ID: <20170827160046.29049-2-rekado@elephly.net> (raw)
In-Reply-To: <20170827160046.29049-1-rekado@elephly.net>
* 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 <ludo@gnu.org>
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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
next prev parent reply other threads:[~2017-08-27 16:01 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-08-27 15:58 [bug#28251] [PATCH 0/3] Add generic JSON importer Ricardo Wurmus
2017-08-27 16:00 ` [bug#28251] [PATCH 1/3] packages: Add package->code Ricardo Wurmus
2017-08-27 16:00 ` Ricardo Wurmus [this message]
2017-09-04 13:04 ` [bug#28251] [PATCH 2/3] import: Add generic data to package converter Ludovic Courtès
2017-08-27 16:00 ` [bug#28251] [PATCH 3/3] import: Add JSON importer Ricardo Wurmus
2017-09-04 13:04 ` Ludovic Courtès
2017-09-01 15:55 ` [bug#28251] [PATCH 1/3] packages: Add package->code Ludovic Courtès
2017-09-28 11:19 ` bug#28251: " Ricardo Wurmus
2017-08-28 12:27 ` [bug#28251] [PATCH 0/3] Add generic JSON importer Ricardo Wurmus
2017-09-01 15:35 ` Ludovic Courtès
2017-09-28 11:23 ` Ricardo Wurmus
2017-09-28 19:58 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20170827160046.29049-2-rekado@elephly.net \
--to=rekado@elephly.net \
--cc=28251@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.