diff --git a/Makefile.rkt b/Makefile.rkt index 1f1babb..b5058ad 100644 --- a/Makefile.rkt +++ b/Makefile.rkt @@ -21,6 +21,9 @@ (deps clean) (zip-package)) +(target zip + (deps package)) + (define doc-target "docs/git.html") (define doc-src "scribblings/git.scrbl") diff --git a/info.rkt b/info.rkt index a55034b..82c8ad7 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.11") +(define version "0.3.14") (define pkg-authors '("Hans Dijkema")) (define license 'MIT) diff --git a/main.rkt b/main.rkt index 98a59e6..e78fac5 100644 --- a/main.rkt +++ b/main.rkt @@ -18,6 +18,12 @@ git-push git-log git-grep + git-branch + git-clone + git-rev-list + git-diff + git-help + git-version git-new-version ) @@ -31,10 +37,12 @@ ;; Command invocation using 'git' ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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 (git command . args) ((hash-ref git-commands command @@ -46,11 +54,23 @@ ;; Supporting functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Read one line of input after displaying a prompt. +; pre : p can be displayed. +; post : The prompt has been flushed before input is read. +; result : The entered line or an EOF object. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (git-prompt p) (display p) (flush-output) (read-line)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Add --porcelain to a Git argument list when it is absent. +; pre : args is a list and an optional transformation accepts a list. +; post : Existing porcelain options have not been duplicated. +; result : The transformed Git argument list. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (add-porcelain args info . f) (let ((m (has-git-arg? args #px"^[-][-]porcelain([=](.*))?")) (g (if (null? f) (λ (x) x) (car f))) @@ -59,6 +79,12 @@ (g args) (g (cons '--porcelain args))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Convert one porcelain status character to a semantic symbol. +; pre : status is one Git porcelain v1 status character. +; post : Unknown status characters have raised an exception. +; result : The corresponding semantic status symbol. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (status->symbol status) (cond ((string=? status " ") 'unchanged) @@ -73,6 +99,12 @@ ((string=? status "!") 'ignored) (else (error 'git-status "Unexpected status: ~a" status)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Recognize Git output that reports there is nothing to commit. +; pre : out is a list of Git output lines. +; post : out has only been inspected. +; result : #t when a known nothing-to-commit message occurs, otherwise #f. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (nothing-to-commit? out) (ormap (λ (line) (let ((line* (string-downcase line))) @@ -84,6 +116,12 @@ ;; Command definition macro ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Define and register a public Git command procedure. +; pre : pre-code and process-result follow the command proxy interfaces. +; post : cmd-sym is registered in the generic git command table. +; result : Definitions for the public and internal command procedures. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-syntax def-cmd (syntax-rules () ((_ cmd cmd* cmd-sym) @@ -104,10 +142,12 @@ ;; Typical git commands ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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) @@ -126,16 +166,20 @@ ) -;; 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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) @@ -154,48 +198,121 @@ (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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : List, create or delete branches. +; pre : The supplied arguments are valid for git branch. +; post : Git branch has completed successfully or an exception was raised. +; result : #t after a successful branch command. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def-cmd git-branch cmd-git-branch 'branch) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Clone a repository into a new directory. +; pre : The supplied arguments are valid for git clone. +; post : The clone exists or an exception was raised. +; result : #t after a successful clone. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Display the Git commit log or return it as a Racket list. +; pre : The supplied arguments are valid for git log; --list and -l are git-cli options. +; post : Git log has completed successfully or an exception has been raised. +; result : A list of (commit subject) items with --list/-l, otherwise #t. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def-cmd git-log cmd-git-log 'log + (λ (args info) + (map (λ (e) + (let ((o (format "~a" e))) + (cond + ((or + (string=? o "--list") + (string=? o "-l")) + (begin + (hash-set! info 'scheme-format #t) + "--oneline")) + (else e)))) + args)) + (λ (cmd exit-code result output out info) + (if (hash-ref info 'scheme-format #f) + (if (and (= exit-code 0) result) + (let ((re #px"([0-9a-f]+)\\s+(.*)")) + (map (λ (line) + (let ((m (regexp-match re line))) + (if m + (list (cadr m) (caddr m)) + (list #f line)))) + out)) + #f) + (std-process-git-result cmd exit-code result output out info))) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : List commit objects reachable from supplied revisions. +; pre : The supplied arguments are valid for git rev-list. +; post : Git rev-list has completed successfully or an exception was raised. +; result : #t after successfully displaying the result. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def-cmd git-rev-list cmd-git-rev-list 'rev-list) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Render a Git diff in the default browser. +; pre : The supplied arguments are valid for git diff or +; are special cases like --output=-, --output=string. +; post : A successful diff has been rendered as HTML or +; to stdout/string. +; result : #t or a string when a diff was rendered, otherwise #f. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def-cmd git-diff cmd-git-diff 'diff - (λ (args info) args) + (λ (args info) + (hash-set! info 'file-output (has-git-arg? args #px"^[-][-]output[=]")) + (hash-set! info 'stdout (has-git-arg? args #px"^[-][-]output[=][-]")) + (hash-set! info 'string (has-git-arg? args #px"^[-][-]output[=]string")) + (if (or (hash-ref info 'stdout #f) (hash-ref info 'string #f)) + (filter (λ (e) (not (has-git-arg? (list e) #px"^[-][-]output[=]([-]|string)"))) args) + args)) (λ (cmd exit-code result output out info) (if (and (zero? exit-code) result) - (let ((diff (string-join - (filter (λ (line) + (if (eq? (hash-ref info 'file-output #f) #f) + (let ((diff (string-join + (filter (λ (line) (not (string-prefix? (string-downcase line) "warning:"))) - out) - "\n"))) - (diff->html diff) - #t) - #f))) + out) + "\n"))) + (diff->html diff) + #t) + (if (hash-ref info 'string #f) + (string-join out "\n") + (std-process-git-result cmd exit-code result output out info))) + (std-process-git-result cmd exit-code result output out info)))) -;; 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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) @@ -244,6 +361,13 @@ #f)))) ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Display help for Git or a Git command. +; pre : The supplied arguments are valid for git help. +; post : Git help has completed successfully or an exception was raised. +; result : #t after successfully displaying help. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def-cmd git-help cmd-git-help 'help) @@ -251,21 +375,41 @@ ;; Racket module versioning ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Return the package version from info.rkt. +; pre : No arguments are required. +; post : info.rkt has only been inspected. +; result : A list containing major, minor and patch. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (git-version . args) (cmd-git-version args)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Implement the registered version command. +; pre : args is the command argument list. +; post : info.rkt has only been inspected. +; result : A list containing major, minor and patch. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (cmd-git-version args) (info-version ".")) (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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Implement the registered new-version command. +; pre : args contains a supported version kind. +; post : The version definition in info.rkt has been updated. +; result : The new version as a list containing major, minor and patch. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (cmd-git-new-version args) (when(null? args) (error "git-new-version expects 'maj, 'major, 'min, 'minor or 'patch")) diff --git a/private/config.rkt b/private/config.rkt index d7999d3..f4c33b8 100644 --- a/private/config.rkt +++ b/private/config.rkt @@ -43,11 +43,24 @@ ;; Provided functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Store one git-cli configuration value. +; pre : section and key identify a simple-ini setting. +; post : value has been persisted. +; result : The result returned by simple-ini. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (cfg-set! section key value) (critical (check-ini) (send ini set! section key value))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Read one git-cli configuration value. +; pre : section and key identify a simple-ini setting. +; post : Configuration has not been changed. +; result : The stored value or default-value. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (cfg-get section key default-value) (critical (check-ini) diff --git a/private/diff.rkt b/private/diff.rkt index d680a32..75fed8e 100644 --- a/private/diff.rkt +++ b/private/diff.rkt @@ -11,6 +11,12 @@ (define (make-js . args) (string-join args "\n")) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Render a Git diff in a temporary HTML file. +; pre : diff is a unified Git diff string. +; post : The generated HTML file has been opened in the default browser. +; result : void. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (diff->html diff) (let ((highlight-css "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.8.0/styles/github.min.css") (diff2html-min-css "https://cdn.jsdelivr.net/npm/diff2html/bundles/css/diff2html.min.css") diff --git a/private/git-commands.rkt b/private/git-commands.rkt index 6f8425d..5dbf9a2 100644 --- a/private/git-commands.rkt +++ b/private/git-commands.rkt @@ -12,6 +12,12 @@ ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Determine whether a Git option occurs in an argument list. +; pre : args is a list and opt is a symbol, string or regular expression. +; post : args has only been inspected. +; result : The match result, or #f when the option is absent. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (has-git-arg? args opt) (let ((cmp (cond ((symbol? opt) (λ (x) (eq? x opt))) ((string? opt) (λ (x) (string=? (format "~a" x) opt))) @@ -28,6 +34,13 @@ (f args) (error 'has-git-arg? "args must be a list of arguments"))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Check that mandatory Git options and their arguments are present. +; pre : flags contains (option argument-count error-message) items. +; post : Missing options have raised an exception. +; result : args when every mandatory option is present. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (check-git-args cmd args flags) (for-each (λ (opt) @@ -51,10 +64,12 @@ 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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) (begin @@ -65,10 +80,12 @@ ) -;; 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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 pre-code process-result) diff --git a/private/git-provider.rkt b/private/git-provider.rkt index fde9f9c..dc054bf 100644 --- a/private/git-provider.rkt +++ b/private/git-provider.rkt @@ -47,6 +47,12 @@ ;; Provided functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Find the configured Git executable. +; pre : Git is on PATH or a valid executable can be selected interactively. +; post : The executable path has been cached. +; result : The path to git or git.exe. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define/contract (git-exe) (-> (or/c path? #f)) (if (eq? cached-git-exe #f) @@ -64,6 +70,13 @@ the-git-exe) cached-git-exe)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Configure the Git executable. +; pre : exe-path names an executable path. +; post : The path has been stored and cached. +; result : void. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define/contract (set-git-exe! exe-path) (-> path? void?) (void @@ -72,6 +85,13 @@ (set! cached-git-exe exe-path)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Run Git without allowing interactive terminal prompts. +; pre : args contains the Git command and its arguments. +; post : Standard output and error have been read completely. +; result : The exit code and ordered (source line) output items. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (run-git args) (putenv "GIT_TERMINAL_PROMPT" "0") (let-values (((process stdout stdin stderr) @@ -123,6 +143,13 @@ (define (is-error? e) (not (is-output? e))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Separate normal Git output from error output. +; pre : output contains (source line) items returned by run-git. +; post : output has only been inspected. +; result : Whether no error occurred and either normal or error lines. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (git-out cmd output) (let* ((out (map (λ (e) (cadr e)) (filter (λ (e) (is-output? e)) output))) (err (map (λ (e) (cadr e)) (filter (λ (e) (is-error? e)) output))) @@ -130,6 +157,13 @@ ) (values r (if (eq? r #t) out err)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Log and raise a Git exception. +; pre : cmd, msg* and outp describe a failed Git command. +; post : The message has been logged and an exception has been raised. +; result : No normal return value. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-syntax git-error (syntax-rules () ((_ cmd msg* outp) @@ -153,6 +187,13 @@ (define re-a #px"~+") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Log Git output and optionally display it. +; pre : out is a string or a list of displayable lines. +; post : Non-empty output has been logged. +; result : void. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (git-displ out) (let ((str (if (string? out) out (string-join out "\n")))) (unless (string=? (string-trim str) "") diff --git a/private/info.rkt b/private/info.rkt index 1f0ef33..c686ed3 100644 --- a/private/info.rkt +++ b/private/info.rkt @@ -9,6 +9,12 @@ git-next-version ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Read a package version from info.rkt. +; pre : dir contains a readable info.rkt. +; post : info.rkt has only been inspected. +; result : A list containing major, minor and patch. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (info-version dir) (let* ((l (get-info/full dir)) (re #px"([0-9]+)[.]([0-9]+)([.]([0-9]+))?") @@ -23,6 +29,13 @@ (cadddr (cdr m))))) )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Store a package version in info.rkt. +; pre : dir contains info.rkt and version parts are numbers. +; post : The version definition has been replaced. +; result : #t after writing the file. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (set-info-version! dir maj min patch) (define (write-version fh) @@ -54,6 +67,13 @@ #t))))) ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Increment a package version. +; pre : kind is maj, major, min, minor or patch. +; post : The version definition in info.rkt has been updated. +; result : #t after writing the new version. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (git-next-version kind . dir*) (let ((dir (if (null? dir*) "." diff --git a/scribblings/git.scrbl b/scribblings/git.scrbl index 7a79fd9..dcdd8e9 100644 --- a/scribblings/git.scrbl +++ b/scribblings/git.scrbl @@ -1,8 +1,8 @@ #lang scribble/manual @(require (for-label racket/base + racket/contract "../main.rkt")) -@;git-cli)) @title[#:tag "top"]{git-cli} @author{Hans Dijkema} @@ -10,18 +10,27 @@ @defmodule[git-cli] 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. +implemented by invoking the @tt{git} executable. Commands do not allow Git to +read credentials or other answers from the terminal. + +@section{Command interface} @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], +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['branch], @racket['clone], @racket['log], @racket['rev-list], @racket['diff], @racket['grep], @racket['help], @racket['version], and @racket['new-version]. + +Most registered commands invoke the Git command with the same name. Some +commands process the result into a Racket value, such as @racket['status], +@racket['grep], @racket['log] with @tt{--list}, @racket['version], and +@racket['new-version]. } +@section{Provided commands} + @defproc[(git-status [argument any/c] ...) list?]{ Runs @tt{git status --porcelain} with the supplied arguments. @@ -37,11 +46,11 @@ Both statuses are one of @racket['unchanged], @racket['modified], are @racket['untracked]. @racketblock[ -((modified unchanged "staged.rkt") - (unchanged modified "working-tree.rkt") - (modified modified "both.rkt") - (renamed unchanged "old.rkt -> new.rkt") - (untracked untracked "new.rkt")) +'((modified unchanged "staged.rkt") + (unchanged modified "working-tree.rkt") + (modified modified "both.rkt") + (renamed unchanged "old.rkt -> new.rkt") + (untracked untracked "new.rkt")) ]} @defproc[(git-add [argument any/c] ...) boolean?]{ @@ -62,11 +71,27 @@ 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. +error is accepted when Git exits successfully. } -@defproc[(git-log [argument any/c] ...) boolean?]{ +@defproc[(git-log [argument any/c] ...) (or/c boolean? list?)]{ Displays Git log output and returns @racket[#t] when Git exits successfully. + +The git-cli-specific option @tt{--list}, or its short form @tt{-l}, changes the +result to a Racket list. Internally this option is replaced by Git's +@tt{--oneline} option. Each returned item contains the abbreviated commit id and +the commit subject. + +@racketblock[ +(git-log '--list '-5) + +'(("003f371" "Diverse commando's toegevoegd. Ik weet nog niet of ik ze allemaal ga houden") + ("2cb7e93" "Small changes. git main function is now a real function, not syntax")) +] + +Other Git log options are still passed to Git. Consequently, options that add +extra output lines can also influence how useful @tt{--list} is as a structured +result. } @defproc[(git-grep [argument any/c] ...) list?]{ @@ -75,6 +100,8 @@ optional match count, and matched text. Exit status one means that no matches were found and returns an empty list. } +@section{Package version} + @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