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: Add 'alphabetical-sort' option.

Browse source 
* guix/scripts/style.scm (show-help): Describe option.
(order-packages): Add procedure.
(format-whole-file): Add 'order?' argument.
(%options): Add 'alphabetical-sort' option.
(guix-style): Alphabetically order packages in files.
* tests/guix-style.sh: Test alphabetical ordering.
* doc/guix.texi (Invoking guix style): Document option.

Change-Id: I4aa7c0bd0b6d42529ae7d304587ffb10bf5f4006
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Herman Rimm 2024-09-02 20:58:05 +02:00 • committed by Ludovic Courtès
parent 52681a036a
commit c4ce313052
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 100 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

73
guix/scripts/style.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
;;;
;;; This file is part of GNU Guix.
;;;
@ -29,6 +30,7 @@
(define-module (guix scripts style)
#:autoload (gnu packages) (specification->package fold-packages)
#:use-module (guix combinators)
#:use-module (guix scripts)
#:use-module ((guix scripts build) #:select (%standard-build-options))
#:use-module (guix ui)
@ -494,11 +496,62 @@ bailing out~%"))
;;; Whole-file formatting.
;;;
(define* (format-whole-file file #:rest rest)
"Reformat all of FILE."
(define (order-packages lst)
"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)
(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)))
(define (package>? lst1 lst2)
(let ((name1 (package-name lst1))
(name2 (package-name lst2))
(version1 (package-version lst1))
(version2 (package-version lst2)))
(and name1 name2 (or (string>? name1 name2)
(and (string=? name1 name2)
version1
version2
(version>? version2 version1))))))
;; Group define-public with preceding blanks and defines.
(let ((lst (fold2 (lambda (expr tail head)
(let ((head (cons expr head)))
(match expr
((? blank?)
(values tail head))
(('define _ ...)
(values tail head))
(_ (values (cons head tail) '())))))
'() '() lst)))
(reverse (concatenate (sort! lst package>?)))))
(define* (format-whole-file file order? #:rest rest)
"Reformat all of FILE. When ORDER? is true, top-level package definitions
are put in alphabetical order."
(with-fluids ((%default-port-encoding "UTF-8"))
(let ((lst (call-with-input-file file read-with-comments/sequence
#:guess-encoding #t)))
(let* ((lst (call-with-input-file file read-with-comments/sequence
#:guess-encoding #t))
(lst (if order?
(order-packages lst)
lst)))
(with-atomic-file-output file
(lambda (port)
(apply pretty-print-with-comments/splice port lst
@ -526,6 +579,9 @@ bailing out~%"))
(option '(#\f "whole-file") #f #f
(lambda (opt name arg result)
(alist-cons 'whole-file? #t result)))
(option '(#\A "--alphabetical-sort") #f #f
(lambda (opt name arg result)
(alist-cons 'order? #t result)))
(option '(#\S "styling") #t #f
(lambda (opt name arg result)
(alist-cons 'styling-procedure
@ -569,7 +625,7 @@ Update package definitions to the latest style.\n"))
(display (G_ "
-S, --styling=RULE apply RULE, a styling rule"))
(display (G_ "
-l, --list-stylings display the list of available style rules"))
-l, --list-stylings display the list of available style rules"))
(newline)
(display (G_ "
-n, --dry-run display files that would be edited but do nothing"))
@ -584,6 +640,9 @@ Update package definitions to the latest style.\n"))
(newline)
(display (G_ "
-f, --whole-file format the entire contents of the given file(s)"))
(display (G_ "
-A, --alphabetical-sort
place the contents in alphabetical order as well"))
(newline)
(display (G_ "
-h, --help display this help and exit"))
@ -627,7 +686,9 @@ Update package definitions to the latest style.\n"))
(warning (G_ "'--styling' option has no effect in whole-file mode~%")))
(when (null? files)
(warning (G_ "no files specified, nothing to do~%")))
(for-each format-whole-file files))
(for-each
(cute format-whole-file <> (assoc-ref opts 'order?))
files))
(let ((packages (filter-map (match-lambda
(('argument . spec)
(specification->package spec))