git command structure now in place

private/git-commands.rkt

@@ -4,13 +4,29 @@
          racket/string
          )
 
-(provide cmd-git-status
-         cmd-git-add
-         cmd-git-commit
+(provide def-git-cmd-proxy
+         check-git-args
+         has-git-arg?
+         std-process-git-result
          )
 
 
-(define (check-arg cmd args flags)
+(define (has-git-arg? args opt)
+  (if (list? args)
+      (if (null? args)
+          #f
+          (if (symbol? opt)
+              (if (or (eq? (car args) opt)
+                      (and (string? (car args))
+                           (string=? (car args) (symbol->string opt))))
+                  #t
+                  (has-git-arg? (cdr args) opt))
+              (error 'has-git-arg? "opt must be of type symbol?")))
+      (error 'has-git-arg? "args must be a list of arguments")
+      )
+  )
+
+(define (check-git-args cmd args flags)
   (for-each
    (λ (opt)
      (let ((flag (car opt))
@@ -29,59 +45,30 @@
              (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)))
-      (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" out)
-          )
-      )
-    )
-  )
+   flags)
+  args)
 
 
+(define (std-process-git-result cmd result output out)
+  (git-displ out)
+  (if result
+      result
+      (git-error cmd "Error" out)))
 
-
-(define-syntax def-proxy-cmd
+(define-syntax def-git-cmd-proxy
   (syntax-rules ()
     ((_ f cmd)
-     (def-proxy-cmd f cmd (λ args (begin #t))))
-    ((_ f cmd code)
+     (def-proxy-cmd f cmd (λ args t) standard-result))
+    ((_ f cmd pre-code)
+     (def-proxy-cmd f cmd pre-code standard-result))
+    ((_ f cmd pre-code process-result)
      (define (f args)
-       (code args)
-       (let ((output (run-git (cons 'cmd args))))
-         (let-values (((result out) (git-out 'cmd output)))
-           (if result
-               (begin
-                 (git-displ out)
-                 result)
-               (git-error 'cmd "Error" out)))))
-     )
+       (let ((nargs (pre-code args)))
+         (let ((output (run-git (cons cmd nargs))))
+           (let-values (((result out) (git-out cmd output)))
+             (process-result cmd result output out))))))
     )
   )
 
 
-(def-proxy-cmd cmd-git-add add)
-(def-proxy-cmd cmd-git-commit commit
-  (λ (args) (check-arg 'commit args '((-m 1 "A commit message is mandatory"))))
-  )