nonguix: Add with-transformation.

* nonguix/utils.scm (with-transformation): New procedure.

Signed-off-by: Hilton Chain <hako@ultrarare.space>
This commit is contained in:
Sergio Pastor Pérez 2025-01-18 21:45:21 +01:00 committed by Hilton Chain
parent a11ff2a65a
commit c29a9af656
No known key found for this signature in database
GPG Key ID: ACC66D09CA528292

View File

@ -4,11 +4,14 @@
(define-module (nonguix utils)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-43)
#:use-module (ice-9 match)
#:use-module (ice-9 textual-ports)
#:use-module (ice-9 popen)
#:use-module (guix utils)
#:use-module (guix packages))
#:use-module (guix packages)
#:use-module (gnu services)
#:export (with-transformation))
(define-public (to32 package64)
"Build package for i686-linux.
@ -22,3 +25,45 @@ Only x86_64-linux and i686-linux are supported.
(arguments `(#:system "i686-linux"
,@(package-arguments package64)))))
(_ package64)))
;; For concerns and direction of improvement, see this thread:
;; https://lists.gnu.org/archive/html/guix-devel/2024-06/msg00275.html
(define* (with-transformation proc obj #:optional (pred package?))
"Recursing into child elements, apply PROC to every element of OBJ that
matches PRED."
(match obj
((? pred)
(proc obj))
((? procedure?)
(lambda args
(apply values
(map (cut with-transformation proc <> pred)
(call-with-values
(lambda ()
(apply obj args))
list)))))
((a . b)
(cons (with-transformation proc a pred)
(with-transformation proc b pred)))
((_ ...)
(map (cut with-transformation proc <> pred)
obj))
(#(_ ...)
(vector-map (lambda (vec elt)
(with-transformation proc elt pred))
obj))
;; `<service-type>' and `<origin>' record types are expected to not be
;; modified. Altering them causes very difficult to debug run-time errors.
((or (? service-type?)
(? origin?))
obj)
((? record?)
(let* ((record-type (record-type-descriptor obj))
(record-fields (record-type-fields record-type)))
(apply (record-constructor record-type)
(map (lambda (field)
(let* ((accessor (record-accessor record-type field))
(obj (accessor obj)))
(with-transformation proc obj pred)))
record-fields))))
(_ obj)))