mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
scripts: style: Refactor order-packages.
* 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:
parent
dbd9478d71
commit
0950b726f2
1 changed files with 15 additions and 21 deletions
|
@ -43,6 +43,7 @@
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
|
@ -500,31 +501,19 @@ bailing out~%"))
|
||||||
"Return LST, a list of top-level expressions and blanks, with
|
"Return LST, a list of top-level expressions and blanks, with
|
||||||
top-level package definitions in alphabetical order. Packages which
|
top-level package definitions in alphabetical order. Packages which
|
||||||
share a name are placed with versions in descending order."
|
share a name are placed with versions in descending order."
|
||||||
(define (package-name pkg)
|
(define (package-fields pkg)
|
||||||
(match pkg
|
(match pkg
|
||||||
((('define-public _ expr) _ ...)
|
((('define-public _ expr) _ ...)
|
||||||
(match expr
|
(match expr
|
||||||
((or ('package _ ('name name) _ ...)
|
((or ('package _ ('name name) ('version version) _ ...)
|
||||||
('package ('name name) _ ...))
|
('package ('name name) ('version version) _ ...))
|
||||||
name)
|
(values name version))
|
||||||
(_ #f)))
|
(_ (values #f #f))))
|
||||||
(_ #f)))
|
(_ (values #f #f))))
|
||||||
|
|
||||||
(define (package-version pkg)
|
|
||||||
(match pkg
|
|
||||||
((('define-public _ expr) _ ...)
|
|
||||||
(match expr
|
|
||||||
((or ('package _ _ ('version version) _ ...)
|
|
||||||
('package _ ('version version) _ ...))
|
|
||||||
version)
|
|
||||||
(_ #f)))
|
|
||||||
(_ #f)))
|
|
||||||
|
|
||||||
(define (package>? lst1 lst2)
|
(define (package>? lst1 lst2)
|
||||||
(let ((name1 (package-name lst1))
|
(let-values (((name1 version1) (package-fields lst1))
|
||||||
(name2 (package-name lst2))
|
((name2 version2) (package-fields lst2)))
|
||||||
(version1 (package-version lst1))
|
|
||||||
(version2 (package-version lst2)))
|
|
||||||
(and name1 name2 (or (string>? name1 name2)
|
(and name1 name2 (or (string>? name1 name2)
|
||||||
(and (string=? name1 name2)
|
(and (string=? name1 name2)
|
||||||
version1
|
version1
|
||||||
|
@ -550,7 +539,12 @@ are put in alphabetical order."
|
||||||
(let* ((lst (call-with-input-file file read-with-comments/sequence
|
(let* ((lst (call-with-input-file file read-with-comments/sequence
|
||||||
#:guess-encoding #t))
|
#:guess-encoding #t))
|
||||||
(lst (if order?
|
(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)))
|
lst)))
|
||||||
(with-atomic-file-output file
|
(with-atomic-file-output file
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue