mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
upstream: Replace 'input-changes' field by 'inputs'.
Returning the expected list of inputs rather than changes relative to
the current package definition is less ambiguous and offers more
possibilities for further processing.
* guix/upstream.scm (<upstream-source>)[input-changes]: Remove.
[inputs]: New field.
(<upstream-input>): New record type.
* guix/upstream.scm (upstream-input-type-predicate)
(input-type-filter, upstream-source-regular-inputs)
(upstream-source-native-inputs, upstream-source-propagated-inputs): New
procedures.
(changed-inputs): Expect an <upstream-source> as its second argument.
Adjust accordingly.
* guix/import/pypi.scm (distribution-sha256): New procedure.
(maybe-inputs): Expect a list of <upstream-input>.
(compute-inputs): Rewrite to return a list of <upstream-input>.
(pypi-package-inputs, pypi-package->upstream-source): New procedures.
(make-pypi-sexp): Use it.
* guix/import/stackage.scm (latest-lts-release): Define 'cabal'.
Replace 'input-changes' field by 'inputs'.
* guix/scripts/refresh.scm (update-package): Use 'changed-inputs'
instead of 'upstream-source-input-changes'.
* tests/cran.scm ("description->package"): Adjust order of inputs.
* tests/pypi.scm (default-sha256, default-sha256/base32): New variables.
(foo-json): Add 'digests' entry.
("pypi->guix-package, no wheel"): Check HASH against DEFAULT-SHA256/BASE32.
("pypi->guix-package, wheels"): Likewise.
("pypi->guix-package, no usable requirement file."): Likewise.
("pypi->guix-package, package name contains \"-\" followed by digits"):
Likewise.
("package-latest-release"): New test.
* tests/upstream.scm (test-package-sexp): Remove.
("changed-inputs returns no changes"): Rewrite to use <upstream-source>.
(test-new-package-sexp): Remove.
("changed-inputs returns changes to plain input list"): Rewrite.
("changed-inputs returns changes to all plain input lists"): Likewise.
("changed-inputs returns changes to labelled input list")
("changed-inputs returns changes to all labelled input lists"): Remove.
* guix/import/cran.scm (maybe-inputs): Expect PACKAGE-INPUTS to be a
list of <upstream-input>.
(source-dir->dependencies): Return a list of <upstream-input>.
(vignette-builders): Likewise.
(uri-helper, cran-package-source-url)
(cran-package-propagated-inputs, cran-package-inputs): New procedures.
(description->package): Use them instead of local definitions.
(latest-cran-release): Replace 'input-changes' field by 'inputs'.
(latest-bioconductor-release): Likewise.
(format-inputs): Remove.
* guix/import/hackage.scm (cabal-package-inputs): New procedure.
(hackage-module->sexp): Use it.
[maybe-inputs]: Expect a list of <upstream-input>.
This commit is contained in:
Ludovic Courtès
parent
db10a4a2ae
commit
e6223017d9
8 changed files with 510 additions and 357 deletions
|
|
@ -1,6 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015-2023 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015-2017, 2019-2021, 2023 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
|
||||
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
|
||||
|
|
@ -164,24 +164,16 @@ (define (description->alist description)
|
|||
rest)))))))
|
||||
(fold parse '() lines)))
|
||||
|
||||
(define (format-inputs names)
|
||||
"Generate a sorted list of package inputs from a list of package NAMES."
|
||||
(map (lambda (name)
|
||||
(case (%input-style)
|
||||
((specification)
|
||||
`(specification->package ,name))
|
||||
(else
|
||||
(string->symbol name))))
|
||||
(sort names string-ci<?)))
|
||||
|
||||
(define* (maybe-inputs package-inputs #:optional (type 'inputs))
|
||||
(define* (maybe-inputs package-inputs #:optional (input-type 'inputs))
|
||||
"Given a list of PACKAGE-INPUTS, tries to generate the TYPE field of a
|
||||
package definition."
|
||||
(match package-inputs
|
||||
(()
|
||||
'())
|
||||
((package-inputs ...)
|
||||
`((,type (list ,@(format-inputs package-inputs)))))))
|
||||
`((,input-type (list ,@(map (compose string->symbol
|
||||
upstream-input-downstream-name)
|
||||
package-inputs)))))))
|
||||
|
||||
(define %cran-url "https://cran.r-project.org/web/packages/")
|
||||
(define %cran-canonical-url "https://cran.r-project.org/package=")
|
||||
|
|
@ -520,14 +512,29 @@ (define (directory-needs-pkg-config? dir)
|
|||
"(Makevars.*|configure.*)"))
|
||||
|
||||
(define (source-dir->dependencies dir)
|
||||
"Guess dependencies of R package source in DIR and return two values: a list
|
||||
of package names for INPUTS and another list of names of NATIVE-INPUTS."
|
||||
(values
|
||||
(needed-libraries-in-directory dir)
|
||||
(append
|
||||
(if (directory-needs-esbuild? dir) '("esbuild") '())
|
||||
(if (directory-needs-pkg-config? dir) '("pkg-config") '())
|
||||
(if (directory-needs-fortran? dir) '("gfortran") '()))))
|
||||
"Guess dependencies of R package source in DIR and return a list of
|
||||
<upstream-input> corresponding to the dependencies guessed from source files
|
||||
in DIR."
|
||||
(define (native name)
|
||||
(upstream-input
|
||||
(name name)
|
||||
(downstream-name name)
|
||||
(type 'native)))
|
||||
|
||||
(append (map (lambda (name)
|
||||
(upstream-input
|
||||
(name name)
|
||||
(downstream-name (cran-guix-name name))))
|
||||
(needed-libraries-in-directory dir))
|
||||
(if (directory-needs-esbuild? dir)
|
||||
(list (native "esbuild"))
|
||||
'())
|
||||
(if (directory-needs-pkg-config? dir)
|
||||
(list (native "pkg-config"))
|
||||
'())
|
||||
(if (directory-needs-fortran? dir)
|
||||
(list (native "gfortran"))
|
||||
'())))
|
||||
|
||||
(define (source->dependencies source tarball?)
|
||||
"SOURCE-DIR->DEPENDENCIES, but for directories and tarballs as indicated
|
||||
|
|
@ -541,7 +548,79 @@ (define (source->dependencies source tarball?)
|
|||
(source-dir->dependencies source)))
|
||||
|
||||
(define (vignette-builders meta)
|
||||
(map cran-guix-name (listify meta "VignetteBuilder")))
|
||||
(map (lambda (name)
|
||||
(upstream-input
|
||||
(name name)
|
||||
(downstream-name (cran-guix-name name))
|
||||
(type 'native)))
|
||||
(listify meta "VignetteBuilder")))
|
||||
|
||||
(define (uri-helper repository)
|
||||
(match repository
|
||||
('cran cran-uri)
|
||||
('bioconductor bioconductor-uri)
|
||||
('git #f)
|
||||
('hg #f)))
|
||||
|
||||
(define (cran-package-source-url meta repository)
|
||||
"Return the URL of the source code referred to by META, a package in
|
||||
REPOSITORY."
|
||||
(case repository
|
||||
((git) (assoc-ref meta 'git))
|
||||
((hg) (assoc-ref meta 'hg))
|
||||
(else
|
||||
(match (apply (uri-helper repository)
|
||||
(assoc-ref meta "Package")
|
||||
(assoc-ref meta "Version")
|
||||
(case repository
|
||||
((bioconductor)
|
||||
(list (assoc-ref meta 'bioconductor-type)))
|
||||
(else '())))
|
||||
((urls ...) urls)
|
||||
((? string? url) url)
|
||||
(_ #f)))))
|
||||
|
||||
(define (cran-package-propagated-inputs meta)
|
||||
"Return the list of <upstream-input> derived from dependency information in
|
||||
META."
|
||||
(filter-map (lambda (name)
|
||||
(and (not (member name
|
||||
(append default-r-packages invalid-packages)))
|
||||
(upstream-input
|
||||
(name name)
|
||||
(downstream-name (cran-guix-name name))
|
||||
(type 'propagated))))
|
||||
(lset-union equal?
|
||||
(listify meta "Imports")
|
||||
(listify meta "LinkingTo")
|
||||
(delete "R" (listify meta "Depends")))))
|
||||
|
||||
(define* (cran-package-inputs meta repository
|
||||
#:key (download-source download))
|
||||
"Return the list of <upstream-input> corresponding to all the dependencies
|
||||
of META, a package in REPOSITORY."
|
||||
(let* ((url (cran-package-source-url meta repository))
|
||||
(source (download-source url
|
||||
#:method
|
||||
(cond ((assoc-ref meta 'git) 'git)
|
||||
((assoc-ref meta 'hg) 'hg)
|
||||
(else #f))))
|
||||
(tarball? (not (or (assoc-ref meta 'git)
|
||||
(assoc-ref meta 'hg)))))
|
||||
(sort (append (source->dependencies source tarball?)
|
||||
(filter-map (lambda (name)
|
||||
(and (not (member name invalid-packages))
|
||||
(upstream-input
|
||||
(name name)
|
||||
(downstream-name
|
||||
(transform-sysname name)))))
|
||||
(map string-downcase
|
||||
(listify meta "SystemRequirements")))
|
||||
(cran-package-propagated-inputs meta)
|
||||
(vignette-builders meta))
|
||||
(lambda (input1 input2)
|
||||
(string<? (upstream-input-downstream-name input1)
|
||||
(upstream-input-downstream-name input2))))))
|
||||
|
||||
(define* (description->package repository meta #:key (license-prefix identity)
|
||||
(download-source download))
|
||||
|
|
@ -556,11 +635,6 @@ (define* (description->package repository meta #:key (license-prefix identity)
|
|||
((cran) %cran-canonical-url)
|
||||
((bioconductor) %bioconductor-url)
|
||||
((git) #f)))
|
||||
(uri-helper (case repository
|
||||
((cran) cran-uri)
|
||||
((bioconductor) bioconductor-uri)
|
||||
((git) #f)
|
||||
((hg) #f)))
|
||||
(name (assoc-ref meta "Package"))
|
||||
(synopsis (assoc-ref meta "Title"))
|
||||
(version (assoc-ref meta "Version"))
|
||||
|
|
@ -572,40 +646,16 @@ (define* (description->package repository meta #:key (license-prefix identity)
|
|||
(else (match (listify meta "URL")
|
||||
((url rest ...) url)
|
||||
(_ (string-append canonical-url-base name))))))
|
||||
(source-url (case repository
|
||||
((git) (assoc-ref meta 'git))
|
||||
((hg) (assoc-ref meta 'hg))
|
||||
(else
|
||||
(match (apply uri-helper name version
|
||||
(case repository
|
||||
((bioconductor)
|
||||
(list (assoc-ref meta 'bioconductor-type)))
|
||||
(else '())))
|
||||
((urls ...) urls)
|
||||
((? string? url) url)
|
||||
(_ #f)))))
|
||||
(source-url (cran-package-source-url meta repository))
|
||||
(git? (if (assoc-ref meta 'git) #true #false))
|
||||
(hg? (if (assoc-ref meta 'hg) #true #false))
|
||||
(source (download-source source-url #:method (cond
|
||||
(git? 'git)
|
||||
(hg? 'hg)
|
||||
(else #f))))
|
||||
(tarball? (not (or git? hg?)))
|
||||
(source-inputs source-native-inputs
|
||||
(source->dependencies source tarball?))
|
||||
(sysdepends (append
|
||||
source-inputs
|
||||
(filter (lambda (name)
|
||||
(not (member name invalid-packages)))
|
||||
(map string-downcase (listify meta "SystemRequirements")))))
|
||||
(propagate (filter (lambda (name)
|
||||
(not (member name (append default-r-packages
|
||||
invalid-packages))))
|
||||
(lset-union equal?
|
||||
(listify meta "Imports")
|
||||
(listify meta "LinkingTo")
|
||||
(delete "R"
|
||||
(listify meta "Depends")))))
|
||||
(uri-helper (uri-helper repository))
|
||||
(inputs (cran-package-inputs meta repository
|
||||
#:download-source download-source))
|
||||
(package
|
||||
`(package
|
||||
(name ,(cran-guix-name name))
|
||||
|
|
@ -651,12 +701,18 @@ (define* (description->package repository meta #:key (license-prefix identity)
|
|||
`((properties ,`(,'quasiquote ((,'upstream-name . ,name)))))
|
||||
'())
|
||||
(build-system r-build-system)
|
||||
,@(maybe-inputs (map transform-sysname sysdepends))
|
||||
,@(maybe-inputs (map cran-guix-name propagate) 'propagated-inputs)
|
||||
,@(maybe-inputs
|
||||
`(,@source-native-inputs
|
||||
,@(vignette-builders meta))
|
||||
'native-inputs)
|
||||
|
||||
,@(maybe-inputs (filter (upstream-input-type-predicate 'regular)
|
||||
inputs)
|
||||
'inputs)
|
||||
,@(maybe-inputs (filter (upstream-input-type-predicate
|
||||
'propagated)
|
||||
inputs)
|
||||
'propagated-inputs)
|
||||
,@(maybe-inputs (filter (upstream-input-type-predicate 'native)
|
||||
inputs)
|
||||
'native-inputs)
|
||||
|
||||
(home-page ,(if (string-null? home-page)
|
||||
(string-append base-url name)
|
||||
home-page))
|
||||
|
|
@ -675,7 +731,10 @@ (define* (description->package repository meta #:key (license-prefix identity)
|
|||
(revision "1"))
|
||||
,package))
|
||||
(else package))
|
||||
propagate)))
|
||||
(filter-map (lambda (input)
|
||||
(and (eq? 'propagated (upstream-input-type input))
|
||||
(upstream-input-name input)))
|
||||
inputs))))
|
||||
|
||||
(define cran->guix-package
|
||||
(memoize
|
||||
|
|
@ -760,9 +819,7 @@ (define meta
|
|||
(package (package-name pkg))
|
||||
(version version)
|
||||
(urls (cran-uri upstream-name version))
|
||||
(input-changes
|
||||
(changed-inputs pkg
|
||||
(description->package 'cran meta)))))))
|
||||
(inputs (cran-package-inputs meta 'cran))))))
|
||||
|
||||
(define* (latest-bioconductor-release pkg #:key (version #f))
|
||||
"Return an <upstream-source> for the latest release of the package PKG."
|
||||
|
|
@ -784,10 +841,9 @@ (define latest-version
|
|||
(package (package-name pkg))
|
||||
(version latest-version)
|
||||
(urls (bioconductor-uri upstream-name latest-version))
|
||||
(input-changes
|
||||
(changed-inputs
|
||||
pkg
|
||||
(cran->guix-package upstream-name #:repo 'bioconductor))))))
|
||||
(inputs
|
||||
(let ((meta (fetch-description 'bioconductor upstream-name)))
|
||||
(cran-package-inputs meta 'bioconductor))))))
|
||||
|
||||
(define (cran-package? package)
|
||||
"Return true if PACKAGE is an R package from CRAN."
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
|
||||
;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
|
||||
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
|
||||
;;; Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -56,7 +57,9 @@ (define-module (guix import hackage)
|
|||
hackage-fetch
|
||||
hackage-source-url
|
||||
hackage-cabal-url
|
||||
hackage-package?))
|
||||
hackage-package?
|
||||
|
||||
cabal-package-inputs))
|
||||
|
||||
(define ghc-standard-libraries
|
||||
;; List of libraries distributed with ghc (as of 8.10.7).
|
||||
|
|
@ -224,27 +227,12 @@ (define (filter-dependencies dependencies own-names)
|
|||
(filter (lambda (d) (not (member (string-downcase d) ignored-dependencies)))
|
||||
dependencies)))
|
||||
|
||||
(define* (hackage-module->sexp cabal cabal-hash
|
||||
#:key (include-test-dependencies? #t))
|
||||
"Return the `package' S-expression for a Cabal package. CABAL is the
|
||||
representation of a Cabal file as produced by 'read-cabal'. CABAL-HASH is
|
||||
the hash of the Cabal file."
|
||||
|
||||
(define name
|
||||
(cabal-package-name cabal))
|
||||
|
||||
(define version
|
||||
(cabal-package-version cabal))
|
||||
|
||||
(define revision
|
||||
(cabal-package-revision cabal))
|
||||
|
||||
(define source-url
|
||||
(hackage-source-url name version))
|
||||
|
||||
(define own-names (cons (cabal-package-name cabal)
|
||||
(filter (lambda (x) (not (eqv? x #f)))
|
||||
(map cabal-library-name (cabal-package-library cabal)))))
|
||||
(define* (cabal-package-inputs cabal #:key (include-test-dependencies? #t))
|
||||
"Return the list of <upstream-input> for CABAL representing its
|
||||
dependencies."
|
||||
(define own-names
|
||||
(cons (cabal-package-name cabal)
|
||||
(filter-map cabal-library-name (cabal-package-library cabal))))
|
||||
|
||||
(define hackage-dependencies
|
||||
(filter-dependencies (cabal-dependencies->names cabal) own-names))
|
||||
|
|
@ -261,22 +249,54 @@ (define hackage-native-dependencies
|
|||
hackage-dependencies))
|
||||
|
||||
(define dependencies
|
||||
(map string->symbol
|
||||
(map hackage-name->package-name
|
||||
hackage-dependencies)))
|
||||
(map (lambda (name)
|
||||
(upstream-input
|
||||
(name name)
|
||||
(downstream-name (hackage-name->package-name name))
|
||||
(type 'regular)))
|
||||
hackage-dependencies))
|
||||
|
||||
(define native-dependencies
|
||||
(map string->symbol
|
||||
(map hackage-name->package-name
|
||||
hackage-native-dependencies)))
|
||||
|
||||
(map (lambda (name)
|
||||
(upstream-input
|
||||
(name name)
|
||||
(downstream-name (hackage-name->package-name name))
|
||||
(type 'native)))
|
||||
hackage-native-dependencies))
|
||||
|
||||
(append dependencies native-dependencies))
|
||||
|
||||
(define* (hackage-module->sexp cabal cabal-hash
|
||||
#:key (include-test-dependencies? #t))
|
||||
"Return the `package' S-expression for a Cabal package. CABAL is the
|
||||
representation of a Cabal file as produced by 'read-cabal'. CABAL-HASH is
|
||||
the hash of the Cabal file."
|
||||
(define name
|
||||
(cabal-package-name cabal))
|
||||
|
||||
(define version
|
||||
(cabal-package-version cabal))
|
||||
|
||||
(define revision
|
||||
(cabal-package-revision cabal))
|
||||
|
||||
(define source-url
|
||||
(hackage-source-url name version))
|
||||
|
||||
(define inputs
|
||||
(cabal-package-inputs cabal
|
||||
#:include-test-dependencies?
|
||||
include-test-dependencies?))
|
||||
|
||||
(define (maybe-inputs input-type inputs)
|
||||
(match inputs
|
||||
(()
|
||||
'())
|
||||
((inputs ...)
|
||||
(list (list input-type
|
||||
`(list ,@inputs))))))
|
||||
`(list ,@(map (compose string->symbol
|
||||
upstream-input-downstream-name)
|
||||
inputs)))))))
|
||||
|
||||
(define (maybe-arguments)
|
||||
(match (append (if (not include-test-dependencies?)
|
||||
|
|
@ -304,14 +324,18 @@ (define (maybe-arguments)
|
|||
"failed to download tar archive")))))
|
||||
(build-system haskell-build-system)
|
||||
(properties '((upstream-name . ,name)))
|
||||
,@(maybe-inputs 'inputs dependencies)
|
||||
,@(maybe-inputs 'native-inputs native-dependencies)
|
||||
,@(maybe-inputs 'inputs
|
||||
(filter (upstream-input-type-predicate 'regular)
|
||||
inputs))
|
||||
,@(maybe-inputs 'native-inputs
|
||||
(filter (upstream-input-type-predicate 'native)
|
||||
inputs))
|
||||
,@(maybe-arguments)
|
||||
(home-page ,(cabal-package-home-page cabal))
|
||||
(synopsis ,(cabal-package-synopsis cabal))
|
||||
(description ,(beautify-description (cabal-package-description cabal)))
|
||||
(license ,(string->license (cabal-package-license cabal))))
|
||||
(append hackage-dependencies hackage-native-dependencies))))
|
||||
inputs)))
|
||||
|
||||
(define* (hackage->guix-package package-name #:key
|
||||
(include-test-dependencies? #t)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 David Thompson <davet@gnu.org>
|
||||
;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com>
|
||||
;;; Copyright © 2015-2017, 2019-2022 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015-2017, 2019-2023 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||
;;; Copyright © 2018, 2023 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
|
|
@ -33,12 +33,16 @@
|
|||
(define-module (guix import pypi)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 receive)
|
||||
#:use-module ((ice-9 rdelim) #:select (read-line))
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-35)
|
||||
#:use-module (srfi srfi-71)
|
||||
#:autoload (gcrypt hash) (port-sha256)
|
||||
#:autoload (guix base16) (base16-string->bytevector)
|
||||
#:autoload (guix base32) (bytevector->nix-base32-string)
|
||||
#:autoload (guix http-client) (http-fetch)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix memoization)
|
||||
#:use-module (guix diagnostics)
|
||||
|
|
@ -126,6 +130,12 @@ (define-json-mapping <distribution> make-distribution distribution?
|
|||
(python-version distribution-package-python-version
|
||||
"python_version"))
|
||||
|
||||
(define (distribution-sha256 distribution)
|
||||
"Return the SHA256 hash of DISTRIBUTION as a bytevector, or #f."
|
||||
(match (assoc-ref (distribution-digests distribution) "sha256")
|
||||
(#f #f)
|
||||
(str (base16-string->bytevector str))))
|
||||
|
||||
(define (pypi-fetch name)
|
||||
"Return a <pypi-project> record for package NAME, or #f on failure."
|
||||
(and=> (json-fetch (string-append (%pypi-base-url) name "/json"))
|
||||
|
|
@ -198,7 +208,9 @@ (define (maybe-inputs package-inputs input-type)
|
|||
(()
|
||||
'())
|
||||
((package-inputs ...)
|
||||
`((,input-type (list ,@package-inputs))))))
|
||||
`((,input-type (list ,@(map (compose string->symbol
|
||||
upstream-input-downstream-name)
|
||||
package-inputs)))))))
|
||||
|
||||
(define %requirement-name-regexp
|
||||
;; Regexp to match the requirement name in a requirement specification.
|
||||
|
|
@ -409,23 +421,36 @@ (define (guess-requirements-from-source)
|
|||
|
||||
(define (compute-inputs source-url wheel-url archive)
|
||||
"Given the SOURCE-URL and WHEEL-URL of an already downloaded ARCHIVE, return
|
||||
a pair of lists, each consisting of a list of name/variable pairs, for the
|
||||
propagated inputs and the native inputs, respectively. Also
|
||||
return the unaltered list of upstream dependency names."
|
||||
|
||||
(define (strip-argparse deps)
|
||||
(remove (cut string=? "argparse" <>) deps))
|
||||
|
||||
(define (requirement->package-name/sort deps)
|
||||
(map string->symbol
|
||||
(sort (map python->package-name deps) string-ci<?)))
|
||||
|
||||
(define process-requirements
|
||||
(compose requirement->package-name/sort strip-argparse))
|
||||
the corresponding list of <upstream-input> records."
|
||||
(define (requirements->upstream-inputs deps type)
|
||||
(filter-map (match-lambda
|
||||
("argparse" #f)
|
||||
(name (upstream-input
|
||||
(name name)
|
||||
(downstream-name (python->package-name name))
|
||||
(type type))))
|
||||
(sort deps string-ci<?)))
|
||||
|
||||
;; TODO: Record version number ranges in <upstream-input>.
|
||||
(let ((dependencies (guess-requirements source-url wheel-url archive)))
|
||||
(values (map process-requirements dependencies)
|
||||
(concatenate dependencies))))
|
||||
(match dependencies
|
||||
((propagated native)
|
||||
(append (requirements->upstream-inputs propagated 'propagated)
|
||||
(requirements->upstream-inputs native 'native))))))
|
||||
|
||||
(define* (pypi-package-inputs pypi-package #:optional version)
|
||||
"Return the list of <upstream-input> for PYPI-PACKAGE. This procedure
|
||||
downloads the source and possibly the wheel of PYPI-PACKAGE."
|
||||
(let* ((info (pypi-project-info pypi-package))
|
||||
(version (or version (project-info-version info)))
|
||||
(dist (source-release pypi-package version))
|
||||
(source-url (distribution-url dist))
|
||||
(wheel-url (and=> (wheel-release pypi-package version)
|
||||
distribution-url)))
|
||||
(call-with-temporary-output-file
|
||||
(lambda (archive port)
|
||||
(and (url-fetch source-url archive)
|
||||
(compute-inputs source-url wheel-url archive))))))
|
||||
|
||||
(define (find-project-url name pypi-url)
|
||||
"Try different project name substitution until the result is found in
|
||||
|
|
@ -445,52 +470,85 @@ (define (find-project-url name pypi-url)
|
|||
a substring of the PyPI URI that identifies the package.") pypi-url name))
|
||||
name)))
|
||||
|
||||
(define (make-pypi-sexp name version source-url wheel-url home-page synopsis
|
||||
description license)
|
||||
"Return the `package' s-expression for a python package with the given NAME,
|
||||
VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
|
||||
(define* (pypi-package->upstream-source pypi-package #:optional version)
|
||||
"Return the upstream source for the given VERSION of PYPI-PACKAGE, a
|
||||
<pypi-project> record. If VERSION is omitted or #f, use the latest version."
|
||||
(let* ((info (pypi-project-info pypi-package))
|
||||
(version (or version (project-info-version info)))
|
||||
(dist (source-release pypi-package version))
|
||||
(source-url (distribution-url dist))
|
||||
(wheel-url (and=> (wheel-release pypi-package version)
|
||||
distribution-url)))
|
||||
(let ((extra-inputs (if (string-suffix? ".zip" source-url)
|
||||
(list (upstream-input
|
||||
(name "zip")
|
||||
(downstream-name "zip")
|
||||
(type 'native)))
|
||||
'())))
|
||||
(upstream-source
|
||||
(urls (list source-url))
|
||||
(signature-urls
|
||||
(if (distribution-has-signature? dist)
|
||||
(list (string-append source-url ".asc"))
|
||||
#f))
|
||||
(inputs (append (pypi-package-inputs pypi-package)
|
||||
extra-inputs))
|
||||
(package (project-info-name info))
|
||||
(version version)))))
|
||||
|
||||
(define* (make-pypi-sexp pypi-package
|
||||
#:optional (version (latest-version pypi-package)))
|
||||
"Return the `package' s-expression the given VERSION of PYPI-PACKAGE, a
|
||||
<pypi-project> record."
|
||||
(define (maybe-upstream-name name)
|
||||
(if (string-match ".*\\-[0-9]+" name)
|
||||
`((properties ,`'(("upstream-name" . ,name))))
|
||||
'()))
|
||||
|
||||
(call-with-temporary-output-file
|
||||
(lambda (temp port)
|
||||
(and (url-fetch source-url temp)
|
||||
(receive (guix-dependencies upstream-dependencies)
|
||||
(compute-inputs source-url wheel-url temp)
|
||||
(match guix-dependencies
|
||||
((required-inputs native-inputs)
|
||||
(when (string-suffix? ".zip" source-url)
|
||||
(set! native-inputs (cons 'unzip native-inputs)))
|
||||
(values
|
||||
`(package
|
||||
(name ,(python->package-name name))
|
||||
(version ,version)
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri
|
||||
,(find-project-url name source-url)
|
||||
version
|
||||
;; Some packages have been released as `.zip`
|
||||
;; instead of the more common `.tar.gz`. For
|
||||
;; example, see "path-and-address".
|
||||
,@(if (string-suffix? ".zip" source-url)
|
||||
'(".zip")
|
||||
'())))
|
||||
(sha256
|
||||
(base32
|
||||
,(guix-hash-url temp)))))
|
||||
,@(maybe-upstream-name name)
|
||||
(build-system pyproject-build-system)
|
||||
,@(maybe-inputs required-inputs 'propagated-inputs)
|
||||
,@(maybe-inputs native-inputs 'native-inputs)
|
||||
(home-page ,home-page)
|
||||
(synopsis ,synopsis)
|
||||
(description ,(beautify-description description))
|
||||
(license ,(license->symbol license)))
|
||||
upstream-dependencies))))))))
|
||||
|
||||
(let* ((info (pypi-project-info pypi-package))
|
||||
(name (project-info-name info))
|
||||
(source-url (and=> (source-release pypi-package version)
|
||||
distribution-url))
|
||||
(sha256 (and=> (source-release pypi-package version)
|
||||
distribution-sha256))
|
||||
(source (pypi-package->upstream-source pypi-package version)))
|
||||
(values
|
||||
`(package
|
||||
(name ,(python->package-name name))
|
||||
(version ,version)
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri
|
||||
,(find-project-url name source-url)
|
||||
version
|
||||
;; Some packages have been released as `.zip`
|
||||
;; instead of the more common `.tar.gz`. For
|
||||
;; example, see "path-and-address".
|
||||
,@(if (string-suffix? ".zip" source-url)
|
||||
'(".zip")
|
||||
'())))
|
||||
(sha256 (base32
|
||||
,(and=> (or sha256
|
||||
(let* ((port (http-fetch source-url))
|
||||
(hash (port-sha256 port)))
|
||||
(close-port port)
|
||||
hash))
|
||||
bytevector->nix-base32-string)))))
|
||||
,@(maybe-upstream-name name)
|
||||
(build-system pyproject-build-system)
|
||||
,@(maybe-inputs (upstream-source-propagated-inputs source)
|
||||
'propagated-inputs)
|
||||
,@(maybe-inputs (upstream-source-native-inputs source)
|
||||
'native-inputs)
|
||||
(home-page ,(project-info-home-page info))
|
||||
(synopsis ,(project-info-summary info))
|
||||
(description ,(beautify-description
|
||||
(project-info-summary info)))
|
||||
(license ,(license->symbol
|
||||
(string->license
|
||||
(project-info-license info)))))
|
||||
(map upstream-input-name (upstream-source-inputs source)))))
|
||||
|
||||
(define pypi->guix-package
|
||||
(memoize
|
||||
|
|
@ -520,16 +578,7 @@ (define pypi->guix-package
|
|||
source. To build it from source, refer to the upstream repository at
|
||||
@uref{~a}.")
|
||||
url))))))))))))
|
||||
(make-pypi-sexp (project-info-name info) version
|
||||
(and=> (source-release project version)
|
||||
distribution-url)
|
||||
(and=> (wheel-release project version)
|
||||
distribution-url)
|
||||
(project-info-home-page info)
|
||||
(project-info-summary info)
|
||||
(project-info-summary info)
|
||||
(string->license
|
||||
(project-info-license info))))
|
||||
(make-pypi-sexp project version))
|
||||
(values #f '()))))))
|
||||
|
||||
(define* (pypi-recursive-import package-name #:optional version)
|
||||
|
|
@ -566,21 +615,7 @@ (define* (import-release package #:key (version #f))
|
|||
(pypi-package (pypi-fetch pypi-name)))
|
||||
(and pypi-package
|
||||
(guard (c ((missing-source-error? c) #f))
|
||||
(let* ((info (pypi-project-info pypi-package))
|
||||
(version (or version (project-info-version info)))
|
||||
(dist (source-release pypi-package version))
|
||||
(url (distribution-url dist)))
|
||||
(upstream-source
|
||||
(urls (list url))
|
||||
(signature-urls
|
||||
(if (distribution-has-signature? dist)
|
||||
(list (string-append url ".asc"))
|
||||
#f))
|
||||
(input-changes
|
||||
(changed-inputs package
|
||||
(pypi->guix-package pypi-name #:version version)))
|
||||
(package (package-name package))
|
||||
(version version)))))))
|
||||
(pypi-package->upstream-source pypi-package version)))))
|
||||
|
||||
(define %pypi-updater
|
||||
(upstream-updater
|
||||
|
|
|
|||
|
|
@ -29,6 +29,7 @@ (define-module (guix import stackage)
|
|||
#:use-module (srfi srfi-35)
|
||||
#:use-module (guix import json)
|
||||
#:use-module (guix import hackage)
|
||||
#:autoload (guix import cabal) (eval-cabal)
|
||||
#:use-module (guix import utils)
|
||||
#:use-module (guix memoization)
|
||||
#:use-module (guix packages)
|
||||
|
|
@ -157,15 +158,13 @@ (define latest-lts-release
|
|||
(warning (G_ "failed to parse ~a~%")
|
||||
(hackage-cabal-url hackage-name))
|
||||
#f)
|
||||
(_ (let ((url (hackage-source-url hackage-name version)))
|
||||
(_ (let ((url (hackage-source-url hackage-name version))
|
||||
(cabal (eval-cabal (hackage-fetch hackage-name) '())))
|
||||
(upstream-source
|
||||
(package (package-name pkg))
|
||||
(version version)
|
||||
(urls (list url))
|
||||
(input-changes
|
||||
(changed-inputs
|
||||
pkg
|
||||
(stackage->guix-package hackage-name #:packages (packages))))))))))))
|
||||
(inputs (cabal-package-inputs cabal))))))))))
|
||||
|
||||
(define (stackage-lts-package? package)
|
||||
"Return whether PACKAGE is available on the default Stackage LTS release."
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013-2023 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
|
@ -404,7 +404,7 @@ (define change-name
|
|||
(('remove 'propagated)
|
||||
(info loc (G_ "~a: consider removing this propagated input: ~a~%")
|
||||
name change-name))))
|
||||
(upstream-source-input-changes source))
|
||||
(changed-inputs package source))
|
||||
(let ((hash (file-hash* output)))
|
||||
(update-package-source package source hash)))
|
||||
(warning (G_ "~a: version ~a could not be \
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2010-2022 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2010-2023 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
;;; Copyright © 2019, 2022 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
|
||||
|
|
@ -55,7 +55,20 @@ (define-module (guix upstream)
|
|||
upstream-source-urls
|
||||
upstream-source-signature-urls
|
||||
upstream-source-archive-types
|
||||
upstream-source-input-changes
|
||||
upstream-source-inputs
|
||||
|
||||
upstream-input-type-predicate
|
||||
upstream-source-regular-inputs
|
||||
upstream-source-native-inputs
|
||||
upstream-source-propagated-inputs
|
||||
|
||||
upstream-input
|
||||
upstream-input?
|
||||
upstream-input-name
|
||||
upstream-input-downstream-name
|
||||
upstream-input-type
|
||||
upstream-input-min-version
|
||||
upstream-input-max-version
|
||||
|
||||
url-predicate
|
||||
url-prefix-predicate
|
||||
|
|
@ -102,8 +115,40 @@ (define-record-type* <upstream-source>
|
|||
(urls upstream-source-urls) ;list of strings|git-reference
|
||||
(signature-urls upstream-source-signature-urls ;#f | list of strings
|
||||
(default #f))
|
||||
(input-changes upstream-source-input-changes
|
||||
(default '()) (thunked)))
|
||||
(inputs upstream-source-inputs ;#f | list of <upstream-input>
|
||||
(delayed) (default #f))) ;delayed because optional and costly
|
||||
|
||||
;; Representation of a dependency as expressed by upstream.
|
||||
(define-record-type* <upstream-input>
|
||||
upstream-input make-upstream-input
|
||||
upstream-input?
|
||||
(name upstream-input-name) ;upstream package name
|
||||
(downstream-name upstream-input-downstream-name) ;Guix package name
|
||||
(type upstream-input-type ;'regular | 'native | 'propagated
|
||||
(default 'regular))
|
||||
(min-version upstream-input-min-version
|
||||
(default 'any))
|
||||
(max-version upstream-input-max-version
|
||||
(default 'any)))
|
||||
|
||||
(define (upstream-input-type-predicate type)
|
||||
"Return a predicate that returns true when passed an <upstream-input> record
|
||||
of the given TYPE (a symbol such as 'propagated)."
|
||||
(lambda (source)
|
||||
(eq? type (upstream-input-type source))))
|
||||
|
||||
(define (input-type-filter type)
|
||||
"Return a procedure that, given an <upstream-source>, returns the subset of
|
||||
its inputs that have the given TYPE (a symbol such as 'native)."
|
||||
(lambda (source)
|
||||
"Return the subset of inputs of SOURCE that have the given TYPE."
|
||||
(filter (lambda (input)
|
||||
(eq? type (upstream-input-type input)))
|
||||
(upstream-source-inputs source))))
|
||||
|
||||
(define upstream-source-regular-inputs (input-type-filter 'regular))
|
||||
(define upstream-source-native-inputs (input-type-filter 'native))
|
||||
(define upstream-source-propagated-inputs (input-type-filter 'propagated))
|
||||
|
||||
;; Representation of an upstream input change.
|
||||
(define-record-type* <upstream-input-change>
|
||||
|
|
@ -113,67 +158,55 @@ (define-record-type* <upstream-input-change>
|
|||
(type upstream-input-change-type) ;symbol: regular | native | propagated
|
||||
(action upstream-input-change-action)) ;symbol: add | remove
|
||||
|
||||
(define (changed-inputs package package-sexp)
|
||||
"Return a list of input changes for PACKAGE based on the newly imported
|
||||
S-expression PACKAGE-SEXP."
|
||||
(match package-sexp
|
||||
((and expr ('package fields ...))
|
||||
(let* ((input->name (match-lambda ((name pkg . out) name)))
|
||||
(new-regular
|
||||
(match expr
|
||||
((path *** ('inputs
|
||||
('quasiquote ((label ('unquote sym)) ...)))) label)
|
||||
((path *** ('inputs
|
||||
('list sym ...))) (map symbol->string sym))
|
||||
(_ '())))
|
||||
(new-native
|
||||
(match expr
|
||||
((path *** ('native-inputs
|
||||
('quasiquote ((label ('unquote sym)) ...)))) label)
|
||||
((path *** ('native-inputs
|
||||
('list sym ...))) (map symbol->string sym))
|
||||
(_ '())))
|
||||
(new-propagated
|
||||
(match expr
|
||||
((path *** ('propagated-inputs
|
||||
('quasiquote ((label ('unquote sym)) ...)))) label)
|
||||
((path *** ('propagated-inputs
|
||||
('list sym ...))) (map symbol->string sym))
|
||||
(_ '())))
|
||||
(current-regular
|
||||
(map input->name (package-inputs package)))
|
||||
(current-native
|
||||
(map input->name (package-native-inputs package)))
|
||||
(current-propagated
|
||||
(map input->name (package-propagated-inputs package))))
|
||||
(append-map
|
||||
(match-lambda
|
||||
((action type names)
|
||||
(map (lambda (name)
|
||||
(upstream-input-change
|
||||
(name name)
|
||||
(type type)
|
||||
(action action)))
|
||||
names)))
|
||||
`((add regular
|
||||
,(lset-difference equal?
|
||||
new-regular current-regular))
|
||||
(remove regular
|
||||
,(lset-difference equal?
|
||||
current-regular new-regular))
|
||||
(add native
|
||||
,(lset-difference equal?
|
||||
new-native current-native))
|
||||
(remove native
|
||||
,(lset-difference equal?
|
||||
current-native new-native))
|
||||
(add propagated
|
||||
,(lset-difference equal?
|
||||
new-propagated current-propagated))
|
||||
(remove propagated
|
||||
,(lset-difference equal?
|
||||
current-propagated new-propagated))))))
|
||||
(_ '())))
|
||||
(define (changed-inputs package source)
|
||||
"Return a list of input changes for PACKAGE compared to the 'inputs' field
|
||||
of SOURCE, an <upstream-source> record."
|
||||
(define input->name
|
||||
(match-lambda
|
||||
((label (? package? pkg) . out) (package-name pkg))
|
||||
(_ #f)))
|
||||
|
||||
(if (upstream-source-inputs source)
|
||||
(let* ((new-regular (map upstream-input-downstream-name
|
||||
(upstream-source-regular-inputs source)))
|
||||
(new-native (map upstream-input-downstream-name
|
||||
(upstream-source-native-inputs source)))
|
||||
(new-propagated (map upstream-input-downstream-name
|
||||
(upstream-source-propagated-inputs source)))
|
||||
(current-regular
|
||||
(filter-map input->name (package-inputs package)))
|
||||
(current-native
|
||||
(filter-map input->name (package-native-inputs package)))
|
||||
(current-propagated
|
||||
(filter-map input->name (package-propagated-inputs package))))
|
||||
(append-map
|
||||
(match-lambda
|
||||
((action type names)
|
||||
(map (lambda (name)
|
||||
(upstream-input-change
|
||||
(name name)
|
||||
(type type)
|
||||
(action action)))
|
||||
names)))
|
||||
`((add regular
|
||||
,(lset-difference equal?
|
||||
new-regular current-regular))
|
||||
(remove regular
|
||||
,(lset-difference equal?
|
||||
current-regular new-regular))
|
||||
(add native
|
||||
,(lset-difference equal?
|
||||
new-native current-native))
|
||||
(remove native
|
||||
,(lset-difference equal?
|
||||
current-native new-native))
|
||||
(add propagated
|
||||
,(lset-difference equal?
|
||||
new-propagated current-propagated))
|
||||
(remove propagated
|
||||
,(lset-difference equal?
|
||||
current-propagated new-propagated)))))
|
||||
'()))
|
||||
|
||||
(define* (url-predicate matching-url?)
|
||||
"Return a predicate that returns true when passed a package whose source is
|
||||
|
|
|
|||
|
|
@ -25,9 +25,12 @@ (define-module (test-pypi)
|
|||
#:use-module (guix base32)
|
||||
#:use-module (guix memoization)
|
||||
#:use-module (guix utils)
|
||||
#:use-module ((guix base16) #:select (base16-string->bytevector))
|
||||
#:use-module (guix upstream)
|
||||
#:use-module (gcrypt hash)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (guix tests http)
|
||||
#:use-module ((guix download) #:select (url-fetch))
|
||||
#:use-module (guix build-system python)
|
||||
#:use-module ((guix build utils)
|
||||
#:select (delete-file-recursively
|
||||
|
|
@ -43,6 +46,12 @@ (define-module (test-pypi)
|
|||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 optargs))
|
||||
|
||||
(define default-sha256
|
||||
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
|
||||
(define default-sha256/base32
|
||||
(bytevector->nix-base32-string
|
||||
(base16-string->bytevector default-sha256)))
|
||||
|
||||
(define* (foo-json #:key (name "foo") (name-in-url #f))
|
||||
"Create a JSON description of an example pypi package, named @var{name},
|
||||
optionally using a different @var{name in its URL}."
|
||||
|
|
@ -65,7 +74,8 @@ (define* (foo-json #:key (name "foo") (name-in-url #f))
|
|||
((url . ,(format #f "~a/~a-1.0.0.tar.gz"
|
||||
(%local-url #:path "")
|
||||
(or name-in-url name)))
|
||||
(packagetype . "sdist"))
|
||||
(packagetype . "sdist")
|
||||
(digests . (("sha256" . ,default-sha256))))
|
||||
((url . ,(format #f "~a/~a-1.0.0-py2.py3-none-any.whl"
|
||||
(%local-url #:path "")
|
||||
(or name-in-url name)))
|
||||
|
|
@ -308,9 +318,7 @@ (define-syntax-rule (with-pypi responses body ...)
|
|||
('synopsis "summary")
|
||||
('description "summary")
|
||||
('license 'license:lgpl2.0))
|
||||
(and (string=? (bytevector->nix-base32-string
|
||||
(file-sha256 tarball))
|
||||
hash)
|
||||
(and (string=? default-sha256/base32 hash)
|
||||
(equal? (pypi->guix-package "foo" #:version "1.0.0")
|
||||
(pypi->guix-package "foo"))
|
||||
(guard (c ((error? c) #t))
|
||||
|
|
@ -352,8 +360,7 @@ (define-syntax-rule (with-pypi responses body ...)
|
|||
('synopsis "summary")
|
||||
('description "summary")
|
||||
('license 'license:lgpl2.0))
|
||||
(string=? (bytevector->nix-base32-string (file-sha256 tarball))
|
||||
hash))
|
||||
(string=? default-sha256/base32 hash))
|
||||
(x
|
||||
(pk 'fail x #f))))))
|
||||
|
||||
|
|
@ -382,8 +389,7 @@ (define-syntax-rule (with-pypi responses body ...)
|
|||
('synopsis "summary")
|
||||
('description "summary")
|
||||
('license 'license:lgpl2.0))
|
||||
(string=? (bytevector->nix-base32-string (file-sha256 tarball))
|
||||
hash))
|
||||
(string=? default-sha256/base32 hash))
|
||||
(x
|
||||
(pk 'fail x #f))))))
|
||||
|
||||
|
|
@ -414,11 +420,47 @@ (define-syntax-rule (with-pypi responses body ...)
|
|||
('synopsis "summary")
|
||||
('description "summary")
|
||||
('license 'license:lgpl2.0))
|
||||
(string=? (bytevector->nix-base32-string (file-sha256 tarball))
|
||||
hash))
|
||||
(string=? default-sha256/base32 hash))
|
||||
(x
|
||||
(pk 'fail x #f))))))
|
||||
|
||||
(test-equal "package-latest-release"
|
||||
(list '("foo-1.0.0.tar.gz")
|
||||
'("foo-1.0.0.tar.gz.asc")
|
||||
(list (upstream-input
|
||||
(name "bar")
|
||||
(downstream-name "python-bar")
|
||||
(type 'propagated))
|
||||
(upstream-input
|
||||
(name "foo")
|
||||
(downstream-name "python-foo")
|
||||
(type 'propagated))
|
||||
(upstream-input
|
||||
(name "pytest")
|
||||
(downstream-name "python-pytest")
|
||||
(type 'native))))
|
||||
(let ((tarball (pypi-tarball
|
||||
"foo-1.0.0"
|
||||
`(("src/bizarre.egg-info/requires.txt"
|
||||
,test-requires.txt)))))
|
||||
(with-pypi `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball))
|
||||
("/foo-1.0.0-py2.py3-none-any.whl" 404 "")
|
||||
("/foo/json" 200 ,(lambda (port)
|
||||
(display (foo-json) port))))
|
||||
(define source
|
||||
(package-latest-release
|
||||
(dummy-package "python-foo"
|
||||
(version "0.1.2")
|
||||
(source (dummy-origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "foo" version))))
|
||||
(build-system python-build-system))
|
||||
(list %pypi-updater)))
|
||||
|
||||
(list (map basename (upstream-source-urls source))
|
||||
(map basename (upstream-source-signature-urls source))
|
||||
(upstream-source-inputs source)))))
|
||||
|
||||
(test-end "pypi")
|
||||
(delete-file-recursively sample-directory)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016, 2023 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
|
|
@ -78,69 +78,29 @@ (define test-package
|
|||
(description "test")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define test-package-sexp
|
||||
'(package
|
||||
(name "test")
|
||||
(version "2.10")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/hello/hello-" version
|
||||
".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("hello" ,hello)))
|
||||
(native-inputs
|
||||
`(("sed" ,sed)
|
||||
("tar" ,tar)))
|
||||
(propagated-inputs
|
||||
`(("grep" ,grep)))
|
||||
(home-page "http://localhost")
|
||||
(synopsis "test")
|
||||
(description "test")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(test-equal "changed-inputs returns no changes"
|
||||
'()
|
||||
(changed-inputs test-package test-package-sexp))
|
||||
|
||||
(test-assert "changed-inputs returns changes to labelled input list"
|
||||
(let ((changes (changed-inputs
|
||||
(package
|
||||
(inherit test-package)
|
||||
(inputs `(("hello" ,hello)
|
||||
("sed" ,sed))))
|
||||
test-package-sexp)))
|
||||
(match changes
|
||||
;; Exactly one change
|
||||
(((? upstream-input-change? item))
|
||||
(and (equal? (upstream-input-change-type item)
|
||||
'regular)
|
||||
(equal? (upstream-input-change-action item)
|
||||
'remove)
|
||||
(string=? (upstream-input-change-name item)
|
||||
"sed")))
|
||||
(else (pk else #false)))))
|
||||
|
||||
(test-assert "changed-inputs returns changes to all labelled input lists"
|
||||
(let ((changes (changed-inputs
|
||||
(package
|
||||
(inherit test-package)
|
||||
(inputs '())
|
||||
(native-inputs '())
|
||||
(propagated-inputs '()))
|
||||
test-package-sexp)))
|
||||
(match changes
|
||||
(((? upstream-input-change? items) ...)
|
||||
(and (equal? (map upstream-input-change-type items)
|
||||
'(regular native native propagated))
|
||||
(equal? (map upstream-input-change-action items)
|
||||
'(add add add add))
|
||||
(equal? (map upstream-input-change-name items)
|
||||
'("hello" "sed" "tar" "grep"))))
|
||||
(else (pk else #false)))))
|
||||
(changed-inputs test-package
|
||||
(upstream-source
|
||||
(package "test")
|
||||
(version "1")
|
||||
(urls '())
|
||||
(inputs
|
||||
(let ((->input
|
||||
(lambda (type)
|
||||
(match-lambda
|
||||
((label _)
|
||||
(upstream-input
|
||||
(name label)
|
||||
(downstream-name label)
|
||||
(type type)))))))
|
||||
(append (map (->input 'regular)
|
||||
(package-inputs test-package))
|
||||
(map (->input 'native)
|
||||
(package-native-inputs test-package))
|
||||
(map (->input 'propagated)
|
||||
(package-propagated-inputs
|
||||
test-package))))))))
|
||||
|
||||
(define test-new-package
|
||||
(package
|
||||
|
|
@ -152,35 +112,20 @@ (define test-new-package
|
|||
(propagated-inputs
|
||||
(list grep))))
|
||||
|
||||
(define test-new-package-sexp
|
||||
'(package
|
||||
(name "test")
|
||||
(version "2.10")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/hello/hello-" version
|
||||
".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
(list hello))
|
||||
(native-inputs
|
||||
(list sed tar))
|
||||
(propagated-inputs
|
||||
(list grep))
|
||||
(home-page "http://localhost")
|
||||
(synopsis "test")
|
||||
(description "test")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(test-assert "changed-inputs returns changes to plain input list"
|
||||
(let ((changes (changed-inputs
|
||||
(package
|
||||
(inherit test-new-package)
|
||||
(inputs (list hello sed)))
|
||||
test-new-package-sexp)))
|
||||
(inputs (list hello sed))
|
||||
(native-inputs '())
|
||||
(propagated-inputs '()))
|
||||
(upstream-source
|
||||
(package "test")
|
||||
(version "1")
|
||||
(urls '())
|
||||
(inputs (list (upstream-input
|
||||
(name "hello")
|
||||
(downstream-name name))))))))
|
||||
(match changes
|
||||
;; Exactly one change
|
||||
(((? upstream-input-change? item))
|
||||
|
|
@ -199,7 +144,26 @@ (define test-new-package-sexp
|
|||
(inputs '())
|
||||
(native-inputs '())
|
||||
(propagated-inputs '()))
|
||||
test-new-package-sexp)))
|
||||
(upstream-source
|
||||
(package "test")
|
||||
(version "1")
|
||||
(urls '())
|
||||
(inputs (list (upstream-input
|
||||
(name "hello")
|
||||
(downstream-name name)
|
||||
(type 'regular))
|
||||
(upstream-input
|
||||
(name "sed")
|
||||
(downstream-name name)
|
||||
(type 'native))
|
||||
(upstream-input
|
||||
(name "tar")
|
||||
(downstream-name name)
|
||||
(type 'native))
|
||||
(upstream-input
|
||||
(name "grep")
|
||||
(downstream-name name)
|
||||
(type 'propagated))))))))
|
||||
(match changes
|
||||
(((? upstream-input-change? items) ...)
|
||||
(and (equal? (map upstream-input-change-type items)
|
||||
|
|
|
|||
Loading…
Reference in a new issue