Subject: [bug#48999] [PATCH v2 3/3] scripts: import: hackage: Add option to import package from local filesystem.

From: Xinglu Chen <[email-masked]>
Date: Sun, 04 Jul 2021 13:54:20 +0200

This adds a ‘--path’ option for importing a Haskell package from the local
filesystem

* guix/scripts/import/hackage.scm (show-help, %options): Add ‘-p’ and ‘--path’
options.
(guix-import-hackage): Set the #:port and #:source keywords when the ‘--path’
option is used.
---
 guix/scripts/import/hackage.scm | 43 +++++++++++++++++++++++++++------
 1 file changed, 35 insertions(+), 8 deletions(-)

diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm
index 906dca24b1..8728791b52 100644
--- a/guix/scripts/import/hackage.scm
+++ b/guix/scripts/import/hackage.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <[email-masked]>
 ;;; Copyright © 2018 Ricardo Wurmus <[email-masked]>
+;;; Copyright © 2021 Xinglu Chen <[email-masked]>
 ;;;
 ;;; 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))))
-- 
2.32.0