From 2db419232a42032571034f6bb26e0c797f135ac5 Mon Sep 17 00:00:00 2001
From: Hilton Chain <hako@ultrarare.space>
Date: Fri, 13 Feb 2026 15:23:22 +0800
Subject: [PATCH] =?UTF-8?q?utils:=20Add=20=E2=80=98mapping-for-system?=
 =?UTF-8?q?=E2=80=99=20and=20=E2=80=98binary-package=E2=80=99.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* modules/rosenthal/utils/packages.scm (system-mapping, binary-package): New
procedures.
---
 modules/rosenthal/utils/packages.scm | 32 +++++++++++++++++++++++++++-
 1 file changed, 31 insertions(+), 1 deletion(-)

diff --git a/modules/rosenthal/utils/packages.scm b/modules/rosenthal/utils/packages.scm
index 402e3d4..042754a 100644
--- a/modules/rosenthal/utils/packages.scm
+++ b/modules/rosenthal/utils/packages.scm
@@ -11,10 +11,13 @@
   #:use-module (guix deprecation)
   #:use-module (guix diagnostics)
   #:use-module (guix discovery)
+  #:use-module (guix gexp)
   #:use-module (guix i18n)
   #:use-module (guix memoization)
   #:use-module (guix packages)
+  #:use-module (guix platform)
   #:use-module (guix ui)
+  #:use-module (guix utils)
   ;; Guix packages
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
@@ -32,7 +35,9 @@
             specs->pkgs
             specs->pkgs+out
 
-            %binary-source))
+            %binary-source
+            binary-package
+            mapping-for-system))
 
 (define %rosenthal-root-directory
   ;; This is like %distro-root-directory from (gnu packages), with adjusted
@@ -150,3 +155,28 @@ packages, excluding superseded packages."
      (synopsis "Binary package source (internal use)")
      (description "")
      (license #f))))
+
+(define* (mapping-for-system mapping #:optional (default-system "x86_64-linux"))
+  (let ((system
+         (or (and=> (%current-target-system) platform-target->system)
+             (%current-system))))
+    (or (assoc-ref mapping system)
+        (assoc-ref mapping default-system))))
+
+(define* (binary-package source-mapping p #:optional (default-system "x86_64-linux"))
+  (package
+    (inherit p)
+    (version (package-version (assoc-ref source-mapping default-system)))
+    (source #f)
+    (arguments
+     (substitute-keyword-arguments (package-arguments p)
+       ((#:phases phases #~%standard-phases)
+        #~(modify-phases #$phases
+            (replace 'unpack
+              (lambda _
+                ((assoc-ref %standard-phases 'unpack)
+                 #:source
+                 #+(package-source (mapping-for-system source-mapping)))))))))
+    (properties
+     (cons '(disable-updater? . #t)
+           (package-properties p)))))