guix/scripts/import.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013, 2014, 2020 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
   4 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
   5 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (guix scripts import)
  23   #:use-module (guix ui)
  24   #:use-module (guix scripts)
  25   #:use-module (guix utils)
  26   #:use-module (srfi srfi-1)
  27   #:use-module (srfi srfi-11)
  28   #:use-module (srfi srfi-26)
  29   #:use-module (srfi srfi-37)
  30   #:use-module (ice-9 format)
  31   #:use-module (ice-9 match)
  32   #:use-module (ice-9 pretty-print)
  33   #:export (%standard-import-options
  34             guix-import))
  35
  36 \f
  37 ;;;
  38 ;;; Helper.
  39 ;;;
  40
  41 (define (newline-rewriting-port output)
  42   "Return an output port that rewrites strings containing the \\n escape
  43 to an actual newline.  This works around the behavior of `pretty-print'
  44 and `write', which output these as \\n instead of actual newlines,
  45 whereas we want the `description' field to contain actual newlines
  46 rather than \\n."
  47   (define (write-string str)
  48     (let loop ((chars (string->list str)))
  49       (match chars
  50         (()
  51          #t)
  52         ((#\\ #\n rest ...)
  53          (newline output)
  54          (loop rest))
  55         ((chr rest ...)
  56          (write-char chr output)
  57          (loop rest)))))
  58
  59   (make-soft-port (vector (cut write-char <>)
  60                           write-string
  61                           (lambda _ #t)           ; flush
  62                           #f
  63                           (lambda _ #t)           ; close
  64                           #f)
  65                   "w"))
  66
  67 \f
  68 ;;;
  69 ;;; Command line options.
  70 ;;;
  71
  72 (define %standard-import-options '())
  73
  74 \f
  75 ;;;
  76 ;;; Entry point.
  77 ;;;
  78
  79 (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem"
  80                     "go" "cran" "crate" "texlive" "json" "opam"))
  81
  82 (define (resolve-importer name)
  83   (let ((module (resolve-interface
  84                  `(guix scripts import ,(string->symbol name))))
  85         (proc (string->symbol (string-append "guix-import-" name))))
  86     (module-ref module proc)))
  87
  88 (define (show-help)
  89   (display (G_ "Usage: guix import IMPORTER ARGS ...
  90 Run IMPORTER with ARGS.\n"))
  91   (newline)
  92   (display (G_ "IMPORTER must be one of the importers listed below:\n"))
  93   (newline)
  94   (format #t "~{   ~a~%~}" importers)
  95   (display (G_ "
  96   -h, --help             display this help and exit"))
  97   (display (G_ "
  98   -V, --version          display version information and exit"))
  99   (newline)
 100   (show-bug-report-information))
 101
 102 (define-command (guix-import . args)
 103   (category packaging)
 104   (synopsis "import a package definition from an external repository")
 105
 106   (match args
 107     (()
 108      (format (current-error-port)
 109              (G_ "guix import: missing importer name~%")))
 110     ((or ("-h") ("--help"))
 111      (show-help)
 112      (exit 0))
 113     ((or ("-V") ("--version"))
 114      (show-version-and-exit "guix import"))
 115     ((importer args ...)
 116      (if (member importer importers)
 117          (let ((print (lambda (expr)
 118                         (pretty-print expr (newline-rewriting-port
 119                                             (current-output-port))))))
 120            (match (apply (resolve-importer importer) args)
 121              ((and expr (or ('package _ ...)
 122                             ('let _ ...)
 123                             ('define-public _ ...)))
 124               (print expr))
 125              ((? list? expressions)
 126               (for-each (lambda (expr)
 127                           (print expr)
 128                           (newline))
 129                         expressions))
 130              (x
 131               (leave (G_ "'~a' import failed~%") importer))))
 132          (leave (G_ "~a: invalid importer~%") importer)))))