import: cpan: Adapt for the change to guile-json version 3.
In guile-json version 3, JSON objects are represented as hash tables, rather than alists. * guix/import/cpan.scm (string->license): Change the match expression to match on lists, rather than vectors. (module->dist-name, cpan-source-url, cpan-version): Change assoc-ref to hash-ref. (cpan-module->sexp): Change assoc-ref to hash-ref, and assoc-ref* to hash-ref*. * tests/cpan.scm ("source-url-http", "source-url-https"): Convert the alist to a hash table.
This commit is contained in:
parent
8a3b11d1eb
commit
01ce7af25a
|
@ -34,7 +34,7 @@
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
#:use-module ((guix download) #:select (download-to-store url-fetch))
|
#:use-module ((guix download) #:select (download-to-store url-fetch))
|
||||||
#:use-module ((guix import utils) #:select (factorize-uri
|
#:use-module ((guix import utils) #:select (factorize-uri
|
||||||
flatten assoc-ref*))
|
flatten hash-ref*))
|
||||||
#:use-module (guix import json)
|
#:use-module (guix import json)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix upstream)
|
#:use-module (guix upstream)
|
||||||
|
@ -76,8 +76,8 @@
|
||||||
;; ssleay
|
;; ssleay
|
||||||
;; sun
|
;; sun
|
||||||
("zlib" 'zlib)
|
("zlib" 'zlib)
|
||||||
(#(x) (string->license x))
|
((x) (string->license x))
|
||||||
(#(lst ...) `(list ,@(map string->license lst)))
|
((lst ...) `(list ,@(map string->license lst)))
|
||||||
(_ #f)))
|
(_ #f)))
|
||||||
|
|
||||||
(define (module->name module)
|
(define (module->name module)
|
||||||
|
@ -88,11 +88,11 @@
|
||||||
"Return the base distribution module for a given module. E.g. the 'ok'
|
"Return the base distribution module for a given module. E.g. the 'ok'
|
||||||
module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
|
module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
|
||||||
return \"Test-Simple\""
|
return \"Test-Simple\""
|
||||||
(assoc-ref (json-fetch (string-append
|
(hash-ref (json-fetch (string-append
|
||||||
"https://fastapi.metacpan.org/v1/module/"
|
"https://fastapi.metacpan.org/v1/module/"
|
||||||
module
|
module
|
||||||
"?fields=distribution"))
|
"?fields=distribution"))
|
||||||
"distribution"))
|
"distribution"))
|
||||||
|
|
||||||
(define (package->upstream-name package)
|
(define (package->upstream-name package)
|
||||||
"Return the CPAN name of PACKAGE."
|
"Return the CPAN name of PACKAGE."
|
||||||
|
@ -122,12 +122,12 @@ or #f on failure. MODULE should be e.g. \"Test::Script\""
|
||||||
(define (cpan-source-url meta)
|
(define (cpan-source-url meta)
|
||||||
"Return the download URL for a module's source tarball."
|
"Return the download URL for a module's source tarball."
|
||||||
(regexp-substitute/global #f "http[s]?://cpan.metacpan.org"
|
(regexp-substitute/global #f "http[s]?://cpan.metacpan.org"
|
||||||
(assoc-ref meta "download_url")
|
(hash-ref meta "download_url")
|
||||||
'pre "mirror://cpan" 'post))
|
'pre "mirror://cpan" 'post))
|
||||||
|
|
||||||
(define (cpan-version meta)
|
(define (cpan-version meta)
|
||||||
"Return the version number from META."
|
"Return the version number from META."
|
||||||
(match (assoc-ref meta "version")
|
(match (hash-ref meta "version")
|
||||||
((? number? version)
|
((? number? version)
|
||||||
;; version is sometimes not quoted in the module json, so it gets
|
;; version is sometimes not quoted in the module json, so it gets
|
||||||
;; imported into Guile as a number, so convert it to a string.
|
;; imported into Guile as a number, so convert it to a string.
|
||||||
|
@ -183,7 +183,7 @@ depend on (gnu packages perl)."
|
||||||
"Return the `package' s-expression for a CPAN module from the metadata in
|
"Return the `package' s-expression for a CPAN module from the metadata in
|
||||||
META."
|
META."
|
||||||
(define name
|
(define name
|
||||||
(assoc-ref meta "distribution"))
|
(hash-ref meta "distribution"))
|
||||||
|
|
||||||
(define (guix-name name)
|
(define (guix-name name)
|
||||||
(if (string-prefix? "perl-" name)
|
(if (string-prefix? "perl-" name)
|
||||||
|
@ -198,7 +198,9 @@ META."
|
||||||
(match (flatten
|
(match (flatten
|
||||||
(map (lambda (ph)
|
(map (lambda (ph)
|
||||||
(filter-map (lambda (t)
|
(filter-map (lambda (t)
|
||||||
(assoc-ref* meta "metadata" "prereqs" ph t))
|
(and=> (hash-ref* meta "metadata" "prereqs" ph t)
|
||||||
|
(lambda (h)
|
||||||
|
(hash-map->list cons h))))
|
||||||
'("requires" "recommends" "suggests")))
|
'("requires" "recommends" "suggests")))
|
||||||
phases))
|
phases))
|
||||||
(#f
|
(#f
|
||||||
|
@ -251,9 +253,9 @@ META."
|
||||||
,@(maybe-inputs 'propagated-inputs
|
,@(maybe-inputs 'propagated-inputs
|
||||||
(convert-inputs '("runtime")))
|
(convert-inputs '("runtime")))
|
||||||
(home-page ,(cpan-home name))
|
(home-page ,(cpan-home name))
|
||||||
(synopsis ,(assoc-ref meta "abstract"))
|
(synopsis ,(hash-ref meta "abstract"))
|
||||||
(description fill-in-yourself!)
|
(description fill-in-yourself!)
|
||||||
(license ,(string->license (assoc-ref meta "license"))))))
|
(license ,(string->license (hash-ref meta "license"))))))
|
||||||
|
|
||||||
(define (cpan->guix-package module-name)
|
(define (cpan->guix-package module-name)
|
||||||
"Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the
|
"Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the
|
||||||
|
|
|
@ -24,7 +24,8 @@
|
||||||
#:use-module (guix tests)
|
#:use-module (guix tests)
|
||||||
#:use-module (guix grafts)
|
#:use-module (guix grafts)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (ice-9 match))
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 hash-table))
|
||||||
|
|
||||||
;; Globally disable grafts because they can trigger early builds.
|
;; Globally disable grafts because they can trigger early builds.
|
||||||
(%graft? #f)
|
(%graft? #f)
|
||||||
|
@ -109,14 +110,16 @@
|
||||||
|
|
||||||
(test-equal "source-url-http"
|
(test-equal "source-url-http"
|
||||||
((@@ (guix import cpan) cpan-source-url)
|
((@@ (guix import cpan) cpan-source-url)
|
||||||
`(("download_url" .
|
(alist->hash-table
|
||||||
"http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))
|
`(("download_url" .
|
||||||
|
"http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))))
|
||||||
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
|
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
|
||||||
|
|
||||||
(test-equal "source-url-https"
|
(test-equal "source-url-https"
|
||||||
((@@ (guix import cpan) cpan-source-url)
|
((@@ (guix import cpan) cpan-source-url)
|
||||||
`(("download_url" .
|
(alist->hash-table
|
||||||
"https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))
|
`(("download_url" .
|
||||||
|
"https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))))
|
||||||
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
|
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
|
||||||
|
|
||||||
(test-end "cpan")
|
(test-end "cpan")
|
||||||
|
|
Loading…
Reference in New Issue