From 792d3e3ebda07bf809a2107720b07ceb067979b1 Mon Sep 17 00:00:00 2001
From: Martin Becze <mjbecze@riseup.net>
Date: Tue, 4 Feb 2020 07:18:18 -0500
Subject: import: utils: 'recursive-import' accepts an optional version
 parameter.

This adds a key VERSION to 'recursive-import' and move the paramter REPO to a
key. This also changes all the things that rely on 'recursive-import'

* guix/import/utils.scm (recursive-import): Add the VERSION key. Make REPO a
 key.
(package->definition): Added optional 'append-version?'.
* guix/import/cran.scm (cran->guix-package): Change the REPO parameter to a key.
(cran-recursive-import): Likewise.
* guix/import/elpa.scm (elpa->guix-pakcage): Likewise.
(elpa-recursive-import): Likewise.
* guix/import/gem.scm (gem->guix-package): Likewise.
(recursive-import): Likewise.
* guix/import/opam.scm (opam-recurive-import): Likewise.
* guix/import/pypi.scm (pypi-recursive-import): Likewise.
* guix/import/stackage.scm (stackage-recursive-import): Likewise.
* guix/scripts/import/cran.scm: (guix-import-cran) Likewise.
* guix/scripts/import/elpa.scm: (guix-import-elpa) Likewise.
* tests/elpa.scm: (eval-test-with-elpa) Likewise.
* tests/import-utils.scm Likewise.
---
 guix/import/utils.scm | 59 ++++++++++++++++++++++++++++++++-------------------
 1 file changed, 37 insertions(+), 22 deletions(-)

(limited to 'guix/import/utils.scm')

diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 3809c3d074..3f559a9f31 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2017, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -44,6 +45,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:export (factorize-uri
 
             flatten
@@ -250,13 +252,15 @@ package definition."
     ((package-inputs ...)
      `((native-inputs (,'quasiquote ,package-inputs))))))
 
-(define (package->definition guix-package)
+(define* (package->definition guix-package #:optional append-version?)
   (match guix-package
-    (('package ('name (? string? name)) _ ...)
-     `(define-public ,(string->symbol name)
-        ,guix-package))
-    (('let anything ('package ('name (? string? name)) _ ...))
-     `(define-public ,(string->symbol name)
+    ((or
+      ('package ('name name) ('version version) . rest)
+      ('let _ ('package ('name name) ('version version) . rest)))
+
+     `(define-public ,(string->symbol (if append-version?
+                                          (string-append name "-" version)
+                                          version))
         ,guix-package))))
 
 (define (build-system-modules)
@@ -405,32 +409,43 @@ obtain a node's uniquely identifying \"key\"."
                    (cons head result)
                    (set-insert (node-name head) visited))))))))
 
-(define* (recursive-import package-name repo
-                           #:key repo->guix-package guix-name
+(define* (recursive-import package-name
+                           #:key repo->guix-package guix-name version repo
                            #:allow-other-keys)
   "Return a list of package expressions for PACKAGE-NAME and all its
 dependencies, sorted in topological order.  For each package,
-call (REPO->GUIX-PACKAGE NAME REPO), which should return a package expression
-and a list of dependencies; call (GUIX-NAME NAME) to obtain the Guix package
-name corresponding to the upstream name."
+call (REPO->GUIX-PACKAGE NAME :KEYS version repo), which should return a
+package expression and a list of dependencies; call (GUIX-NAME NAME) to
+obtain the Guix package name corresponding to the upstream name."
   (define-record-type <node>
-    (make-node name package dependencies)
+    (make-node name version package dependencies)
     node?
     (name         node-name)
+    (version       node-version)
     (package      node-package)
     (dependencies node-dependencies))
 
-  (define (exists? name)
-    (not (null? (find-packages-by-name (guix-name name)))))
+  (define (exists? name version)
+    (not (null? (find-packages-by-name (guix-name name) version))))
 
-  (define (lookup-node name)
-    (receive (package dependencies) (repo->guix-package name repo)
-      (make-node name package dependencies)))
+  (define (lookup-node name version)
+    (let* ((package dependencies (repo->guix-package name
+                                                     #:version version
+                                                     #:repo repo))
+           (normilizied-deps (map (match-lambda
+                                    ((name version) (list name version))
+                                    (name (list name #f))) dependencies)))
+      (make-node name version package normilizied-deps)))
 
   (map node-package
-       (topological-sort (list (lookup-node package-name))
+       (topological-sort (list (lookup-node package-name version))
+                         (lambda (node)
+                           (map (lambda (name-version)
+                                  (apply lookup-node name-version))
+                                (remove (lambda (name-version)
+                                          (apply exists? name-version))
+                                         (node-dependencies node))))
                          (lambda (node)
-                           (map lookup-node
-                                (remove exists?
-                                        (node-dependencies node))))
-                         node-name)))
+                           (string-append
+                            (node-name node)
+                            (or (node-version node) ""))))))
-- 
cgit v1.2.3