From 4b85db10b1b45c6ef7b41b9c338eddf87e12b373 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Thu, 16 May 2024 16:06:03 +0100
Subject: [PATCH] guix: packages: Add new &package-unsupported-target-error.

Some packages don't support cross building to specific targets, so add a error
type to signal this.

* guix/packages.scm (&package-unsupported-target-error): New condition type.
[package-unsupported-target-error? package-unsupported-target-error-target):
New procedures.
* guix/ui.scm (call-with-error-handling): Handle this new condition type.

Change-Id: Ib47813399e04b20d616a95f545b6aabe25736e92
---
 guix/packages.scm | 7 +++++++
 guix/ui.scm       | 7 +++++++
 2 files changed, 14 insertions(+)

diff --git a/guix/packages.scm b/guix/packages.scm
index f3a9a617852..e793714f2ed 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -173,6 +173,9 @@
             package-error-invalid-input
             &package-cross-build-system-error
             package-cross-build-system-error?
+            &package-unsupported-target-error
+            package-unsupported-target-error?
+            package-unsupported-target-error-target
 
             package->bag
             bag->derivation
@@ -850,6 +853,10 @@ exist, return #f instead."
 (define-condition-type &package-cross-build-system-error &package-error
   package-cross-build-system-error?)
 
+(define-condition-type &package-unsupported-target-error &package-error
+  package-unsupported-target-error?
+  (target package-unsupported-target-error-target))
+
 (define* (package-full-name package #:optional (delimiter "@"))
   "Return the full name of PACKAGE--i.e., `NAME@VERSION'.  By specifying
 DELIMITER (a string), you can customize what will appear between the name and
diff --git a/guix/ui.scm b/guix/ui.scm
index d82fa533cc3..0bb1b3b3bac 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -756,6 +756,13 @@ evaluating the tests and bodies of CLAUSES."
                        (location->string loc)
                        (package-full-name package)
                        (build-system-name system))))
+             ((package-unsupported-target-error? c)
+              (let* ((package (package-error-package c))
+                     (loc     (package-location package)))
+                (leave (G_ "~a: ~a: does not support target `~a'~%")
+                       (location->string loc)
+                       (package-full-name package)
+                       (package-unsupported-target-error-target c))))
              ((gexp-input-error? c)
               (let ((input (gexp-error-invalid-input c)))
                 (leave (G_ "~s: invalid G-expression input~%")