From e1d599345980b3f0a18eeaced2156c0926b7d926 Mon Sep 17 00:00:00 2001
From: Martin Becze <mjbecze@riseup.net>
Date: Tue, 4 Feb 2020 07:18:18 -0500
Subject: [PATCH v13 1/6] 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/cran.scm | 8 +++--
guix/import/elpa.scm | 6 ++--
guix/import/gem.scm | 6 ++--
guix/import/opam.scm | 8 ++---
guix/import/pypi.scm | 8 ++---
guix/import/stackage.scm | 5 +--
guix/import/utils.scm | 59 ++++++++++++++++++++++--------------
guix/scripts/import/cran.scm | 5 +--
guix/scripts/import/elpa.scm | 4 ++-
tests/elpa.scm | 3 +-
tests/import-utils.scm | 8 +++--
11 files changed, 74 insertions(+), 46 deletions(-)
@@ -2,6 +2,7 @@
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -511,7 +512,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(define cran->guix-package
(memoize
- (lambda* (package-name #:optional (repo 'cran))
+ (lambda* (package-name #:key (repo 'cran) version)
"Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
s-expression corresponding to that package, or #f on failure."
(let ((description (fetch-description repo package-name)))
@@ -526,8 +527,9 @@ s-expression corresponding to that package, or #f on failure."
(cran->guix-package package-name 'cran))
(else (values #f '()))))))))
-(define* (cran-recursive-import package-name #:optional (repo 'cran))
- (recursive-import package-name repo
+(define* (cran-recursive-import package-name #:key (repo 'cran))
+ (recursive-import package-name
+ #:repo repo
#:repo->guix-package cran->guix-package
#:guix-name cran-guix-name))
@@ -2,6 +2,7 @@
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -245,7 +246,7 @@ type '<elpa-package>'."
(license ,license))
dependencies-names)))
-(define* (elpa->guix-package name #:optional (repo 'gnu))
+(define* (elpa->guix-package name #:key (repo 'gnu) version)
"Fetch the package NAME from REPO and produce a Guix package S-expression."
(match (fetch-elpa-package name repo)
(#f #f)
@@ -301,7 +302,8 @@ type '<elpa-package>'."
(define elpa-guix-name (cut guix-name "emacs-" <>))
(define* (elpa-recursive-import package-name #:optional (repo 'gnu))
- (recursive-import package-name repo
+ (recursive-import package-name
+ #:repo repo
#:repo->guix-package elpa->guix-package
#:guix-name elpa-guix-name))
@@ -3,6 +3,7 @@
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -122,7 +123,7 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES."
((license) (license->symbol license))
(_ `(list ,@(map license->symbol licenses)))))))
-(define* (gem->guix-package package-name #:optional (repo 'rubygems) version)
+(define* (gem->guix-package package-name #:key (repo 'rubygems) version)
"Fetch the metadata for PACKAGE-NAME from rubygems.org, and return the
`package' s-expression corresponding to that package, or #f on failure."
(let ((gem (rubygems-fetch package-name)))
@@ -200,6 +201,7 @@ package on RubyGems."
(latest latest-release)))
(define* (gem-recursive-import package-name #:optional version)
- (recursive-import package-name '()
+ (recursive-import package-name
+ #:repo '()
#:repo->guix-package gem->guix-package
#:guix-name ruby-package-name))
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -250,7 +251,7 @@ path to the repository."
(substring version 1)
version)))))
-(define* (opam->guix-package name #:key (repository (get-opam-repository)))
+(define* (opam->guix-package name #:key (repository (get-opam-repository)) version)
"Import OPAM package NAME from REPOSITORY (a directory name) or, if
REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp
or #f on failure."
@@ -311,9 +312,8 @@ or #f on failure."
dependencies))))))))
(define (opam-recursive-import package-name)
- (recursive-import package-name #f
- #:repo->guix-package (lambda (name repo)
- (opam->guix-package name))
+ (recursive-import package-name
+ #:repo->guix-package opam->guix-package
#:guix-name ocaml-name->guix-name))
(define (guix-name->opam-name name)
@@ -7,6 +7,7 @@
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -468,7 +469,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
(define pypi->guix-package
(memoize
- (lambda* (package-name)
+ (lambda* (package-name #:key repo version)
"Fetch the metadata for PACKAGE-NAME from pypi.org, and return the
`package' s-expression corresponding to that package, or #f on failure."
(let* ((project (pypi-fetch package-name))
@@ -492,9 +493,8 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
(project-info-license info)))))))))
(define (pypi-recursive-import package-name)
- (recursive-import package-name #f
- #:repo->guix-package (lambda (name repo)
- (pypi->guix-package name))
+ (recursive-import package-name
+ #:repo->guix-package pypi->guix-package
#:guix-name python->package-name))
(define (string->license str)
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -108,8 +109,8 @@ included in the Stackage LTS release."
(leave-with-message "~a: Stackage package not found" package-name))))))
(define (stackage-recursive-import package-name . args)
- (recursive-import package-name #f
- #:repo->guix-package (lambda (name repo)
+ (recursive-import package-name
+ #:repo->guix-package (lambda* (name #:key repo version)
(apply stackage->guix-package (cons name args)))
#:guix-name hackage-name->package-name))
@@ -5,6 +5,7 @@
;;; Copyright © 2017, 2019 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)
@@ -391,32 +395,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) ""))))))
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -98,10 +99,10 @@ Import and convert the CRAN package for PACKAGE-NAME.\n"))
;; Recursive import
(map package->definition
(cran-recursive-import package-name
- (or (assoc-ref opts 'repo) 'cran)))
+ #:repo (or (assoc-ref opts 'repo) 'cran)))
;; Single import
(let ((sexp (cran->guix-package package-name
- (or (assoc-ref opts 'repo) 'cran))))
+ #:repo (or (assoc-ref opts 'repo) 'cran))))
(unless sexp
(leave (G_ "failed to download description for package '~a'~%")
package-name))
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -102,7 +103,8 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n"))
(_ #f))
(elpa-recursive-import package-name
(or (assoc-ref opts 'repo) 'gnu)))
- (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo))))
+ (let ((sexp (elpa->guix-package package-name
+ #:repo (assoc-ref opts 'repo))))
(unless sexp
(leave (G_ "failed to download package '~a'~%") package-name))
sexp)))
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,7 +52,7 @@
(200 "This is the description.")
(200 "fake tarball contents"))
(parameterize ((current-http-proxy (%local-url)))
- (match (elpa->guix-package pkg 'gnu/http)
+ (match (elpa->guix-package pkg #:repo 'gnu/http)
(('package
('name "emacs-auctex")
('version "11.88.6")
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -48,15 +49,16 @@
(package
(name "foo")
(inputs `(("bar" ,bar)))))
- (recursive-import "foo" 'repo
+ (recursive-import "foo"
+ #:repo 'repo
#:repo->guix-package
(match-lambda*
- (("foo" 'repo)
+ (("foo" #:version #f #:repo 'repo)
(values '(package
(name "foo")
(inputs `(("bar" ,bar))))
'("bar")))
- (("bar" 'repo)
+ (("bar" #:version #f #:repo 'repo)
(values '(package
(name "bar"))
'())))
--
2.25.2