Simplifying.

main.rkt

@@ -2,6 +2,7 @@
 
 (require ffi/unsafe
          racket/list
+         racket/match
          racket/path
          racket/string
          "credentials.rkt"
@@ -11,6 +12,7 @@
                   _git_error_code/check))
 
 (provide git
+         dgit
          git-repository?
          git-root
          git-init
@@ -555,44 +557,93 @@
       remote-name
       (format "refs/tags/~a:refs/tags/~a" tag tag))]))
 
-(define-syntax git
-  (syntax-rules (init clone status add config commit branch -d checkout -b
-                      tag log remote get-url fetch pull push push-tag
-                      credentials init unlock lock set remove unlocked?)
-    [(_ init args ...) (git-init args ...)]
-    [(_ clone args ...) (git-clone args ...)]
-    [(_ status) (git-status)]
-    [(_ add paths ...) (git-add paths ...)]
-    [(_ config args ...) (git-config args ...)]
-    [(_ commit message) (git-commit message)]
-    [(_ branch -d name) (git-branch-delete name)]
-    [(_ branch) (git-branch)]
-    [(_ branch name) (git-branch name)]
-    [(_ checkout -b name) (git-checkout-new name)]
-    [(_ checkout name) (git-checkout name)]
-    [(_ tag -d name) (git-tag-delete name)]
-    [(_ tag) (git-tag)]
-    [(_ tag name) (git-tag name)]
-    [(_ log) (git-log)]
-    [(_ log count) (git-log count)]
-    [(_ remote) (git-remotes)]
-    [(_ remote add name url) (git-remote-add name url)]
-    [(_ remote get-url name) (git-remote-url name)]
-    [(_ fetch) (git-fetch)]
-    [(_ fetch remote-name) (git-fetch remote-name)]
-    [(_ pull) (git-pull)]
-    [(_ pull remote-name) (git-pull remote-name)]
-    [(_ push) (git-push)]
-    [(_ push remote-name) (git-push remote-name)]
-    [(_ push remote-name branch) (git-push remote-name branch)]
-    [(_ push-tag tag-name) (git-push-tag tag-name)]
-    [(_ push-tag tag-name remote-name) (git-push-tag tag-name remote-name)]
-    [(_ credentials init password) (git-credentials-init! password)]
-    [(_ credentials unlock password) (git-credentials-unlock! password)]
-    [(_ credentials unlock password seconds)
-     (git-credentials-unlock! password #:for seconds)]
-    [(_ credentials lock) (git-credentials-lock!)]
-    [(_ credentials unlocked?) (git-credentials-unlocked?)]
-    [(_ credentials set remote username token)
-     (git-credentials-set! remote username token)]
-    [(_ credentials remove remote) (git-credentials-remove! remote)]))
+(define (git command . args)
+  (unless (symbol? command)
+    (raise-argument-error 'git "symbol?" command))
+  (case command
+    [(init) (apply git-init args)]
+    [(clone) (apply git-clone args)]
+    [(status) (apply git-status args)]
+    [(add) (apply git-add args)]
+    [(config) (apply git-config args)]
+    [(commit) (apply git-commit args)]
+    [(branch)
+     (match args
+       [(list '-d name) (git-branch-delete name)]
+       [_ (apply git-branch args)])]
+    [(checkout)
+     (match args
+       [(list '-b name) (git-checkout-new name)]
+       [_ (apply git-checkout args)])]
+    [(tag)
+     (match args
+       [(list '-d name) (git-tag-delete name)]
+       [_ (apply git-tag args)])]
+    [(log) (apply git-log args)]
+    [(remote)
+     (match args
+       ['() (git-remotes)]
+       [(list 'add name url) (git-remote-add name url)]
+       [(list 'get-url name) (git-remote-url name)]
+       [_ (error 'git "invalid remote arguments: ~e" args)])]
+    [(fetch) (apply git-fetch args)]
+    [(pull) (apply git-pull args)]
+    [(push) (apply git-push args)]
+    [(push-tag) (apply git-push-tag args)]
+    [(credentials)
+     (match args
+       [(list 'init password) (git-credentials-init! password)]
+       [(list 'unlock password) (git-credentials-unlock! password)]
+       [(list 'unlock password seconds)
+        (git-credentials-unlock! password #:for seconds)]
+       [(list 'lock) (git-credentials-lock!)]
+       [(list 'unlocked?) (git-credentials-unlocked?)]
+       [(list 'set remote username token)
+        (git-credentials-set! remote username token)]
+       [(list 'remove remote) (git-credentials-remove! remote)]
+       [_ (error 'git "invalid credentials arguments: ~e" args)])]
+    [else (error 'git "unknown command: ~a" command)]))
+
+(define (status-description entry)
+  (define flags (git-status-entry-flags entry))
+  (cond
+    [(has-status? flags 'GIT_STATUS_CONFLICTED) "Conflicted"]
+    [(has-status? flags 'GIT_STATUS_WT_NEW) "New"]
+    [(or (has-status? flags 'GIT_STATUS_INDEX_RENAMED)
+         (has-status? flags 'GIT_STATUS_WT_RENAMED)) "Renamed"]
+    [(or (has-status? flags 'GIT_STATUS_INDEX_DELETED)
+         (has-status? flags 'GIT_STATUS_WT_DELETED)) "Deleted"]
+    [(has-status? flags 'GIT_STATUS_INDEX_NEW) "Added"]
+    [(or (has-status? flags 'GIT_STATUS_INDEX_TYPECHANGE)
+         (has-status? flags 'GIT_STATUS_WT_TYPECHANGE)) "Type changed"]
+    [(or (has-status? flags 'GIT_STATUS_INDEX_MODIFIED)
+         (has-status? flags 'GIT_STATUS_WT_MODIFIED)) "Modified"]
+    [(has-status? flags 'GIT_STATUS_WT_UNREADABLE) "Unreadable"]
+    [else (git-status-entry-code entry)]))
+
+(define (pad-right value width)
+  (define text (format "~a" value))
+  (string-append text (make-string (max 0 (- width (string-length text))) #\space)))
+
+(define (display-git-result command result [out (current-output-port)])
+  (cond
+    [(eq? command 'status)
+     (for ([entry (in-list result)])
+       (fprintf out "~a - ~a\n"
+                (pad-right (status-description entry) 12)
+                (git-status-entry-path entry)))]
+    [(eq? command 'log)
+     (for ([entry (in-list result)])
+       (fprintf out "~a ~a\n"
+                (substring (git-log-entry-id entry) 0 7)
+                (git-log-entry-summary entry)))]
+    [(list? result)
+     (for ([item (in-list result)])
+       (displayln item out))]
+    [(void? result) (void)]
+    [else (displayln result out)]))
+
+(define (dgit command . args)
+  (define result (apply git command args))
+  (display-git-result command result)
+  result)