More commands

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<number>` 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`,

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)
 

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 ...)
+    ((_ cmd arg ...)
-     (git 'cmd 'a1 ...))))
+     (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)

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.