Cleaned up the code. added some documentation.

This commit is contained in:
2026-08-13 00:33:22 +02:00
parent c556b4f452
commit a025481ae4
4 changed files with 177 additions and 73 deletions
+1 -1
View File
@@ -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)
+70 -19
View File
@@ -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)
(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))
(if (< (string-length line) 3)
(git-error 'status "Unexpected output" line)
(list (status->symbol (substring line 0 1))
(status->symbol (substring line 1 2))
(substring line 3))))
(map cadr
(filter (λ (entry) (eq? (car entry) 'stdout)) 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))
@@ -155,6 +202,10 @@
#t)
#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)
+9 -10
View File
@@ -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
(git-displ out)
(git-displ (map cadr output))
#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))))))
)
)
+71 -17
View File
@@ -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)
(git 'diff)
(git 'diff '--cached)
(git 'add "main.rkt" "info.rkt")
(git 'restore '--staged "scratch.rkt")
(git 'reset 'HEAD "--" "main.rkt")
(git 'grep '-i '-n "todo")
(git 'commit "Implement raco support")
(git 'tag "v0.1")
(git 'checkout "main")
]
@defproc[(git-add [argument any/c] ...) boolean?]{
Adds file contents to the index. Returns @racket[#t] when Git exits with status
zero; otherwise an exception is raised.
}
@defproc[(git-commit [argument any/c] ...) boolean?]{
Creates a commit. When @tt{-m} is omitted, a commit message is requested before
Git is started. A repository with nothing to commit returns @racket[#t]. Other
non-zero exit statuses, including a rejected commit hook, raise an exception.
}
@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.
}