git config added

README.md

@@ -42,14 +42,30 @@ credentials, SSH keys, pull strategy, and other repository configuration.
 ## Commands
 
 The package currently registers commands including `status`, `add`, `commit`,
-`push`, `pull`, `fetch`, `branch`, `switch`, `clone`, `tag`, `log`,
+`push`, `pull`, `fetch`, `config`, `branch`, `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`,
-`git-fetch`, `git-switch`, `git-tag`, `git-log`, `git-diff`, and `git-show`.
+`git-fetch`, `git-config`, `git-switch`, `git-tag`, `git-log`, `git-diff`, and `git-show`.
 
 See the Scribble documentation for command-specific behavior and return values.
 
+## Git configuration
+
+`git config` has a small Racket-oriented interface:
+
+```racket
+(git 'config 'get '--all)
+(git 'config 'get '--all "credential.helper")
+(git 'config 'get "credential.helper")
+(git 'config 'set! "user.email" "hans@example.invalid")
+(git 'config 'set! '--global "user.email" "hans@example.invalid")
+```
+
+`get --all` without a key returns `(key value)` items. `get --all key`
+returns all values for one key. `get key` returns one string or `#f` when the
+key is absent. `set!` returns `#t` after a successful write.
+
 ## Low-level Git execution
 
 `run-git` can be used when direct access to Git's stdin/stdout protocol is

main.rkt

@@ -20,6 +20,7 @@
          git-fetch
          git-switch
          git-tag
+         git-config
          git-log
          git-grep
          git-branch
@@ -123,6 +124,101 @@
                  (string-contains? line* "no changes added to commit"))))
          out))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Convert one git config --list output line to a key/value item.
+; pre    : line is one line produced by git config --list.
+; post   : line has only been inspected.
+; result : A list containing the configuration key and value.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (config-line->item line)
+  (let ((m (regexp-match #px"^([^=]+)=(.*)$" line)))
+    (if m
+        (list (cadr m) (caddr m))
+        (list line ""))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Translate the Racket-oriented config interface to git config arguments.
+; pre    : args starts with get or set! and follows one of the supported forms.
+; post   : info contains the config operation used to process Git's result.
+; result : Arguments accepted by git config.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-config-args args info)
+  (if (null? args)
+      (error 'git-config "Expected get or set!")
+      (let ((action (car args))
+            (rest (cdr args)))
+        (cond
+          ((eq? action 'get)
+           (cond
+             ((null? rest)
+              (error 'git-config "Expected a configuration key or --all"))
+             ((eq? (car rest) '--all)
+              (cond
+                ((null? (cdr rest))
+                 (hash-set! info 'config-operation 'all)
+                 '(--list))
+                ((null? (cddr rest))
+                 (hash-set! info 'config-operation 'get-all)
+                 (list '--get-all (cadr rest)))
+                (else
+                 (error 'git-config "Too many arguments for config get --all"))))
+             ((null? (cdr rest))
+              (hash-set! info 'config-operation 'get)
+              (list '--get (car rest)))
+             (else
+              (error 'git-config "Too many arguments for config get"))))
+
+          ((eq? action 'set!)
+           (cond
+             ((= (length rest) 2)
+              (hash-set! info 'config-operation 'set)
+              rest)
+             ((and (= (length rest) 3)
+                   (member (car rest) '(--global --local --system)))
+              (hash-set! info 'config-operation 'set)
+              rest)
+             (else
+              (error 'git-config
+                     "Expected config set! [--global|--local|--system] key value"))))
+
+          (else
+           (error 'git-config "Expected get or set!"))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Process the result of the Racket-oriented git config interface.
+; pre    : info contains the operation selected by git-config-args.
+; post   : Successful query output has been converted to Racket data.
+; result : Config data, #f for a missing single key, or #t after set!.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (process-git-config-result cmd exit-code result output out info)
+  (let* ((operation (hash-ref info 'config-operation))
+         (stdout (map cadr
+                      (filter (λ (entry) (eq? (car entry) 'stdout))
+                              output))))
+    (cond
+      ((eq? operation 'all)
+       (if (= exit-code 0)
+           (map config-line->item stdout)
+           (std-process-git-result cmd exit-code result output out info)))
+
+      ((eq? operation 'get-all)
+       (cond
+         ((= exit-code 0) stdout)
+         ((= exit-code 1) '())
+         (else
+          (std-process-git-result cmd exit-code result output out info))))
+
+      ((eq? operation 'get)
+       (cond
+         ((= exit-code 0)
+          (if (null? stdout) #f (car stdout)))
+         ((= exit-code 1) #f)
+         (else
+          (std-process-git-result cmd exit-code result output out info))))
+
+      (else
+       (std-process-git-result cmd exit-code result output out info)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Command definition macro
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -233,6 +329,16 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (def-cmd git-fetch cmd-git-fetch 'fetch)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read or write Git configuration through a Racket-oriented interface.
+; pre    : Arguments follow one of the supported get/set! forms.
+; post   : Git config has completed or an exception has been raised.
+; result : Structured config data, #f for a missing key, or #t after set!.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-config cmd-git-config 'config
+  git-config-args
+  process-git-config-result)
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : List, create or delete branches.

scribblings/git.scrbl

@@ -19,7 +19,8 @@ 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['branch], @racket['switch], @racket['clone], @racket['tag],
+@racket['config], @racket['branch], @racket['switch], @racket['clone],
+@racket['tag],
 @racket['log], @racket['rev-list], @racket['diff],
 @racket['show], @racket['grep], @racket['help], @racket['version], and
 @racket['new-version].
@@ -88,6 +89,46 @@ For example:
 ]
 }
 
+@defproc[(git-config [argument any/c] ...) any/c]{
+Provides a Racket-oriented interface to @tt{git config}. The same interface is
+available through @racket[git] with command @racket['config].
+
+@racketblock[
+(git 'config 'get '--all)
+]
+
+returns all visible configuration entries as key/value items:
+
+@racketblock[
+'(("user.name" "Hans Dijkema")
+  ("user.email" "hans@example.invalid")
+  ("credential.helper" "manager"))
+]
+
+@racketblock[
+(git 'config 'get "credential.helper")
+]
+
+returns one value as a string, or @racket[#f] when the key is absent.
+
+@racketblock[
+(git 'config 'get '--all "credential.helper")
+]
+
+returns all values for one key as a list. An absent key produces the empty
+list.
+
+Configuration values can be written with @racket['set!]:
+
+@racketblock[
+(git 'config 'set! "user.email" "hans@example.invalid")
+(git 'config 'set! '--global "user.email" "hans@example.invalid")
+]
+
+The optional write scope can be @tt{--global}, @tt{--local}, or @tt{--system}.
+A successful write returns @racket[#t].
+}
+
 @defproc[(git-branch [argument any/c] ...) boolean?]{
 Runs @tt{git branch} with the supplied arguments. This can be used to list,
 create, rename, or delete branches according to the options supported by the