amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

scripts: style: Refactor order-packages.

Browse source 
* 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 <ludo@gnu.org>
This commit is contained in:
Herman Rimm 2025-01-21 22:43:00 +01:00 • committed by Ludovic Courtès
parent dbd9478d71
commit 0950b726f2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 15 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

36
guix/scripts/style.scm
View file

@ -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)