command structure

private/git-commands.rkt

@@ -2,7 +2,6 @@
 
 (require "git-provider.rkt"
          racket/string
-         
          )
 
 (provide cmd-git-status
@@ -10,6 +9,28 @@
          cmd-git-commit
          )
 
+
+(define (check-arg cmd args flags)
+  (for-each
+   (λ (opt)
+     (let ((flag (car opt))
+           (num-args (cadr opt))
+           (err-msg (caddr opt)))
+       (letrec ((find (λ (l)
+                        (if (null? l)
+                            #f
+                            (if (eq? (car l) flag)
+                                (if  (>= (length (cdr l)) num-args)
+                                     #t
+                                     #f)
+                                (find (cdr l)))))))
+         (let ((found (find args)))
+           (unless found
+             (error 'git (format "git ~a: ~a" cmd err-msg))))
+         )
+       ))
+   flags))
+
 (define (cmd-git-status args)
   (let ((output (run-git '(status -s))))
     (let-values (((result out) (git-out 'status output)))
@@ -43,7 +64,10 @@
 (define-syntax def-proxy-cmd
   (syntax-rules ()
     ((_ f cmd)
+     (def-proxy-cmd f cmd (λ args (begin #t))))
+    ((_ f cmd code)
      (define (f args)
+       (code args)
        (let ((output (run-git (cons 'cmd args))))
          (let-values (((result out) (git-out 'cmd output)))
            (if result
@@ -57,5 +81,7 @@
 
 
 (def-proxy-cmd cmd-git-add add)
-(def-proxy-cmd cmd-git-commit commit)
+(def-proxy-cmd cmd-git-commit commit
+  (λ (args) (check-arg 'commit args '((-m 1 "A commit message is mandatory"))))
+  )
 

private/git-provider.rkt

@@ -75,6 +75,7 @@
 (define/contract (run-git args)
   (-> (listof (or/c path-string? symbol?))
       (listof (list/c (one-of/c 'stdout 'stderr) string?)))
+  (putenv "GIT_TERMINAL_PROMPT" "0")
   (let-values (((process stdout stdin stderr)
                 (apply subprocess
                        #f