[bug#28251] [PATCH 2/3] import: Add generic data to package converter.

[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 <address@hidden>
 ;;; Copyright © 2016 Jelle Licht <address@hidden>
 ;;; Copyright © 2016 David Craven <address@hidden>
+;;; Copyright © 2017 Ricardo Wurmus <address@hidden>
 ;;;
 ;;; 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