diff --git a/info.rkt b/info.rkt index e8b5bac..f83ca6c 100644 --- a/info.rkt +++ b/info.rkt @@ -1,23 +1,23 @@ -#lang info - -(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 pkg-authors '("Hans Dijkema")) -(define license 'MIT) - -(define deps - '("base" - "simple-ini" - "simple-log" - "racket-index" - "scribble-lib" - "racket-makefile" - "package-zipper")) - -(define build-deps - '("rackunit-lib" - "racket-doc")) - -(define scribblings - '(("scribblings/git.scrbl" () ("Git")))) \ No newline at end of file +#lang info + +(define collection "git-cli") +(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command") +(define version "0.3.10") +(define pkg-authors '("Hans Dijkema")) +(define license 'MIT) + +(define deps + '("base" + "simple-ini" + "simple-log" + "racket-index" + "scribble-lib" + "racket-makefile" + "package-zipper")) + +(define build-deps + '("rackunit-lib" + "racket-doc")) + +(define scribblings + '(("scribblings/git.scrbl" () ("Git")))) diff --git a/main.rkt b/main.rkt index f00d5a3..7d4a105 100644 --- a/main.rkt +++ b/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) - (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) diff --git a/private/git-commands.rkt b/private/git-commands.rkt index ea28996..6f8425d 100644 --- a/private/git-commands.rkt +++ b/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 - (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)))))) ) ) - - - diff --git a/scribblings/git.scrbl b/scribblings/git.scrbl index 677cf2c..61ac4e0 100644 --- a/scribblings/git.scrbl +++ b/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) -(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. +}