From e4e37d22148f7c5c5bbf9718fd5e9886fbcf1aca Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Wed, 12 Aug 2026 16:50:57 +0200 Subject: [PATCH] exit code checking added --- info.rkt | 5 +++-- main.rkt | 43 +++++++++++++++++++++------------------- private/git-commands.rkt | 10 ++++++---- private/git-provider.rkt | 9 ++++----- 4 files changed, 36 insertions(+), 31 deletions(-) diff --git a/info.rkt b/info.rkt index c4d29fe..2af6405 100644 --- a/info.rkt +++ b/info.rkt @@ -2,13 +2,14 @@ (define collection "git-cli") (define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command") -(define version "0.3.5") +(define version "0.3.6") (define pkg-authors '("Hans Dijkema")) (define license 'MIT) (define deps '("base" - ("simple-ini") + "simple-ini" + "simple-log" "racket-index" "scribble-lib" "racket-makefile" diff --git a/main.rkt b/main.rkt index 3fb8bab..ea2e4a0 100644 --- a/main.rkt +++ b/main.rkt @@ -57,26 +57,29 @@ (λ (args) (if (has-git-arg? args '-s) args (cons '-s args))) - (λ (cmd result output out) - (if result - (map (λ (line) - (let* ((state (string->symbol (string-trim (substring line 0 2)))) - (file (string-trim (substring line 3)))) - (cond - ([eq? state '??] (list 'new file)) - ([eq? state 'M] (list 'modified file)) - ([eq? state 'A] (list 'added file)) - ([eq? state 'D] (list 'deleted file)) - ([eq? state 'AM] (list 'modified file)) - ([eq? state 'AD] (list 'deleted file)) - ([eq? state 'MM] (list 'modified file)) - ([eq? state 'MD] (list 'deleted file)) - (else - (git-error 'status "Unexpected state" state)) - ) - )) - out) - (git-error 'status "Error" output))) + (λ (cmd exit-code result output out) + (if (= exit-code 0) + (if result + (map (λ (line) + (let* ((state (string->symbol (string-trim (substring line 0 2)))) + (file (string-trim (substring line 3)))) + (cond + ([eq? state '??] (list 'new file)) + ([eq? state 'M] (list 'modified file)) + ([eq? state 'A] (list 'added file)) + ([eq? state 'D] (list 'deleted file)) + ([eq? state 'AM] (list 'modified file)) + ([eq? state 'AD] (list 'deleted file)) + ([eq? state 'MM] (list 'modified file)) + ([eq? state 'MD] (list 'deleted file)) + (else + (git-error 'status "Unexpected state" state)) + ) + )) + out) + (git-error 'status "Error" output)) + (git-error 'status "Exitcode <> 0" (cons (format "~a\n" exit-code) output)) + )) ) diff --git a/private/git-commands.rkt b/private/git-commands.rkt index e79dd0e..63a5f86 100644 --- a/private/git-commands.rkt +++ b/private/git-commands.rkt @@ -49,10 +49,12 @@ args) -(define (std-process-git-result cmd result output out) +(define (std-process-git-result cmd exit-code result output out) (git-displ out) (if result - result + (if (= exit-code 0) + #t + #f) (git-error cmd "Error" out))) (define-syntax def-git-cmd-proxy @@ -64,9 +66,9 @@ ((_ f cmd pre-code process-result) (define (f args) (let ((nargs (pre-code args))) - (let ((output (run-git (cons cmd nargs)))) + (let-values (((exit-code output) (run-git (cons cmd nargs)))) (let-values (((result out) (git-out cmd output))) - (process-result cmd result output out)))))) + (process-result cmd exit-code result output out)))))) ) ) diff --git a/private/git-provider.rkt b/private/git-provider.rkt index 5cfaf76..a7ef28a 100644 --- a/private/git-provider.rkt +++ b/private/git-provider.rkt @@ -72,9 +72,7 @@ (set! cached-git-exe exe-path)))) -(define/contract (run-git args) - (-> (listof (or/c path-string? symbol?)) - (listof (list/c (one-of/c 'stdout 'stderr) string?))) +(define (run-git args) (putenv "GIT_TERMINAL_PROMPT" "0") (let-values (((process stdout stdin stderr) (apply subprocess @@ -107,7 +105,8 @@ (if (= open-ports 0) (begin (subprocess-wait process) - (reverse result)) + (values (subprocess-status process) + (reverse result))) (let* ((output (channel-get output-channel)) (line (cadr output))) (if (eof-object? line) @@ -146,7 +145,7 @@ (format "~a" e))) (format "~a" e))) (if (list? outp) outp (list outp)))) - (enter (if (eq? (system-type 'os) 'windows) "\r\n" "\n")) + (enter (if (eq? (system-type 'os) 'windows) "\n" "\n")) (msg (format "git ~a: ~a: ~a" cmd msg* (string-join out enter))) ) (err-git msg)