diff mbox series

[bug#68935,v2,3/6] utils: Add insert-expression procedure.

Message ID 69ff85b93e8a7f9095412429c213a2e10e9b0e6d.1707505804.git.herman@rimm.ee
State New
Headers show
Series [bug#68935,v2,1/6] doc: Note SVN dependency of texlive importer. | expand

Commit Message

Herman Rimm Feb. 9, 2024, 7:25 p.m. UTC 
* guix/utils.scm (define-module): Use (guix read-print) and export
(insert-expression).
(insert-expression): Add procedure.
* tests/utils.scm ("insert-expression"): Add test.

Change-Id: I971a43a78aa6ecaaef33c1a7a0db4b287eb85036
---
 guix/utils.scm  | 11 +++++++++++
 tests/utils.scm | 14 ++++++++++++++
 2 files changed, 25 insertions(+)

Comments

Ludovic Courtès Feb. 19, 2024, 9:31 p.m. UTC | #1 
Herman Rimm <herman@rimm.ee> skribis:

> * guix/utils.scm (define-module): Use (guix read-print) and export
> (insert-expression).
> (insert-expression): Add procedure.
> * tests/utils.scm ("insert-expression"): Add test.
>
> Change-Id: I971a43a78aa6ecaaef33c1a7a0db4b287eb85036

Nice!
diff mbox series

Patch

diff --git a/guix/utils.scm b/guix/utils.scm
index e4e9d922e7..8f0bc2399e 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -20,6 +20,7 @@ 
 ;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2023 Zheng Junjie <873216071@qq.com>
 ;;; Copyright © 2023 Foundation Devices, Inc. <hello@foundationdevices.com>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,6 +39,7 @@ 
 
 (define-module (guix utils)
   #:use-module (guix config)
+  #:use-module (guix read-print)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -145,6 +147,7 @@  (define-module (guix utils)
             go-to-location
             edit-expression
             delete-expression
+            insert-expression
 
             filtered-port
             decompressed-port
@@ -502,6 +505,14 @@  (define (delete-expression source-properties)
   "Delete the expression specified by SOURCE-PROPERTIES."
   (edit-expression source-properties (const "") #:include-trailing-newline? #t))
 
+(define (insert-expression source-properties expr)
+  "Insert EXPR before the top-level expression specified by
+SOURCE-PROPERTIES."
+  (let* ((expr (object->string* expr 0))
+         (insert (lambda (str)
+                   (string-append expr "\n\n" str))))
+    (edit-expression source-properties insert)))
+
 
 ;;;
 ;;; Keyword arguments.
diff --git a/tests/utils.scm b/tests/utils.scm
index 5664165c85..cd54112846 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -5,6 +5,7 @@ 
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2023 Foundation Devices, Inc. <hello@foundationdevices.com>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -274,6 +275,19 @@  (define (test-compression/decompression method run?)
                      string-reverse)
     (call-with-input-file temp-file get-string-all)))
 
+(test-equal "insert-expression"
+  "(define-public package-1\n  'package)\n
+(define-public package-2\n  'package)\n"
+  (begin
+    (call-with-output-file temp-file
+      (lambda (port)
+        (display "(define-public package-2\n  'package)\n" port)))
+    (insert-expression `((filename . ,temp-file)
+                         (line     . 0)
+                         (column   . 0))
+                       `(define-public package-1 'package))
+    (call-with-input-file temp-file get-string-all)))
+
 (test-equal "string-distance"
   '(0 1 1 5 5)
   (list