diff options
| -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)) |