diff options
Diffstat (limited to 'guix/import/json.scm')
| -rw-r--r-- | guix/import/json.scm | 61 |
1 files changed, 60 insertions, 1 deletions
diff --git a/guix/import/json.scm b/guix/import/json.scm index 8900724dcd..0c98bb25b8 100644 --- a/guix/import/json.scm +++ b/guix/import/json.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,8 +23,16 @@ #:use-module (json) #:use-module (guix http-client) #:use-module (guix import utils) + #:use-module (guix import print) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) - #:export (json-fetch)) + #:export (json-fetch + json->code + json->scheme-file)) (define* (json-fetch url ;; Note: many websites returns 403 if we omit a @@ -42,3 +51,53 @@ the query." (result (json->scm port))) (close-port port) result))) + +(define (json->code file-name) + "Read FILE-NAME containing one ore more JSON package definitions and return +a list of S-expressions, or return #F when the JSON is invalid." + (catch 'json-invalid + (lambda () + (let ((json (json-string->scm + (with-input-from-file file-name read-string)))) + (match json + (#(packages ...) + ;; To allow definitions to refer to one another, collect references + ;; to local definitions and tell alist->package to ignore them. + (second + (memq #:result + (fold + (lambda (pkg names+result) + (match names+result + ((#:names names #:result result) + (list #:names + (cons (assoc-ref pkg "name") names) + #:result + (append result + (list + (package->code (alist->package pkg names)) + (string->symbol (assoc-ref pkg "name")))))))) + (list #:names '() + #:result '()) + packages)))) + (package + (list (package->code (alist->package json)) + (string->symbol (assoc-ref json "name"))))))) + (const #f))) + +(define (json->scheme-file file) + "Convert the FILE containing a JSON package definition to a Scheme +representation and return the new file name (or #F on error)." + (and-let* ((sexprs (json->code file)) + (file* (let* ((tempdir (or (getenv "TMPDIR") "/tmp")) + (template (string-append tempdir "/guix-XXXXXX")) + (port (mkstemp! template))) + (close-port port) + template))) + (call-with-output-file file* + (lambda (port) + (write '(use-modules (gnu) + (guix) + ((guix licenses) #:prefix license:)) + port) + (for-each (cut write <> port) sexprs))) + file*)) |