guix/import/json.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
   3 ;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org>
   4 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
   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)
  23   #:use-module (guix http-client)
  24   #:use-module (guix import utils)
  25   #:use-module (srfi srfi-34)
  26   #:export (json-fetch
  27             json-fetch-alist))
  28
  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"))))
  34   "Return a representation of the JSON resource URL (a list or hash table), or
  35 #f if URL returns 403 or 404.  HEADERS is a list of HTTP headers to pass in
  36 the query."
  37   (guard (c ((and (http-get-error? c)
  38                   (let ((error (http-get-error-code c)))
  39                     (or (= 403 error)
  40                         (= 404 error))))
  41              #f))
  42     (let* ((port   (http-fetch url #:headers headers))
  43            (result (json->scm port)))
  44       (close-port port)
  45       result)))
  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."
  50   (and=> (json-fetch url)
  51          hash-table->alist))