mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
import: utils: 'recursive-import' accepts an optional version parameter.
This adds a key VERSION to 'recursive-import' and moves the parameter REPO to a key. This also changes all the places that rely on 'recursive-import'. * guix/import/utils.scm (recursive-import): Add the VERSION key. Make REPO a key. (package->definition): Add optional 'append-version?'. * guix/scripts/import/crate.scm (guix-import-crate): Add the VERSION key. * guix/import/crate.scm (crate->guix-package): Add the VERSION key. (crate-recursive-import): Pass VERSION to recursive-import, remove now unnecessary code. * guix/import/cran.scm (cran->guix-package, cran-recursive-import): Change the REPO parameter to a key. * guix/import/elpa.scm (elpa->guix-package, elpa-recursive-import): Likewise. * guix/import/gem.scm (gem->guix-package, 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 (recursive-import): Likewise. Co-authored-by: Hartmut Goebel <h.goebel@crazy-compilers.com>
This commit is contained in:
parent
23e2cd156f
commit
bea3b17739
13 changed files with 80 additions and 55 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.
|
||||
;;;
|
||||
|
@ -568,7 +569,7 @@ (define (description->package repository meta)
|
|||
|
||||
(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)))
|
||||
|
@ -586,8 +587,9 @@ (define cran->guix-package
|
|||
(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))
|
||||
|
||||
|
|
|
@ -187,7 +187,7 @@ (define (string->license string)
|
|||
'unknown-license!)))
|
||||
(string-split string (string->char-set " /"))))
|
||||
|
||||
(define* (crate->guix-package crate-name #:optional version)
|
||||
(define* (crate->guix-package crate-name #:key version repo)
|
||||
"Fetch the metadata for CRATE-NAME from crates.io, and return the
|
||||
`package' s-expression corresponding to that package, or #f on failure.
|
||||
When VERSION is specified, attempt to fetch that version; otherwise fetch the
|
||||
|
@ -233,13 +233,10 @@ (define version*
|
|||
string->license))
|
||||
(append cargo-inputs cargo-development-inputs)))))
|
||||
|
||||
(define* (crate-recursive-import crate-name #:optional version)
|
||||
(recursive-import crate-name #f
|
||||
#:repo->guix-package
|
||||
(lambda (name repo)
|
||||
(let ((version (and (string=? name crate-name)
|
||||
version)))
|
||||
(crate->guix-package name version)))
|
||||
(define* (crate-recursive-import crate-name #:key version)
|
||||
(recursive-import crate-name
|
||||
#:repo->guix-package crate->guix-package
|
||||
#:version version
|
||||
#:guix-name crate-name->package-name))
|
||||
|
||||
(define (guix-package->crate-name package)
|
||||
|
|
|
@ -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 @@ (define (maybe-inputs input-type inputs)
|
|||
(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)
|
||||
|
@ -299,7 +300,8 @@ (define %elpa-updater
|
|||
(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 @@ (define (make-gem-sexp name version hash home-page synopsis description
|
|||
((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)))
|
||||
|
@ -188,6 +189,7 @@ (define %gem-updater
|
|||
(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.
|
||||
;;;
|
||||
|
@ -260,7 +261,7 @@ (define* (opam-fetch name #:optional (repository (get-opam-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."
|
||||
|
@ -322,9 +323,8 @@ (define* (opam->guix-package name #:key (repository (get-opam-repository)))
|
|||
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)
|
||||
|
|
|
@ -8,6 +8,7 @@
|
|||
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
|
||||
;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org>
|
||||
;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
|
||||
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -471,7 +472,7 @@ (define (make-pypi-sexp name version source-url wheel-url home-page synopsis
|
|||
|
||||
(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))
|
||||
|
@ -495,9 +496,8 @@ (define pypi->guix-package
|
|||
(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.
|
||||
;;;
|
||||
|
@ -109,8 +110,8 @@ (define stackage->guix-package
|
|||
(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))
|
||||
|
||||
|
|
|
@ -6,6 +6,7 @@
|
|||
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
|
||||
;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
|
||||
;;; Copyright © 2020 Helio Machado <0x2b3bfa0+guix@googlemail.com>
|
||||
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -45,6 +46,7 @@ (define-module (guix import utils)
|
|||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-71)
|
||||
#:export (factorize-uri
|
||||
|
||||
flatten
|
||||
|
@ -254,13 +256,15 @@ (define* (maybe-native-inputs package-names #:optional (output #f))
|
|||
((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)
|
||||
|
@ -409,32 +413,43 @@ (define (topological-sort nodes
|
|||
(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))
|
||||
(normalizied-deps (map (match-lambda
|
||||
((name version) (list name version))
|
||||
(name (list name #f))) dependencies)))
|
||||
(make-node name version package normalizied-deps)))
|
||||
|
||||
(map node-package
|
||||
(topological-sort (list (lookup-node package-name))
|
||||
(topological-sort (list (lookup-node package-name version))
|
||||
(lambda (node)
|
||||
(map lookup-node
|
||||
(remove exists?
|
||||
(map (lambda (name-version)
|
||||
(apply lookup-node name-version))
|
||||
(remove (lambda (name-version)
|
||||
(apply exists? name-version))
|
||||
(node-dependencies node))))
|
||||
node-name)))
|
||||
(lambda (node)
|
||||
(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 @@ (define (parse-options)
|
|||
;; 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))
|
||||
|
|
|
@ -100,8 +100,8 @@ (define-values (name version)
|
|||
`(define-public ,(string->symbol name)
|
||||
,pkg))
|
||||
(_ #f))
|
||||
(crate-recursive-import name version))
|
||||
(let ((sexp (crate->guix-package name version)))
|
||||
(crate-recursive-import name #:version version))
|
||||
(let ((sexp (crate->guix-package name #:version version)))
|
||||
(unless sexp
|
||||
(leave (G_ "failed to download meta-data for package '~a'~%")
|
||||
(if version
|
||||
|
|
|
@ -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 @@ (define (parse-options)
|
|||
(_ #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 @@ (define (eval-test-with-elpa pkg)
|
|||
(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 @@ (define-module (test-import-utils)
|
|||
(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"))
|
||||
'())))
|
||||
|
|
Loading…
Reference in a new issue