json.scm 3.0 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
  3. ;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
  4. ;;;
  5. ;;; This file is part of GNU Guix.
  6. ;;;
  7. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  8. ;;; under the terms of the GNU General Public License as published by
  9. ;;; the Free Software Foundation; either version 3 of the License, or (at
  10. ;;; your option) any later version.
  11. ;;;
  12. ;;; GNU Guix is distributed in the hope that it will be useful, but
  13. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;;; GNU General Public License for more details.
  16. ;;;
  17. ;;; You should have received a copy of the GNU General Public License
  18. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  19. (define-module (guix scripts import json)
  20. #:use-module (json)
  21. #:use-module (guix ui)
  22. #:use-module (guix utils)
  23. #:use-module (guix scripts)
  24. #:use-module (guix import utils)
  25. #:use-module (guix import json)
  26. #:use-module (guix scripts import)
  27. #:use-module (guix packages)
  28. #:use-module (srfi srfi-1)
  29. #:use-module (srfi srfi-9 gnu)
  30. #:use-module (srfi srfi-11)
  31. #:use-module (srfi srfi-37)
  32. #:use-module (srfi srfi-41)
  33. #:use-module (ice-9 match)
  34. #:use-module (ice-9 rdelim)
  35. #:use-module (ice-9 format)
  36. #:export (guix-import-json))
  37. ;;;
  38. ;;; Command-line options.
  39. ;;;
  40. (define %default-options
  41. '())
  42. (define (show-help)
  43. (display (G_ "Usage: guix import json PACKAGE-FILE
  44. Import and convert the JSON package definition in PACKAGE-FILE.\n"))
  45. (display (G_ "
  46. -h, --help display this help and exit"))
  47. (display (G_ "
  48. -V, --version display version information and exit"))
  49. (newline)
  50. (show-bug-report-information))
  51. (define %options
  52. ;; Specification of the command-line options.
  53. (cons* (option '(#\h "help") #f #f
  54. (lambda args
  55. (show-help)
  56. (exit 0)))
  57. (option '(#\V "version") #f #f
  58. (lambda args
  59. (show-version-and-exit "guix import json")))
  60. %standard-import-options))
  61. ;;;
  62. ;;; Entry point.
  63. ;;;
  64. (define (guix-import-json . args)
  65. (define (parse-options)
  66. ;; Return the alist of option values.
  67. (args-fold* args %options
  68. (lambda (opt name arg result)
  69. (leave (G_ "~A: unrecognized option~%") name))
  70. (lambda (arg result)
  71. (alist-cons 'argument arg result))
  72. %default-options))
  73. (let* ((opts (parse-options))
  74. (args (filter-map (match-lambda
  75. (('argument . value)
  76. value)
  77. (_ #f))
  78. (reverse opts))))
  79. (match args
  80. ((file-name)
  81. (or (json->code file-name)
  82. (leave (G_ "invalid JSON in file '~a'~%") file-name)))
  83. (()
  84. (leave (G_ "too few arguments~%")))
  85. ((many ...)
  86. (leave (G_ "too many arguments~%"))))))