suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

DrDr, test this push

Browse Source
This commit is contained in:
Jay McCarthy 2011-11-01 11:14:10 -06:00
parent c2065b2128
commit 6466c480b0
2 changed files with 25 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/meta/drdr/monitor-scm.rkt
View File

@ -8,7 +8,7 @@
(define (monitor-scm repos start-rev notify-newer! notify-user!) (define (monitor-scm repos start-rev notify-newer! notify-user!)
(define (monitor-w/o-wait prev-rev) (define (monitor-w/o-wait prev-rev)
(define new-revs (define new-revs
(scm-revisions-after prev-rev)) (scm-revisions-after prev-rev repos))
(match new-revs (match new-revs
[(list) [(list)
; There has not yet been more revisions ; There has not yet been more revisions

38
collects/meta/drdr/scm.rkt
View File

@ -120,20 +120,23 @@
[else [else
empty])) empty]))
(define (parse-push num author in-p)
(make-git-push num author (read-commits in-p)))
(define (get-scm-commit-msg rev repo) (define (get-scm-commit-msg rev repo)
(match-define (struct push-data (who _ branches)) (push-info rev)) (match-define (struct push-data (who _ branches)) (push-info rev))
(match-define (vector start-commit end-commit) (hash-ref branches master-branch)) (make-git-push
(parameterize ([current-directory repo]) rev who
(system/output-port (apply append
#:k (curry parse-push rev who) (for/list
(git-path) ([(branch cs) branches])
"--no-pager" "log" "--date=iso" "--name-only" "--no-merges" (match-define (vector start-commit end-commit) cs)
(format "~a..~a" start-commit end-commit)))) (parameterize
([current-directory repo])
(system/output-port
#:k read-commits
(git-path)
"--no-pager" "log" "--date=iso" "--name-only" "--no-merges"
(format "~a..~a" start-commit end-commit)))))))
(provide/contract (provide/contract
[struct git-push [struct git-push
([num exact-nonnegative-integer?] ([num exact-nonnegative-integer?]
[author string?] [author string?]
[commits (listof git-commit?)])] [commits (listof git-commit?)])]
@ -212,16 +215,23 @@
(define master-branch "refs/heads/master") (define master-branch "refs/heads/master")
(define (scm-revisions-after cur-rev) (define (contains-drdr-request? p)
(for*/or ([c (in-list (git-push-commits p))]
[m (in-list (git-commit-msg c))])
(regexp-match #rx"DrDr, test this push" m)))
(define (scm-revisions-after cur-rev repo)
(define newest-rev (newest-push)) (define newest-rev (newest-push))
(for/list ([rev (in-range (add1 cur-rev) (add1 newest-rev))] (for/list ([rev (in-range (add1 cur-rev) (add1 newest-rev))]
#:when #:when
(let ([info (push-info rev)]) (let ([info (push-info rev)])
(and info (hash-has-key? (push-data-branches info) master-branch)))) (and info
(or (hash-has-key? (push-data-branches info) master-branch)
(contains-drdr-request? (get-scm-commit-msg rev repo))))))
rev)) rev))
(provide/contract (provide/contract
[scm-update (path? . -> . void?)] [scm-update (path? . -> . void?)]
[scm-revisions-after (exact-nonnegative-integer? . -> . (listof exact-nonnegative-integer?))] [scm-revisions-after (exact-nonnegative-integer? path-string? . -> . (listof exact-nonnegative-integer?))]
[scm-export-file (exact-nonnegative-integer? path-string? string? path-string? . -> . void?)] [scm-export-file (exact-nonnegative-integer? path-string? string? path-string? . -> . void?)]
[scm-export-repo (exact-nonnegative-integer? path-string? path-string? . -> . void?)]) [scm-export-repo (exact-nonnegative-integer? path-string? path-string? . -> . void?)])