From da1a10cc577699e69b6de99c7373b59d9ba726d0 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 5 Jul 2022 10:36:13 +0530
Subject: git: Add condition-git-error utility.

* tissue/git.scm: Import (rnrs conditions) and (srfi srfi-1).
(condition-git-error): New public function.
* bin/tissue (default-configuration): Use condition-git-error.
---
 bin/tissue     | 10 ++++------
 tissue/git.scm |  8 ++++++++
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/bin/tissue b/bin/tissue
index 1dab955..946a240 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -222,12 +222,10 @@ Export the repository as a website to OUTPUT-DIRECTORY.
     (state-directory . "/var/lib/tissue")
     ;; Assume current repository as default. If there is no current
     ;; repository, do not configure any hosts.
-    (hosts . ,(guard (c ((and (irritants-condition? c)
-                              (match (condition-irritants c)
-                                ((git-error _ ...)
-                                 (= (git-error-code git-error)
-                                    GIT_ENOTFOUND))
-                                (_ #f)))
+    (hosts . ,(guard (c ((let ((git-error (condition-git-error c)))
+                           (and git-error
+                                (= (git-error-code git-error)
+                                   GIT_ENOTFOUND)))
                          '()))
                 `(("localhost"
                    (upstream-repository . ,(git-top-level))))))))
diff --git a/tissue/git.scm b/tissue/git.scm
index 7f61785..024ebb6 100644
--- a/tissue/git.scm
+++ b/tissue/git.scm
@@ -18,8 +18,10 @@
 
 (define-module (tissue git)
   #:use-module (rnrs arithmetic bitwise)
+  #:use-module (rnrs conditions)
   #:use-module (rnrs hashtables)
   #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
@@ -35,6 +37,7 @@
   #:use-module (tissue utils)
   #:export (reference-set-target!
             reference-symbolic-target
+            condition-git-error
             git-top-level
             %current-git-repository
             current-git-repository
@@ -71,6 +74,11 @@
       (pointer->string
        (proc (reference->pointer reference))))))
 
+(define (condition-git-error condition)
+  "Return <git-error> object from CONDITION. If none, return #f."
+  (and (irritants-condition? condition)
+       (find git-error? (condition-irritants condition))))
+
 (define %current-git-repository
   (make-parameter #f))
 
-- 
cgit v1.2.3