TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

import: cpan: Represent dependencies as <upstream-input> records. 

* guix/import/cpan.scm (cpan-name->downstream-name)
(cran-dependency->upstream-input, cran-module-inputs): New procedures.
(cpan-module->sexp)[guix-name, convert-inputs]: Remove.
[maybe-inputs]: Adjust to deal with <upstream-input>.
Use 'cpan-name->downstream-name' instead of 'guix-name'.  Add call to
'cpan-module-inputs' and adjust calls to 'maybe-inputs'.  No longer emit
input labels.
* tests/cpan.scm ("cpan->guix-package"): Adjust test accordingly.
This commit is contained in:
Ludovic Courtès 2023-05-17 22:25:41 +02:00
parent f13e73df10
commit c4fe4e7eb8
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 58 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
guix/import/cpan.scm
View File

@ -3,7 +3,7 @@
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
@ -222,56 +222,73 @@ depend on (gnu packages perl)."
first perl-version last))))
(loop)))))))))))
(define (cpan-name->downstream-name name)
"Return the Guix package name corresponding to NAME."
(if (string-prefix? "perl-" name)
(string-downcase name)
(string-append "perl-" (string-downcase name))))
(define (cran-dependency->upstream-input dependency)
"Return the <upstream-input> corresponding to DEPENDENCY, or #f if
DEPENDENCY denotes an implicit or otherwise unnecessary dependency."
(match (cpan-dependency-module dependency)
("perl" #f) ;implicit dependency
(module
(let ((type (match (cpan-dependency-phase dependency)
((or 'configure 'build 'test)
;; "runtime" may also be needed here. See
;; https://metacpan.org/pod/CPAN::Meta::Spec#Phases,
;; which says they are required during
;; building. We have not yet had a need for
;; cross-compiled Perl modules, however, so
;; we leave it out.
'native)
('runtime
'propagated)
(_
#f))))
(and type
(not (core-module? module)) ;expensive call!
(upstream-input
(name (module->dist-name module))
(downstream-name (cpan-name->downstream-name name))
(type type)))))))
(define (cpan-module-inputs release)
"Return the list of <upstream-input> for dependencies of RELEASE, a
<cpan-release>."
(define (upstream-input<? a b)
(string<? (upstream-input-downstream-name a)
(upstream-input-downstream-name b)))
(sort (delete-duplicates
(filter-map cran-dependency->upstream-input
(cpan-release-dependencies release)))
upstream-input<?))
(define (cpan-module->sexp release)
"Return the 'package' s-expression for a CPAN module from the release data
in RELEASE, a <cpan-release> record."
(define name
(cpan-release-distribution release))
(define (guix-name name)
(if (string-prefix? "perl-" name)
(string-downcase name)
(string-append "perl-" (string-downcase name))))
(define version (cpan-release-version release))
(define source-url (cpan-source-url release))
(define (convert-inputs phases)
;; Convert phase dependencies into a list of name/variable pairs.
(match (filter-map (lambda (dependency)
(and (memq (cpan-dependency-phase dependency)
phases)
(cpan-dependency-module dependency)))
(cpan-release-dependencies release))
((inputs ...)
(sort
(delete-duplicates
;; Listed dependencies may include core modules. Filter those out.
(filter-map (match-lambda
("perl" #f) ;implicit dependency
((? core-module?) #f)
(module
(let ((name (guix-name (module->dist-name module))))
(list name
(list 'unquote (string->symbol name))))))
inputs))
(lambda args
(match args
(((a _ ...) (b _ ...))
(string<? a b))))))))
(define (maybe-inputs guix-name inputs)
(define (maybe-inputs input-type inputs)
(match inputs
(()
'())
((inputs ...)
(list (list guix-name
(list 'quasiquote inputs))))))
`((,input-type (list ,@(map (compose string->symbol
upstream-input-downstream-name)
inputs)))))))
(let ((tarball (with-store store
(download-to-store store source-url))))
(download-to-store store source-url)))
(inputs (cpan-module-inputs release)))
`(package
(name ,(guix-name name))
(name ,(cpan-name->downstream-name name))
(version ,version)
(source (origin
(method url-fetch)
@ -281,14 +298,11 @@ in RELEASE, a <cpan-release> record."
,(bytevector->nix-base32-string (file-sha256 tarball))))))
(build-system perl-build-system)
,@(maybe-inputs 'native-inputs
;; "runtime" may also be needed here. See
;; https://metacpan.org/pod/CPAN::Meta::Spec#Phases,
;; which says they are required during building. We
;; have not yet had a need for cross-compiled perl
;; modules, however, so we leave it out.
(convert-inputs '(configure build test)))
(filter (upstream-input-type-predicate 'native)
inputs))
,@(maybe-inputs 'propagated-inputs
(convert-inputs '(runtime)))
(filter (upstream-input-type-predicate 'propagated)
inputs))
(home-page ,(cpan-home name))
(synopsis ,(cpan-release-abstract release))
(description fill-in-yourself!)

7
tests/cpan.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020, 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -64,7 +64,6 @@
(test-begin "cpan")
(test-assert "cpan->guix-package"
;; Replace network resources with sample data.
(with-http-server `((200 ,test-json)
(200 ,test-source)
(200 "{ \"distribution\" : \"Test-Script\" }"))
@ -82,9 +81,7 @@
('base32
(? string? hash)))))
('build-system 'perl-build-system)
('propagated-inputs
('quasiquote
(("perl-test-script" ('unquote 'perl-test-script)))))
('propagated-inputs ('list 'perl-test-script))
('home-page "https://metacpan.org/release/Foo-Bar")
('synopsis "Fizzle Fuzz")
('description 'fill-in-yourself!)