diff options
| author | Arun Isaac | 2022-07-05 10:36:13 +0530 |
|---|---|---|
| committer | Arun Isaac | 2022-07-05 10:36:13 +0530 |
| commit | da1a10cc577699e69b6de99c7373b59d9ba726d0 (patch) | |
| tree | 03787d1d6f52a12d918faf2f83e6cb029cbae317 | |
| parent | 80acb7203d05607bd3601b5b0931c977f2687ffd (diff) | |
| download | tissue-da1a10cc577699e69b6de99c7373b59d9ba726d0.tar.gz tissue-da1a10cc577699e69b6de99c7373b59d9ba726d0.tar.lz tissue-da1a10cc577699e69b6de99c7373b59d9ba726d0.zip | |
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.
| -rwxr-xr-x | bin/tissue | 10 | ||||
| -rw-r--r-- | tissue/git.scm | 8 |
2 files changed, 12 insertions, 6 deletions
@@ -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)) |