git command structure now in place

main.rkt

@@ -4,32 +4,77 @@
          "private/git-commands.rkt"
          "private/config.rkt"
          simple-log
+         racket/string
          )
 
-(provide git)
+(provide git
+         git-add
+         git-status
+         git-commit
+         git-pull
+         git-push
+         )
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Provided commands
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (git command . args)
-  (cond
-    ([eq? command 'status] (cmd-git-status args))
-    ([eq? command 'add] (cmd-git-add args))
-    ([eq? command 'commit] (cmd-git-commit args))
-    (else (error "Not supported git command '~a" command))
+(define git-commands (make-hash))
+
+(define-syntax git
+  (syntax-rules ()
+    ((_ command b1 ...)
+     ((hash-ref git-commands 'command
+                (λ ()
+                  (error "Not supported git command '~a" 'command)))
+      (list b1 ...)))
     )
   )
 
 (define-syntax def-cmd
   (syntax-rules ()
-    ((_ cmd cmd*)
-     (define (cmd . args)
-       (cmd* args)))))
+    ((_ cmd cmd* cmd-sym)
+     (def-cmd cmd cmd* cmd-sym (λ (args) args) std-process-git-result))
+    ((_ cmd cmd* cmd-sym pre-code)
+     (def-cmd cmd cmd* cmd-sym pre-code std-process-git-result))
+    ((_ cmd cmd* cmd-sym pre-code process-result)
+     (begin
+       (def-git-cmd-proxy cmd* cmd-sym pre-code process-result)
+       (define (cmd . args) (cmd* args))
+       (hash-set! git-commands cmd-sym cmd*)))
+    )
+  )
+
+(def-cmd git-status cmd-git-status 'status
+  (λ (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)))
+  )
 
 
-
-(def-cmd git-status cmd-git-status)
-(def-cmd git-add cmd-git-add)
-(def-cmd git-commit cmd-git-commit)
-
+(def-cmd git-add cmd-git-add 'add)
+(def-cmd git-commit cmd-git-commit 'commit
+  (λ (args) (check-git-args 'commit args '((-m 1 "A commit message is mandatory"))))
+  )
+(def-cmd git-push cmd-git-push 'push)
+(def-cmd git-pull cmd-git-pull 'pull)