From d0caf07961ae15799475d176705bd4adc81ab306 Mon Sep 17 00:00:00 2001 From: Martin Becze Date: Tue, 4 Feb 2020 07:18:18 -0500 Subject: [PATCH v14 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(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 53b930acd0..0c2a388c68 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -567,7 +568,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))) @@ -585,8 +586,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)) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 2d4487dba0..0e32a6508d 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès ;;; Copyright © 2018 Oleg Pykhalov +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type ''." (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 ''." (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)) diff --git a/guix/import/gem.scm b/guix/import/gem.scm index bd5d5b3569..345d6f003c 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Ben Woodcroft ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2020 Martin Becze ;;; ;;; 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)) diff --git a/guix/import/opam.scm b/guix/import/opam.scm index ae7df8a8b5..81f178e6a9 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Julien Lepiller +;;; Copyright © 2020 Martin Becze ;;; ;;; 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) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index f93fa8831f..3ec984b1f4 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2019 Maxim Cournoyer ;;; Copyright © 2020 Jakub Kądziołka ;;; Copyright © 2020 Lars-Dominik Braun +;;; Copyright © 2020 Martin Becze ;;; ;;; 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) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 14150201b5..767fc491bf 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Federico Beffa ;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2020 Martin Becze ;;; ;;; 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)) 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 ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2019 Robert Vollmert +;;; Copyright © 2020 Martin Becze ;;; ;;; 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 - (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) "")))))) diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm index d6f371ef3a..bc266ad9da 100644 --- a/guix/scripts/import/cran.scm +++ b/guix/scripts/import/cran.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus +;;; Copyright © 2020 Martin Becze ;;; ;;; 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)) diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm index d270d2b4bc..07ac07a3d5 100644 --- a/guix/scripts/import/elpa.scm +++ b/guix/scripts/import/elpa.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2018 Oleg Pykhalov +;;; Copyright © 2020 Martin Becze ;;; ;;; 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))) diff --git a/tests/elpa.scm b/tests/elpa.scm index b70539bda6..a008cf993c 100644 --- a/tests/elpa.scm +++ b/tests/elpa.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2020 Martin Becze ;;; ;;; 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") diff --git a/tests/import-utils.scm b/tests/import-utils.scm index 87dda3238f..2357ea5c40 100644 --- a/tests/import-utils.scm +++ b/tests/import-utils.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2017 Ricardo Wurmus ;;; Copyright © 2016 Ben Woodcroft +;;; Copyright © 2020 Martin Becze ;;; ;;; 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.26.2