@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,6 +23,7 @@
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix scripts)
+ #:use-module (guix import utils)
#:use-module (guix import hackage)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)
@@ -29,6 +31,7 @@
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
+ #:use-module (rnrs io ports)
#:export (guix-import-hackage))
@@ -62,6 +65,8 @@ version.\n"))
(display (G_ "
-s, --stdin read from standard input"))
(display (G_ "
+ -p, --path=DIR use local directory as source"))
+ (display (G_ "
-t, --no-test-dependencies don't include test-only dependencies"))
(display (G_ "
-V, --version display version information and exit"))
@@ -87,6 +92,11 @@ version.\n"))
(alist-cons 'read-from-stdin? #t
(alist-delete 'read-from-stdin?
result))))
+ (option '(#\p "path") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'read-path arg
+ (alist-delete 'read-path
+ result))))
(option '(#\e "cabal-environment") #t #f
(lambda (opt name arg result)
(alist-cons 'cabal-environment (read/eval arg)
@@ -113,22 +123,39 @@ version.\n"))
%default-options))
(define (run-importer package-name opts error-fn)
- (let* ((arguments (list
+ (let* ((local-directory (assoc-ref opts 'read-path))
+ (arguments (list
package-name
#:include-test-dependencies?
(assoc-ref opts 'include-test-dependencies?)
- #:port (if (assoc-ref opts 'read-from-stdin?)
- (current-input-port)
- #f)
+ #:port
+ (cond
+ ((assoc-ref opts 'read-from-stdin?)
+ (current-input-port))
+ (local-directory
+ (open-file-input-port
+ (string-append local-directory
+ "/" package-name ".cabal")))
+ (else #f))
+ #:source
+ `(local-file ,local-directory
+ ,package-name
+ #:recursive? #t
+ #:select? ,(cond
+ ((git-repository? local-directory)
+ 'git-predicate)
+ ((hg-repository? local-directory)
+ 'hg-predicate)
+ (else '(const #t))))
#:cabal-environment
(assoc-ref opts 'cabal-environment)))
(sexp (if (assoc-ref opts 'recursive)
;; Recursive import
(map (match-lambda
- ((and ('package ('name name) . rest) pkg)
- `(define-public ,(string->symbol name)
- ,pkg))
- (_ #f))
+ ((and ('package ('name name) . rest) pkg)
+ `(define-public ,(string->symbol name)
+ ,pkg))
+ (_ #f))
(apply hackage-recursive-import arguments))
;; Single import
(apply hackage->guix-package arguments))))