Commit | Line | Data |
---|---|---|
1ff2619b EB |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2014 David Thompson <davet@gnu.org> | |
63773200 | 3 | ;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org> |
2766282f | 4 | ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> |
1ff2619b EB |
5 | ;;; |
6 | ;;; This file is part of GNU Guix. | |
7 | ;;; | |
8 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
9 | ;;; under the terms of the GNU General Public License as published by | |
10 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
11 | ;;; your option) any later version. | |
12 | ;;; | |
13 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
14 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;;; GNU General Public License for more details. | |
17 | ;;; | |
18 | ;;; You should have received a copy of the GNU General Public License | |
19 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
20 | ||
21 | (define-module (guix import json) | |
22 | #:use-module (json) | |
63773200 | 23 | #:use-module (guix http-client) |
1ff2619b | 24 | #:use-module (guix import utils) |
63773200 | 25 | #:use-module (srfi srfi-34) |
3edf0d53 JL |
26 | #:export (json-fetch |
27 | json-fetch-alist)) | |
1ff2619b | 28 | |
2766282f LC |
29 | (define* (json-fetch url |
30 | ;; Note: many websites returns 403 if we omit a | |
31 | ;; 'User-Agent' header. | |
32 | #:key (headers `((user-agent . "GNU Guile") | |
33 | (Accept . "application/json")))) | |
3edf0d53 | 34 | "Return a representation of the JSON resource URL (a list or hash table), or |
2766282f LC |
35 | #f if URL returns 403 or 404. HEADERS is a list of HTTP headers to pass in |
36 | the query." | |
63773200 | 37 | (guard (c ((and (http-get-error? c) |
3edf0d53 JL |
38 | (let ((error (http-get-error-code c))) |
39 | (or (= 403 error) | |
40 | (= 404 error)))) | |
41 | #f)) | |
2766282f | 42 | (let* ((port (http-fetch url #:headers headers)) |
3edf0d53 | 43 | (result (json->scm port))) |
63773200 EB |
44 | (close-port port) |
45 | result))) | |
3edf0d53 JL |
46 | |
47 | (define (json-fetch-alist url) | |
48 | "Return an alist representation of the JSON resource URL, or #f if URL | |
49 | returns 403 or 404." | |
ad0082af DM |
50 | (and=> (json-fetch url) |
51 | hash-table->alist)) |