[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#68935] [PATCH v2 4/6] utils: Add find-expression procedure.
From: |
Herman Rimm |
Subject: |
[bug#68935] [PATCH v2 4/6] utils: Add find-expression procedure. |
Date: |
Fri, 9 Feb 2024 20:25:16 +0100 |
* guix/utils.scm (find-expression): Add and export procedure.
* tests/utils.scm ("find-expression"): Add test.
Change-Id: Ie209df39c1f006b20aa6436fb1aef4c84b1694ee
---
guix/utils.scm | 24 ++++++++++++++++++++++++
tests/utils.scm | 16 ++++++++++++++++
2 files changed, 40 insertions(+)
diff --git a/guix/utils.scm b/guix/utils.scm
index 8f0bc2399e..315feeb232 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -148,6 +148,7 @@ (define-module (guix utils)
edit-expression
delete-expression
insert-expression
+ find-expression
filtered-port
decompressed-port
@@ -513,6 +514,29 @@ (define (insert-expression source-properties expr)
(string-append expr "\n\n" str))))
(edit-expression source-properties insert)))
+(define (find-expression file expr proc)
+ "Search in FILE for a top-level expression which alphabetically
+succeeds EXPR. Call PROC with the location if found, or with #f
+otherwise."
+ (let* ((name (match expr
+ (('define-public symbol _ ...)
+ (symbol->string symbol))))
+ (source-properties
+ (call-with-input-file
+ file
+ (lambda (port)
+ (do ((syntax (read-syntax port)
+ (read-syntax port)))
+ ((match (syntax->datum syntax)
+ (('define-public symbol _ ...)
+ (string> (symbol->string symbol)
+ name))
+ ((? eof-object?) #t)
+ (_ #f))
+ (if (eof-object? syntax)
+ #f (syntax-source syntax))))))))
+ (proc source-properties)))
+
;;;
;;; Keyword arguments.
diff --git a/tests/utils.scm b/tests/utils.scm
index cd54112846..feaed4b561 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -288,6 +288,22 @@ (define-public package-2\n 'package)\n"
`(define-public package-1 'package))
(call-with-input-file temp-file get-string-all)))
+(test-equal "find-expression"
+ (list `((filename . ,temp-file) (line . 0) (column . 0))
+ `((filename . ,temp-file) (line . 5) (column . 0))
+ #f)
+ (begin
+ (call-with-output-file temp-file
+ (lambda (port)
+ (display "(define-public package-1\n 'foo)\n\n" port)
+ (display "(define foo 'bar)\n\n" port)
+ (display "(define-public package-2\n 'baz)\n" port)))
+ (map (lambda (expr)
+ (find-expression temp-file expr identity))
+ (list `(define-public package 'foo)
+ `(define-public package-1 'bar)
+ `(define-public package-2 'baz)))))
+
(test-equal "string-distance"
'(0 1 1 5 5)
(list
--
2.41.0
- [bug#68935] [PATCH 0/3] Add 'put' option to guix import., Herman Rimm, 2024/02/05
- [bug#68935] [PATCH 1/3] svn-fetch: Require svn-command argument., Herman Rimm, 2024/02/05
- [bug#68935] [PATCH 2/3] guix: import: Wrap package expressions with define-public., Herman Rimm, 2024/02/05
- [bug#68935] [PATCH 3/3] guix: import: Put packages into modules in alphabetical order., Herman Rimm, 2024/02/05
- [bug#68935] [PATCH v2 1/6] doc: Note SVN dependency of texlive importer., Herman Rimm, 2024/02/09
- [bug#68935] [PATCH v3 0/7] Add insert option to guix import., Herman Rimm, 2024/02/20