Cleaned up the code. added some documentation.

info.rkt

@@ -2,7 +2,7 @@
 
 (define collection "git-cli")
 (define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
-(define version "0.3.9")
+(define version "0.3.10")
 (define pkg-authors '("Hans Dijkema"))
 (define license 'MIT)
 

main.rkt

@@ -28,6 +28,10 @@
 (define git-commands (make-hash))
 
 
+;; goal: Invoke a supported Git command through the command table.
+;; pre: command is a registered Git command symbol.
+;; post: The selected command has processed all supplied arguments.
+;; result: The command-specific result.
 (define-syntax git
   (syntax-rules ()
     ((_ command b1 ...)
@@ -51,6 +55,27 @@
         (g args)
         (g (cons '--porcelain args)))))
 
+(define (status->symbol status)
+  (cond
+    ((string=? status " ") 'unchanged)
+    ((string=? status "M") 'modified)
+    ((string=? status "T") 'type-changed)
+    ((string=? status "A") 'added)
+    ((string=? status "D") 'deleted)
+    ((string=? status "R") 'renamed)
+    ((string=? status "C") 'copied)
+    ((string=? status "U") 'unmerged)
+    ((string=? status "?") 'untracked)
+    ((string=? status "!") 'ignored)
+    (else (error 'git-status "Unexpected status: ~a" status))))
+
+(define (nothing-to-commit? out)
+  (ormap (λ (line)
+           (let ((line* (string-downcase line)))
+             (or (string-contains? line* "nothing to commit")
+                 (string-contains? line* "no changes added to commit"))))
+         out))
+
 
 (define-syntax def-cmd
   (syntax-rules ()
@@ -68,37 +93,38 @@
     )
   )
 
+;; goal: Return the complete Git index and worktree status for every reported file.
+;; pre: The current directory is inside a Git working tree.
+;; post: Git status has been invoked with --porcelain.
+;; result: A list containing (index-status worktree-status file) for every file.
 (def-cmd git-status cmd-git-status 'status
   add-porcelain
   (λ (cmd exit-code result output out info)
     (dbg-git (format "~a" output))
     (if (= exit-code 0)
-        (if result
+        (map (λ (line)
-            (map (λ (line)
+               (if (< (string-length line) 3)
-                   (let* ((state (string->symbol (string-trim (substring line 0 2))))
+                   (git-error 'status "Unexpected output" line)
-                          (file (string-trim (substring line 3))))
+                   (list (status->symbol (substring line 0 1))
-                     (cond
+                         (status->symbol (substring line 1 2))
-                       ([eq? state '??] (list 'new file))
+                         (substring line 3))))
-                       ([eq? state 'M] (list 'modified file))
+             (map cadr
-                       ([eq? state 'A] (list 'added file))
+                  (filter (λ (entry) (eq? (car entry) 'stdout)) output)))
-                       ([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))
         ))
   )
 
 
+;; goal: Add file contents to the Git index.
+;; pre: The supplied arguments are valid for git add.
+;; post: Git add has completed successfully or an exception has been raised.
+;; result: #t after a successful Git command.
 (def-cmd git-add cmd-git-add 'add)
 
+;; goal: Create a Git commit.
+;; pre: A commit message is supplied or can be requested from the user.
+;; post: The commit was created, nothing needed committing, or an exception was raised.
+;; result: #t after a commit or when the repository has nothing to commit.
 (def-cmd git-commit cmd-git-commit 'commit
   (λ (args info)
     (with-handlers ([exn:fail? (λ (e)
@@ -109,15 +135,32 @@
       (check-git-args 'commit args '((-m 1 "A commit message is mandatory")))))
   (λ (cmd exit-code result output out info)
     (cond
-      ((= exit-code 1) (git-displ out) #t)
+      ((and (= exit-code 1)
+            (nothing-to-commit? out))
+       (git-displ out)
+       #t)
       (else 
        (std-process-git-result cmd exit-code result output out info))))
   )
 
+;; goal: Push local changes to a remote repository.
+;; pre: The supplied arguments are valid for git push.
+;; post: Git push has completed successfully or an exception has been raised.
+;; result: #t after a successful push.
 (def-cmd git-push cmd-git-push 'push add-porcelain)
+
+;; goal: Fetch and integrate changes from a remote repository.
+;; pre: The supplied arguments are valid for git pull.
+;; post: Git pull has completed successfully or an exception has been raised.
+;; result: #t after a successful pull.
 (def-cmd git-pull cmd-git-pull 'pull)
 (def-cmd git-branch cmd-git-branch 'branch)
 (def-cmd git-clone cmd-git-clone 'clone)
+
+;; goal: Display the Git commit log.
+;; pre: The supplied arguments are valid for git log.
+;; post: Git log has completed successfully or an exception has been raised.
+;; result: #t after successfully displaying the log.
 (def-cmd git-log cmd-git-log 'log)
 (def-cmd git-rev-list cmd-git-rev-list 'rev-list)
 
@@ -129,6 +172,10 @@
 
 (hash-set! git-commands 'version cmd-git-version)
 
+;; goal: Increment the package version in info.rkt.
+;; pre: kind is 'maj, 'major, 'min, 'minor or 'patch.
+;; post: The version definition in info.rkt has been updated.
+;; result: The new version as a list containing major, minor and patch.
 (define (git-new-version . args)
   (cmd-git-new-version args))
 
@@ -153,8 +200,12 @@
                      "\n")))
           (diff->html diff)
           #t)
-        #f)))
+          #f)))
 
+;; goal: Search tracked files for a pattern.
+;; pre: The supplied arguments are valid for git grep.
+;; post: Git grep has completed; exit code one is treated as no matches.
+;; result: A list containing file, line number, match count and matched text.
 (def-cmd git-grep cmd-git-grep 'grep
   (λ (args info)
     (let ((matches #f)

private/git-commands.rkt

@@ -51,24 +51,26 @@
   args)
 
 
+;; goal: Process the standard result of a Git command.
+;; pre: exit-code and out belong to the completed Git command.
+;; post: Successful output has been displayed or a Git exception has been raised.
+;; result: #t when exit-code is zero.
 (define (std-process-git-result cmd exit-code result output out info)
   (if (= exit-code 0)
-      (if result
+      (begin
-          (begin
+        (git-displ (map cadr output))
-            (git-displ out)
+        #t)
-            #t)
-          (git-error cmd "Error" out))
       (git-error cmd (format "Exitcode <> 0: ~a" exit-code) out)
       )
   )
 
 
+;; goal: Define the internal proxy for a Git command.
+;; pre: pre-code and process-result accept the command proxy arguments.
+;; post: The proxy invokes Git without standard input and processes its result.
+;; result: A procedure named f accepting a list of Git arguments.
 (define-syntax def-git-cmd-proxy
   (syntax-rules ()
-    ((_ f cmd)
-     (def-proxy-cmd f cmd (λ (args info) args) standard-result))
-    ((_ f cmd pre-code)
-     (def-proxy-cmd f cmd pre-code standard-result))
     ((_ f cmd pre-code process-result)
      (define (f args*)
        (let* ((args (flatten args*))
@@ -79,6 +81,3 @@
              (process-result cmd exit-code result output out info))))))
     )
   )
-
-
-

scribblings/git.scrbl

@@ -1,27 +1,81 @@
 #lang scribble/manual
 
-@(require (for-label racket/base git))
+@(require (for-label racket/base
+                     git-cli))
 
-@title[#:tag "top"]{git}
+@title[#:tag "top"]{git-cli}
 @author{Hans Dijkema}
 
-@defmodule[git]
+@defmodule[git-cli]
 
-The @racketmodname[git] module provides a small command-line-like Git interface implemented on top of the @tt{libgit2} package. It does not invoke the @tt{git} executable.
+The @racketmodname[git-cli] module provides a command-line-like Git interface
+implemented by invoking the @tt{git} executable. Commands never read from
+standard input.
 
-The short form is intended for build scripts and interactive use:
+@defform[(git command argument ...)]{
+Runs a supported Git @racket[command]. The arguments are passed to the Git
+command. Supported commands include @racket['status], @racket['add],
+@racket['commit], @racket['push], @racket['pull], @racket['branch],
+@racket['clone], @racket['log], @racket['rev-list], @racket['diff],
+@racket['grep], @racket['help], @racket['version], and
+@racket['new-version].
+}
+
+@defproc[(git-status [argument any/c] ...) list?]{
+Runs @tt{git status --porcelain} with the supplied arguments.
+
+Each result item has the form
+@racket[(index-status worktree-status file)]. The index status describes the
+change staged for the next commit. The worktree status describes the change in
+the working tree relative to the index.
+
+Both statuses are one of @racket['unchanged], @racket['modified],
+@racket['type-changed], @racket['added], @racket['deleted], @racket['renamed],
+@racket['copied], @racket['unmerged], @racket['untracked], or
+@racket['ignored]. For an untracked file, Git reports @tt{??}, so both statuses
+are @racket['untracked].
 
 @racketblock[
-(require git)
+((modified unchanged "staged.rkt")
+ (unchanged modified "working-tree.rkt")
+ (modified modified "both.rkt")
+ (renamed unchanged "old.rkt -> new.rkt")
+ (untracked untracked "new.rkt"))
+]}
 
-(git 'status)
+@defproc[(git-add [argument any/c] ...) boolean?]{
-(git 'diff)
+Adds file contents to the index. Returns @racket[#t] when Git exits with status
-(git 'diff '--cached)
+zero; otherwise an exception is raised.
-(git 'add "main.rkt" "info.rkt")
+}
-(git 'restore '--staged "scratch.rkt")
+
-(git 'reset 'HEAD "--" "main.rkt")
+@defproc[(git-commit [argument any/c] ...) boolean?]{
-(git 'grep '-i '-n "todo")
+Creates a commit. When @tt{-m} is omitted, a commit message is requested before
-(git 'commit "Implement raco support")
+Git is started. A repository with nothing to commit returns @racket[#t]. Other
-(git 'tag "v0.1")
+non-zero exit statuses, including a rejected commit hook, raise an exception.
-(git 'checkout "main")
+}
-]
+
+@defproc[(git-push [argument any/c] ...) boolean?]{
+Pushes changes using @tt{--porcelain}. Returns @racket[#t] when Git exits with
+status zero; otherwise an exception is raised.
+}
+
+@defproc[(git-pull [argument any/c] ...) boolean?]{
+Fetches and integrates changes. Normal progress written by Git to standard
+error is treated as output when Git exits successfully.
+}
+
+@defproc[(git-log [argument any/c] ...) boolean?]{
+Displays Git log output and returns @racket[#t] when Git exits successfully.
+}
+
+@defproc[(git-grep [argument any/c] ...) list?]{
+Searches tracked files. Each result contains the file, optional line number,
+optional match count, and matched text. Exit status one means that no matches
+were found and returns an empty list.
+}
+
+@defproc[(git-new-version [kind symbol?]) list?]{
+Updates the version in @filepath{info.rkt}. The kind is @racket['major],
+@racket['minor], or @racket['patch], with @racket['maj] and @racket['min] as
+abbreviations. The result is the new version as a list of three integers.
+}