GNU bug report logs -
#77093
[PATCH rust-team 00/18] New Rust packaging workflow based on lockfile importer.
Previous Next
Full log
Message #140 received at 77093 <at> debbugs.gnu.org (full text, mbox):
* guix/utils.scm (find-definition-location): New procedure.
(find-definition-insertion-location): Define with it.
* guix/scripts/import.scm (import-as-definitions, guix-import): Support
expressions defined by 'define.
Change-Id: I03118e1a3372028b4f0530964aba871b4a1a4d25
---
guix/scripts/import.scm | 19 ++++++++++++++-----
guix/utils.scm | 27 +++++++++++++++++++--------
2 files changed, 33 insertions(+), 13 deletions(-)
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 58a84d0db7..e53028e747 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -30,6 +30,7 @@ (define-module (guix scripts import)
#:use-module (guix read-print)
#:use-module (guix utils)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (%standard-import-options
@@ -83,7 +84,8 @@ (define (import-as-definitions importer args proc)
((and expr (or ('package _ ...)
('let _ ...)))
(proc (package->definition expr)))
- ((and expr ('define-public _ ...))
+ ((and expr (or ('define-public _ ...)
+ ('define _ ...)))
(proc expr))
((expressions ...)
(for-each (lambda (expr)
@@ -91,7 +93,8 @@ (define (import-as-definitions importer args proc)
((and expr (or ('package _ ...)
('let _ ...)))
(proc (package->definition expr)))
- ((and expr ('define-public _ ...))
+ ((and expr (or ('define-public _ ...)
+ ('define _ ...)))
(proc expr))))
expressions))
(x
@@ -117,13 +120,19 @@ (define-command (guix-import . args)
(show-version-and-exit "guix import"))
((or ("-i" file importer args ...)
("--insert" file importer args ...))
- (let ((find-and-insert
+ (let* ((importer-definers
+ `(,@(if (member importer '("crate"))
+ '(define)
+ '())
+ define-public))
+ (definer? (cut member <> importer-definers))
+ (find-and-insert
(lambda (expr)
(match expr
- (('define-public term _ ...)
+ (((? definer? definer) term _ ...)
(let ((source-properties
(find-definition-insertion-location
- file term)))
+ file term #:definer definer)))
(if source-properties
(insert-expression source-properties expr)
(let ((port (open-file file "a")))
diff --git a/guix/utils.scm b/guix/utils.scm
index c7c23d9d5b..77ec6d992a 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -154,6 +154,7 @@ (define-module (guix utils)
edit-expression
delete-expression
insert-expression
+ find-definition-location
find-definition-insertion-location
filtered-port
@@ -520,24 +521,34 @@ (define (insert-expression source-properties expr)
(string-append expr "\n\n" str))))
(edit-expression source-properties insert)))
-(define (find-definition-insertion-location file term)
- "Search in FILE for a top-level public definition whose defined term
-alphabetically succeeds TERM. Return the location if found, or #f
-otherwise."
- (let ((search-term (symbol->string term)))
+(define* (find-definition-location file term
+ #:key (definer 'define-public)
+ (pred string=))
+ "Search in FILE for a top-level definition defined by DEFINER with defined
+term comparing to TERM through PRED. Return the location if PRED returns #t,
+or #f otherwise."
+ (let ((search-term (symbol->string term))
+ (definer? (cut eq? definer <>)))
(call-with-input-file file
(lambda (port)
(do ((syntax (read-syntax port)
(read-syntax port)))
((match (syntax->datum syntax)
- (('define-public current-term _ ...)
- (string> (symbol->string current-term)
- search-term))
+ (((? definer?) current-term _ ...)
+ (pred (symbol->string current-term)
+ search-term))
((? eof-object?) #t)
(_ #f))
(and (not (eof-object? syntax))
(syntax-source syntax))))))))
+(define* (find-definition-insertion-location file term
+ #:key (definer 'define-public))
+ "Search in FILE for a top-level definition defined by DEFINER with defined
+term alphabetically succeeds TERM. Return the location if found, or #f
+otherwise."
+ (find-definition-location file term #:definer definer #:pred string>))
+
;;;
;;; Keyword arguments.
--
2.48.1
This bug report was last modified 13 days ago.
Previous Next
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.