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.
---
 tissue/git.scm | 8 ++++++++
 1 file changed, 8 insertions(+)

(limited to 'tissue')

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