nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

import: json: Consolidate duplicate json-fetch functionality. 

* guix/import/json.scm (json-fetch): Return a list or hash table.
  (json-fetch-alist): New procedure.
* guix/import/github.scm (json-fetch*): Remove.
  (latest-released-version): Use json-fetch.
* guix/import/cpan.scm (module->dist-name): Use json-fetch-alist.
  (cpan-fetch): Likewise.
* guix/import/crate.scm (crate-fetch): Likewise.
* guix/import/gem.scm (rubygems-fetch): Likewise.
* guix/import/pypi.scm (pypi-fetch): Likewise.
* guix/import/stackage.scm (stackage-lts-info-fetch): Likewise.
master
Jelle Licht 2018-06-10 20:35:39 +02:00
parent 670a5e5430
commit 3edf0d53a4
No known key found for this signature in database
GPG Key ID: DA4597F947B41025
7 changed files with 30 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
guix/import/cpan.scm
View File

@ -88,9 +88,10 @@
"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
return \"Test-Simple\""
(assoc-ref (json-fetch (string-append "https://fastapi.metacpan.org/v1/module/"
module
"?fields=distribution"))
(assoc-ref (json-fetch-alist (string-append
"https://fastapi.metacpan.org/v1/module/"
module
"?fields=distribution"))
"distribution"))
(define (package->upstream-name package)
@ -113,7 +114,7 @@ return \"Test-Simple\""
"Return an alist representation of the CPAN metadata for the perl module MODULE,
or #f on failure. MODULE should be e.g. \"Test::Script\""
;; This API always returns the latest release of the module.
(json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" name)))
(json-fetch-alist (string-append "https://fastapi.metacpan.org/v1/release/" name)))
(define (cpan-home name)
(string-append "http://search.cpan.org/dist/" name "/"))

4
guix/import/crate.scm
View File

@ -51,7 +51,7 @@
(define (crate-kind-predicate kind)
(lambda (dep) (string=? (assoc-ref dep "kind") kind)))
(and-let* ((crate-json (json-fetch (string-append crate-url crate-name)))
(and-let* ((crate-json (json-fetch-alist (string-append crate-url crate-name)))
(crate (assoc-ref crate-json "crate"))
(name (assoc-ref crate "name"))
(version (assoc-ref crate "max_version"))
@ -63,7 +63,7 @@
string->license)
'())) ;missing license info
(path (string-append "/" version "/dependencies"))
(deps-json (json-fetch (string-append crate-url name path)))
(deps-json (json-fetch-alist (string-append crate-url name path)))
(deps (assoc-ref deps-json "dependencies"))
(input-crates (filter (crate-kind-predicate "normal") deps))
(native-input-crates

2
guix/import/gem.scm
View File

@ -38,7 +38,7 @@
(define (rubygems-fetch name)
"Return an alist representation of the RubyGems metadata for the package NAME,
or #f on failure."
(json-fetch
(json-fetch-alist
(string-append "https://rubygems.org/api/v1/gems/" name ".json")))
(define (ruby-package-name name)

19
guix/import/github.scm
View File

@ -22,31 +22,16 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (json)
#:use-module (guix utils)
#:use-module ((guix download) #:prefix download:)
#:use-module (guix import utils)
#:use-module (guix import json)
#:use-module (guix packages)
#:use-module (guix upstream)
#:use-module (guix http-client)
#:use-module (web uri)
#:export (%github-updater))
(define (json-fetch* url)
"Return a representation of the JSON resource URL (a list or hash table), or
#f if URL returns 403 or 404."
(guard (c ((and (http-get-error? c)
(let ((error (http-get-error-code c)))
(or (= 403 error)
(= 404 error))))
#f)) ;; "expected" if there is an authentification error (403),
;; or if package is unknown (404).
;; Note: github.com returns 403 if we omit a 'User-Agent' header.
(let* ((port (http-fetch url))
(result (json->scm port)))
(close-port port)
result)))
(define (find-extension url)
"Return the extension of the archive e.g. '.tar.gz' given a URL, or
false if none is recognized"
@ -144,7 +129,7 @@ the package e.g. 'bedtools2'. Return #f if there is no releases"
"https://api.github.com/repos/"
(github-user-slash-repository url)
"/releases"))
(json (json-fetch*
(json (json-fetch
(if token
(string-append api-url "?access_token=" token)
api-url))))

24
guix/import/json.scm
View File

@ -22,15 +22,25 @@
#:use-module (guix http-client)
#:use-module (guix import utils)
#:use-module (srfi srfi-34)
#:export (json-fetch))
#:export (json-fetch
json-fetch-alist))
(define (json-fetch url)
"Return an alist representation of the JSON resource URL, or #f on failure."
"Return a representation of the JSON resource URL (a list or hash table), or
#f if URL returns 403 or 404."
(guard (c ((and (http-get-error? c)
(= 404 (http-get-error-code c)))
#f)) ;"expected" if package is unknown
(let* ((port (http-fetch url #:headers '((user-agent . "GNU Guile")
(Accept . "application/json"))))
(result (hash-table->alist (json->scm port))))
(let ((error (http-get-error-code c)))
(or (= 403 error)
(= 404 error))))
#f))
;; Note: many websites returns 403 if we omit a 'User-Agent' header.
(let* ((port (http-fetch url #:headers '((user-agent . "GNU Guile")
(Accept . "application/json"))))
(result (json->scm port)))
(close-port port)
result)))
(define (json-fetch-alist url)
"Return an alist representation of the JSON resource URL, or #f if URL
returns 403 or 404."
(hash-table->alist (json-fetch url)))

4
guix/import/pypi.scm
View File

@ -51,8 +51,8 @@
(define (pypi-fetch name)
"Return an alist representation of the PyPI metadata for the package NAME,
or #f on failure."
(json-fetch (string-append "https://pypi.python.org/pypi/"
name "/json")))
(json-fetch-alist (string-append "https://pypi.python.org/pypi/"
name "/json")))
;; For packages found on PyPI that lack a source distribution.
(define-condition-type &missing-source-error &error

2
guix/import/stackage.scm
View File

@ -60,7 +60,7 @@
(let* ((url (if (string=? "" version)
(string-append %stackage-url "/lts")
(string-append %stackage-url "/lts-" version)))
(lts-info (json-fetch url)))
(lts-info (json-fetch-alist url)))
(if lts-info
(reverse lts-info)
(leave-with-message "LTS release version not found: ~a" version))))))