From a15542d26df42dabdb5e2f76d150ae200230c3b0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 2 Aug 2022 18:01:35 +0200
Subject: [PATCH] style: Add '--whole-file' option.

* guix/scripts/style.scm (format-whole-file): New procedure.
(%options, show-help): Add '--whole-file'.
(guix-style): Honor it.
* tests/guix-style.sh: New file.
* Makefile.am (SH_TESTS): Add it.
* doc/guix.texi (Invoking guix style): Document it.
---
 Makefile.am            |  1 +
 doc/guix.texi          | 28 +++++++++++++--
 guix/scripts/style.scm | 65 ++++++++++++++++++++++++----------
 tests/guix-style.sh    | 80 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 153 insertions(+), 21 deletions(-)
 create mode 100644 tests/guix-style.sh

diff --git a/Makefile.am b/Makefile.am
index 2cda20e61c..f7c42e8153 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -580,6 +580,7 @@ SH_TESTS =					\
   tests/guix-package.sh				\
   tests/guix-package-aliases.sh			\
   tests/guix-package-net.sh			\
+  tests/guix-style.sh				\
   tests/guix-system.sh				\
   tests/guix-home.sh				\
   tests/guix-archive.sh				\
diff --git a/doc/guix.texi b/doc/guix.texi
index d6460a785f..9a6a5c307d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14058,9 +14058,12 @@ otherwise.
 @node Invoking guix style
 @section Invoking @command{guix style}
 
-The @command{guix style} command helps packagers style their package
-definitions according to the latest fashionable trends.  The command
-currently provides the following styling rules:
+The @command{guix style} command helps users and packagers alike style
+their package definitions and configuration files according to the
+latest fashionable trends.  It can either reformat whole files, with the
+@option{--whole-file} option, or apply specific @dfn{styling rules} to
+individual package definitions.  The command currently provides the
+following styling rules:
 
 @itemize
 @item
@@ -14115,6 +14118,12 @@ the packages.  The @option{--styling} or @option{-S} option allows you
 to select the style rule, the default rule being @code{format}---see
 below.
 
+To reformat entire source files, the syntax is:
+
+@example
+guix style --whole-file @var{file}@dots{}
+@end example
+
 The available options are listed below.
 
 @table @code
@@ -14122,6 +14131,19 @@ The available options are listed below.
 @itemx -n
 Show source file locations that would be edited but do not modify them.
 
+@item --whole-file
+@itemx -f
+Reformat the given files in their entirety.  In that case, subsequent
+arguments are interpreted as file names (rather than package names), and
+the @option{--styling} option has no effect.
+
+As an example, here is how you might reformat your operating system
+configuration (you need write permissions for the file):
+
+@example
+guix style -f /etc/config.scm
+@end example
+
 @item --styling=@var{rule}
 @itemx -S @var{rule}
 Apply @var{rule}, one of the following styling rules:
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 2e14bc68fd..c0b9ea1a28 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -328,6 +328,21 @@ PACKAGE."
              (< (location-line loc1) (location-line loc2))
              (string<? (location-file loc1) (location-file loc2))))))
 
+
+;;;
+;;; Whole-file formatting.
+;;;
+
+(define* (format-whole-file file #:rest rest)
+  "Reformat all of FILE."
+  (let ((lst (call-with-input-file file read-with-comments/sequence)))
+    (with-atomic-file-output file
+      (lambda (port)
+        (apply pretty-print-with-comments/splice port lst
+               #:format-comment canonicalize-comment
+               #:format-vertical-space canonicalize-vertical-space
+               rest)))))
+
 
 ;;;
 ;;; Options.
@@ -345,6 +360,9 @@ PACKAGE."
         (option '(#\e "expression") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'expression arg result)))
+        (option '(#\f "whole-file") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'whole-file? #t result)))
         (option '(#\S "styling") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'styling-procedure
@@ -400,6 +418,9 @@ Update package definitions to the latest style.\n"))
                          of 'silent', 'safe', or 'always'"))
   (newline)
   (display (G_ "
+  -f, --whole-file       format the entire contents of the given file(s)"))
+  (newline)
+  (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
   -V, --version          display version information and exit"))
@@ -426,27 +447,35 @@ Update package definitions to the latest style.\n"))
                         #:build-options? #f))
 
   (let* ((opts     (parse-options))
-         (packages (filter-map (match-lambda
-                                 (('argument . spec)
-                                  (specification->package spec))
-                                 (('expression . str)
-                                  (read/eval str))
-                                 (_ #f))
-                               opts))
          (edit     (if (assoc-ref opts 'dry-run?)
                        edit-expression/dry-run
                        edit-expression))
          (style    (assoc-ref opts 'styling-procedure))
          (policy   (assoc-ref opts 'input-simplification-policy)))
     (with-error-handling
-      (for-each (lambda (package)
-                  (style package #:policy policy
-                         #:edit-expression edit))
-                ;; Sort package by source code location so that we start editing
-                ;; files from the bottom and going upward.  That way, the
-                ;; 'location' field of <package> records is not invalidated as
-                ;; we modify files.
-                (sort (if (null? packages)
-                          (fold-packages cons '() #:select? (const #t))
-                          packages)
-                      (negate package-location<?))))))
+      (if (assoc-ref opts 'whole-file?)
+          (let ((files (filter-map (match-lambda
+                                     (('argument . file) file)
+                                     (_ #f))
+                                   opts)))
+            (unless (eq? format-package-definition style)
+              (warning (G_ "'--styling' option has no effect in whole-file mode~%")))
+            (for-each format-whole-file files))
+          (let ((packages (filter-map (match-lambda
+                                        (('argument . spec)
+                                         (specification->package spec))
+                                        (('expression . str)
+                                         (read/eval str))
+                                        (_ #f))
+                                      opts)))
+            (for-each (lambda (package)
+                        (style package #:policy policy
+                               #:edit-expression edit))
+                      ;; Sort package by source code location so that we start
+                      ;; editing files from the bottom and going upward.  That
+                      ;; way, the 'location' field of <package> records is not
+                      ;; invalidated as we modify files.
+                      (sort (if (null? packages)
+                                (fold-packages cons '() #:select? (const #t))
+                                packages)
+                            (negate package-location<?))))))))
diff --git a/tests/guix-style.sh b/tests/guix-style.sh
new file mode 100644
index 0000000000..58f953a0ec
--- /dev/null
+++ b/tests/guix-style.sh
@@ -0,0 +1,80 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test 'guix style'.
+#
+
+set -e
+
+guix style --version
+
+tmpdir="guix-style-$$"
+trap 'rm -r "$tmpdir"' EXIT
+
+tmpfile="$tmpdir/os.scm"
+mkdir "$tmpdir"
+cat > "$tmpfile" <<EOF
+;;; This is a header with three semicolons.
+;;;
+
+(define-module (foo bar)
+  #:use-module (guix)
+  #:use-module (gnu))
+
+;; One blank line and a page break.
+
+
+;; And now, the OS.
+(operating-system
+  (host-name "komputilo")
+  (locale "eo_EO.UTF-8")
+
+  ;; User accounts.
+  (users (cons (user-account
+                 (name "alice")
+                 (comment "Bob's sister")
+                 (group "users")
+
+                 ;; Groups fit on one line.
+                 (supplementary-groups '("wheel" "audio" "video")))
+               %base-user-accounts))
+
+  ;; The services.
+  (services
+   (cons (service mcron-service-type) %base-services)))
+EOF
+
+cp "$tmpfile" "$tmpfile.bak"
+
+initial_hash="$(guix hash "$tmpfile")"
+
+guix style -f "$tmpfile"
+if ! test "$initial_hash" = "$(guix hash "$tmpfile")"
+then
+    cat "$tmpfile"
+    diff -u "$tmpfile.bak" "$tmpfile"
+    false
+fi
+
+# Introduce random changes and try again.
+sed -i "$tmpfile" -e's/ +/ /g'
+! test "$initial_hash" = "$(guix hash "$tmpfile")"
+
+guix style -f "$tmpfile"
+test "$initial_hash" = "$(guix hash "$tmpfile")"