From 702c61f21a42d1f67e576f4100f61ca5f597e4df Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 5 Jul 2022 10:37:16 +0530
Subject: bin: Guard main function against all git errors.

* bin/tissue (main): Guard against git errors printing the error
message instead of a backtrace.
---
 bin/tissue | 85 +++++++++++++++++++++++++++++++++-----------------------------
 1 file changed, 45 insertions(+), 40 deletions(-)

(limited to 'bin')

diff --git a/bin/tissue b/bin/tissue
index 946a240..d7736c2 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -463,45 +463,50 @@ Pull latest from upstream repositories.
                               (assq-ref parameters 'upstream-repository)))))
                    (assq-ref args 'hosts)))))))
 
-(define main
-  (match-lambda*
-    ((_ (or "-h" "--help"))
-     (print-usage))
-    ((_ "pull" args ...)
-     (apply tissue-pull args))
-    ((_ "run-web" args ...)
-     (apply tissue-run-web args))
-    ((_ command args ...)
-     (call-with-current-directory (git-top-level)
-       (lambda ()
-         (let ((config (load-config)))
-           (parameterize ((%aliases (tissue-configuration-aliases config)))
-             ;; Create hidden tissue directory unless it exists.
-             (unless (file-exists? %state-directory)
-               (mkdir %state-directory))
-             ;; Ensure index exists, rebuilding it if it is stale.
-             (let ((current-head
-                    (oid->string (reference-name->oid (current-git-repository) "HEAD"))))
-               (unless (and (file-exists? db-path)
-                            (string=? (call-with-database db-path
-                                        (cut Database-get-metadata <> "commit"))
-                                      current-head))
-                 (index %xapian-index)))
-             ;; Handle sub-command.
-             (apply (match command
-                      ("search" tissue-search)
-                      ("show" tissue-show)
-                      ("repl" tissue-repl)
-                      ("web" tissue-web)
-                      ("index" tissue-index)
-                      (invalid-command
-                       (format (current-error-port) "Invalid command `~a'~%~%"
-                               invalid-command)
-                       (print-usage)
-                       (exit #f)))
-                    args))))))
-    ;; tissue is an alias for `tissue search'
-    ((_)
-     (main "tissue" "search"))))
+(define (main . args)
+  (guard (c ((condition-git-error c)
+             => (lambda (git-error)
+                  (display (git-error-message git-error) (current-error-port))
+                  (newline (current-error-port))
+                  (exit #f))))
+    (match args
+      ((_ (or "-h" "--help"))
+       (print-usage))
+      ((_ "pull" args ...)
+       (apply tissue-pull args))
+      ((_ "run-web" args ...)
+       (apply tissue-run-web args))
+      ((_ command args ...)
+       (call-with-current-directory (git-top-level)
+         (lambda ()
+           (let ((config (load-config)))
+             (parameterize ((%aliases (tissue-configuration-aliases config)))
+               ;; Create hidden tissue directory unless it exists.
+               (unless (file-exists? %state-directory)
+                 (mkdir %state-directory))
+               ;; Ensure index exists, rebuilding it if it is stale.
+               (let ((current-head
+                      (oid->string (reference-name->oid (current-git-repository) "HEAD"))))
+                 (unless (and (file-exists? db-path)
+                              (string=? (call-with-database db-path
+                                          (cut Database-get-metadata <> "commit"))
+                                        current-head))
+                   (index %xapian-index)))
+               ;; Handle sub-command.
+               (apply (match command
+                        ("search" tissue-search)
+                        ("show" tissue-show)
+                        ("repl" tissue-repl)
+                        ("web" tissue-web)
+                        ("index" tissue-index)
+                        (invalid-command
+                         (format (current-error-port) "Invalid command `~a'~%~%"
+                                 invalid-command)
+                         (print-usage)
+                         (exit #f)))
+                      args))))))
+      ;; tissue is an alias for `tissue search'
+      ((_)
+       (main "tissue" "search")))))
 
 (apply main (command-line))
-- 
cgit v1.2.3