Adding branch information to commits
This commit is contained in:
parent
acc95cbb56
commit
32d1060c33
|
@ -153,14 +153,21 @@
|
||||||
".." ,(substring end-commit 0 8))))
|
".." ,(substring end-commit 0 8))))
|
||||||
,@(append-map
|
,@(append-map
|
||||||
(match-lambda
|
(match-lambda
|
||||||
[(struct git-merge (hash author date msg from to))
|
[(or (and (struct git-merge (hash author date msg from to))
|
||||||
|
(app (λ (x) #f) branch))
|
||||||
|
(struct git-merge* (branch hash author date msg from to)))
|
||||||
; Don't display these "meaningless" commits
|
; Don't display these "meaningless" commits
|
||||||
empty]
|
empty]
|
||||||
[(struct git-diff (hash author date msg mfiles))
|
[(or (and (struct git-diff (hash author date msg mfiles))
|
||||||
|
(app (λ (x) #f) branch))
|
||||||
|
(struct git-diff* (branch hash author date msg mfiles)))
|
||||||
(define cg-id (symbol->string (gensym 'changes)))
|
(define cg-id (symbol->string (gensym 'changes)))
|
||||||
(define ccss-id
|
(define ccss-id
|
||||||
(symbol->string (gensym 'changes)))
|
(symbol->string (gensym 'changes)))
|
||||||
`((tr
|
`(,@(if branch
|
||||||
|
(list `(tr ([class "branch"]) (td "Branch:") (td ,branch)))
|
||||||
|
empty)
|
||||||
|
(tr
|
||||||
([class "hash"])
|
([class "hash"])
|
||||||
(td "Commit:")
|
(td "Commit:")
|
||||||
(td
|
(td
|
||||||
|
@ -649,7 +656,7 @@
|
||||||
@p{The timing files are a list of S-expressions. Their grammar is: @code{(push duration ((cpu real gc) ...))} where @code{push} is an integer, @code{duration} is an inexact millisecond, and @code{cpu}, @code{real}, and @code{gc} are parsed from the @code{time-apply} function.}
|
@p{The timing files are a list of S-expressions. Their grammar is: @code{(push duration ((cpu real gc) ...))} where @code{push} is an integer, @code{duration} is an inexact millisecond, and @code{cpu}, @code{real}, and @code{gc} are parsed from the @code{time-apply} function.}
|
||||||
|
|
||||||
@h1{Why are some pushes missing?}
|
@h1{Why are some pushes missing?}
|
||||||
@p{Some pushes are missing because they only modify branches. Only pushes that change the @code{master} branch are tested.}
|
@p{Some pushes are missing because they only modify branches. Only pushes that change the @code{master} or @code{release} branch are tested.}
|
||||||
|
|
||||||
@h1{How do I make the most use of DrDr?}
|
@h1{How do I make the most use of DrDr?}
|
||||||
@p{So DrDr can be effective with all testing packages and untested code, it only pays attention to error output and non-zero exit codes. You can make the most of this strategy by ensuring that when your tests are run successfully they have no STDERR output and exit cleanly, but have both when they fail.}
|
@p{So DrDr can be effective with all testing packages and untested code, it only pays attention to error output and non-zero exit codes. You can make the most of this strategy by ensuring that when your tests are run successfully they have no STDERR output and exit cleanly, but have both when they fail.}
|
||||||
|
|
|
@ -82,6 +82,10 @@
|
||||||
(define-struct (git-diff git-commit) (mfiles) #:prefab)
|
(define-struct (git-diff git-commit) (mfiles) #:prefab)
|
||||||
(define-struct (git-merge git-commit) (from to) #:prefab)
|
(define-struct (git-merge git-commit) (from to) #:prefab)
|
||||||
|
|
||||||
|
(define-struct git-commit* (branch hash author date msg) #:prefab)
|
||||||
|
(define-struct (git-diff* git-commit*) (mfiles) #:prefab)
|
||||||
|
(define-struct (git-merge* git-commit*) (from to) #:prefab)
|
||||||
|
|
||||||
(define (read-until-empty-line in-p)
|
(define (read-until-empty-line in-p)
|
||||||
(let loop ()
|
(let loop ()
|
||||||
(let ([l (read-line in-p)])
|
(let ([l (read-line in-p)])
|
||||||
|
@ -94,7 +98,7 @@
|
||||||
[else
|
[else
|
||||||
(list* (regexp-replace #rx"^ +" l "") (loop))]))))
|
(list* (regexp-replace #rx"^ +" l "") (loop))]))))
|
||||||
|
|
||||||
(define (read-commit in-p)
|
(define (read-commit branch in-p)
|
||||||
(match (read-line in-p)
|
(match (read-line in-p)
|
||||||
[(? eof-object?)
|
[(? eof-object?)
|
||||||
#f]
|
#f]
|
||||||
|
@ -105,24 +109,24 @@
|
||||||
(match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
|
(match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
|
||||||
(define _1 (read-line in-p))
|
(define _1 (read-line in-p))
|
||||||
(define msg (read-until-empty-line in-p))
|
(define msg (read-until-empty-line in-p))
|
||||||
(make-git-merge hash author date msg from to)]
|
(make-git-merge* branch hash author date msg from to)]
|
||||||
[(regexp #rx"^Author: +(.+)$" (list _ author))
|
[(regexp #rx"^Author: +(.+)$" (list _ author))
|
||||||
(match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
|
(match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
|
||||||
(define _1 (read-line in-p))
|
(define _1 (read-line in-p))
|
||||||
(define msg (read-until-empty-line in-p))
|
(define msg (read-until-empty-line in-p))
|
||||||
(define mfiles (read-until-empty-line in-p))
|
(define mfiles (read-until-empty-line in-p))
|
||||||
(make-git-diff hash author date msg mfiles)])]))
|
(make-git-diff* branch hash author date msg mfiles)])]))
|
||||||
|
|
||||||
(define port-empty? port-closed?)
|
(define port-empty? port-closed?)
|
||||||
|
|
||||||
(define (read-commits in-p)
|
(define (read-commits branch in-p)
|
||||||
(cond
|
(cond
|
||||||
[(port-empty? in-p)
|
[(port-empty? in-p)
|
||||||
empty]
|
empty]
|
||||||
[(read-commit in-p)
|
[(read-commit branch in-p)
|
||||||
=> (lambda (c)
|
=> (lambda (c)
|
||||||
(printf "~S\n" c)
|
(printf "~S\n" c)
|
||||||
(list* c (read-commits in-p)))]
|
(list* c (read-commits branch in-p)))]
|
||||||
[else
|
[else
|
||||||
empty]))
|
empty]))
|
||||||
|
|
||||||
|
@ -137,7 +141,7 @@
|
||||||
(parameterize
|
(parameterize
|
||||||
([current-directory repo])
|
([current-directory repo])
|
||||||
(system/output-port
|
(system/output-port
|
||||||
#:k read-commits
|
#:k (curry read-commits branch)
|
||||||
(git-path)
|
(git-path)
|
||||||
"--no-pager" "log" "--date=iso" "--name-only" "--no-merges"
|
"--no-pager" "log" "--date=iso" "--name-only" "--no-merges"
|
||||||
(format "~a..~a" start-commit end-commit)))))))
|
(format "~a..~a" start-commit end-commit)))))))
|
||||||
|
@ -164,6 +168,27 @@
|
||||||
[msg (listof string?)]
|
[msg (listof string?)]
|
||||||
[from string?]
|
[from string?]
|
||||||
[to string?])]
|
[to string?])]
|
||||||
|
[struct git-commit*
|
||||||
|
([branch string?]
|
||||||
|
[hash string?]
|
||||||
|
[author string?]
|
||||||
|
[date string?]
|
||||||
|
[msg (listof string?)])]
|
||||||
|
[struct git-diff*
|
||||||
|
([branch string?]
|
||||||
|
[hash string?]
|
||||||
|
[author string?]
|
||||||
|
[date string?]
|
||||||
|
[msg (listof string?)]
|
||||||
|
[mfiles (listof string?)])]
|
||||||
|
[struct git-merge*
|
||||||
|
([branch string?]
|
||||||
|
[hash string?]
|
||||||
|
[author string?]
|
||||||
|
[date string?]
|
||||||
|
[msg (listof string?)]
|
||||||
|
[from string?]
|
||||||
|
[to string?])]
|
||||||
[get-scm-commit-msg (exact-nonnegative-integer? path-string? . -> . git-push?)])
|
[get-scm-commit-msg (exact-nonnegative-integer? path-string? . -> . git-push?)])
|
||||||
|
|
||||||
(define (git-push-previous-commit gp)
|
(define (git-push-previous-commit gp)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user