[bug#68935] [PATCH v2 4/6] utils: Add find-expression procedure.

[Herman Rimm via Guix-patches via <guix-patches@gnu.org>]

* 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)))
+
 \f
 ;;;
 ;;; 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