ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-25 20:19:18 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

etc/committer: Teach it how to commit package removal.

Browse source 
* etc/committer.scm.in (hunk-types): New variable.
(<hunk>): Rename hunk-definition? getter to 'hunk-type'.
(diff-info): Mute a git warning by separating file names from arguments with
'--'.  Rename the 'definitions?' variable to 'type'.
Use the 'addition type when a new package addition is detected, 'removal when
removed else #f.
(add-commit-message): Re-indent.
(remove-commit-message): New procedure.
(main)[definitions]: Make commit message conditional depending on whether it
is an addition or removal.
[changes]: Adjust indentation.
This commit is contained in:
Maxim Cournoyer 2022-04-25 22:56:08 -04:00
parent 6c956243bc
commit 5e6efdfeec
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 91 additions and 73 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

164
etc/committer.scm.in
View file

@ -101,12 +101,16 @@ (define (surrounding-sexp port line-no)
(read-line port) (read-line port)
(loop (1- i) last-top-level-sexp)))))) (loop (1- i) last-top-level-sexp))))))
;;; Whether the hunk contains a newly added package (definition), a removed
;;; package (removal) or something else (#false).
(define hunk-types '(addition removal #false))
(define-record-type <hunk> (define-record-type <hunk>
(make-hunk file-name (make-hunk file-name
old-line-number old-line-number
new-line-number new-line-number
diff-lines diff-lines
definition?) type)
hunk? hunk?
(file-name hunk-file-name) (file-name hunk-file-name)
;; Line number before the change ;; Line number before the change
@ -115,8 +119,8 @@ (define-record-type <hunk>
(new-line-number hunk-new-line-number) (new-line-number hunk-new-line-number)
;; The full diff to be used with "git apply --cached" ;; The full diff to be used with "git apply --cached"
(diff-lines hunk-diff-lines) (diff-lines hunk-diff-lines)
;; Does this hunk add a definition? ;; Does this hunk add or remove a package?
(definition? hunk-definition?)) (type hunk-type)) ;one of 'hunk-types'
(define* (hunk->patch hunk #:optional (port (current-output-port))) (define* (hunk->patch hunk #:optional (port (current-output-port)))
(let ((file-name (hunk-file-name hunk))) (let ((file-name (hunk-file-name hunk)))
@ -134,25 +138,30 @@ (define (diff-info)
;; new definitions with changes to existing ;; new definitions with changes to existing
;; definitions. ;; definitions.
"--unified=1" "--unified=1"
"gnu"))) "--" "gnu")))
(define (extract-line-number line-tag) (define (extract-line-number line-tag)
(abs (string->number (abs (string->number
(car (string-split line-tag #\,))))) (car (string-split line-tag #\,)))))
(define (read-hunk) (define (read-hunk)
(let loop ((lines '()) (let loop ((lines '())
(definition? #false)) (type #false))
(let ((line (read-line port 'concat))) (let ((line (read-line port 'concat)))
(cond (cond
((eof-object? line) ((eof-object? line)
(values (reverse lines) definition?)) (values (reverse lines) type))
((or (string-prefix? "@@ " line) ((or (string-prefix? "@@ " line)
(string-prefix? "diff --git" line)) (string-prefix? "diff --git" line))
(unget-string port line) (unget-string port line)
(values (reverse lines) definition?)) (values (reverse lines) type))
(else (else
(loop (cons line lines) (loop (cons line lines)
(or definition? (or type
(string-prefix? "+(define" line)))))))) (cond
((string-prefix? "+(define" line)
'addition)
((string-prefix? "-(define" line)
'removal)
(else #false)))))))))
(define info (define info
(let loop ((acc '()) (let loop ((acc '())
(file-name #f)) (file-name #f))
@ -167,13 +176,13 @@ (define info
(match (string-split line #\space) (match (string-split line #\space)
((_ old-start new-start . _) ((_ old-start new-start . _)
(let-values (let-values
(((diff-lines definition?) (read-hunk))) (((diff-lines type) (read-hunk)))
(loop (cons (make-hunk file-name (loop (cons (make-hunk file-name
(extract-line-number old-start) (extract-line-number old-start)
(extract-line-number new-start) (extract-line-number new-start)
(cons (string-append line "\n") (cons (string-append line "\n")
diff-lines) diff-lines)
definition?) acc) type) acc)
file-name))))) file-name)))))
(else (loop acc file-name)))))) (else (loop acc file-name))))))
(close-pipe port) (close-pipe port)
@ -263,10 +272,18 @@ (define version
(listify added)))))))))) (listify added))))))))))
'(inputs propagated-inputs native-inputs))) '(inputs propagated-inputs native-inputs)))
(define* (add-commit-message file-name variable-name #:optional (port (current-output-port))) (define* (add-commit-message file-name variable-name
"Print ChangeLog commit message for a change to FILE-NAME adding a definition." #:optional (port (current-output-port)))
(format port "Print ChangeLog commit message for a change to FILE-NAME adding a
"gnu: Add ~a.~%~%* ~a (~a): New variable.~%" definition."
(format port "gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
variable-name file-name variable-name))
(define* (remove-commit-message file-name variable-name
#:optional (port (current-output-port)))
"Print ChangeLog commit message for a change to FILE-NAME removing a
definition."
(format port "gnu: Remove ~a.~%~%* ~a (~a): Delete variable.~%"
variable-name file-name variable-name)) variable-name file-name variable-name))
(define* (custom-commit-message file-name variable-name message changelog (define* (custom-commit-message file-name variable-name message changelog
@ -345,66 +362,67 @@ (define* (change-commit-message* file-name old new #:rest rest)
(() (()
(display "Nothing to be done.\n" (current-error-port))) (display "Nothing to be done.\n" (current-error-port)))
(hunks (hunks
(let-values (let-values (((definitions changes) (partition hunk-type hunks)))
(((definitions changes) ;; Additions/removals.
(partition hunk-definition? hunks))) (for-each
(lambda (hunk)
(and-let* ((define-line (find (cut string-match "(\\+|-)\\(define" <>)
(hunk-diff-lines hunk)))
(variable-name (and=> (string-tokenize define-line)
second))
(commit-message-proc (match (hunk-type hunk)
('addition add-commit-message)
('removal remove-commit-message))))
(commit-message-proc (hunk-file-name hunk) variable-name)
(let ((port (open-pipe* OPEN_WRITE
"git" "apply"
"--cached"
"--unidiff-zero")))
(hunk->patch hunk port)
(unless (eqv? 0 (status:exit-val (close-pipe port)))
(error "Cannot apply")))
;; Additions. (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
(for-each (lambda (hunk) (commit-message-proc (hunk-file-name hunk) variable-name port)
(and-let* (usleep %delay)
((define-line (find (cut string-prefix? "+(define" <>) (unless (eqv? 0 (status:exit-val (close-pipe port)))
(hunk-diff-lines hunk))) (error "Cannot commit"))))
(variable-name (and=> (string-tokenize define-line) second))) (usleep %delay))
(add-commit-message (hunk-file-name hunk) variable-name) definitions))
(let ((port (open-pipe* OPEN_WRITE
"git" "apply"
"--cached"
"--unidiff-zero")))
(hunk->patch hunk port)
(unless (eqv? 0 (status:exit-val (close-pipe port)))
(error "Cannot apply")))
(let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) ;; Changes.
(add-commit-message (hunk-file-name hunk) (for-each
variable-name port) (match-lambda
(usleep %delay) ((new old . hunks)
(for-each (lambda (hunk)
(let ((port (open-pipe* OPEN_WRITE
"git" "apply"
"--cached"
"--unidiff-zero")))
(hunk->patch hunk port)
(unless (eqv? 0 (status:exit-val (close-pipe port))) (unless (eqv? 0 (status:exit-val (close-pipe port)))
(error "Cannot commit")))) (error "Cannot apply")))
(usleep %delay)) (usleep %delay))
definitions) hunks)
(define copyright-line
;; Changes. (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line)
(for-each (match-lambda (const line)))
((new old . hunks) (hunk-diff-lines (first hunks))))
(for-each (lambda (hunk) (cond
(let ((port (open-pipe* OPEN_WRITE (copyright-line
"git" "apply" (add-copyright-line copyright-line))
"--cached" (else
"--unidiff-zero"))) (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
(hunk->patch hunk port) (change-commit-message* (hunk-file-name (first hunks))
(unless (eqv? 0 (status:exit-val (close-pipe port))) old new)
(error "Cannot apply"))) (change-commit-message* (hunk-file-name (first hunks))
(usleep %delay)) old new
hunks) port)
(define copyright-line (usleep %delay)
(any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line) (unless (eqv? 0 (status:exit-val (close-pipe port)))
(const line))) (error "Cannot commit")))))))
(hunk-diff-lines (first hunks)))) ;; XXX: we recompute the hunks here because previous
(cond ;; insertions lead to offsets.
(copyright-line (new+old+hunks (diff-info))))))
(add-copyright-line copyright-line))
(else
(let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
(change-commit-message* (hunk-file-name (first hunks))
old new)
(change-commit-message* (hunk-file-name (first hunks))
old new
port)
(usleep %delay)
(unless (eqv? 0 (status:exit-val (close-pipe port)))
(error "Cannot commit")))))))
;; XXX: we recompute the hunks here because previous
;; insertions lead to offsets.
(new+old+hunks (diff-info)))))))
(apply main (cdr (command-line))) (apply main (cdr (command-line)))