From patchwork Sun May 15 04:36:30 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 39271 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 7AD0E27BBE9; Sun, 15 May 2022 05:47:42 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_INVALID,DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7241827BBEA for ; Sun, 15 May 2022 05:47:38 +0100 (BST) Received: from localhost ([::1]:47100 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nq6AL-00029k-Dz for patchwork@mira.cbaines.net; Sun, 15 May 2022 00:47:37 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:41918) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nq69n-00028J-87 for guix-patches@gnu.org; Sun, 15 May 2022 00:47:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:53966) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nq69m-0003ax-Va for guix-patches@gnu.org; Sun, 15 May 2022 00:47:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nq69m-0002tE-UG for guix-patches@gnu.org; Sun, 15 May 2022 00:47:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#55424] [PATCH 003/602] etc/committer: Teach it how to commit package removal. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 15 May 2022 04:47:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 55424 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 55424@debbugs.gnu.org Cc: Maxim Cournoyer Received: via spool by 55424-submit@debbugs.gnu.org id=B55424.165259001511043 (code B ref 55424); Sun, 15 May 2022 04:47:02 +0000 Received: (at 55424) by debbugs.gnu.org; 15 May 2022 04:46:55 +0000 Received: from localhost ([127.0.0.1]:47854 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nq69e-0002s2-F4 for submit@debbugs.gnu.org; Sun, 15 May 2022 00:46:54 -0400 Received: from mail-qt1-f181.google.com ([209.85.160.181]:33760) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nq69d-0002rZ-4J for 55424@debbugs.gnu.org; Sun, 15 May 2022 00:46:53 -0400 Received: by mail-qt1-f181.google.com with SMTP id s22so4387589qta.0 for <55424@debbugs.gnu.org>; Sat, 14 May 2022 21:46:53 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=iwsddj8mDPl1ScTpZyy07USZsdE1OMUabzyQvgDdDUQ=; b=eflbTdLAEcSOZ1OhH/Wu6tv+RMnTGV7JTfvUMBCNsx3Y3QzmCBobGK0F6W3jV4GUdn R9aMYHkZLiRqfIoMRvzYUIIeMspUbc025BIv5uxs4yUoZyZRo4+2WUZU4wWVprP18uf0 A1CZKs1BExKv1Nxr9apOrV7rVOAvOhdCUsOH3lW0pVE7uKzf25GT9XOtJWHMgoHHq0t2 u8OFPJRoVxmLYycFxsEtXojleDPvaKpZwkIvEY2D82g61Aely8dCR3BSzbYgAwPWSzCy 1qd8bqCrXpIg2Lb32AGDdxEy64V67dilWnidjusJW0FPIOFTTl7NwrZXl8DXsykfkCr/ yVRg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=iwsddj8mDPl1ScTpZyy07USZsdE1OMUabzyQvgDdDUQ=; b=hs+F6Y6sjXCu/ui90UTIw2U8yd4NnWd+8UpvtAYiHUwwQk6g4iXV4HtF5aU55FlgRK cQ1tD6XsLvcy3SGyhp8/BnecCFdN8XY3a0nWoRKOFOB990X89bRulUSt640lXw5I2qnm i3TvSA+q8w0d9O/GUZ+GDuXYKzPUCX2BrrmeEayOQQwK38PIpTauNyrmrwyvWC4061Ax Hxg8by6F3ohphiHihfz99GntY7a+VmyHMNCqlgla+EHHkix4r/FoyT3XWEel1WFyAbiU N/6Gn6nW6mUKPQ+xXqf5eB2aLHSgNgTarkH3QlJ0MARNGYu96zb4YJjJdhYcdCcWbWMH mrEQ== X-Gm-Message-State: AOAM532tyd0Snh9T8x6EQ7kSzQMr+6Qvz9XLHkrzRpcm8oEt2Wzy9hmm eqsP5hJzlStG8s7V1AiYko5pht328vr6Zg== X-Google-Smtp-Source: ABdhPJzqw7DyFi3fNFWs4A5A2kn0M7jPTbxx8Nt476VgRFMPrM9KK2vwpKI/WKpjH1VTy8W+rnCoIA== X-Received: by 2002:a05:622a:2cc:b0:2f3:b741:fac2 with SMTP id a12-20020a05622a02cc00b002f3b741fac2mr10949848qtx.685.1652590007377; Sat, 14 May 2022 21:46:47 -0700 (PDT) Received: from localhost.localdomain (dsl-149-239.b2b2c.ca. [66.158.149.239]) by smtp.gmail.com with ESMTPSA id 2-20020ac82082000000b002f39b99f672sm4287690qtd.12.2022.05.14.21.46.46 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 14 May 2022 21:46:47 -0700 (PDT) From: Maxim Cournoyer Date: Sun, 15 May 2022 00:36:30 -0400 Message-Id: <20220515044629.6843-3-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.36.0 In-Reply-To: <20220515044629.6843-1-maxim.cournoyer@gmail.com> References: <20220515044629.6843-1-maxim.cournoyer@gmail.com> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * etc/committer.scm.in (hunk-types): New variable. (): 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. --- etc/committer.scm.in | 164 ++++++++++++++++++++++++------------------- 1 file changed, 91 insertions(+), 73 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 3b37320e89..e7f1ca8c45 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -101,12 +101,16 @@ (define (surrounding-sexp port line-no) (read-line port) (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 (make-hunk file-name old-line-number new-line-number diff-lines - definition?) + type) hunk? (file-name hunk-file-name) ;; Line number before the change @@ -115,8 +119,8 @@ (define-record-type (new-line-number hunk-new-line-number) ;; The full diff to be used with "git apply --cached" (diff-lines hunk-diff-lines) - ;; Does this hunk add a definition? - (definition? hunk-definition?)) + ;; Does this hunk add or remove a package? + (type hunk-type)) ;one of 'hunk-types' (define* (hunk->patch hunk #:optional (port (current-output-port))) (let ((file-name (hunk-file-name hunk))) @@ -134,25 +138,30 @@ (define (diff-info) ;; new definitions with changes to existing ;; definitions. "--unified=1" - "gnu"))) + "--" "gnu"))) (define (extract-line-number line-tag) (abs (string->number (car (string-split line-tag #\,))))) (define (read-hunk) (let loop ((lines '()) - (definition? #false)) + (type #false)) (let ((line (read-line port 'concat))) (cond ((eof-object? line) - (values (reverse lines) definition?)) + (values (reverse lines) type)) ((or (string-prefix? "@@ " line) (string-prefix? "diff --git" line)) (unget-string port line) - (values (reverse lines) definition?)) + (values (reverse lines) type)) (else (loop (cons line lines) - (or definition? - (string-prefix? "+(define" line)))))))) + (or type + (cond + ((string-prefix? "+(define" line) + 'addition) + ((string-prefix? "-(define" line) + 'removal) + (else #false))))))))) (define info (let loop ((acc '()) (file-name #f)) @@ -167,13 +176,13 @@ (define info (match (string-split line #\space) ((_ old-start new-start . _) (let-values - (((diff-lines definition?) (read-hunk))) + (((diff-lines type) (read-hunk))) (loop (cons (make-hunk file-name (extract-line-number old-start) (extract-line-number new-start) (cons (string-append line "\n") diff-lines) - definition?) acc) + type) acc) file-name))))) (else (loop acc file-name)))))) (close-pipe port) @@ -263,10 +272,18 @@ (define version (listify added)))))))))) '(inputs propagated-inputs native-inputs))) -(define* (add-commit-message file-name variable-name #:optional (port (current-output-port))) - "Print ChangeLog commit message for a change to FILE-NAME adding a definition." - (format port - "gnu: Add ~a.~%~%* ~a (~a): New variable.~%" +(define* (add-commit-message file-name variable-name + #:optional (port (current-output-port))) + "Print ChangeLog commit message for a change to FILE-NAME adding a +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)) (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))) (hunks - (let-values - (((definitions changes) - (partition hunk-definition? hunks))) + (let-values (((definitions changes) (partition hunk-type hunks))) + ;; Additions/removals. + (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. - (for-each (lambda (hunk) - (and-let* - ((define-line (find (cut string-prefix? "+(define" <>) - (hunk-diff-lines hunk))) - (variable-name (and=> (string-tokenize define-line) second))) - (add-commit-message (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"))) + (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) + (commit-message-proc (hunk-file-name hunk) variable-name port) + (usleep %delay) + (unless (eqv? 0 (status:exit-val (close-pipe port))) + (error "Cannot commit")))) + (usleep %delay)) + definitions)) - (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) - (add-commit-message (hunk-file-name hunk) - variable-name port) - (usleep %delay) + ;; Changes. + (for-each + (match-lambda + ((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))) - (error "Cannot commit")))) - (usleep %delay)) - definitions) - - ;; Changes. - (for-each (match-lambda - ((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))) - (error "Cannot apply"))) - (usleep %delay)) - hunks) - (define copyright-line - (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line) - (const line))) - (hunk-diff-lines (first hunks)))) - (cond - (copyright-line - (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))))))) + (error "Cannot apply"))) + (usleep %delay)) + hunks) + (define copyright-line + (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line) + (const line))) + (hunk-diff-lines (first hunks)))) + (cond + (copyright-line + (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)))