diff --git a/README.md b/README.md index c234b19..cbd125d 100644 --- a/README.md +++ b/README.md @@ -24,6 +24,26 @@ procedure and through direct procedures. `git` is an ordinary procedure. The first argument is the Git command symbol and the remaining arguments are passed to that command. +`git*` is the compact command-style syntax. Bare arguments are converted to +strings, so `(git* remote get-url origin)` is equivalent to +`(git 'remote "get-url" "origin")`. Use `(eval expression)` when an argument +must come from a Racket expression. `gt` remains available as a compatibility +alias for `git*`. + +```racket +(git* remote -v) +(git* switch main) +(git* restore --staged main.rkt) +(git* reset --hard HEAD) +(git* revert HEAD) +(git* rebase main) +(git* merge feature) +(git* cherry-pick abc1234) + +(define branch "develop") +(git* switch (eval branch)) +``` + Several commands provide Racket-oriented output in addition to the normal Git behavior: @@ -32,6 +52,8 @@ behavior: - `git-tag -l` / `git-tag --list` returns tag names; with `-n` it returns `(tag subject)` items and `-n` supports multiple content lines. - `git-branch -l` / `git-branch --list` returns `(current|local|remote branch)` items; `-a`, `-r`, and `--sort=` remain Git options. - `git-remote` returns remote names; `git-remote -v` / `git-remote --verbose` returns separate `(name url fetch|push)` items. +- `git-stash list` returns `(stash-name description)` items; other stash subcommands keep Git's normal behavior. +- `git-restore`, `git-reset`, `git-revert`, `git-rebase`, `git-merge`, and `git-cherry-pick` pass Git's command syntax through unchanged. - `git-diff` renders HTML by default; `--output=-` selects stdout and `--output=string` returns a string. - `git-show` renders a commit and its diff as HTML by default. `-l` / @@ -44,7 +66,7 @@ credentials, SSH keys, pull strategy, and other repository configuration. ## Commands The package currently registers commands including `status`, `add`, `commit`, -`push`, `pull`, `fetch`, `config`, `branch`, `switch`, `clone`, `tag`, `log`, +`push`, `pull`, `fetch`, `config`, `branch`, `remote`, `stash`, `restore`, `reset`, `revert`, `rebase`, `merge`, `cherry-pick`, `switch`, `clone`, `tag`, `log`, `rev-list`, `diff`, `show`, `grep`, `help`, `version`, and `new-version`. Most are also exported as direct procedures such as `git-status`, `git-add`, diff --git a/info.rkt b/info.rkt index f142c0b..09eaa75 100644 --- a/info.rkt +++ b/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.29") +(define version "0.3.33") (define pkg-authors '("Hans Dijkema")) (define license 'MIT) diff --git a/main.rkt b/main.rkt index 583bd78..994548e 100644 --- a/main.rkt +++ b/main.rkt @@ -12,6 +12,7 @@ ) (provide gt + git* git git-add git-status @@ -26,6 +27,13 @@ git-grep git-branch git-remote + git-stash + git-restore + git-reset + git-revert + git-rebase + git-merge + git-cherry-pick git-clone git-rev-list git-diff @@ -54,10 +62,22 @@ ;; Command invocation using 'git' ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-syntax git*-argument + (syntax-rules (eval) + ((_ (eval expr)) + expr) + ((_ arg) + (format "~a" 'arg)))) + +(define-syntax git* + (syntax-rules () + ((_ cmd arg ...) + (git 'cmd (git*-argument arg) ...)))) + (define-syntax gt (syntax-rules () - ((_ cmd a1 ...) - (git 'cmd 'a1 ...)))) + ((_ cmd arg ...) + (git* cmd arg ...)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Invoke a supported Git command through the command table. @@ -85,6 +105,26 @@ (define (git-prompt p) (input-prompt p)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Compare a Git argument independent of its Racket representation. +; pre : arg and expected can be formatted as command-line arguments. +; post : Neither value has been changed. +; result : #t when both arguments have the same command-line text. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (git-argument=? arg expected) + (string=? (format "~a" arg) + (format "~a" expected))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Test whether a Git argument occurs in a set of accepted values. +; pre : values is a list of Git argument representations. +; post : arg and values have only been inspected. +; result : #t when arg matches one of values. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (git-argument-member? arg values) + (ormap (λ (value) (git-argument=? arg value)) + values)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Add --porcelain to a Git argument list when it is absent. ; pre : args is a list and an optional transformation accepts a list. @@ -152,7 +192,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (git-config-args args info) (define (scope? x) - (member x '(--global --local --system))) + (git-argument-member? x '(--global --local --system))) (define (split-scope args) (cond @@ -166,7 +206,7 @@ ;; Short form: (git 'config '--all) ((and (not scope) (= (length args*) 1) - (eq? (car args*) '--all)) + (git-argument=? (car args*) '--all)) (hash-set! info 'config-operation 'all) '(--list)) @@ -177,7 +217,7 @@ (let ((action (car args*)) (rest (cdr args*))) (cond - ((eq? action 'get) + ((git-argument=? action 'get) ;; Also accept scope directly after get. (let-values (((scope* rest*) (split-scope rest))) (let ((effective-scope (or scope scope*))) @@ -187,7 +227,7 @@ ((null? rest*) (error 'git-config "Expected a configuration key or --all")) - ((eq? (car rest*) '--all) + ((git-argument=? (car rest*) '--all) (cond ((null? (cdr rest*)) (hash-set! info 'config-operation 'all) @@ -208,7 +248,7 @@ (else (error 'git-config "Too many arguments for config get")))))) - ((eq? action 'set!) + ((git-argument=? action 'set!) ;; Also accept scope directly after set!. (let-values (((scope* rest*) (split-scope rest))) (let ((effective-scope (or scope scope*))) @@ -443,13 +483,13 @@ args) ((and (= (length args) 1) - (member (car args) '(-v --verbose))) + (git-argument-member? (car args) '(-v --verbose))) (hash-set! info 'remote-operation 'verbose-list) args) - ((eq? (car args) 'get-url) + ((git-argument=? (car args) 'get-url) (hash-set! info 'remote-operation - (if (member '--all args) + (if (ormap (λ (arg) (git-argument=? arg '--all)) args) 'get-url-all 'get-url)) args) @@ -497,6 +537,94 @@ (else (std-process-git-result cmd exit-code result output out info))))) ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Store, inspect or restore stashed working tree changes. +; pre : The supplied arguments are valid for git stash. +; post : Git stash has completed successfully or an exception was raised. +; result : Structured stash entries for `stash list`, otherwise the normal result. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def-cmd git-stash cmd-git-stash 'stash + (λ (args info) + (let ((list-output + (and (pair? args) + (git-argument=? (car args) 'list) + (not + (ormap + (λ (arg) + (regexp-match? + #px"^--(format|pretty)(=|$)" + (format "~a" arg))) + args))))) + (hash-set! info 'stash-list list-output) + (if list-output + (append args + '("--format=%gd%x00%gs")) + args))) + (λ (cmd exit-code result output out info) + (if (hash-ref info 'stash-list #f) + (if (= exit-code 0) + (map + (λ (line) + (let ((parts (string-split line "\u0000" #:trim? #f))) + (if (null? (cdr parts)) + (list (car parts) "") + (list (car parts) (cadr parts))))) + (map cadr + (filter (λ (entry) (eq? (car entry) 'stdout)) + output))) + (std-process-git-result cmd exit-code result output out info)) + (std-process-git-result cmd exit-code result output out info))) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Restore working tree or index files from a Git source. +; pre : The supplied arguments are valid for git restore. +; post : Git restore has completed successfully or an exception was raised. +; result : #t after a successful restore. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def-cmd git-restore cmd-git-restore 'restore) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Reset HEAD or selected paths according to Git reset semantics. +; pre : The supplied arguments are valid for git reset. +; post : Git reset has completed successfully or an exception was raised. +; result : #t after a successful reset. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def-cmd git-reset cmd-git-reset 'reset) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Revert one or more commits using Git's revert command. +; pre : The supplied arguments are valid for git revert. +; post : Git revert has completed successfully or an exception was raised. +; result : #t after a successful revert or sequencer command. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def-cmd git-revert cmd-git-revert 'revert) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Reapply commits on top of another base with Git rebase. +; pre : The supplied arguments are valid for git rebase. +; post : Git rebase has completed successfully or an exception was raised. +; result : #t after a successful rebase or rebase control command. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def-cmd git-rebase cmd-git-rebase 'rebase) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Join development histories with Git merge. +; pre : The supplied arguments are valid for git merge. +; post : Git merge has completed successfully or an exception was raised. +; result : #t after a successful merge or merge control command. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def-cmd git-merge cmd-git-merge 'merge) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Apply changes introduced by existing commits. +; pre : The supplied arguments are valid for git cherry-pick. +; post : Git cherry-pick has completed successfully or an exception was raised. +; result : #t after a successful cherry-pick or sequencer command. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def-cmd git-cherry-pick cmd-git-cherry-pick 'cherry-pick) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Switch branches. ; pre : The supplied arguments are valid for git switch. @@ -760,7 +888,7 @@ ((string=? o "-c") (set! matches #t)) ((string=? o "-n") (set! line-nr #t)))) e) - (map (λ (x) (if (eq? x '-i) "-i" x)) args)))) + (map (λ (x) (if (git-argument=? x '-i) "-i" x)) args)))) (when (eq? line-nr #f) (set! nargs (cons "-n" nargs))) ;; add line numbers / counts for pattern recognition (hash-set! info 'matches matches) diff --git a/scribblings/git-cli.scrbl b/scribblings/git-cli.scrbl index 67f280a..2e7079f 100644 --- a/scribblings/git-cli.scrbl +++ b/scribblings/git-cli.scrbl @@ -19,7 +19,7 @@ read credentials or other answers from the terminal. Runs a registered Git @racket[command]. The arguments are passed to the command. Registered command symbols are @racket['status], @racket['add], @racket['commit], @racket['push], @racket['pull], @racket['fetch], -@racket['config], @racket['branch], @racket['remote], @racket['switch], @racket['clone], +@racket['config], @racket['branch], @racket['remote], @racket['stash], @racket['restore], @racket['reset], @racket['revert], @racket['rebase], @racket['merge], @racket['cherry-pick], @racket['switch], @racket['clone], @racket['tag], @racket['log], @racket['rev-list], @racket['diff], @racket['show], @racket['grep], @racket['help], @racket['version], and @@ -31,6 +31,27 @@ commands process the result into a Racket value, such as @racket['status], @racket['new-version]. } + +@defform[(git* command argument ...)]{ +Provides compact command-style syntax for @racket[git]. The command name is +used as a symbol. Other literal arguments are converted to strings. + +@racketblock[ +(git* remote -v) +(git* switch main) +] + +An argument written as @racket[(eval expression)] is evaluated instead of being +converted from its literal syntax. + +@racketblock[ +(define branch "develop") +(git* switch (eval branch)) +] + +@racket[gt] is retained as a compatibility alias for @racket[git*]. +} + @section{Provided commands} @defproc[(git-status [argument any/c] ...) list?]{ @@ -204,6 +225,95 @@ Other forms, including @tt{add}, @tt{rename}, @tt{remove}, @tt{set-head}, @tt{show}, @tt{prune}, @tt{update}, @tt{set-branches}, and @tt{set-url}, are passed to Git unchanged and use the normal git-cli command result processing. } +@defproc[(git-stash [argument any/c] ...) (or/c boolean? list?)]{ +Runs @tt{git stash} with the supplied arguments. Calling it without a +subcommand keeps Git's normal behavior, which is equivalent to +@tt{git stash push}. + +@tt{git stash list} is returned as structured Racket data. Each item contains +the stash reference and Git's stash description. + +@racketblock[ +(git-stash 'list) + +'(("stash@{0}" "WIP on main: 1234567 Example") + ("stash@{1}" "On main: older work")) +] + +The structured form is only used when the caller has not supplied a +@tt{--format} or @tt{--pretty} option. Explicit Git formatting is left +unchanged. + +Other stash subcommands, including @tt{push}, @tt{show}, @tt{pop}, +@tt{apply}, @tt{drop}, @tt{clear}, @tt{branch}, @tt{create}, @tt{store}, +@tt{export}, and @tt{import}, are passed to Git unchanged. +} + +@defproc[(git-restore [argument any/c] ...) boolean?]{ +Runs @tt{git restore} with the supplied arguments. Git's path, source, +@tt{--staged}, @tt{--worktree}, and patch semantics are preserved. + +@racketblock[ +(git-restore "main.rkt") +(git-restore '--staged "main.rkt") +(git* restore --source=HEAD~1 main.rkt) +] +} + +@defproc[(git-reset [argument any/c] ...) boolean?]{ +Runs @tt{git reset} with the supplied arguments. Modes such as @tt{--soft}, +@tt{--mixed}, @tt{--hard}, @tt{--merge}, and @tt{--keep}, as well as path +forms, are passed through unchanged. + +@racketblock[ +(git-reset '--hard 'HEAD) +(git* reset --soft HEAD~1) +] +} + +@defproc[(git-revert [argument any/c] ...) boolean?]{ +Runs @tt{git revert} with the supplied arguments. Sequencer controls such as +@tt{--continue}, @tt{--skip}, @tt{--quit}, and @tt{--abort} are passed through +unchanged. + +@racketblock[ +(git-revert 'HEAD) +(git* revert --abort) +] +} + +@defproc[(git-rebase [argument any/c] ...) boolean?]{ +Runs @tt{git rebase} with the supplied arguments, including normal, interactive, +and continuation/abort forms. + +@racketblock[ +(git-rebase "main") +(git* rebase --continue) +(git* rebase --abort) +] +} + +@defproc[(git-merge [argument any/c] ...) boolean?]{ +Runs @tt{git merge} with the supplied arguments and preserves Git's merge +options and control forms. + +@racketblock[ +(git-merge "feature") +(git* merge --abort) +] +} + +@defproc[(git-cherry-pick [argument any/c] ...) boolean?]{ +Runs @tt{git cherry-pick} with the supplied arguments. Sequencer controls such +as @tt{--continue}, @tt{--skip}, @tt{--quit}, and @tt{--abort} are passed +through unchanged. + +@racketblock[ +(git-cherry-pick "abc1234") +(git* cherry-pick --continue) +] +} + @defproc[(git-switch [argument any/c] ...) boolean?]{ Runs @tt{git switch} with the supplied arguments.