exit code checking added

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"

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))
+        ))
   )
 
 

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

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)