From 0950b726f231a2eae3133e56aac15a935ace057e Mon Sep 17 00:00:00 2001 From: Herman Rimm Date: Tue, 21 Jan 2025 22:43:00 +0100 Subject: [PATCH] scripts: style: Refactor order-packages. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/style.scm (order-packages): Combine package-name and package-version procedures into package-fields. (format-whole-file): Do not sort copyright headers or module definition. Change-Id: I5507bf8ed221f7017f972f0e0e64d149bea4854b Signed-off-by: Ludovic Courtès --- guix/scripts/style.scm | 36 +++++++++++++++--------------------- 1 file changed, 15 insertions(+), 21 deletions(-) diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index 51234952e91..4b704ddfb7e 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -43,6 +43,7 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) @@ -500,31 +501,19 @@ bailing out~%")) "Return LST, a list of top-level expressions and blanks, with top-level package definitions in alphabetical order. Packages which share a name are placed with versions in descending order." - (define (package-name pkg) + (define (package-fields pkg) (match pkg ((('define-public _ expr) _ ...) (match expr - ((or ('package _ ('name name) _ ...) - ('package ('name name) _ ...)) - name) - (_ #f))) - (_ #f))) - - (define (package-version pkg) - (match pkg - ((('define-public _ expr) _ ...) - (match expr - ((or ('package _ _ ('version version) _ ...) - ('package _ ('version version) _ ...)) - version) - (_ #f))) - (_ #f))) + ((or ('package _ ('name name) ('version version) _ ...) + ('package ('name name) ('version version) _ ...)) + (values name version)) + (_ (values #f #f)))) + (_ (values #f #f)))) (define (package>? lst1 lst2) - (let ((name1 (package-name lst1)) - (name2 (package-name lst2)) - (version1 (package-version lst1)) - (version2 (package-version lst2))) + (let-values (((name1 version1) (package-fields lst1)) + ((name2 version2) (package-fields lst2))) (and name1 name2 (or (string>? name1 name2) (and (string=? name1 name2) version1 @@ -550,7 +539,12 @@ are put in alphabetical order." (let* ((lst (call-with-input-file file read-with-comments/sequence #:guess-encoding #t)) (lst (if order? - (order-packages lst) + (let loop ((lst lst)) + (match lst + (((? blank? blank) rest ...) + (cons blank (loop rest))) + ((module rest ...) + (cons module (order-packages rest))))) lst))) (with-atomic-file-output file (lambda (port)