guix-import.in

   1 #!/bin/sh
   2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
   3
   4 prefix="@prefix@"
   5 datarootdir="@datarootdir@"
   6
   7 GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH"
   8 export GUILE_LOAD_COMPILED_PATH
   9
  10 main='(module-ref (resolve-interface '\''(guix-import)) '\'guix-import')'
  11 exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
  12          -c "(apply $main (cdr (command-line)))" "$@"
  13 !#
  14 ;;; GNU Guix --- Functional package management for GNU
  15 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
  16 ;;;
  17 ;;; This file is part of GNU Guix.
  18 ;;;
  19 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  20 ;;; under the terms of the GNU General Public License as published by
  21 ;;; the Free Software Foundation; either version 3 of the License, or (at
  22 ;;; your option) any later version.
  23 ;;;
  24 ;;; GNU Guix is distributed in the hope that it will be useful, but
  25 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  26 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  27 ;;; GNU General Public License for more details.
  28 ;;;
  29 ;;; You should have received a copy of the GNU General Public License
  30 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  31
  32 (define-module (guix-import)
  33   #:use-module (guix ui)
  34   #:use-module (guix snix)
  35   #:use-module (guix utils)
  36   #:use-module (srfi srfi-1)
  37   #:use-module (srfi srfi-11)
  38   #:use-module (srfi srfi-26)
  39   #:use-module (srfi srfi-37)
  40   #:use-module (ice-9 match)
  41   #:use-module (ice-9 pretty-print)
  42   #:export (guix-import))
  43
  44 \f
  45 ;;;
  46 ;;; Helper.
  47 ;;;
  48
  49 (define (newline-rewriting-port output)
  50   "Return an output port that rewrites strings containing the \\n escape
  51 to an actual newline.  This works around the behavior of `pretty-print'
  52 and `write', which output these as \\n instead of actual newlines,
  53 whereas we want the `description' field to contain actual newlines
  54 rather than \\n."
  55   (define (write-string str)
  56     (let loop ((chars (string->list str)))
  57       (match chars
  58         (()
  59          #t)
  60         ((#\\ #\n rest ...)
  61          (newline output)
  62          (loop rest))
  63         ((chr rest ...)
  64          (write-char chr output)
  65          (loop rest)))))
  66
  67   (make-soft-port (vector (cut write-char <>)
  68                           write-string
  69                           (lambda _ #t)           ; flush
  70                           #f
  71                           (lambda _ #t)           ; close
  72                           #f)
  73                   "w"))
  74
  75 \f
  76 ;;;
  77 ;;; Command-line options.
  78 ;;;
  79
  80 (define %default-options
  81   '())
  82
  83 (define (show-help)
  84   (display (_ "Usage: guix-import NIXPKGS ATTRIBUTE
  85 Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n"))
  86   (display (_ "
  87   -h, --help             display this help and exit"))
  88   (display (_ "
  89   -V, --version          display version information and exit"))
  90   (newline)
  91   (show-bug-report-information))
  92
  93 (define %options
  94   ;; Specification of the command-line options.
  95   (list (option '(#\h "help") #f #f
  96                 (lambda args
  97                   (show-help)
  98                   (exit 0)))
  99         (option '(#\V "version") #f #f
 100                 (lambda args
 101                   (show-version-and-exit "guix-import")))))
 102
 103 \f
 104 ;;;
 105 ;;; Entry point.
 106 ;;;
 107
 108 (define (guix-import . args)
 109   (define (parse-options)
 110     ;; Return the alist of option values.
 111     (args-fold args %options
 112                (lambda (opt name arg result)
 113                  (leave (_ "~A: unrecognized option~%") name))
 114                (lambda (arg result)
 115                  (alist-cons 'argument arg result))
 116                %default-options))
 117
 118   (setlocale LC_ALL "")
 119   (textdomain "guix")
 120   (setvbuf (current-output-port) _IOLBF)
 121   (setvbuf (current-error-port) _IOLBF)
 122
 123   (let* ((opts (parse-options))
 124          (args (filter-map (match-lambda
 125                             (('argument . value)
 126                              value)
 127                             (_ #f))
 128                            (reverse opts))))
 129     (match args
 130       ((nixpkgs attribute)
 131        (let-values (((expr loc)
 132                      (nixpkgs->guix-package nixpkgs attribute)))
 133          (format #t ";; converted from ~a:~a~%~%"
 134                  (location-file loc) (location-line loc))
 135          (pretty-print expr (newline-rewriting-port (current-output-port)))))
 136       (_
 137        (leave (_ "wrong number of arguments~%"))))))