Added git show functionality

main.rkt

@@ -22,6 +22,7 @@
          git-clone
          git-rev-list
          git-diff
+         git-show
          git-help
          git-version
          git-new-version
@@ -307,6 +308,88 @@
                 (std-process-git-result cmd exit-code result output out info)))
         (std-process-git-result cmd exit-code result output out info))))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Show a Git object, render a commit diff as HTML or return structured output.
+; pre    : The supplied arguments are valid for git show; --list/-l and
+;          --output=html/--output=-/--output=string are git-cli options.
+; post   : Git show has completed successfully or an exception has been raised.
+; result : Structured Racket data with --list/-l, a string with --output=string,
+;          otherwise #t.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-show cmd-git-show 'show
+  (λ (args info)
+    (let* ((list-output (ormap (λ (e) (member (format "~a" e) '("--list" "-l"))) args))
+           (output-html (has-git-arg? args #px"^[-][-]output[=]html$"))
+           (output-stdout (has-git-arg? args #px"^[-][-]output[=][-]$"))
+           (output-string (has-git-arg? args #px"^[-][-]output[=]string$"))
+           (name-only (has-git-arg? args #px"^[-][-]name-only$"))
+           (name-status (has-git-arg? args #px"^[-][-]name-status$"))
+           (stat (has-git-arg? args #px"^[-][-]stat([=](.*))?$"))
+           (no-patch (or (has-git-arg? args #px"^[-][-]no-patch$")
+                         (has-git-arg? args "-s")))
+           (list-formats (filter (λ (x) x)
+                                 (list (if name-only 'name-only #f)
+                                       (if name-status 'name-status #f)
+                                       (if stat 'stat #f)))))
+      
+      (when (and list-output (or output-html output-stdout output-string))
+        (error 'git-show "--list/-l cannot be combined with --output=..."))
+      (when (and list-output (> (length list-formats) 1))
+        (error 'git-show "--list/-l accepts only one of --stat, --name-only or --name-status"))
+
+      (hash-set! info 'scheme-format list-output)
+      (hash-set! info 'show-list-format (if (null? list-formats) 'stat (car list-formats)))
+      (hash-set! info 'show-output
+                 (cond (output-html 'html)
+                       (output-stdout 'stdout)
+                       (output-string 'string)
+                       ((or stat name-only name-status no-patch) 'stdout)
+                       (else 'html)))
+
+      (let ((nargs (filter (λ (e)
+                             (not (member (format "~a" e)
+                                          '("--list" "-l"
+                                            "--output=html" "--output=-" "--output=string"))))
+                           args)))
+        (if (and list-output (null? list-formats))
+            (cons '--stat nargs)
+            nargs))))
+
+  (λ (cmd exit-code result output out info)
+    (if (and (zero? exit-code) result)
+        (cond
+          ((hash-ref info 'scheme-format #f)
+           (let ((lines (filter (λ (line) (not (string=? (string-trim line) ""))) out)))
+             (case (hash-ref info 'show-list-format 'stat)
+               ((name-only) lines)
+               ((name-status) (map (λ (line) (string-split line "\t")) lines))
+               ((stat)
+                (let ((file-re #px"^\\s*(.*?)\\s+[|]\\s+([0-9]+)\\s+([+\\-]+)$")
+                      (total-re #px"^([0-9]+) files? changed(, ([0-9]+) insertions?\\(\\+\\))?(, ([0-9]+) deletions?\\(-\\))?$"))
+                  (map (λ (line)
+                         (let* ((trimmed (string-trim line))
+                                (fm (regexp-match file-re line))
+                                (tm (regexp-match total-re trimmed)))
+                           (cond
+                             (fm (list 'file (cadr fm) (string->number (caddr fm)) (cadddr fm)))
+                             (tm (list 'total
+                                       (string->number (cadr tm))
+                                       (if (cadddr tm) (string->number (cadddr tm)) 0)
+                                       (if (list-ref tm 5) (string->number (list-ref tm 5)) 0)))
+                             (else (list 'info line)))))
+                       lines))))))
+          ((eq? (hash-ref info 'show-output 'html) 'string)
+           (string-join out "\n"))
+          ((eq? (hash-ref info 'show-output 'html) 'html)
+           (show->html
+            (string-join
+             (filter (λ (line) (not (string-prefix? (string-downcase line) "warning:"))) out)
+             "\n"))
+           #t)
+          (else (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.

private/diff.rkt

@@ -1,16 +1,62 @@
 #lang racket/base
 
 (require net/sendurl
+         racket/list
          json
          xml
          racket/string
+         "config.rkt"
          )
 
-(provide diff->html)
+(provide diff->html
+         show->html)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helper functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (make-js . args)
   (string-join args "\n"))
 
+(define (highlight-css)
+  (cfg-get 'diff 'highlight-css
+           "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.8.0/styles/github.min.css")
+  )
+
+(define (diff2html-min-css)
+  (cfg-get 'diff 'diff2html-min-css
+           "https://cdn.jsdelivr.net/npm/diff2html/bundles/css/diff2html.min.css")
+  )
+
+(define (diff2html-ui-min-js)
+  (cfg-get 'diff 'diff2html-ui-min-js
+           "https://cdn.jsdelivr.net/npm/diff2html/bundles/js/diff2html-ui.min.js")
+  )
+
+(define (diff-script diff)
+  (format
+   (make-js
+    "window.do_diff = function() {"
+    "const diff = ~a;"
+    "const ui = new Diff2HtmlUI("
+    "                   document.getElementById('diff'),"
+    "                   diff,"
+    "                   {"
+    "                     drawFileList: true,"
+    "                     matching: 'lines',"
+    "                     outputFormat: 'side-by-side',"
+    "                   });"
+    "ui.draw();"
+    "ui.highlightCode();"
+    "};"
+    )
+   (jsexpr->string diff))
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Exported functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Render a Git diff in a temporary HTML file.
 ; pre    : diff is a unified Git diff string.
@@ -18,44 +64,77 @@
 ; result : void.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (diff->html diff)
-  (let ((highlight-css "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.8.0/styles/github.min.css")
+  (let ((html `(html
-        (diff2html-min-css "https://cdn.jsdelivr.net/npm/diff2html/bundles/css/diff2html.min.css")
+                (head
-        (diff2html-ui-min-js "https://cdn.jsdelivr.net/npm/diff2html/bundles/js/diff2html-ui.min.js"))
+                 (meta ((charset "utf-8")))
-    (let ((html `(html
+                 (link ((rel "stylesheet") (href ,(highlight-css) )))
-                  (head
+                 (link ((rel "stylesheet") (href ,(diff2html-min-css) )))
-                   (meta ((charset "utf-8")))
+                 (script ((src ,diff2html-ui-min-js)) "")
-                   (link ((rel "stylesheet") (href ,highlight-css)))
+                 (script ,(diff-script diff))
-                   (link ((rel "stylesheet") (href ,diff2html-min-css)))
+                 )
-                   (script ((src ,diff2html-ui-min-js)) "")
+                (body
-                   (script ,(format
+                 (div ((id "diff")))
-                             (make-js
+                 (script ((type "text/javascript"))
-                              "window.do_diff = function() {"
+                         "window.do_diff();")
-                              "const diff = ~a;"
+                 ))))
-                              "const ui = new Diff2HtmlUI("
+    (let ((tmp-file (build-path (find-system-path 'temp-dir) "racket-git-diff.html")))
-                              "                   document.getElementById('diff'),"
+      (call-with-output-file tmp-file #:exists 'truncate
-                              "                   diff,"
+        (λ (out)
-                              "                   {"
+          (display (xexpr->string html) out)))
-                              "                     drawFileList: true,"
+      (send-url/file tmp-file))))
-                              "                     matching: 'lines',"
+
-                              "                     outputFormat: 'side-by-side',"
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-                              "                   });"
+; goal   : Render git show output as commit information followed by a diff.
-                              "ui.draw();"
+; pre    : show is the textual output produced by git show.
-                              "ui.highlightCode();"
+; post   : The generated HTML file has been opened in the default browser.
-                              "};"
+; result : void.
-                              )
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-                             (jsexpr->string diff))
+(define (show->html show)
-                           )
+  (let* ((lines (string-split show "\n" #:trim? #f))
-                   )
+         (diff-pos (let loop ((rest lines) (n 0))
-                  (body
+                     (cond ((null? rest) #f)
-                   (div ((id "diff")))
+                           ((string-prefix? (car rest) "diff --git ") n)
-                   (script ((type "text/javascript"))
+                           (else (loop (cdr rest) (+ n 1))))))
-                           "window.do_diff();")
+         (header (string-join (if diff-pos (take lines diff-pos) lines) "\n"))
-                   ))))
+         (diff (string-join (if diff-pos (drop lines diff-pos) '()) "\n"))
-      (let ((tmp-file (build-path (find-system-path 'temp-dir) "racket-git-diff.html")))
+         (highlight-css "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.8.0/styles/github.min.css")
-        (call-with-output-file tmp-file #:exists 'truncate
+         (diff2html-min-css "https://cdn.jsdelivr.net/npm/diff2html/bundles/css/diff2html.min.css")
-          (λ (out)
+         (diff2html-ui-min-js "https://cdn.jsdelivr.net/npm/diff2html/bundles/js/diff2html-ui.min.js")
-            (display (xexpr->string html) out)))
+         (html
-        (send-url/file tmp-file)))))
+          `(html
-      
+            (head
-      
+             (meta ((charset "utf-8")))
+             (link ((rel "stylesheet") (href ,highlight-css)))
+             (link ((rel "stylesheet") (href ,diff2html-min-css)))
+             (style "body { font-family: sans-serif; margin: 1.5em; } pre.commit { white-space: pre-wrap; }")
+             ,@(if diff-pos
+                   `((script ((src ,diff2html-ui-min-js)) "")
+                     (script
+                      ,(format
+                        (make-js
+                         "window.do_diff = function() {"
+                         "const diff = ~a;"
+                         "const ui = new Diff2HtmlUI("
+                         "                   document.getElementById('diff'),"
+                         "                   diff,"
+                         "                   {"
+                         "                     drawFileList: true,"
+                         "                     matching: 'lines',"
+                         "                     outputFormat: 'side-by-side',"
+                         "                   });"
+                         "ui.draw();"
+                         "ui.highlightCode();"
+                         "};")
+                        (jsexpr->string diff))))
+                   '()))
+            (body
+             (pre ((class "commit")) ,header)
+             ,@(if diff-pos
+                   `((div ((id "diff")))
+                     (script ((type "text/javascript")) "window.do_diff();"))
+                   '()))))
+         (tmp-file (build-path (find-system-path 'temp-dir) "racket-git-show.html")))
+    (call-with-output-file tmp-file #:exists 'truncate
+      (λ (out) (display (xexpr->string html) out)))
+    (send-url/file tmp-file)))
 

scribblings/git.scrbl

@@ -20,7 +20,7 @@ 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['show], @racket['grep], @racket['help], @racket['version], and
 @racket['new-version].
 
 Most registered commands invoke the Git command with the same name. Some
@@ -94,6 +94,48 @@ extra output lines can also influence how useful @tt{--list} is as a structured
 result.
 }
 
+
+
+@defproc[(git-show [argument any/c] ...) (or/c boolean? string? list?)]{
+Shows a Git object.
+
+For a commit that includes a patch, the default git-cli output is HTML. The
+commit information is shown above the diff and the diff is rendered using the
+same Diff2Html presentation as @racket[git-diff].
+
+The git-cli-specific output options are @tt{--output=html},
+@tt{--output=-}, and @tt{--output=string}. @tt{--output=html} explicitly
+selects the HTML presentation, @tt{--output=-} keeps Git's normal textual
+output, and @tt{--output=string} returns that textual output as a string.
+Options such as @tt{--stat}, @tt{--name-only}, @tt{--name-status}, and
+@tt{--no-patch} default to textual output because they do not normally contain
+a patch.
+
+The git-cli-specific option @tt{--list}, or its short form @tt{-l}, returns a
+Racket value. Without another show-format option it implies @tt{--stat}.
+
+@racketblock[
+(git-show '-l "9741b1c")
+]
+
+The result of @tt{--stat --list} contains @racket['file] and
+@racket['total] items:
+
+@racketblock[
+'((file "README.md" 67 "+++---")
+  (file "main.rkt" 532 "++++-------------------------------------------")
+  (total 9 124 823))
+]
+
+With @tt{--name-only --list}, the result is a list of file names. With
+@tt{--name-status --list}, every result item is the tab-separated Git
+name-status record converted to a list of strings.
+
+@tt{--list}/@tt{-l} cannot be combined with @tt{--output=...}. Only one of
+@tt{--stat}, @tt{--name-only}, and @tt{--name-status} can be used with
+@tt{--list}.
+}
+
 @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