Cleaned up the code. added some documentation.
This commit is contained in:
@@ -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)
|
||||
|
||||
|
||||
@@ -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))
|
||||
(map (λ (line)
|
||||
(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))
|
||||
|
||||
@@ -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)
|
||||
|
||||
+11
-12
@@ -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)
|
||||
#t)
|
||||
(git-error cmd "Error" out))
|
||||
(begin
|
||||
(git-displ (map cadr output))
|
||||
#t)
|
||||
(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
@@ -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.
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user