From: Amélia P. H. Coutard <amy@ameliathe1st.gay>
Date: Wed, 24 Apr 2024 20:51:14 +0000 (+0200)
Subject: replace-store-files bien plus utilisable, et probablement un peu plus rapide
X-Git-Url: https://git.ameliathe1st.gay/?a=commitdiff_plain;h=2ce57d538b3a6261f9461d857e2dcbfae5f088a6;p=canal-guix.git

replace-store-files bien plus utilisable, et probablement un peu plus rapide
---

diff --git a/amyx/home.scm b/amyx/home.scm
index f4eec34..1e0d6c7 100644
--- a/amyx/home.scm
+++ b/amyx/home.scm
@@ -18,31 +18,22 @@
   #:use-module (srfi srfi-1)
   #:export (replace-store-files))
 
-(define (find-file-in-packages f packages)
-  (let ((l (filter-map (lambda (p)
-                         (and (stat (string-append p "/" f) #f)
-                              (string-append p "/" f))) packages)))
-    (cond
-      ((= (length l) 0)
-       (raise-exception (make-exception (make-error)
-                                        (make-exception-with-message (string-append
-                                                                      "File found in no packages: "
-                                                                      f)))))
-      ((= (length l) 1)
-       (car l))
-      (else (raise-exception (make-exception (make-error)
-                                             (make-exception-with-message (string-append
-                                                                           "File found in multiple packages: "
-                                                                           f))))))))
+(define store-path-regexp
+  (make-regexp "#\\$([^/]*)/"))
 
-(define (replace-store-files file packages)
-  (regexp-substitute/global #f
-                            "#\\$([^ \n\t]*)"
-                            (call-with-input-file file
-                              get-string-all)
-                            'pre
-                            (lambda (m)
-                              (find-file-in-packages (match:substring m 1)
-                                                     packages))
-                            'post))
+(define (regexp-map-list regexp str f)
+  (let ((m (regexp-exec regexp str)))
+    (if m
+        `(,(match:prefix m) ,@(f m)
+          ,@(regexp-map-list regexp
+                             (match:suffix m) f))
+        `(,str))))
 
+(define-macro (replace-store-files file)
+              `(list ,@(regexp-map-list store-path-regexp
+                                          (call-with-input-file file
+                                            get-string-all)
+                                          (lambda (m)
+                                            `(,(string->symbol (match:substring
+                                                                  m 1))
+                                              "/")))))