From d1d857ea0ca76f1a917382777f57871e50026df3 Mon Sep 17 00:00:00 2001
Message-Id: <d1d857ea0ca76f1a917382777f57871e50026df3.1637548566.git.julien@lepiller.eu>
From: Julien Lepiller <julien@lepiller.eu>
Date: Mon, 22 Nov 2021 02:54:06 +0100
Subject: [PATCH 1/2] guix: ui: Print syntax errors.

* guix/ui.scm (display-syntax): New procedure.
(call-with-error-handling, report-load-error): Print syntax errors.
---
 guix/ui.scm | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

diff --git a/guix/ui.scm b/guix/ui.scm
index bd999103ff..79aab2db84 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -69,9 +69,11 @@ (define-module (guix ui)
   #:use-module (srfi srfi-31)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (ice-9 exceptions)
   #:autoload   (ice-9 ftw)  (scandir)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 pretty-print)
   #:use-module (ice-9 regex)
   #:autoload   (ice-9 popen) (open-pipe* close-pipe)
   #:autoload   (system repl repl)  (start-repl)
@@ -315,6 +317,19 @@ (define* (display-hint message #:optional (port (current-error-port)))
      (texi->plain-text message))
    port))
 
+(define %syntax-color (color BOLD GREEN))
+
+(define* (display-syntax form #:optional (port (current-error-port)))
+  "Display FORM, an sexp, to PORT"
+  (define colorize
+    (if (color-output? port)
+        (lambda (str)
+          (colorize-string str %syntax-color))
+        identity))
+
+  (display (colorize (G_ "in form: ")) port)
+  (pretty-print form port))
+
 (define* (report-unbound-variable-error args #:key frame)
   "Return the given unbound-variable error, where ARGS is the list of 'throw'
 arguments."
@@ -398,6 +413,9 @@ (define* (report-load-error file args #:optional frame)
                    (formatted-message-arguments obj)))
            (else
             (report-error (G_ "exception thrown: ~s~%") obj)))
+     (when (syntax-error? obj)
+       (let ((form (or (syntax-error-subform obj) (syntax-error-form obj))))
+         (display-syntax form)))
      (when (fix-hint? obj)
        (display-hint (condition-fix-hint obj))))
     ((key args ...)
@@ -801,6 +819,9 @@ (define (call-with-error-handling thunk)
                      (and (error-location? c) (error-location c))
                      (gettext (formatted-message-string c) %gettext-domain)
                      (formatted-message-arguments c))
+              (when (syntax-error? c)
+                (let ((form (or (syntax-error-subform c) (syntax-error-form c))))
+                  (display-syntax form)))
               (when (fix-hint? c)
                 (display-hint (condition-fix-hint c)))
               (exit 1))
@@ -826,6 +847,9 @@ (define (call-with-error-handling thunk)
               (report-error (and (error-location? c) (error-location c))
                             (G_ "~a~%")
                             (gettext (condition-message c) %gettext-domain))
+              (when (syntax-error? c)
+                (let ((form (or (syntax-error-subform c) (syntax-error-form c))))
+                  (display-syntax form)))
               (when (fix-hint? c)
                 (display-hint (condition-fix-hint c)))
               (exit 1)))
-- 
2.33.1