From patchwork Tue Aug 2 21:44:07 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41103 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 3FE2427BBEA; Tue, 2 Aug 2022 23:30:02 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 6043027BBE9 for ; Tue, 2 Aug 2022 23:29:58 +0100 (BST) Received: from localhost ([::1]:60080 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIzj8-0003Ir-E0 for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:46:58 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44442) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhH-0001ut-TN for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55557) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhH-0006HR-IG for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhH-00039g-Dp for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 01/13] style: Move reader and printer to (guix read-print). References: <20220802214236.18965-1-ludo@gnu.org> In-Reply-To: <20220802214236.18965-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668311993 (code B ref 56898); Tue, 02 Aug 2022 21:45:03 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:43 +0000 Received: from localhost ([127.0.0.1]:45281 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgt-00036m-TK for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:43 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59522) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgn-00035M-Bh for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:35 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55150) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgi-00068n-44; Tue, 02 Aug 2022 17:44:28 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=O4YmzS3HBZ+mqv23Jpx/CJu7JjDsLw7a/oFXLhmU8vo=; b=F3FklEa2WjyPf2 t1poykLyA4Y7nmoyEuxr9I06EPBELC2esawN62Y3/PLoNcOcdqRqgat5KUxFSm15tXrV82d7OJyFN +3zXrGdH7grybb+qTIUbeqm0vgLKj+YPNU/g+sYegAx6dg9WAJ0Noml1TipbXo9bNcKuQ4IBANMnC Q4BmwzojW8Ewb/lcXv6wGWzpcWUyGIBEpzrFWUBZLLPe2iPyi8WhBB5AGqpJ9HrR4XJMZaP/lMGMq e79IPSUFXvCsplz0TKWBSo9tq6M047/yvbP5o3w+c3F6d9H1q+arIyf7tJEqougg35noeGOOEfzFE bzGoS5V5wQWzG+8VBv0A==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgh-0006W4-Hh; Tue, 02 Aug 2022 17:44:27 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:07 +0200 Message-Id: <20220802214419.19013-1-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/scripts/style.scm (, read-with-comments) (vhashq, %special-forms, %newline-forms, prefix?) (special-form-lead, newline-form?, escaped-string) (string-width, canonicalize-comment, pretty-print-with-comments) (object->string*): Move to... * guix/read-print.scm: ... here. New file. * guix/scripts/import.scm: Adjust accordingly. * tests/style.scm: Move 'test-pretty-print' and tests to... * tests/read-print.scm: ... here. New file. * Makefile.am (MODULES): Add 'guix/read-print.scm'. (SCM_TESTS): Add 'tests/read-print.scm'. --- Makefile.am | 2 + guix/read-print.scm | 490 ++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 4 +- guix/scripts/style.scm | 457 +------------------------------------ tests/read-print.scm | 209 +++++++++++++++++ tests/style.scm | 181 --------------- 6 files changed, 705 insertions(+), 638 deletions(-) create mode 100644 guix/read-print.scm create mode 100644 tests/read-print.scm diff --git a/Makefile.am b/Makefile.am index e5363140fb..2cda20e61c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -130,6 +130,7 @@ MODULES = \ guix/cve.scm \ guix/workers.scm \ guix/least-authority.scm \ + guix/read-print.scm \ guix/ipfs.scm \ guix/platform.scm \ guix/platforms/arm.scm \ @@ -524,6 +525,7 @@ SCM_TESTS = \ tests/profiles.scm \ tests/publish.scm \ tests/pypi.scm \ + tests/read-print.scm \ tests/records.scm \ tests/scripts.scm \ tests/search-paths.scm \ diff --git a/guix/read-print.scm b/guix/read-print.scm new file mode 100644 index 0000000000..69ab8ac8b3 --- /dev/null +++ b/guix/read-print.scm @@ -0,0 +1,490 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021-2022 Ludovic Courtès +;;; +;;; 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 . + +(define-module (guix read-print) + #:use-module (ice-9 control) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:export (pretty-print-with-comments + read-with-comments + object->string* + + comment? + comment->string + comment-margin? + canonicalize-comment)) + +;;; Commentary: +;;; +;;; This module provides a comment-preserving reader and a comment-preserving +;;; pretty-printer smarter than (ice-9 pretty-print). +;;; +;;; Code: + + +;;; +;;; Comment-preserving reader. +;;; + +;; A comment. +(define-record-type + (comment str margin?) + comment? + (str comment->string) + (margin? comment-margin?)) + +(define (read-with-comments port) + "Like 'read', but include objects when they're encountered." + ;; Note: Instead of implementing this functionality in 'read' proper, which + ;; is the best approach long-term, this code is a layer on top of 'read', + ;; such that we don't have to rely on a specific Guile version. + (define dot (list 'dot)) + (define (dot? x) (eq? x dot)) + + (define (reverse/dot lst) + ;; Reverse LST and make it an improper list if it contains DOT. + (let loop ((result '()) + (lst lst)) + (match lst + (() result) + (((? dot?) . rest) + (let ((dotted (reverse rest))) + (set-cdr! (last-pair dotted) (car result)) + dotted)) + ((x . rest) (loop (cons x result) rest))))) + + (let loop ((blank-line? #t) + (return (const 'unbalanced))) + (match (read-char port) + ((? eof-object? eof) + eof) ;oops! + (chr + (cond ((eqv? chr #\newline) + (loop #t return)) + ((char-set-contains? char-set:whitespace chr) + (loop blank-line? return)) + ((memv chr '(#\( #\[)) + (let/ec return + (let liip ((lst '())) + (liip (cons (loop (match lst + (((? comment?) . _) #t) + (_ #f)) + (lambda () + (return (reverse/dot lst)))) + lst))))) + ((memv chr '(#\) #\])) + (return)) + ((eq? chr #\') + (list 'quote (loop #f return))) + ((eq? chr #\`) + (list 'quasiquote (loop #f return))) + ((eq? chr #\,) + (list (match (peek-char port) + (#\@ + (read-char port) + 'unquote-splicing) + (_ + 'unquote)) + (loop #f return))) + ((eqv? chr #\;) + (unread-char chr port) + (comment (read-line port 'concat) + (not blank-line?))) + (else + (unread-char chr port) + (match (read port) + ((and token '#{.}#) + (if (eq? chr #\.) dot token)) + (token token)))))))) + +;;; +;;; Comment-preserving pretty-printer. +;;; + +(define-syntax vhashq + (syntax-rules (quote) + ((_) vlist-null) + ((_ (key (quote (lst ...))) rest ...) + (vhash-consq key '(lst ...) (vhashq rest ...))) + ((_ (key value) rest ...) + (vhash-consq key '((() . value)) (vhashq rest ...))))) + +(define %special-forms + ;; Forms that are indented specially. The number is meant to be understood + ;; like Emacs' 'scheme-indent-function' symbol property. When given an + ;; alist instead of a number, the alist gives "context" in which the symbol + ;; is a special form; for instance, context (modify-phases) means that the + ;; symbol must appear within a (modify-phases ...) expression. + (vhashq + ('begin 1) + ('lambda 2) + ('lambda* 2) + ('match-lambda 1) + ('match-lambda* 2) + ('define 2) + ('define* 2) + ('define-public 2) + ('define*-public 2) + ('define-syntax 2) + ('define-syntax-rule 2) + ('define-module 2) + ('define-gexp-compiler 2) + ('let 2) + ('let* 2) + ('letrec 2) + ('letrec* 2) + ('match 2) + ('when 2) + ('unless 2) + ('package 1) + ('origin 1) + ('operating-system 1) + ('modify-inputs 2) + ('modify-phases 2) + ('add-after '(((modify-phases) . 3))) + ('add-before '(((modify-phases) . 3))) + ('replace '(((modify-phases) . 2))) ;different from 'modify-inputs' + ('substitute* 2) + ('substitute-keyword-arguments 2) + ('call-with-input-file 2) + ('call-with-output-file 2) + ('with-output-to-file 2) + ('with-input-from-file 2))) + +(define %newline-forms + ;; List heads that must be followed by a newline. The second argument is + ;; the context in which they must appear. This is similar to a special form + ;; of 1, except that indent is 1 instead of 2 columns. + (vhashq + ('arguments '(package)) + ('sha256 '(origin source package)) + ('base32 '(sha256 origin)) + ('git-reference '(uri origin source)) + ('search-paths '(package)) + ('native-search-paths '(package)) + ('search-path-specification '()))) + +(define (prefix? candidate lst) + "Return true if CANDIDATE is a prefix of LST." + (let loop ((candidate candidate) + (lst lst)) + (match candidate + (() #t) + ((head1 . rest1) + (match lst + (() #f) + ((head2 . rest2) + (and (equal? head1 head2) + (loop rest1 rest2)))))))) + +(define (special-form-lead symbol context) + "If SYMBOL is a special form in the given CONTEXT, return its number of +arguments; otherwise return #f. CONTEXT is a stack of symbols lexically +surrounding SYMBOL." + (match (vhash-assq symbol %special-forms) + (#f #f) + ((_ . alist) + (any (match-lambda + ((prefix . level) + (and (prefix? prefix context) (- level 1)))) + alist)))) + +(define (newline-form? symbol context) + "Return true if parenthesized expressions starting with SYMBOL must be +followed by a newline." + (match (vhash-assq symbol %newline-forms) + (#f #f) + ((_ . prefix) + (prefix? prefix context)))) + +(define (escaped-string str) + "Return STR with backslashes and double quotes escaped. Everything else, in +particular newlines, is left as is." + (list->string + `(#\" + ,@(string-fold-right (lambda (chr lst) + (match chr + (#\" (cons* #\\ #\" lst)) + (#\\ (cons* #\\ #\\ lst)) + (_ (cons chr lst)))) + '() + str) + #\"))) + +(define (string-width str) + "Return the \"width\" of STR--i.e., the width of the longest line of STR." + (apply max (map string-length (string-split str #\newline)))) + +(define (canonicalize-comment c) + "Canonicalize comment C, ensuring it has the \"right\" number of leading +semicolons." + (let ((line (string-trim-both + (string-trim (comment->string c) (char-set #\;))))) + (comment (string-append + (if (comment-margin? c) + ";" + (if (string-null? line) + ";;" ;no trailing space + ";; ")) + line "\n") + (comment-margin? c)))) + +(define* (pretty-print-with-comments port obj + #:key + (format-comment identity) + (indent 0) + (max-width 78) + (long-list 5)) + "Pretty-print OBJ to PORT, attempting to at most MAX-WIDTH character columns +and assuming the current column is INDENT. Comments present in OBJ are +included in the output. + +Lists longer than LONG-LIST are written as one element per line. Comments are +passed through FORMAT-COMMENT before being emitted; a useful value for +FORMAT-COMMENT is 'canonicalize-comment'." + (define (list-of-lists? head tail) + ;; Return true if HEAD and TAIL denote a list of lists--e.g., a list of + ;; 'let' bindings. + (match head + ((thing _ ...) ;proper list + (and (not (memq thing + '(quote quasiquote unquote unquote-splicing))) + (pair? tail))) + (_ #f))) + + (let loop ((indent indent) + (column indent) + (delimited? #t) ;true if comes after a delimiter + (context '()) ;list of "parent" symbols + (obj obj)) + (define (print-sequence context indent column lst delimited?) + (define long? + (> (length lst) long-list)) + + (let print ((lst lst) + (first? #t) + (delimited? delimited?) + (column column)) + (match lst + (() + column) + ((item . tail) + (define newline? + ;; Insert a newline if ITEM is itself a list, or if TAIL is long, + ;; but only if ITEM is not the first item. Also insert a newline + ;; before a keyword. + (and (or (pair? item) long? + (and (keyword? item) + (not (eq? item #:allow-other-keys)))) + (not first?) (not delimited?) + (not (comment? item)))) + + (when newline? + (newline port) + (display (make-string indent #\space) port)) + (let ((column (if newline? indent column))) + (print tail + (keyword? item) ;keep #:key value next to one another + (comment? item) + (loop indent column + (or newline? delimited?) + context + item))))))) + + (define (sequence-would-protrude? indent lst) + ;; Return true if elements of LST written at INDENT would protrude + ;; beyond MAX-WIDTH. This is implemented as a cheap test with false + ;; negatives to avoid actually rendering all of LST. + (find (match-lambda + ((? string? str) + (>= (+ (string-width str) 2 indent) max-width)) + ((? symbol? symbol) + (>= (+ (string-width (symbol->string symbol)) indent) + max-width)) + ((? boolean?) + (>= (+ 2 indent) max-width)) + (() + (>= (+ 2 indent) max-width)) + (_ ;don't know + #f)) + lst)) + + (define (special-form? head) + (special-form-lead head context)) + + (match obj + ((? comment? comment) + (if (comment-margin? comment) + (begin + (display " " port) + (display (comment->string (format-comment comment)) + port)) + (begin + ;; When already at the beginning of a line, for example because + ;; COMMENT follows a margin comment, no need to emit a newline. + (unless (= column indent) + (newline port) + (display (make-string indent #\space) port)) + (display (comment->string (format-comment comment)) + port))) + (display (make-string indent #\space) port) + indent) + (('quote lst) + (unless delimited? (display " " port)) + (display "'" port) + (loop indent (+ column (if delimited? 1 2)) #t context lst)) + (('quasiquote lst) + (unless delimited? (display " " port)) + (display "`" port) + (loop indent (+ column (if delimited? 1 2)) #t context lst)) + (('unquote lst) + (unless delimited? (display " " port)) + (display "," port) + (loop indent (+ column (if delimited? 1 2)) #t context lst)) + (('unquote-splicing lst) + (unless delimited? (display " " port)) + (display ",@" port) + (loop indent (+ column (if delimited? 2 3)) #t context lst)) + (('gexp lst) + (unless delimited? (display " " port)) + (display "#~" port) + (loop indent (+ column (if delimited? 2 3)) #t context lst)) + (('ungexp obj) + (unless delimited? (display " " port)) + (display "#$" port) + (loop indent (+ column (if delimited? 2 3)) #t context obj)) + (('ungexp-native obj) + (unless delimited? (display " " port)) + (display "#+" port) + (loop indent (+ column (if delimited? 2 3)) #t context obj)) + (('ungexp-splicing lst) + (unless delimited? (display " " port)) + (display "#$@" port) + (loop indent (+ column (if delimited? 3 4)) #t context lst)) + (('ungexp-native-splicing lst) + (unless delimited? (display " " port)) + (display "#+@" port) + (loop indent (+ column (if delimited? 3 4)) #t context lst)) + (((? special-form? head) arguments ...) + ;; Special-case 'let', 'lambda', 'modify-inputs', etc. so the second + ;; and following arguments are less indented. + (let* ((lead (special-form-lead head context)) + (context (cons head context)) + (head (symbol->string head)) + (total (length arguments))) + (unless delimited? (display " " port)) + (display "(" port) + (display head port) + (unless (zero? lead) + (display " " port)) + + ;; Print the first LEAD arguments. + (let* ((indent (+ column 2 + (if delimited? 0 1))) + (column (+ column 1 + (if (zero? lead) 0 1) + (if delimited? 0 1) + (string-length head))) + (initial-indent column)) + (define new-column + (let inner ((n lead) + (arguments (take arguments (min lead total))) + (column column)) + (if (zero? n) + (begin + (newline port) + (display (make-string indent #\space) port) + indent) + (match arguments + (() column) + ((head . tail) + (inner (- n 1) tail + (loop initial-indent column + (= n lead) + context + head))))))) + + ;; Print the remaining arguments. + (let ((column (print-sequence + context indent new-column + (drop arguments (min lead total)) + #t))) + (display ")" port) + (+ column 1))))) + ((head tail ...) + (let* ((overflow? (>= column max-width)) + (column (if overflow? + (+ indent 1) + (+ column (if delimited? 1 2)))) + (newline? (or (newline-form? head context) + (list-of-lists? head tail))) ;'let' bindings + (context (cons head context))) + (if overflow? + (begin + (newline port) + (display (make-string indent #\space) port)) + (unless delimited? (display " " port))) + (display "(" port) + + (let* ((new-column (loop column column #t context head)) + (indent (if (or (>= new-column max-width) + (not (symbol? head)) + (sequence-would-protrude? + (+ new-column 1) tail) + newline?) + column + (+ new-column 1)))) + (when newline? + ;; Insert a newline right after HEAD. + (newline port) + (display (make-string indent #\space) port)) + + (let ((column + (print-sequence context indent + (if newline? indent new-column) + tail newline?))) + (display ")" port) + (+ column 1))))) + (_ + (let* ((str (if (string? obj) + (escaped-string obj) + (object->string obj))) + (len (string-width str))) + (if (and (> (+ column 1 len) max-width) + (not delimited?)) + (begin + (newline port) + (display (make-string indent #\space) port) + (display str port) + (+ indent len)) + (begin + (unless delimited? (display " " port)) + (display str port) + (+ column (if delimited? 0 1) len)))))))) + +(define (object->string* obj indent . args) + "Pretty-print OBJ with INDENT columns as the initial indent. ARGS are +passed as-is to 'pretty-print-with-comments'." + (call-with-output-string + (lambda (port) + (apply pretty-print-with-comments port obj + #:indent indent + args)))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 71ab4b4fed..bd3cfd2dc3 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2020, 2021 Ludovic Courtès +;;; Copyright © 2012-2014, 2020-2022 Ludovic Courtès ;;; Copyright © 2014 David Thompson ;;; Copyright © 2018 Kyle Meyer ;;; Copyright © 2019, 2022 Ricardo Wurmus @@ -25,7 +25,7 @@ (define-module (guix scripts import) #:use-module (guix ui) #:use-module (guix scripts) - #:use-module (guix scripts style) + #:use-module (guix read-print) #:use-module (guix utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index 9fd652beb1..e2530e80c0 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -37,468 +37,15 @@ (define-module (guix scripts style) #:use-module (guix utils) #:use-module (guix i18n) #:use-module (guix diagnostics) + #:use-module (guix read-print) #:use-module (ice-9 control) #:use-module (ice-9 match) - #:use-module (ice-9 rdelim) - #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) - #:export (pretty-print-with-comments - read-with-comments - canonicalize-comment - - guix-style)) - - -;;; -;;; Comment-preserving reader. -;;; - -;; A comment. -(define-record-type - (comment str margin?) - comment? - (str comment->string) - (margin? comment-margin?)) - -(define (read-with-comments port) - "Like 'read', but include objects when they're encountered." - ;; Note: Instead of implementing this functionality in 'read' proper, which - ;; is the best approach long-term, this code is a layer on top of 'read', - ;; such that we don't have to rely on a specific Guile version. - (define dot (list 'dot)) - (define (dot? x) (eq? x dot)) - - (define (reverse/dot lst) - ;; Reverse LST and make it an improper list if it contains DOT. - (let loop ((result '()) - (lst lst)) - (match lst - (() result) - (((? dot?) . rest) - (let ((dotted (reverse rest))) - (set-cdr! (last-pair dotted) (car result)) - dotted)) - ((x . rest) (loop (cons x result) rest))))) - - (let loop ((blank-line? #t) - (return (const 'unbalanced))) - (match (read-char port) - ((? eof-object? eof) - eof) ;oops! - (chr - (cond ((eqv? chr #\newline) - (loop #t return)) - ((char-set-contains? char-set:whitespace chr) - (loop blank-line? return)) - ((memv chr '(#\( #\[)) - (let/ec return - (let liip ((lst '())) - (liip (cons (loop (match lst - (((? comment?) . _) #t) - (_ #f)) - (lambda () - (return (reverse/dot lst)))) - lst))))) - ((memv chr '(#\) #\])) - (return)) - ((eq? chr #\') - (list 'quote (loop #f return))) - ((eq? chr #\`) - (list 'quasiquote (loop #f return))) - ((eq? chr #\,) - (list (match (peek-char port) - (#\@ - (read-char port) - 'unquote-splicing) - (_ - 'unquote)) - (loop #f return))) - ((eqv? chr #\;) - (unread-char chr port) - (comment (read-line port 'concat) - (not blank-line?))) - (else - (unread-char chr port) - (match (read port) - ((and token '#{.}#) - (if (eq? chr #\.) dot token)) - (token token)))))))) - -;;; -;;; Comment-preserving pretty-printer. -;;; - -(define-syntax vhashq - (syntax-rules (quote) - ((_) vlist-null) - ((_ (key (quote (lst ...))) rest ...) - (vhash-consq key '(lst ...) (vhashq rest ...))) - ((_ (key value) rest ...) - (vhash-consq key '((() . value)) (vhashq rest ...))))) - -(define %special-forms - ;; Forms that are indented specially. The number is meant to be understood - ;; like Emacs' 'scheme-indent-function' symbol property. When given an - ;; alist instead of a number, the alist gives "context" in which the symbol - ;; is a special form; for instance, context (modify-phases) means that the - ;; symbol must appear within a (modify-phases ...) expression. - (vhashq - ('begin 1) - ('lambda 2) - ('lambda* 2) - ('match-lambda 1) - ('match-lambda* 2) - ('define 2) - ('define* 2) - ('define-public 2) - ('define*-public 2) - ('define-syntax 2) - ('define-syntax-rule 2) - ('define-module 2) - ('define-gexp-compiler 2) - ('let 2) - ('let* 2) - ('letrec 2) - ('letrec* 2) - ('match 2) - ('when 2) - ('unless 2) - ('package 1) - ('origin 1) - ('operating-system 1) - ('modify-inputs 2) - ('modify-phases 2) - ('add-after '(((modify-phases) . 3))) - ('add-before '(((modify-phases) . 3))) - ('replace '(((modify-phases) . 2))) ;different from 'modify-inputs' - ('substitute* 2) - ('substitute-keyword-arguments 2) - ('call-with-input-file 2) - ('call-with-output-file 2) - ('with-output-to-file 2) - ('with-input-from-file 2))) - -(define %newline-forms - ;; List heads that must be followed by a newline. The second argument is - ;; the context in which they must appear. This is similar to a special form - ;; of 1, except that indent is 1 instead of 2 columns. - (vhashq - ('arguments '(package)) - ('sha256 '(origin source package)) - ('base32 '(sha256 origin)) - ('git-reference '(uri origin source)) - ('search-paths '(package)) - ('native-search-paths '(package)) - ('search-path-specification '()))) - -(define (prefix? candidate lst) - "Return true if CANDIDATE is a prefix of LST." - (let loop ((candidate candidate) - (lst lst)) - (match candidate - (() #t) - ((head1 . rest1) - (match lst - (() #f) - ((head2 . rest2) - (and (equal? head1 head2) - (loop rest1 rest2)))))))) - -(define (special-form-lead symbol context) - "If SYMBOL is a special form in the given CONTEXT, return its number of -arguments; otherwise return #f. CONTEXT is a stack of symbols lexically -surrounding SYMBOL." - (match (vhash-assq symbol %special-forms) - (#f #f) - ((_ . alist) - (any (match-lambda - ((prefix . level) - (and (prefix? prefix context) (- level 1)))) - alist)))) - -(define (newline-form? symbol context) - "Return true if parenthesized expressions starting with SYMBOL must be -followed by a newline." - (match (vhash-assq symbol %newline-forms) - (#f #f) - ((_ . prefix) - (prefix? prefix context)))) - -(define (escaped-string str) - "Return STR with backslashes and double quotes escaped. Everything else, in -particular newlines, is left as is." - (list->string - `(#\" - ,@(string-fold-right (lambda (chr lst) - (match chr - (#\" (cons* #\\ #\" lst)) - (#\\ (cons* #\\ #\\ lst)) - (_ (cons chr lst)))) - '() - str) - #\"))) - -(define (string-width str) - "Return the \"width\" of STR--i.e., the width of the longest line of STR." - (apply max (map string-length (string-split str #\newline)))) - -(define (canonicalize-comment c) - "Canonicalize comment C, ensuring it has the \"right\" number of leading -semicolons." - (let ((line (string-trim-both - (string-trim (comment->string c) (char-set #\;))))) - (comment (string-append - (if (comment-margin? c) - ";" - (if (string-null? line) - ";;" ;no trailing space - ";; ")) - line "\n") - (comment-margin? c)))) - -(define* (pretty-print-with-comments port obj - #:key - (format-comment identity) - (indent 0) - (max-width 78) - (long-list 5)) - "Pretty-print OBJ to PORT, attempting to at most MAX-WIDTH character columns -and assuming the current column is INDENT. Comments present in OBJ are -included in the output. - -Lists longer than LONG-LIST are written as one element per line. Comments are -passed through FORMAT-COMMENT before being emitted; a useful value for -FORMAT-COMMENT is 'canonicalize-comment'." - (define (list-of-lists? head tail) - ;; Return true if HEAD and TAIL denote a list of lists--e.g., a list of - ;; 'let' bindings. - (match head - ((thing _ ...) ;proper list - (and (not (memq thing - '(quote quasiquote unquote unquote-splicing))) - (pair? tail))) - (_ #f))) - - (let loop ((indent indent) - (column indent) - (delimited? #t) ;true if comes after a delimiter - (context '()) ;list of "parent" symbols - (obj obj)) - (define (print-sequence context indent column lst delimited?) - (define long? - (> (length lst) long-list)) - - (let print ((lst lst) - (first? #t) - (delimited? delimited?) - (column column)) - (match lst - (() - column) - ((item . tail) - (define newline? - ;; Insert a newline if ITEM is itself a list, or if TAIL is long, - ;; but only if ITEM is not the first item. Also insert a newline - ;; before a keyword. - (and (or (pair? item) long? - (and (keyword? item) - (not (eq? item #:allow-other-keys)))) - (not first?) (not delimited?) - (not (comment? item)))) - - (when newline? - (newline port) - (display (make-string indent #\space) port)) - (let ((column (if newline? indent column))) - (print tail - (keyword? item) ;keep #:key value next to one another - (comment? item) - (loop indent column - (or newline? delimited?) - context - item))))))) - - (define (sequence-would-protrude? indent lst) - ;; Return true if elements of LST written at INDENT would protrude - ;; beyond MAX-WIDTH. This is implemented as a cheap test with false - ;; negatives to avoid actually rendering all of LST. - (find (match-lambda - ((? string? str) - (>= (+ (string-width str) 2 indent) max-width)) - ((? symbol? symbol) - (>= (+ (string-width (symbol->string symbol)) indent) - max-width)) - ((? boolean?) - (>= (+ 2 indent) max-width)) - (() - (>= (+ 2 indent) max-width)) - (_ ;don't know - #f)) - lst)) - - (define (special-form? head) - (special-form-lead head context)) - - (match obj - ((? comment? comment) - (if (comment-margin? comment) - (begin - (display " " port) - (display (comment->string (format-comment comment)) - port)) - (begin - ;; When already at the beginning of a line, for example because - ;; COMMENT follows a margin comment, no need to emit a newline. - (unless (= column indent) - (newline port) - (display (make-string indent #\space) port)) - (display (comment->string (format-comment comment)) - port))) - (display (make-string indent #\space) port) - indent) - (('quote lst) - (unless delimited? (display " " port)) - (display "'" port) - (loop indent (+ column (if delimited? 1 2)) #t context lst)) - (('quasiquote lst) - (unless delimited? (display " " port)) - (display "`" port) - (loop indent (+ column (if delimited? 1 2)) #t context lst)) - (('unquote lst) - (unless delimited? (display " " port)) - (display "," port) - (loop indent (+ column (if delimited? 1 2)) #t context lst)) - (('unquote-splicing lst) - (unless delimited? (display " " port)) - (display ",@" port) - (loop indent (+ column (if delimited? 2 3)) #t context lst)) - (('gexp lst) - (unless delimited? (display " " port)) - (display "#~" port) - (loop indent (+ column (if delimited? 2 3)) #t context lst)) - (('ungexp obj) - (unless delimited? (display " " port)) - (display "#$" port) - (loop indent (+ column (if delimited? 2 3)) #t context obj)) - (('ungexp-native obj) - (unless delimited? (display " " port)) - (display "#+" port) - (loop indent (+ column (if delimited? 2 3)) #t context obj)) - (('ungexp-splicing lst) - (unless delimited? (display " " port)) - (display "#$@" port) - (loop indent (+ column (if delimited? 3 4)) #t context lst)) - (('ungexp-native-splicing lst) - (unless delimited? (display " " port)) - (display "#+@" port) - (loop indent (+ column (if delimited? 3 4)) #t context lst)) - (((? special-form? head) arguments ...) - ;; Special-case 'let', 'lambda', 'modify-inputs', etc. so the second - ;; and following arguments are less indented. - (let* ((lead (special-form-lead head context)) - (context (cons head context)) - (head (symbol->string head)) - (total (length arguments))) - (unless delimited? (display " " port)) - (display "(" port) - (display head port) - (unless (zero? lead) - (display " " port)) - - ;; Print the first LEAD arguments. - (let* ((indent (+ column 2 - (if delimited? 0 1))) - (column (+ column 1 - (if (zero? lead) 0 1) - (if delimited? 0 1) - (string-length head))) - (initial-indent column)) - (define new-column - (let inner ((n lead) - (arguments (take arguments (min lead total))) - (column column)) - (if (zero? n) - (begin - (newline port) - (display (make-string indent #\space) port) - indent) - (match arguments - (() column) - ((head . tail) - (inner (- n 1) tail - (loop initial-indent column - (= n lead) - context - head))))))) - - ;; Print the remaining arguments. - (let ((column (print-sequence - context indent new-column - (drop arguments (min lead total)) - #t))) - (display ")" port) - (+ column 1))))) - ((head tail ...) - (let* ((overflow? (>= column max-width)) - (column (if overflow? - (+ indent 1) - (+ column (if delimited? 1 2)))) - (newline? (or (newline-form? head context) - (list-of-lists? head tail))) ;'let' bindings - (context (cons head context))) - (if overflow? - (begin - (newline port) - (display (make-string indent #\space) port)) - (unless delimited? (display " " port))) - (display "(" port) - - (let* ((new-column (loop column column #t context head)) - (indent (if (or (>= new-column max-width) - (not (symbol? head)) - (sequence-would-protrude? - (+ new-column 1) tail) - newline?) - column - (+ new-column 1)))) - (when newline? - ;; Insert a newline right after HEAD. - (newline port) - (display (make-string indent #\space) port)) - - (let ((column - (print-sequence context indent - (if newline? indent new-column) - tail newline?))) - (display ")" port) - (+ column 1))))) - (_ - (let* ((str (if (string? obj) - (escaped-string obj) - (object->string obj))) - (len (string-width str))) - (if (and (> (+ column 1 len) max-width) - (not delimited?)) - (begin - (newline port) - (display (make-string indent #\space) port) - (display str port) - (+ indent len)) - (begin - (unless delimited? (display " " port)) - (display str port) - (+ column (if delimited? 0 1) len)))))))) - -(define (object->string* obj indent . args) - (call-with-output-string - (lambda (port) - (apply pretty-print-with-comments port obj - #:indent indent - args)))) + #:export (guix-style)) ;;; diff --git a/tests/read-print.scm b/tests/read-print.scm new file mode 100644 index 0000000000..e9ba1127d4 --- /dev/null +++ b/tests/read-print.scm @@ -0,0 +1,209 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021-2022 Ludovic Courtès +;;; +;;; 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 . + +(define-module (tests-style) + #:use-module (guix read-print) + #:use-module (guix gexp) ;for the reader extensions + #:use-module (srfi srfi-64)) + +(define-syntax-rule (test-pretty-print str args ...) + "Test equality after a round-trip where STR is passed to +'read-with-comments' and the resulting sexp is then passed to +'pretty-print-with-comments'." + (test-equal str + (call-with-output-string + (lambda (port) + (let ((exp (call-with-input-string str + read-with-comments))) + (pretty-print-with-comments port exp args ...)))))) + + +(test-begin "read-print") + +(test-equal "read-with-comments: dot notation" + (cons 'a 'b) + (call-with-input-string "(a . b)" + read-with-comments)) + +(test-pretty-print "(list 1 2 3 4)") +(test-pretty-print "((a . 1) (b . 2))") +(test-pretty-print "(a b c . boom)") +(test-pretty-print "(list 1 + 2 + 3 + 4)" + #:long-list 3 + #:indent 20) +(test-pretty-print "\ +(list abc + def)" + #:max-width 11) +(test-pretty-print "\ +(#:foo + #:bar)" + #:max-width 10) + +(test-pretty-print "\ +(#:first 1 + #:second 2 + #:third 3)") + +(test-pretty-print "\ +((x + 1) + (y + 2) + (z + 3))" + #:max-width 3) + +(test-pretty-print "\ +(let ((x 1) + (y 2) + (z 3) + (p 4)) + (+ x y))" + #:max-width 11) + +(test-pretty-print "\ +(lambda (x y) + ;; This is a procedure. + (let ((z (+ x y))) + (* z z)))") + +(test-pretty-print "\ +#~(string-append #$coreutils \"/bin/uname\")") + +(test-pretty-print "\ +(package + (inherit coreutils) + (version \"42\"))") + +(test-pretty-print "\ +(modify-phases %standard-phases + (add-after 'unpack 'post-unpack + (lambda _ + #t)) + (add-before 'check 'pre-check + (lambda* (#:key inputs #:allow-other-keys) + do things ...)))") + +(test-pretty-print "\ +(#:phases (modify-phases sdfsdf + (add-before 'x 'y + (lambda _ + xyz))))") + +(test-pretty-print "\ +(description \"abcdefghijkl +mnopqrstuvwxyz.\")" + #:max-width 30) + +(test-pretty-print "\ +(description + \"abcdefghijkl +mnopqrstuvwxyz.\")" + #:max-width 12) + +(test-pretty-print "\ +(description + \"abcdefghijklmnopqrstuvwxyz\")" + #:max-width 33) + +(test-pretty-print "\ +(modify-phases %standard-phases + (replace 'build + ;; Nicely indented in 'modify-phases' context. + (lambda _ + #t)))") + +(test-pretty-print "\ +(modify-inputs inputs + ;; Regular indentation for 'replace' here. + (replace \"gmp\" gmp))") + +(test-pretty-print "\ +(package + ;; Here 'sha256', 'base32', and 'arguments' must be + ;; immediately followed by a newline. + (source (origin + (method url-fetch) + (sha256 + (base32 + \"not a real base32 string\")))) + (arguments + '(#:phases %standard-phases + #:tests? #f)))") + +;; '#:key value' is kept on the same line. +(test-pretty-print "\ +(package + (name \"keyword-value-same-line\") + (arguments + (list #:phases #~(modify-phases %standard-phases + (add-before 'x 'y + (lambda* (#:key inputs #:allow-other-keys) + (foo bar baz)))) + #:make-flags #~'(\"ANSWER=42\") + #:tests? #f)))") + +(test-pretty-print "\ +(let ((x 1) + (y 2) + (z (let* ((a 3) + (b 4)) + (+ a b)))) + (list x y z))") + +(test-pretty-print "\ +(substitute-keyword-arguments (package-arguments x) + ((#:phases phases) + `(modify-phases ,phases + (add-before 'build 'do-things + (lambda _ + #t)))) + ((#:configure-flags flags) + `(cons \"--without-any-problem\" + ,flags)))") + +(test-equal "pretty-print-with-comments, canonicalize-comment" + "\ +(list abc + ;; Not a margin comment. + ;; Ditto. + ;; + ;; There's a blank line above. + def ;margin comment + ghi)" + (let ((sexp (call-with-input-string + "\ +(list abc + ;Not a margin comment. + ;;; Ditto. + ;;;;; + ; There's a blank line above. + def ;; margin comment + ghi)" + read-with-comments))) + (call-with-output-string + (lambda (port) + (pretty-print-with-comments port sexp + #:format-comment + canonicalize-comment))))) + +(test-end) diff --git a/tests/style.scm b/tests/style.scm index 55bad2b3ba..4ac5ae7c09 100644 --- a/tests/style.scm +++ b/tests/style.scm @@ -113,17 +113,6 @@ (define* (read-package-field package field #:optional (count 1)) (lambda (port) (read-lines port line count))))) -(define-syntax-rule (test-pretty-print str args ...) - "Test equality after a round-trip where STR is passed to -'read-with-comments' and the resulting sexp is then passed to -'pretty-print-with-comments'." - (test-equal str - (call-with-output-string - (lambda (port) - (let ((exp (call-with-input-string str - read-with-comments))) - (pretty-print-with-comments port exp args ...)))))) - (test-begin "style") @@ -377,176 +366,6 @@ (define file (list (package-inputs (@ (my-packages) my-coreutils)) (read-package-field (@ (my-packages) my-coreutils) 'inputs 4))))) -(test-equal "read-with-comments: dot notation" - (cons 'a 'b) - (call-with-input-string "(a . b)" - read-with-comments)) - -(test-pretty-print "(list 1 2 3 4)") -(test-pretty-print "((a . 1) (b . 2))") -(test-pretty-print "(a b c . boom)") -(test-pretty-print "(list 1 - 2 - 3 - 4)" - #:long-list 3 - #:indent 20) -(test-pretty-print "\ -(list abc - def)" - #:max-width 11) -(test-pretty-print "\ -(#:foo - #:bar)" - #:max-width 10) - -(test-pretty-print "\ -(#:first 1 - #:second 2 - #:third 3)") - -(test-pretty-print "\ -((x - 1) - (y - 2) - (z - 3))" - #:max-width 3) - -(test-pretty-print "\ -(let ((x 1) - (y 2) - (z 3) - (p 4)) - (+ x y))" - #:max-width 11) - -(test-pretty-print "\ -(lambda (x y) - ;; This is a procedure. - (let ((z (+ x y))) - (* z z)))") - -(test-pretty-print "\ -#~(string-append #$coreutils \"/bin/uname\")") - -(test-pretty-print "\ -(package - (inherit coreutils) - (version \"42\"))") - -(test-pretty-print "\ -(modify-phases %standard-phases - (add-after 'unpack 'post-unpack - (lambda _ - #t)) - (add-before 'check 'pre-check - (lambda* (#:key inputs #:allow-other-keys) - do things ...)))") - -(test-pretty-print "\ -(#:phases (modify-phases sdfsdf - (add-before 'x 'y - (lambda _ - xyz))))") - -(test-pretty-print "\ -(description \"abcdefghijkl -mnopqrstuvwxyz.\")" - #:max-width 30) - -(test-pretty-print "\ -(description - \"abcdefghijkl -mnopqrstuvwxyz.\")" - #:max-width 12) - -(test-pretty-print "\ -(description - \"abcdefghijklmnopqrstuvwxyz\")" - #:max-width 33) - -(test-pretty-print "\ -(modify-phases %standard-phases - (replace 'build - ;; Nicely indented in 'modify-phases' context. - (lambda _ - #t)))") - -(test-pretty-print "\ -(modify-inputs inputs - ;; Regular indentation for 'replace' here. - (replace \"gmp\" gmp))") - -(test-pretty-print "\ -(package - ;; Here 'sha256', 'base32', and 'arguments' must be - ;; immediately followed by a newline. - (source (origin - (method url-fetch) - (sha256 - (base32 - \"not a real base32 string\")))) - (arguments - '(#:phases %standard-phases - #:tests? #f)))") - -;; '#:key value' is kept on the same line. -(test-pretty-print "\ -(package - (name \"keyword-value-same-line\") - (arguments - (list #:phases #~(modify-phases %standard-phases - (add-before 'x 'y - (lambda* (#:key inputs #:allow-other-keys) - (foo bar baz)))) - #:make-flags #~'(\"ANSWER=42\") - #:tests? #f)))") - -(test-pretty-print "\ -(let ((x 1) - (y 2) - (z (let* ((a 3) - (b 4)) - (+ a b)))) - (list x y z))") - -(test-pretty-print "\ -(substitute-keyword-arguments (package-arguments x) - ((#:phases phases) - `(modify-phases ,phases - (add-before 'build 'do-things - (lambda _ - #t)))) - ((#:configure-flags flags) - `(cons \"--without-any-problem\" - ,flags)))") - -(test-equal "pretty-print-with-comments, canonicalize-comment" - "\ -(list abc - ;; Not a margin comment. - ;; Ditto. - ;; - ;; There's a blank line above. - def ;margin comment - ghi)" - (let ((sexp (call-with-input-string - "\ -(list abc - ;Not a margin comment. - ;;; Ditto. - ;;;;; - ; There's a blank line above. - def ;; margin comment - ghi)" - read-with-comments))) - (call-with-output-string - (lambda (port) - (pretty-print-with-comments port sexp - #:format-comment - canonicalize-comment))))) (test-end) From patchwork Tue Aug 2 21:44:08 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41110 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 6857727BBEA; Tue, 2 Aug 2022 23:58:07 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 2FFEB27BBE9 for ; Tue, 2 Aug 2022 23:58:07 +0100 (BST) Received: from localhost ([::1]:58412 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIzhZ-0001uw-Su for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:45:22 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44426) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhG-0001uR-Gk for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55554) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhG-0006EZ-7G for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhG-00039I-3i for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 02/13] read-print: Add System and Home special forms. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947667611912 (code B ref 56898); Tue, 02 Aug 2022 21:45:02 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:36 +0000 Received: from localhost ([127.0.0.1]:45261 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgp-000363-SH for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:36 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59532) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgn-00035O-Tn for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:34 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55152) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgi-000690-MU; Tue, 02 Aug 2022 17:44:28 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=PjroGWoXrK2hW0kNr4EMA5saiSx1g8m0ZuXnz4an/N8=; b=goxaRnlIBzc1tLijDk9p 3ABep4/mSXLNaPPi3P/v1jVKQhghzURpYmrJg5ATI0mNIDe6gBocWPd1nIirLcXrbdBCivbCR6nyT lwmwKRBS4swpq08TJMqJQsJYlLXt2fZa88MZ8iAwkBejt+w6HvHESU8X/gxTb6ESZpr8k0lPqzMuW A90XfY9jjNZ2sZDvh4S/rYE3Ky7TkN2r+jwWCbyyoMXkl+CqT9dZX6Aa7uF7TAynajmijs+OKQSRw 8K89gSRRnp2xDhogUGLddmRN9/It28fzmUP8qWZuHDEzMoTA+dobMERPrWrAWzSMcnMIAYVAXnZqr KS1OSvowq6K5bA==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgi-0006W4-AG; Tue, 02 Aug 2022 17:44:28 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:08 +0200 Message-Id: <20220802214419.19013-2-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/read-print.scm (%special-forms): Add System and Home forms. (%newline-forms): Add 'services'. --- guix/read-print.scm | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/guix/read-print.scm b/guix/read-print.scm index 69ab8ac8b3..949a713ca2 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -156,7 +156,6 @@ (define %special-forms ('unless 2) ('package 1) ('origin 1) - ('operating-system 1) ('modify-inputs 2) ('modify-phases 2) ('add-after '(((modify-phases) . 3))) @@ -167,7 +166,22 @@ (define %special-forms ('call-with-input-file 2) ('call-with-output-file 2) ('with-output-to-file 2) - ('with-input-from-file 2))) + ('with-input-from-file 2) + ('with-directory-excursion 2) + + ;; (gnu system) and (gnu services). + ('operating-system 1) + ('bootloader-configuration 1) + ('mapped-device 1) + ('file-system 1) + ('swap-space 1) + ('user-account 1) + ('user-group 1) + ('setuid-program 1) + ('modify-services 2) + + ;; (gnu home). + ('home-environment 1))) (define %newline-forms ;; List heads that must be followed by a newline. The second argument is @@ -180,7 +194,11 @@ (define %newline-forms ('git-reference '(uri origin source)) ('search-paths '(package)) ('native-search-paths '(package)) - ('search-path-specification '()))) + ('search-path-specification '()) + + ('services '(operating-system)) + ('set-xorg-configuration '()) + ('services '(home-environment)))) (define (prefix? candidate lst) "Return true if CANDIDATE is a prefix of LST." From patchwork Tue Aug 2 21:44:09 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41105 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 8D0BA27BBEA; Tue, 2 Aug 2022 23:45:44 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 2C73227BBE9 for ; Tue, 2 Aug 2022 23:45:44 +0100 (BST) Received: from localhost ([::1]:59166 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIziv-0002Ww-5Q for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:46:45 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44430) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhG-0001uZ-Vr for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55555) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhG-0006FP-Ls for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhG-00039P-Hd for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 03/13] read-print: Expose comment constructor. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947667611921 (code B ref 56898); Tue, 02 Aug 2022 21:45:02 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:36 +0000 Received: from localhost ([127.0.0.1]:45263 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgq-00036A-5i for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:36 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59540) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgo-00035P-Ff for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:34 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55154) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgj-00069K-8r; Tue, 02 Aug 2022 17:44:29 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=DQrNEpRA+D4vdxEMPHELwxrZ1zYQ3SRn8KONX4CeXhw=; b=V/tod+9XzrH/46tDdYfu BQYauYJRTu0gFrtVvtNkRi9L3SlyNLL/0jmebT1em7DCx+D0j8KvFVXtEwOWQbvhYGRWIsdvBILJP Zg3I8Ry6ey22h15L+Eb5xM8lhK9IEonNqERQzBEuCnn11OeOxOjrxVZ0toiCpMPlYCVEFeQ8xsgIR uOCZa2jxRqVXmK44BNPpG5hDrELHJeb7Y0VMlKijY9ITK6cK0c50xDBFKwrjpaQahDnXElj+qZHVl nb17YfnM9pxAyAAclnz/anrNOoXscAuunsucpPZnxgT2vljop7fpjUi0fHFpzt0811npCpLtZyVK1 9HqjbqvC1svWDQ==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgi-0006W4-Sx; Tue, 02 Aug 2022 17:44:29 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:09 +0200 Message-Id: <20220802214419.19013-3-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/read-print.scm (): Rename constructor to 'string->comment'. (comment): New procedure. (read-with-comments, canonicalize-comment): Use 'string->comment' instead of 'comment'. --- guix/read-print.scm | 36 +++++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/guix/read-print.scm b/guix/read-print.scm index 949a713ca2..5281878504 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -23,10 +23,13 @@ (define-module (guix read-print) #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:export (pretty-print-with-comments read-with-comments object->string* + comment comment? comment->string comment-margin? @@ -46,11 +49,22 @@ (define-module (guix read-print) ;; A comment. (define-record-type - (comment str margin?) + (string->comment str margin?) comment? (str comment->string) (margin? comment-margin?)) +(define* (comment str #:optional margin?) + "Return a new comment made from STR. When MARGIN? is true, return a margin +comment; otherwise return a line comment. STR must start with a semicolon and +end with newline, otherwise an error is raised." + (when (or (string-null? str) + (not (eqv? #\; (string-ref str 0))) + (not (string-suffix? "\n" str))) + (raise (condition + (&message (message "invalid comment string"))))) + (string->comment str margin?)) + (define (read-with-comments port) "Like 'read', but include objects when they're encountered." ;; Note: Instead of implementing this functionality in 'read' proper, which @@ -106,8 +120,8 @@ (define (reverse/dot lst) (loop #f return))) ((eqv? chr #\;) (unread-char chr port) - (comment (read-line port 'concat) - (not blank-line?))) + (string->comment (read-line port 'concat) + (not blank-line?))) (else (unread-char chr port) (match (read port) @@ -256,14 +270,14 @@ (define (canonicalize-comment c) semicolons." (let ((line (string-trim-both (string-trim (comment->string c) (char-set #\;))))) - (comment (string-append - (if (comment-margin? c) - ";" - (if (string-null? line) - ";;" ;no trailing space - ";; ")) - line "\n") - (comment-margin? c)))) + (string->comment (string-append + (if (comment-margin? c) + ";" + (if (string-null? line) + ";;" ;no trailing space + ";; ")) + line "\n") + (comment-margin? c)))) (define* (pretty-print-with-comments port obj #:key From patchwork Tue Aug 2 21:44:10 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41113 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 5906F27BBE9; Wed, 3 Aug 2022 00:19:17 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id C0C6327BBEA for ; Wed, 3 Aug 2022 00:19:11 +0100 (BST) Received: from localhost ([::1]:58492 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIziE-0001yV-71 for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:46:02 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44438) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhH-0001ui-Fy for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55556) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhH-0006FX-4M for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhG-00039Y-WE for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 04/13] read-print: Introduce parent class of . Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668011955 (code B ref 56898); Tue, 02 Aug 2022 21:45:02 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:40 +0000 Received: from localhost ([127.0.0.1]:45275 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgs-00036c-PR for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:39 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59544) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgp-00035R-48 for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:35 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55156) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgj-00069V-Rj; Tue, 02 Aug 2022 17:44:29 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=pt0sN+GHGiH0RhP9V05jLiSoKT4K+EEgXPIc/+60wFU=; b=YngCfDmdlD4ATBVkgBDe sXOur1PTJwf6F79qubqPZxdZHTbDWLW1bBHXGm/qljW/dDRfjFTmGV30Q91n3M/MbSKmHXp9+py7e tFzE+tHZfEfw2GuUfnnTTcblkrQOOdhSA1In+OZnN85g6IClF2LoIlPu4vM1fzfBOtaTuLyimdg5i 8DOX/svVYWCp7fkoWNQBct1D4Kg1l6oy3Ylto+ICYGrUQtX9HQAM7sAcL9GzNG5Yvxbv9/fxeEyjH aJgnt2/huy7r1jG7RNjuIfguMfazMNVpajLdi/gMfZryXobfi6rndmuFCLttxBYWizgrCxqiUn0EN Ku/4XxmH9odTWQ==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgj-0006W4-FL; Tue, 02 Aug 2022 17:44:29 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:10 +0200 Message-Id: <20220802214419.19013-4-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/read-print.scm (, blank?): New record type. (): Redefine using the record interface. (read-with-comments, pretty-print-with-comments): Change some uses of 'comment?' to 'blank?'. * guix/scripts/style.scm (simplify-inputs)[simplify-expressions]: Use 'blank?' instead of 'comment?'. --- guix/read-print.scm | 37 ++++++++++++++++++++++++++----------- guix/scripts/style.scm | 2 +- 2 files changed, 27 insertions(+), 12 deletions(-) diff --git a/guix/read-print.scm b/guix/read-print.scm index 5281878504..732d0dc1f8 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -22,13 +22,14 @@ (define-module (guix read-print) #:use-module (ice-9 rdelim) #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-9) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (pretty-print-with-comments read-with-comments object->string* + blank? + comment comment? comment->string @@ -47,12 +48,26 @@ (define-module (guix read-print) ;;; Comment-preserving reader. ;;; -;; A comment. -(define-record-type - (string->comment str margin?) - comment? - (str comment->string) - (margin? comment-margin?)) +(define + ;; The parent class for "blanks". + (make-record-type ' '() + (lambda (obj port) + (format port "#" + (number->string (object-address obj) 16))) + #:extensible? #t)) + +(define blank? (record-predicate )) + +(define + ;; Comments. + (make-record-type ' '(str margin?) + #:parent + #:extensible? #f)) + +(define comment? (record-predicate )) +(define string->comment (record-type-constructor )) +(define comment->string (record-accessor 'str)) +(define comment-margin? (record-accessor 'margin?)) (define* (comment str #:optional margin?) "Return a new comment made from STR. When MARGIN? is true, return a margin @@ -66,7 +81,7 @@ (define* (comment str #:optional margin?) (string->comment str margin?)) (define (read-with-comments port) - "Like 'read', but include objects when they're encountered." + "Like 'read', but include objects when they're encountered." ;; Note: Instead of implementing this functionality in 'read' proper, which ;; is the best approach long-term, this code is a layer on top of 'read', ;; such that we don't have to rely on a specific Guile version. @@ -99,7 +114,7 @@ (define (reverse/dot lst) (let/ec return (let liip ((lst '())) (liip (cons (loop (match lst - (((? comment?) . _) #t) + (((? blank?) . _) #t) (_ #f)) (lambda () (return (reverse/dot lst)))) @@ -327,7 +342,7 @@ (define newline? (and (keyword? item) (not (eq? item #:allow-other-keys)))) (not first?) (not delimited?) - (not (comment? item)))) + (not (blank? item)))) (when newline? (newline port) @@ -335,7 +350,7 @@ (define newline? (let ((column (if newline? indent column))) (print tail (keyword? item) ;keep #:key value next to one another - (comment? item) + (blank? item) (loop indent column (or newline? delimited?) context diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index e2530e80c0..5c0ecc0896 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -108,7 +108,7 @@ (define (simplify-expressions exp inputs return) (exp exp) (inputs inputs)) (match exp - (((? comment? head) . rest) + (((? blank? head) . rest) (loop (cons head result) rest inputs)) ((head . rest) (match inputs From patchwork Tue Aug 2 21:44:11 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41114 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 80CB327BBEA; Wed, 3 Aug 2022 00:21:37 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id EC2A227BBE9 for ; Wed, 3 Aug 2022 00:21:36 +0100 (BST) Received: from localhost ([::1]:58554 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIziG-00022J-7Y for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:46:05 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44448) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhI-0001wO-VN for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55560) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhI-0006QO-MO for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhI-0003A2-JA for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 05/13] style: Adjust test to not emit blank lines. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668412016 (code B ref 56898); Tue, 02 Aug 2022 21:45:04 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:44 +0000 Received: from localhost ([127.0.0.1]:45291 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgy-00037e-IU for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:44 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59548) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgq-00035S-QT for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:37 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55158) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgk-00069e-EI; Tue, 02 Aug 2022 17:44:30 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=KfJIRIoRnbWzjUZg0rsRaWP15mI7T4TDJvTgqiEv1UM=; b=ddMXS5UxvZKF43EyHgpN 0n5Gvut04hOjl4PtYnL/aMC6ykd0iVNeQ7W83iQXi4peqi4c0OoqpFdBjdT5OLYBZ+UffvDwlZMAc kcYcbcIp7K6ieKEZFBefLOR9Ft3R8K6i/caSHJHWFIF3EHlv4k4/Df6Lx6hnYB09LzrVx7+B3SxUT HGmyt0Y0P30c/Pw90tjXgCEp9lrYZ1XTzEl0tid1jK6VYncWy9OR4VN1mEQTtbnXYJ2wkEaYmVVXG bbY+A8ULA7ll9D38ci0MiZoHsddn2Qv4izhRcpTjLd4Ef3F+0op+itPZGEUQ80qy4LRB4d9Ncpqwv 7jUHb7YK6ZxZAA==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgk-0006W4-1u; Tue, 02 Aug 2022 17:44:30 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:11 +0200 Message-Id: <20220802214419.19013-5-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Previously this test would produce a file containing blank lines between inputs. * tests/style.scm ("input labels, modify-inputs and margin comment"): Remove trailing newlines in replacement strings of 'substitute*' expression. --- tests/style.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/style.scm b/tests/style.scm index 4ac5ae7c09..6aab2c3785 100644 --- a/tests/style.scm +++ b/tests/style.scm @@ -355,9 +355,9 @@ (define file (substitute* file ((",gmp\\)(.*)$" _ rest) - (string-append ",gmp) ;margin comment\n" rest)) + (string-append ",gmp) ;margin comment" rest)) ((",acl\\)(.*)$" _ rest) - (string-append ",acl) ;another one\n" rest))) + (string-append ",acl) ;another one" rest))) (system* "guix" "style" "-L" directory "-S" "inputs" "my-coreutils") From patchwork Tue Aug 2 21:44:12 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41109 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 3F47B27BBEA; Tue, 2 Aug 2022 23:57:49 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5FF5627BBE9 for ; Tue, 2 Aug 2022 23:57:48 +0100 (BST) Received: from localhost ([::1]:60876 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIzjI-0003s0-LC for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:47:08 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44444) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhI-0001v9-72 for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55558) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhH-0006KT-Tm for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhH-00039n-Py for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 06/13] read-print: Read and render vertical space. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668412001 (code B ref 56898); Tue, 02 Aug 2022 21:45:03 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:44 +0000 Received: from localhost ([127.0.0.1]:45287 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgx-00037O-Dj for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:43 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59552) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgq-00035V-8c for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:36 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55160) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgl-00069m-0U; Tue, 02 Aug 2022 17:44:31 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=kR5dSnJ5x/ASJtlbQSE9/nsQz3ihJBLIwzHylHZweAE=; b=WlhD+agcaUV+Is9h80n0 Jwpac5mTcR0W2pLOJXJ0XrwQE+AXgLh9ATJRG1spPIyDjuzvdjpfv1lqYVVBQspytNgwH1tW83vpX 8kAOyg233r8cHVtpeQiMXZI6u+RlyQNclap1L+WuOwpBVATRFFuK8wKsXv1ydu0TLLLsjOqYSwyUX 9ak0Q8jxYFZlu4gmeFuBTwR7Jntf9iQyablXVJGfpeowTvS+r35CfIX1nbD8cPMfvkxtzPWb5wuac OGYtreKaJtudi7qvnaqvUdfNNXnoRqVPdJ0lTAv4mc4GkTHFQlnc116bvj6btX7Eabqv2rs1z9hJd 5/PzQBXy3LAdNw==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgk-0006W4-Kp; Tue, 02 Aug 2022 17:44:30 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:12 +0200 Message-Id: <20220802214419.19013-6-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/read-print.scm (, vertical-space?) (vertical-space, vertical-space-height): New variables. (combine-vertical-space, canonicalize-vertical-space) (read-vertical-space): New procedures. (read-with-comments): Use it in the #\newline case. (pretty-print-with-comments): Add #:format-vertical-space and honor it. Add case for 'vertical-space?'. * guix/scripts/style.scm (format-package-definition): Pass #:format-vertical-space to 'object->string*'. * tests/read-print.scm ("read-with-comments: list with blank line") ("read-with-comments: list with multiple blank lines") ("read-with-comments: top-level blank lines") ("pretty-print-with-comments, canonicalize-vertical-space"): New tests. Add a couple of additional round-trip tests. --- guix/read-print.scm | 54 ++++++++++++++++++++++++++++-- guix/scripts/style.scm | 3 +- tests/read-print.scm | 76 +++++++++++++++++++++++++++++++++++++++++- 3 files changed, 129 insertions(+), 4 deletions(-) diff --git a/guix/read-print.scm b/guix/read-print.scm index 732d0dc1f8..2b626ba281 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -30,6 +30,11 @@ (define-module (guix read-print) blank? + vertical-space + vertical-space? + vertical-space-height + canonicalize-vertical-space + comment comment? comment->string @@ -58,6 +63,26 @@ (define (define blank? (record-predicate )) +(define + (make-record-type ' '(height) + #:parent + #:extensible? #f)) + +(define vertical-space? (record-predicate )) +(define vertical-space (record-type-constructor )) +(define vertical-space-height (record-accessor 'height)) + +(define (combine-vertical-space x y) + "Return vertical space as high as the combination of X and Y." + (vertical-space (+ (vertical-space-height x) + (vertical-space-height y)))) + +(define canonicalize-vertical-space + (let ((unit (vertical-space 1))) + (lambda (space) + "Return a vertical space corresponding to a single blank line." + unit))) + (define ;; Comments. (make-record-type ' '(str margin?) @@ -80,6 +105,19 @@ (define* (comment str #:optional margin?) (&message (message "invalid comment string"))))) (string->comment str margin?)) +(define (read-vertical-space port) + "Read from PORT until a non-vertical-space character is met, and return a +single record." + (define (space? chr) + (char-set-contains? char-set:whitespace chr)) + + (let loop ((height 1)) + (match (read-char port) + (#\newline (loop (+ 1 height))) + ((? eof-object?) (vertical-space height)) + ((? space?) (loop height)) + (chr (unread-char chr port) (vertical-space height))))) + (define (read-with-comments port) "Like 'read', but include objects when they're encountered." ;; Note: Instead of implementing this functionality in 'read' proper, which @@ -107,7 +145,9 @@ (define (reverse/dot lst) eof) ;oops! (chr (cond ((eqv? chr #\newline) - (loop #t return)) + (if blank-line? + (read-vertical-space port) + (loop #t return))) ((char-set-contains? char-set:whitespace chr) (loop blank-line? return)) ((memv chr '(#\( #\[)) @@ -297,6 +337,7 @@ (define (canonicalize-comment c) (define* (pretty-print-with-comments port obj #:key (format-comment identity) + (format-vertical-space identity) (indent 0) (max-width 78) (long-list 5)) @@ -306,7 +347,8 @@ (define* (pretty-print-with-comments port obj Lists longer than LONG-LIST are written as one element per line. Comments are passed through FORMAT-COMMENT before being emitted; a useful value for -FORMAT-COMMENT is 'canonicalize-comment'." +FORMAT-COMMENT is 'canonicalize-comment'. Vertical space is passed through +FORMAT-VERTICAL-SPACE; a useful value of 'canonicalize-vertical-space'." (define (list-of-lists? head tail) ;; Return true if HEAD and TAIL denote a list of lists--e.g., a list of ;; 'let' bindings. @@ -394,6 +436,14 @@ (define (special-form? head) port))) (display (make-string indent #\space) port) indent) + ((? vertical-space? space) + (unless delimited? (newline port)) + (let loop ((i (vertical-space-height (format-vertical-space space)))) + (unless (zero? i) + (newline port) + (loop (- i 1)))) + (display (make-string indent #\space) port) + indent) (('quote lst) (unless delimited? (display " " port)) (display "'" port) diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index 5c0ecc0896..2e14bc68fd 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -316,7 +316,8 @@ (define* (format-package-definition package (object->string* exp (location-column (package-definition-location package)) - #:format-comment canonicalize-comment))))) + #:format-comment canonicalize-comment + #:format-vertical-space canonicalize-vertical-space))))) (define (package-location X-Patchwork-Id: 41104 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 95BB627BBEB; Tue, 2 Aug 2022 23:43:22 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 589D827BBE9 for ; Tue, 2 Aug 2022 23:43:21 +0100 (BST) Received: from localhost ([::1]:59374 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIziy-0002lS-Ul for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:46:49 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44446) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhI-0001vs-Kt for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55559) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhI-0006NS-BQ for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhI-00039v-7g for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 07/13] read-print: Recognize page breaks. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668412009 (code B ref 56898); Tue, 02 Aug 2022 21:45:04 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:44 +0000 Received: from localhost ([127.0.0.1]:45289 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgy-00037V-1l for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:44 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59556) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgq-00035a-Q9 for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:37 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55162) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgl-00069s-In; Tue, 02 Aug 2022 17:44:31 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=TZsiGBUECifF5vB9KehYhuZHWx6CeIIJlKp8LFvyaOk=; b=Kakq489civk38XzGEuNX RtvH040qHkFs8gNv+kRWNnKrlN1pCKRgZARqLC7K3Jy4ORXMen4vOzUz6UIn+zHXloOb6Vuu995DZ XALjDDiE69R9JArs52E1URIVbeDQTFNHIuYfjH3HJCgW+jviRTundYgCRkuqSmhSUxcdooSTFB/iD 2wHsL4u0GERdj+GNdendn5tVEWgKyPGgwR6Bq0r0t9V4djOIkmHsbiDB+WKqscHJbuDmUVscx4YTO pAH5r9zCqlSV/UzYfjMrZKPfb9LtxDosuQhLgPxdmDyNZmQbx2iHQNrlmGjrPi9rGYJUaeHJgNIVA gWEAclC6zXujww==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgl-0006W4-6q; Tue, 02 Aug 2022 17:44:31 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:13 +0200 Message-Id: <20220802214419.19013-7-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/read-print.scm (, page-break?, page-break) (char-set:whitespace-sans-page-break): New variables. (space?): New procedure. (read-vertical-space): Use it. (read-until-end-of-line): New procedure. (read-with-comments): Add #\page case. (pretty-print-with-comments): Add 'page-break?' case. * tests/read-print.scm ("read-with-comments: top-level page break"): New test. Add round-trip test with page break within an sexp. --- guix/read-print.scm | 46 +++++++++++++++++++++++++++++++++++++++++--- tests/read-print.scm | 22 +++++++++++++++++++++ 2 files changed, 65 insertions(+), 3 deletions(-) diff --git a/guix/read-print.scm b/guix/read-print.scm index 2b626ba281..33ed6e3dbe 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -35,6 +35,9 @@ (define-module (guix read-print) vertical-space-height canonicalize-vertical-space + page-break + page-break? + comment comment? comment->string @@ -83,6 +86,18 @@ (define canonicalize-vertical-space "Return a vertical space corresponding to a single blank line." unit))) +(define + (make-record-type ' '() + #:parent + #:extensible? #f)) + +(define page-break? (record-predicate )) +(define page-break + (let ((break ((record-type-constructor )))) + (lambda () + break))) + + (define ;; Comments. (make-record-type ' '(str margin?) @@ -105,12 +120,17 @@ (define* (comment str #:optional margin?) (&message (message "invalid comment string"))))) (string->comment str margin?)) +(define char-set:whitespace-sans-page-break + ;; White space, excluding #\page. + (char-set-difference char-set:whitespace (char-set #\page))) + +(define (space? chr) + "Return true if CHR is white space, except for page breaks." + (char-set-contains? char-set:whitespace-sans-page-break chr)) + (define (read-vertical-space port) "Read from PORT until a non-vertical-space character is met, and return a single record." - (define (space? chr) - (char-set-contains? char-set:whitespace chr)) - (let loop ((height 1)) (match (read-char port) (#\newline (loop (+ 1 height))) @@ -118,6 +138,15 @@ (define (space? chr) ((? space?) (loop height)) (chr (unread-char chr port) (vertical-space height))))) +(define (read-until-end-of-line port) + "Read white space from PORT until the end of line, included." + (let loop () + (match (read-char port) + (#\newline #t) + ((? eof-object?) #t) + ((? space?) (loop)) + (chr (unread-char chr port))))) + (define (read-with-comments port) "Like 'read', but include objects when they're encountered." ;; Note: Instead of implementing this functionality in 'read' proper, which @@ -148,6 +177,11 @@ (define (reverse/dot lst) (if blank-line? (read-vertical-space port) (loop #t return))) + ((eqv? chr #\page) + ;; Assume that a page break is on a line of its own and read + ;; subsequent white space and newline. + (read-until-end-of-line port) + (page-break)) ((char-set-contains? char-set:whitespace chr) (loop blank-line? return)) ((memv chr '(#\( #\[)) @@ -444,6 +478,12 @@ (define (special-form? head) (loop (- i 1)))) (display (make-string indent #\space) port) indent) + ((? page-break?) + (unless delimited? (newline port)) + (display #\page port) + (newline port) + (display (make-string indent #\space) port) + indent) (('quote lst) (unless delimited? (display " " port)) (display "'" port) diff --git a/tests/read-print.scm b/tests/read-print.scm index f915b7e2d2..70be7754f8 100644 --- a/tests/read-print.scm +++ b/tests/read-print.scm @@ -70,6 +70,21 @@ (define-syntax-rule (test-pretty-print str args ...) (read-with-comments port) (read-with-comments port))))) +(test-equal "read-with-comments: top-level page break" + (list (comment ";; Begin.\n") (vertical-space 1) + (page-break) + (comment ";; End.\n")) + (call-with-input-string "\ +;; Begin. + + +;; End.\n" + (lambda (port) + (list (read-with-comments port) + (read-with-comments port) + (read-with-comments port) + (read-with-comments port))))) + (test-pretty-print "(list 1 2 3 4)") (test-pretty-print "((a . 1) (b . 2))") (test-pretty-print "(a b c . boom)") @@ -229,6 +244,13 @@ (define-syntax-rule (test-pretty-print str args ...) ;; Comment after blank line. two)") +(test-pretty-print "\ +(begin + break + + ;; page break above + end)") + (test-equal "pretty-print-with-comments, canonicalize-comment" "\ (list abc From patchwork Tue Aug 2 21:44:14 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41108 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 30E3927BBEA; Tue, 2 Aug 2022 23:48:08 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id A0F7027BBE9 for ; Tue, 2 Aug 2022 23:48:07 +0100 (BST) Received: from localhost ([::1]:59506 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIzj1-0002rm-60 for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:46:51 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44468) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhK-0001yN-4f for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:06 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55563) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhJ-0006Qp-SG for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:05 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhJ-0003AO-P0 for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 08/13] read-print: Add code to read and write sequences of expressions/blanks. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668612038 (code B ref 56898); Tue, 02 Aug 2022 21:45:05 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:46 +0000 Received: from localhost ([127.0.0.1]:45297 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgz-000380-MS for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:46 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59572) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgr-00035c-H3 for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:40 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55164) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgm-0006A2-9n; Tue, 02 Aug 2022 17:44:32 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=Rd6n1QK4C+HEcBGD8ObK/gAdTLW6ydpJwQ2aDI8c9qo=; b=GIxai5dcnJ345Ko/CEXj iRIaPAIRZTSVjc2DiFeNmcwz6t1Df5LetnN2VGcO8aJ73cO3Q1fqGbhgzGhLdieXjryZ27vwSM4NM kXOxqlIQEvZ0fYScxPkUx6o6l9xBZtNnBr0ts0d0N2ETuuR9ScLMK6w/1pGk8AaGQNHe6nfJU+uO2 GQHoZUnlCh0Je8v4WPN1wDa2TZIeZV0i/3H5XrlLssJ6YwLZWddSEy8W7sHymwLkdoJoK9/NNyIDI G8XZZX1OOCTM9LJ/DPSmZ4mxSePXAocfCAH7Y+h9BhurQ8W6VH/RMxdhJ25bAhBGqrwqXXg1jlLmm s6nGZ7TADEFKTA==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgl-0006W4-PT; Tue, 02 Aug 2022 17:44:32 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:14 +0200 Message-Id: <20220802214419.19013-8-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/read-print.scm (read-with-comments): Add #:blank-line? and honor it. (read-with-comments/sequence, pretty-print-with-comments/splice): New procedures. * tests/read-print.scm (test-pretty-print/sequence): New macro. Add tests using it. --- guix/read-print.scm | 32 +++++++++++++++++++++++++++++--- tests/read-print.scm | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 3 deletions(-) diff --git a/guix/read-print.scm b/guix/read-print.scm index 33ed6e3dbe..4a3afdd4f9 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -25,7 +25,9 @@ (define-module (guix read-print) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (pretty-print-with-comments + pretty-print-with-comments/splice read-with-comments + read-with-comments/sequence object->string* blank? @@ -147,8 +149,9 @@ (define (read-until-end-of-line port) ((? space?) (loop)) (chr (unread-char chr port))))) -(define (read-with-comments port) - "Like 'read', but include objects when they're encountered." +(define* (read-with-comments port #:key (blank-line? #t)) + "Like 'read', but include objects when they're encountered. When +BLANK-LINE? is true, assume PORT is at the beginning of a new line." ;; Note: Instead of implementing this functionality in 'read' proper, which ;; is the best approach long-term, this code is a layer on top of 'read', ;; such that we don't have to rely on a specific Guile version. @@ -167,7 +170,7 @@ (define (reverse/dot lst) dotted)) ((x . rest) (loop (cons x result) rest))))) - (let loop ((blank-line? #t) + (let loop ((blank-line? blank-line?) (return (const 'unbalanced))) (match (read-char port) ((? eof-object? eof) @@ -217,6 +220,20 @@ (define (reverse/dot lst) ((and token '#{.}#) (if (eq? chr #\.) dot token)) (token token)))))))) + +(define (read-with-comments/sequence port) + "Read from PORT until the end-of-file is reached and return the list of +expressions and blanks that were read." + (let loop ((lst '()) + (blank-line? #t)) + (match (read-with-comments port #:blank-line? blank-line?) + ((? eof-object?) + (reverse! lst)) + ((? blank? blank) + (loop (cons blank lst) #t)) + (exp + (loop (cons exp lst) #f))))) + ;;; ;;; Comment-preserving pretty-printer. @@ -625,3 +642,12 @@ (define (object->string* obj indent . args) (apply pretty-print-with-comments port obj #:indent indent args)))) + +(define* (pretty-print-with-comments/splice port lst + #:rest rest) + "Write to PORT the expressions and blanks listed in LST." + (for-each (lambda (exp) + (apply pretty-print-with-comments port exp rest) + (unless (blank? exp) + (newline port))) + lst)) diff --git a/tests/read-print.scm b/tests/read-print.scm index 70be7754f8..94f018dd44 100644 --- a/tests/read-print.scm +++ b/tests/read-print.scm @@ -33,6 +33,16 @@ (define-syntax-rule (test-pretty-print str args ...) read-with-comments))) (pretty-print-with-comments port exp args ...)))))) +(define-syntax-rule (test-pretty-print/sequence str args ...) + "Likewise, but read and print entire sequences rather than individual +expressions." + (test-equal str + (call-with-output-string + (lambda (port) + (let ((lst (call-with-input-string str + read-with-comments/sequence))) + (pretty-print-with-comments/splice port lst args ...)))))) + (test-begin "read-print") @@ -251,6 +261,33 @@ (define-syntax-rule (test-pretty-print str args ...) ;; page break above end)") +(test-pretty-print/sequence "\ +;;; This is a top-level comment. + + +;; Above is a page break. +(this is an sexp + ;; with a comment + !!) + +;; The end.\n") + +(test-pretty-print/sequence " +;;; Hello! + +(define-module (foo bar) + #:use-module (guix) + #:use-module (gnu)) + + +;; And now, the OS. +(operating-system + (host-name \"komputilo\") + (locale \"eo_EO.UTF-8\") + + (services + (cons (service mcron-service-type) %base-services)))\n") + (test-equal "pretty-print-with-comments, canonicalize-comment" "\ (list abc From patchwork Tue Aug 2 21:44:15 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41106 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id AA4E427BBEA; Tue, 2 Aug 2022 23:45:49 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 255B127BBE9 for ; Tue, 2 Aug 2022 23:45:49 +0100 (BST) Received: from localhost ([::1]:60288 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIzjB-0003Rl-S0 for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:47:01 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44456) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhJ-0001xB-AU for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55561) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhJ-0006QY-0t for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:05 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhI-0003A9-U2 for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 09/13] read-print: 'canonicalize-comment' leaves top-level comments unchanged. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668512023 (code B ref 56898); Tue, 02 Aug 2022 21:45:04 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:45 +0000 Received: from localhost ([127.0.0.1]:45293 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgy-00037l-SH for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:45 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59580) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgs-00035e-Fg for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:38 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55166) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgm-0006A9-U8; Tue, 02 Aug 2022 17:44:32 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=gB9ZTp7URun+su0eqU4MpFljdsqgu/OtWTeD0CuD8AI=; b=hW5ZeySLY/TvtlsuATfo g0b3ECKB8PAeTXf1cdOkiFg+F0bfHXqZ1iM29ADlgpGU4biFGC9PIIZ/KCA3IaR5R/8oF3881emEx PSVIESKsaYJBRU26B12DQkbwA65km+vbjY4lqrcx0tQxbX2YFonJRYh/fjOioYy2Zjuo06fO9gaSx 9LTC4PV6LHCsBjn2BjM7xG4602VK4PVWWfFcAd23LovBjtWfXoCcYieRZqV/aQez1qQVWXTcNaaua OTknafl7WlE7x1jaKK14mkXFPpBPJWLY56cdvtOZ80RWqWKJ7qjIEt/hKtiuKTQ3+MH5kE4RWRcra goRJDhOQKZPqng==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgm-0006W4-GU; Tue, 02 Aug 2022 17:44:32 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:15 +0200 Message-Id: <20220802214419.19013-9-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches This lets users use three leading semicolons, for instance, in top-level comments. * guix/read-print.scm (canonicalize-comment): Add INDENT parameter and honor it. (pretty-print-with-comments): Change default value of #:format-comment. Call FORMAT-COMMENT with INDENT as the second argument. * tests/read-print.scm: Adjust test accordingly. --- guix/read-print.scm | 35 +++++++++++++++++++---------------- tests/read-print.scm | 4 +++- 2 files changed, 22 insertions(+), 17 deletions(-) diff --git a/guix/read-print.scm b/guix/read-print.scm index 4a3afdd4f9..2fc3d85a25 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -371,23 +371,26 @@ (define (string-width str) "Return the \"width\" of STR--i.e., the width of the longest line of STR." (apply max (map string-length (string-split str #\newline)))) -(define (canonicalize-comment c) - "Canonicalize comment C, ensuring it has the \"right\" number of leading -semicolons." - (let ((line (string-trim-both - (string-trim (comment->string c) (char-set #\;))))) - (string->comment (string-append - (if (comment-margin? c) - ";" - (if (string-null? line) - ";;" ;no trailing space - ";; ")) - line "\n") - (comment-margin? c)))) +(define (canonicalize-comment comment indent) + "Canonicalize COMMENT, which is to be printed at INDENT, ensuring it has the +\"right\" number of leading semicolons." + (if (zero? indent) + comment ;leave top-level comments unchanged + (let ((line (string-trim-both + (string-trim (comment->string comment) (char-set #\;))))) + (string->comment (string-append + (if (comment-margin? comment) + ";" + (if (string-null? line) + ";;" ;no trailing space + ";; ")) + line "\n") + (comment-margin? comment))))) (define* (pretty-print-with-comments port obj #:key - (format-comment identity) + (format-comment + (lambda (comment indent) comment)) (format-vertical-space identity) (indent 0) (max-width 78) @@ -475,7 +478,7 @@ (define (special-form? head) (if (comment-margin? comment) (begin (display " " port) - (display (comment->string (format-comment comment)) + (display (comment->string (format-comment comment indent)) port)) (begin ;; When already at the beginning of a line, for example because @@ -483,7 +486,7 @@ (define (special-form? head) (unless (= column indent) (newline port) (display (make-string indent #\space) port)) - (display (comment->string (format-comment comment)) + (display (comment->string (format-comment comment indent)) port))) (display (make-string indent #\space) port) indent) diff --git a/tests/read-print.scm b/tests/read-print.scm index 94f018dd44..e3f23194af 100644 --- a/tests/read-print.scm +++ b/tests/read-print.scm @@ -274,6 +274,7 @@ (define-syntax-rule (test-pretty-print/sequence str args ...) (test-pretty-print/sequence " ;;; Hello! +;;; Notice that there are three semicolons here. (define-module (foo bar) #:use-module (guix) @@ -286,7 +287,8 @@ (define-module (foo bar) (locale \"eo_EO.UTF-8\") (services - (cons (service mcron-service-type) %base-services)))\n") + (cons (service mcron-service-type) %base-services)))\n" + #:format-comment canonicalize-comment) (test-equal "pretty-print-with-comments, canonicalize-comment" "\ From patchwork Tue Aug 2 21:44:16 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41107 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 397F227BBEA; Tue, 2 Aug 2022 23:45:54 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 602F127BBE9 for ; Tue, 2 Aug 2022 23:45:53 +0100 (BST) Received: from localhost ([::1]:59440 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIzj0-0002ot-Lq for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:46:50 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44472) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhK-0001ym-KL for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:06 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55564) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhK-0006Qw-AH for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:06 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhK-0003AV-6e for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:06 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 10/13] style: Add '--whole-file' option. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:06 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668612046 (code B ref 56898); Tue, 02 Aug 2022 21:45:06 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:46 +0000 Received: from localhost ([127.0.0.1]:45299 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzh0-000387-41 for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:46 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59584) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgs-00035f-PR for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:40 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55168) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgn-0006AK-HY; Tue, 02 Aug 2022 17:44:33 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=lICy7ikDnNXAQqEhUrt1/u23uLZqJUt02xKAqLjvbzM=; b=om0KsIQ+NylynuGMeQjM M4EZBAnLdQnVhAGo8urCsdlSPaJ0zvwtslruHk2/Q/ZBNR+YzVJBVKgCNE3sN16j+3jsdwr/w0fDT 8fMa7fyf5KF4IsY6HKQhNYe/vHKiJY/8NjV4F4MJg3+oR9OWjrVyPZJEMIZCTJzuA0tOTn0TnKG7j lbtOhRkxwiksgJcHnKaElDCz0O+Ma3BEM3qFZoLR3CQn5rJV5wTDIe2fx88mcDj3AiHchoEtFJ+ma 6zHrh43JFAkiOlqhZ1ebF84QwowrXNiHBuXx4e/yVNSyqW46BX0gpGSRj7zysP1UUyhqY/CJx1y9O HAWZnPoOyqbaNA==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgn-0006W4-4d; Tue, 02 Aug 2022 17:44:33 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:16 +0200 Message-Id: <20220802214419.19013-10-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 fc6f477c9a..8dd1e306de 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 @@ (define (package-locationpackage 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 records is not invalidated as - ;; we modify files. - (sort (if (null? packages) - (fold-packages cons '() #:select? (const #t)) - packages) - (negate package-locationpackage 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 records is not + ;; invalidated as we modify files. + (sort (if (null? packages) + (fold-packages cons '() #:select? (const #t)) + packages) + (negate package-location +# +# 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 . + +# +# Test 'guix style'. +# + +set -e + +guix style --version + +tmpdir="guix-style-$$" +trap 'rm -r "$tmpdir"' EXIT + +tmpfile="$tmpdir/os.scm" +mkdir "$tmpdir" +cat > "$tmpfile" < X-Patchwork-Id: 41115 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 911DD27BBEA; Wed, 3 Aug 2022 00:34:24 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id AB16427BBE9 for ; Wed, 3 Aug 2022 00:34:23 +0100 (BST) Received: from localhost ([::1]:33008 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIzjh-00047Z-09 for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:47:33 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44460) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhJ-0001xs-Pb for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55562) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhJ-0006Qh-Fs for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:05 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhJ-0003AH-D3 for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 11/13] read-print: Support printing multi-line comments. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668512031 (code B ref 56898); Tue, 02 Aug 2022 21:45:05 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:45 +0000 Received: from localhost ([127.0.0.1]:45295 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgz-00037s-8t for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:45 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59588) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgt-00035h-BH for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:40 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55170) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgo-0006AT-3r; Tue, 02 Aug 2022 17:44:34 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=Uu20pag2ZjXZAsB2uO02hiBMS5iRlVv/Ghp+wid3TO0=; b=D/bwoI7pbITG3gwaubxh iPAykjtbXM8cF8POlYRmCX17ThcW/IpfOCxWkVzIgiPTm+4rXMNNB88ysZLJUkfjtgkBtNw/ooQ7e pDKVzlLJMwj5vEsFDiF9LdlPFYcysLQsdZMT+bBz+xIMSk+hlSghEHaK6IayHFJw5to+XPzwE3wCF LVX3pkDG7xPdB2dyWfgwhmAcrcazO3DmA0bxpSAW15bSFce6PlBWqd2DPui7LHYFkm8QIFumrQjK2 JSE3foM8Zj3DclnreHv4icMz78t81okFEspu30wT1eLMCvgGRu9g3PGQFk69v2jtHr66/O5pETCcJ dvvCHE/mN/OKVg==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgn-0006W4-O0; Tue, 02 Aug 2022 17:44:33 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:17 +0200 Message-Id: <20220802214419.19013-11-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/read-print.scm (%not-newline): New variable. (print-multi-line-comment): New procedure. (pretty-print-with-comments): Use it. * tests/read-print.scm ("pretty-print-with-comments, multi-line comment"): New test. --- guix/read-print.scm | 26 ++++++++++++++++++++++++-- tests/read-print.scm | 14 ++++++++++++++ 2 files changed, 38 insertions(+), 2 deletions(-) diff --git a/guix/read-print.scm b/guix/read-print.scm index 2fc3d85a25..df25eb0f50 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -387,6 +387,27 @@ (define (canonicalize-comment comment indent) line "\n") (comment-margin? comment))))) +(define %not-newline + (char-set-complement (char-set #\newline))) + +(define (print-multi-line-comment str indent port) + "Print to PORT STR as a multi-line comment, with INDENT spaces preceding +each line except the first one (they're assumed to be already there)." + + ;; While 'read-with-comments' only returns one-line comments, user-provided + ;; comments might span multiple lines, which is why this is necessary. + (let loop ((lst (string-tokenize str %not-newline))) + (match lst + (() #t) + ((last) + (display last port) + (newline port)) + ((head tail ...) + (display head port) + (newline port) + (display (make-string indent #\space) port) + (loop tail))))) + (define* (pretty-print-with-comments port obj #:key (format-comment @@ -486,8 +507,9 @@ (define (special-form? head) (unless (= column indent) (newline port) (display (make-string indent #\space) port)) - (display (comment->string (format-comment comment indent)) - port))) + (print-multi-line-comment (comment->string + (format-comment comment indent)) + indent port))) (display (make-string indent #\space) port) indent) ((? vertical-space? space) diff --git a/tests/read-print.scm b/tests/read-print.scm index e3f23194af..004fcff19f 100644 --- a/tests/read-print.scm +++ b/tests/read-print.scm @@ -341,4 +341,18 @@ (define-module (foo bar) #:format-vertical-space canonicalize-vertical-space))))) +(test-equal "pretty-print-with-comments, multi-line comment" + "\ +(list abc + ;; This comment spans + ;; two lines. + def)" + (call-with-output-string + (lambda (port) + (pretty-print-with-comments port + `(list abc ,(comment "\ +;; This comment spans\n +;; two lines.\n") + def))))) + (test-end) From patchwork Tue Aug 2 21:44:18 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41112 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 3AC1E27BBEB; Wed, 3 Aug 2022 00:19:17 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 4B4D827BBE9 for ; Wed, 3 Aug 2022 00:19:09 +0100 (BST) Received: from localhost ([::1]:60418 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIzjD-0003WY-4p for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:47:03 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44474) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhK-0001zI-WE for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:07 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55565) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhK-0006R1-MV for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:06 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhK-0003Ad-JK for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:06 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 12/13] installer: Render the final configuration with (guix read-print). Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:06 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668712053 (code B ref 56898); Tue, 02 Aug 2022 21:45:06 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:47 +0000 Received: from localhost ([127.0.0.1]:45301 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzh0-00038F-Rm for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:47 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59602) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgu-000364-W6 for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:42 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55172) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgo-0006At-Nw; Tue, 02 Aug 2022 17:44:34 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=P3RQ1AuJWjp6RfoXgiAZa60MZewlUPiuWpxN5KGGu/E=; b=LTRWTmpDEhmwt+lgxvkC CsRJuipscQ/pELuggdSiLHaGwz8BXlGneT0kzB2RZKPFXf4TGqK7wZIPPBKqDQRb+FK5oCFbyTiou C3uAVMFa035JM4sx0FMQtJY8ccOo/etsgd8wl7UMI5hHSTTQj5dYi5w8F5sc2cL8ViPlQ/SRNZSPt fZvcyh30KjoeSmgmrdpRKrhW3F64vMcQx0BogHo5C2ZpLRazR5c1MyVUglBLpWsIHv9eZ8PiQTD/i F/CYUmCfGgv9L/uxT/5nbx+zj5ROkQnxxbfsCY2e+FDsK0iGjGwLtjlNMUgFK3KcjpveIaPm9Tmpc abBQhzIC346pYg==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgo-0006W4-A6; Tue, 02 Aug 2022 17:44:34 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:18 +0200 Message-Id: <20220802214419.19013-12-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/installer.scm (module-to-import?): Return #t for (guix read-print). * gnu/installer/steps.scm (configuration->file): Use 'pretty-print-with-comments/splice' instead of 'for-each' and 'pretty-print'. --- gnu/installer.scm | 3 ++- gnu/installer/steps.scm | 12 +++++------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/gnu/installer.scm b/gnu/installer.scm index 415f5a7af7..8a6e604fa5 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2020 Mathieu Othacehe -;;; Copyright © 2019, 2020 Ludovic Courtès +;;; Copyright © 2019, 2020, 2022 Ludovic Courtès ;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice ;;; Copyright © 2020 Florian Pelz ;;; @@ -63,6 +63,7 @@ (define module-to-import? (('gnu 'installer _ ...) #t) (('gnu 'build _ ...) #t) (('guix 'build _ ...) #t) + (('guix 'read-print) #t) (_ #f))) (define not-config? diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index 8bc38181a7..f1d61a2bc5 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2019 Mathieu Othacehe -;;; Copyright © 2020, 2021 Ludovic Courtès +;;; Copyright © 2020-2022 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,9 +21,9 @@ (define-module (gnu installer steps) #:use-module (guix records) #:use-module (guix build utils) #:use-module (guix i18n) + #:use-module (guix read-print) #:use-module (gnu installer utils) #:use-module (ice-9 match) - #:use-module (ice-9 pretty-print) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) @@ -244,11 +244,9 @@ (define* (configuration->file configuration ;; by the graphical installer.\n") port) (newline port) - (for-each (lambda (part) - (if (null? part) - (newline port) - (pretty-print part port))) - configuration) + (pretty-print-with-comments/splice port configuration + #:max-width 75) + (flush-output-port port)))) ;;; Local Variables: From patchwork Tue Aug 2 21:44:19 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 41111 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id D850D27BBEA; Wed, 3 Aug 2022 00:00:35 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 0EFEE27BBE9 for ; Wed, 3 Aug 2022 00:00:35 +0100 (BST) Received: from localhost ([::1]:58582 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oIziN-00023e-Bv for patchwork@mira.cbaines.net; Tue, 02 Aug 2022 17:46:11 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44476) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzhL-0001zV-CH for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:07 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55566) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzhL-0006R7-1l for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:07 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oIzhK-0003Ak-VL for guix-patches@gnu.org; Tue, 02 Aug 2022 17:45:06 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56898] [PATCH 13/13] installer: Add comments and vertical space to the generated config. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 02 Aug 2022 21:45:06 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56898 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56898@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 56898-submit@debbugs.gnu.org id=B56898.165947668812060 (code B ref 56898); Tue, 02 Aug 2022 21:45:06 +0000 Received: (at 56898) by debbugs.gnu.org; 2 Aug 2022 21:44:48 +0000 Received: from localhost ([127.0.0.1]:45303 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzh1-00038M-7e for submit@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:47 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59614) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oIzgv-00036D-Oq for 56898@debbugs.gnu.org; Tue, 02 Aug 2022 17:44:42 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55174) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oIzgp-0006B3-F0; Tue, 02 Aug 2022 17:44:35 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=FHoCYsvF8v+XMo+G3Itq/oQ0CX6ynZFLVsxZAp4BVHk=; b=C1hpdUgmDzcqV+GjvyQT hrXLrI7Jac8g/7EuVd6uvsRHJH9W96QMlmGxWUTVkuqSmme0mezzkfbOT5odbNBTvn9rJ1Y4J+B/m krB55lRAgR5l82j4NDIkHrrxy4BdiadZFRVR5ImH4qNsRmG63A4PNL9YR5Vvmucfh0c3aL/85myYg 2aQH0P1kFWP37erT2ffzQokGMtx7rfyVHVUeXbywJrUbOPxl4sKLWJNOvRWH3qHVK0iAC1b2MjY+a H/g99nlbfybT5/8tFNey6UV+sBNX51B6TgzDfu1Hi8P7bX1cCQYt6sqEAcpI0xOK+pgU/OuqB7glL lQeoRyi3I6uOuw==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:52235 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oIzgo-0006W4-TI; Tue, 02 Aug 2022 17:44:35 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Tue, 2 Aug 2022 23:44:19 +0200 Message-Id: <20220802214419.19013-13-ludo@gnu.org> X-Mailer: git-send-email 2.37.1 In-Reply-To: <20220802214419.19013-1-ludo@gnu.org> References: <20220802214419.19013-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/installer/parted.scm (user-partitions->configuration): Introduce vertical space and a comment. * gnu/installer/services.scm (G_): New macro. (%system-services): Add comment for OpenSSH. (system-services->configuration): Add vertical space and comments. * gnu/installer/user.scm (users->configuration): Add comment. * gnu/installer/steps.scm (format-configuration): Add comment. (configuration->file): Expound leading comment. Pass #:format-comment to 'pretty-print-with-comments/splice'. --- gnu/installer/parted.scm | 10 +++++++++- gnu/installer/services.scm | 39 ++++++++++++++++++++++++++++++-------- gnu/installer/steps.scm | 22 +++++++++++++++++---- gnu/installer/user.scm | 7 ++++++- 4 files changed, 64 insertions(+), 14 deletions(-) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 94ef9b42bc..9a57d13452 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2019 Mathieu Othacehe -;;; Copyright © 2019, 2020 Ludovic Courtès +;;; Copyright © 2019, 2020, 2022 Ludovic Courtès ;;; Copyright © 2020 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. @@ -38,6 +38,7 @@ (define-module (gnu installer parted) #:select (%base-initrd-modules)) #:use-module (guix build syscalls) #:use-module (guix build utils) + #:use-module (guix read-print) #:use-module (guix records) #:use-module (guix utils) #:use-module (guix i18n) @@ -1439,6 +1440,13 @@ (define (user-partitions->configuration user-partitions) `((mapped-devices (list ,@(map user-partition->mapped-device encrypted-partitions))))) + + ,(vertical-space 1) + ,(let-syntax ((G_ (syntax-rules () ((_ str) str)))) + (comment (G_ "\ +;; The list of file systems that get \"mounted\". The unique +;; file system identifiers there (\"UUIDs\") can be obtained +;; by running 'blkid' in a terminal.\n"))) (file-systems (cons* ,@(user-partitions->file-systems user-partitions) %base-file-systems))))) diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm index 6584fcceec..6c5f49622f 100644 --- a/gnu/installer/services.scm +++ b/gnu/installer/services.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2022 Ludovic Courtès ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2021 Tobias Geerinckx-Rice ;;; Copyright © 2021 Leo Famulari @@ -22,6 +22,7 @@ (define-module (gnu installer services) #:use-module (guix records) + #:use-module (guix read-print) #:use-module (srfi srfi-1) #:export (system-service? system-service-name @@ -35,6 +36,11 @@ (define-module (gnu installer services) %system-services system-services->configuration)) +(define-syntax-rule (G_ str) + ;; In this file, translatable strings are annotated with 'G_' so xgettext + ;; catches them, but translation happens later on at run time. + str) + (define-record-type* system-service make-system-service system-service? @@ -52,9 +58,7 @@ (define %system-services ((_ fields ...) (system-service (type 'desktop) - fields ...)))) - (G_ (syntax-rules () ;for xgettext - ((_ str) str)))) + fields ...))))) (list ;; This is the list of desktop environments supported as services. (desktop-environment @@ -94,7 +98,12 @@ (define %system-services (system-service (name (G_ "OpenSSH secure shell daemon (sshd)")) (type 'networking) - (snippet '((service openssh-service-type)))) + (snippet `(,(vertical-space 1) + ,(comment + (G_ "\ +;; To configure OpenSSH, pass an 'openssh-configuration' +;; record as a second argument to 'service' below.\n")) + (service openssh-service-type)))) (system-service (name (G_ "Tor anonymous network router")) (type 'networking) @@ -149,24 +158,38 @@ (define (system-services->configuration services) (desktop? (find desktop-system-service? services)) (base (if desktop? '%desktop-services - '%base-services))) + '%base-services)) + (heading (list (vertical-space 1) + (comment (G_ "\ +;; Below is the list of system services. To search for available +;; services, run 'guix system search KEYWORD' in a terminal.\n"))))) + (if (null? snippets) `(,@(if (null? packages) '() `((packages (append (list ,@packages) %base-packages)))) + + ,@heading (services ,base)) `(,@(if (null? packages) '() `((packages (append (list ,@packages) %base-packages)))) + + ,@heading (services (append (list ,@snippets ,@(if desktop? ;; XXX: Assume 'keyboard-layout' is in ;; scope. - '((set-xorg-configuration + `((set-xorg-configuration (xorg-configuration (keyboard-layout keyboard-layout)))) '())) - ,base)))))) + + ,(vertical-space 1) + ,(comment (G_ "\ +;; This is the default list of services we +;; are appending to.\n")) + ,base)))))) diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index f1d61a2bc5..8b25ae97c8 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -224,10 +224,14 @@ (define (format-configuration steps results) (conf-formatter result-step) '()))) steps)) - (modules '((use-modules (gnu)) + (modules `(,(vertical-space 1) + ,(comment (G_ "\ +;; Indicate which modules to import to access the variables +;; used in this configuration.\n")) + (use-modules (gnu)) (use-service-modules cups desktop networking ssh xorg)))) `(,@modules - () + ,(vertical-space 1) (operating-system ,@configuration)))) (define* (configuration->file configuration @@ -241,11 +245,21 @@ (define* (configuration->file configuration ;; length below 60 characters. (display (G_ "\ ;; This is an operating system configuration generated -;; by the graphical installer.\n") +;; by the graphical installer. +;; +;; Once installation is complete, you can learn and modify +;; this file to tweak the system configuration, and pass it +;; to the 'guix system reconfigure' command to effect your +;; changes.\n") port) (newline port) (pretty-print-with-comments/splice port configuration - #:max-width 75) + #:max-width 75 + #:format-comment + (lambda (c indent) + ;; Localize C. + (comment (G_ (comment->string c)) + (comment-margin? c)))) (flush-output-port port)))) diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm index c894a91dc8..224040530c 100644 --- a/gnu/installer/user.scm +++ b/gnu/installer/user.scm @@ -18,6 +18,7 @@ (define-module (gnu installer user) #:use-module (guix records) + #:use-module (guix read-print) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) @@ -69,7 +70,11 @@ (define (user->sexp user) (supplementary-groups '("wheel" "netdev" "audio" "video")))) - `((users (cons* + (define-syntax-rule (G_ str) str) + + `(,(vertical-space 1) + ,(comment (G_ ";; The list of user accounts ('root' is implicit).\n")) + (users (cons* ,@(filter-map (lambda (user) ;; Do not emit a 'user-account' form for "root". (and (not (string=? (user-name user) "root"))