guix/scripts/import.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
   4 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
   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 scripts import)
  22   #:use-module (guix ui)
  23   #:use-module (guix utils)
  24   #:use-module (srfi srfi-1)
  25   #:use-module (srfi srfi-11)
  26   #:use-module (srfi srfi-26)
  27   #:use-module (srfi srfi-37)
  28   #:use-module (ice-9 format)
  29   #:use-module (ice-9 match)
  30   #:use-module (ice-9 pretty-print)
  31   #:export (%standard-import-options
  32             guix-import))
  33
  34 \f
  35 ;;;
  36 ;;; Helper.
  37 ;;;
  38
  39 (define (newline-rewriting-port output)
  40   "Return an output port that rewrites strings containing the \\n escape
  41 to an actual newline.  This works around the behavior of `pretty-print'
  42 and `write', which output these as \\n instead of actual newlines,
  43 whereas we want the `description' field to contain actual newlines
  44 rather than \\n."
  45   (define (write-string str)
  46     (let loop ((chars (string->list str)))
  47       (match chars
  48         (()
  49          #t)
  50         ((#\\ #\n rest ...)
  51          (newline output)
  52          (loop rest))
  53         ((chr rest ...)
  54          (write-char chr output)
  55          (loop rest)))))
  56
  57   (make-soft-port (vector (cut write-char <>)
  58                           write-string
  59                           (lambda _ #t)           ; flush
  60                           #f
  61                           (lambda _ #t)           ; close
  62                           #f)
  63                   "w"))
  64
  65 \f
  66 ;;;
  67 ;;; Command line options.
  68 ;;;
  69
  70 (define %standard-import-options '())
  71
  72 \f
  73 ;;;
  74 ;;; Entry point.
  75 ;;;
  76
  77 (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem"
  78                     "cran" "crate" "texlive" "json" "opam"))
  79
  80 (define (resolve-importer name)
  81   (let ((module (resolve-interface
  82                  `(guix scripts import ,(string->symbol name))))
  83         (proc (string->symbol (string-append "guix-import-" name))))
  84     (module-ref module proc)))
  85
  86 (define (show-help)
  87   (display (G_ "Usage: guix import IMPORTER ARGS ...
  88 Run IMPORTER with ARGS.\n"))
  89   (newline)
  90   (display (G_ "IMPORTER must be one of the importers listed below:\n"))
  91   (newline)
  92   (format #t "~{   ~a~%~}" importers)
  93   (display (G_ "
  94   -h, --help             display this help and exit"))
  95   (display (G_ "
  96   -V, --version          display version information and exit"))
  97   (newline)
  98   (show-bug-report-information))
  99
 100 (define (guix-import . args)
 101   (match args
 102     (()
 103      (format (current-error-port)
 104              (G_ "guix import: missing importer name~%")))
 105     ((or ("-h") ("--help"))
 106      (show-help)
 107      (exit 0))
 108     ((or ("-V") ("--version"))
 109      (show-version-and-exit "guix import"))
 110     ((importer args ...)
 111      (if (member importer importers)
 112          (let ((print (lambda (expr)
 113                         (pretty-print expr (newline-rewriting-port
 114                                             (current-output-port))))))
 115            (match (apply (resolve-importer importer) args)
 116              ((and expr ('package _ ...))
 117               (print expr))
 118              ((? list? expressions)
 119               (for-each (lambda (expr)
 120                           (print expr)
 121                           (newline))
 122                         expressions))
 123              (x
 124               (leave (G_ "'~a' import failed~%") importer))))
 125          (leave (G_ "~a: invalid importer~%") importer)))))