From 8fa41a15f184660ab5bda5f86d645ba9b2582389 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 16 Mar 2023 11:56:31 -0700 Subject: support indented heredocs, add new "Reader macros" manual section Signed-off-by: Sean Whitton --- doc/GNUmakefile | 2 ++ doc/index.rst | 1 + doc/news.rst | 27 ++++++++++++++---- doc/reader.rst | 57 +++++++++++++++++++++++++++++++++++++ emacs/consfigurator.el.in | 2 +- src/property/apt.lisp | 12 ++++---- src/property/sbuild.lisp | 18 ++++++------ src/property/schroot.lisp | 30 ++++++++++---------- src/reader.lisp | 72 ++++++++++++++++++++++++++++++++++++++--------- src/util.lisp | 31 -------------------- tests/reader.lisp | 36 ++++++++++++++++++++++++ 11 files changed, 206 insertions(+), 82 deletions(-) create mode 100644 doc/reader.rst create mode 100644 tests/reader.lisp diff --git a/doc/GNUmakefile b/doc/GNUmakefile index 53d9b35..bf81053 100644 --- a/doc/GNUmakefile +++ b/doc/GNUmakefile @@ -13,6 +13,8 @@ all: html info html info: $(PAGES) conf.py $(wildcard *.rst */*.rst) sphinx-build -M $@ . _build +reader.rst: + $(PAGES) &: $(wildcard *.rst.in */*.rst.in) $(LISP) $(SBCL) --eval "(mapc #'consfigurator::build-manual-rst \ uiop:*command-line-arguments*)" --quit $(PAGES) diff --git a/doc/index.rst b/doc/index.rst index 2592b00..3412fe8 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -30,6 +30,7 @@ Consfigurator user's manual deployment data image + reader .. toctree:: :maxdepth: 1 diff --git a/doc/news.rst b/doc/news.rst index bc45564..da40c27 100644 --- a/doc/news.rst +++ b/doc/news.rst @@ -23,17 +23,32 @@ In summary, you should always be able to upgrade to a release which only increments ``patch``, but if either of the other two components have changed, you should review this document and see if your consfig needs updating. -1.2.4 (unreleased) +1.3.0 (unreleased) ------------------ - New reader macro ``#>>EOF>>`` which is like ``#>EOF>`` except that it skips over the remainder of the current line and its newline. This is more like - how heredocs work in other languages. For the sake of future extension, the - remainder of the line after the ``#>>EOF>>`` should not contain anything - other than a single-line comment. + how heredocs work in other languages. - (This is not a breaking change because the existing implementation for - ``#>EOF>`` does not permit using terminators beginning with ``>``.) +- Support for indented heredocs, where the indentation of the lines of the + heredoc is stripped. This mode is activated by prefixing a tilde to the + heredoc terminator. For example: + + .. code-block:: none + + (foo "argument 1" #>>~EOF>> + My line 1. + My line 2. + EOF) + + The function receives ``"My line 1.\nMy line 2."`` + + This is a minor breaking change because heredoc terminators may no longer + begin with a tilde. + +- New manual section "Reader macros" discussing Consfigurator's named + readtable, including some usage reservations for the sake of future + extension. - New tutorial, "Defining new properties". diff --git a/doc/reader.rst b/doc/reader.rst new file mode 100644 index 0000000..e6f9c3a --- /dev/null +++ b/doc/reader.rst @@ -0,0 +1,57 @@ +Reader macros +============= + +Loading Consfigurator defines the ``:CONSFIGURATOR`` named readtable. Its +original purpose was to define a few reader macros to make Lisp more readily +usable for Unix systems administration, and as such it's helpful in consfigs. +We now have the broader aim of providing a readtable that renders Lisp more +useful for general Unix-style text manipulation. To this end, the reader +macros we define are all inspired by Perl syntax. + +Backwards compatibility +----------------------- + +We don't expect to make incompatible changes to how these reader macros work, +except to make them work more like their Perl equivalents. With this in mind, +some particular reservations are made for particular macros, as detailed below. + +``#?``: Regexps & interpolation +------------------------------- + +Sharp-question mark is the well-known CL-INTERPOL_ reader macro. + +.. _CL-INTERPOL: https://edicl.github.io/cl-interpol/ + +``#>EOF>`` and ``#>>EOF>>``: Heredocs +------------------------------------- + +Following ``#>EOF>``, all characters are read into a string until the next +literal ``EOF``. You may use any string in place of ``EOF``, except that it +must not begin with a tilde or contain any whitespace, and for the sake of +future extension, it must not begin with a backwards slash or begin or end +with single or double quotation marks. + +You can double up the ``>``, as in ``#>>EOF>>``, to skip the remainder of the +line on which the ``#>>EOF>>`` appears, starting the heredoc at the beginning +of the following line. For the sake of future extension, the remainder of the +line after the ``#>>EOF>>`` must not contain anything other than a single-line +comment. + +The specification of the terminating string may be preceded by a tilde, as in +``#>>~EOF>>``, to mean an indented heredoc: + +.. code-block:: none + + (foo "argument 1" #>>~EOF>> + My line 1. + My line 2. + EOF) + +The function receives ``"My line 1.\nMy line 2.\n"``. + +See also +-------- + +- `perlop(1) `_ + +- `inferior-shell `_ diff --git a/emacs/consfigurator.el.in b/emacs/consfigurator.el.in index 29a9d27..d9693f9 100644 --- a/emacs/consfigurator.el.in +++ b/emacs/consfigurator.el.in @@ -142,7 +142,7 @@ Modes that use this should add `syntax-propertize-multiline' to (let (case-fold-search) (funcall (syntax-propertize-rules - ("#\\(>>?\\)\\(.+?\\)\\1\\([^z-a]\\)" + ("#\\(>>?\\)~?\\(.+?\\)\\1\\([^z-a]\\)" (3 (ignore (or (in-string-or-comment-p) (let ((beg (match-beginning 3)) diff --git a/src/property/apt.lisp b/src/property/apt.lisp index f7a258e..11367d2 100644 --- a/src/property/apt.lisp +++ b/src/property/apt.lisp @@ -209,12 +209,12 @@ packages. Does not do any automatic upgrades." (:desc "apt periodic updates") (:hostattrs (os:required 'os:debianlike)) (:apply - (file:has-content "/etc/apt/apt.conf.d/02periodic" -#>EOF>APT::Periodic::Enable "1"; -APT::Periodic::Update-Package-Lists "1"; -APT::Periodic::Download-Upgradeable-Packages "1"; -APT::Periodic::Verbose "1"; -EOF)) + (file:has-content "/etc/apt/apt.conf.d/02periodic" #>>~EOF>> + APT::Periodic::Enable "1"; + APT::Periodic::Update-Package-Lists "1"; + APT::Periodic::Download-Upgradeable-Packages "1"; + APT::Periodic::Verbose "1"; + EOF)) (:unapply (file:does-not-exist "/etc/apt/apt.conf.d/02periodic"))) diff --git a/src/property/sbuild.lisp b/src/property/sbuild.lisp index 297e836..9a0eca6 100644 --- a/src/property/sbuild.lisp +++ b/src/property/sbuild.lisp @@ -123,17 +123,17 @@ To take advantage of the piuparts and autopkgtest support, add to your (file:contains-lines "/etc/schroot/sbuild/fstab" "/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0")) ;; Script from . - (file:has-content "/var/cache/ccache-sbuild/sbuild-setup" -#>EOF>#!/bin/sh + (file:has-content "/var/cache/ccache-sbuild/sbuild-setup" #>>~EOF>> + #!/bin/sh -export CCACHE_DIR=/var/cache/ccache-sbuild -export CCACHE_UMASK=002 -export CCACHE_COMPRESS=1 -unset CCACHE_HARDLINK -export PATH="/usr/lib/ccache:$PATH" + export CCACHE_DIR=/var/cache/ccache-sbuild + export CCACHE_UMASK=002 + export CCACHE_COMPRESS=1 + unset CCACHE_HARDLINK + export PATH="/usr/lib/ccache:$PATH" -exec "$@" -EOF :mode #o755) + exec "$@" + EOF :mode #o755) ;; schroot (chroot:os-bootstrapped-for ,chroot-options ,chroot ,host) diff --git a/src/property/schroot.lisp b/src/property/schroot.lisp index e528f10..3601c45 100644 --- a/src/property/schroot.lisp +++ b/src/property/schroot.lisp @@ -44,22 +44,22 @@ Implicitly sets SCHROOT:USES-OVERLAYS. Shell script from ." (:desc "schroot overlays in tmpfs") (:hostattrs (push-hostattr 'uses-overlays t)) - (:apply (file:has-content "/etc/schroot/setup.d/04tmpfs" -#>EOF>#!/bin/sh + (:apply + (file:has-content "/etc/schroot/setup.d/04tmpfs" #>>~EOF>> + #!/bin/sh -set -e + set -e -. "$SETUP_DATA_DIR/common-data" -. "$SETUP_DATA_DIR/common-functions" -. "$SETUP_DATA_DIR/common-config" + . "$SETUP_DATA_DIR/common-data" + . "$SETUP_DATA_DIR/common-functions" + . "$SETUP_DATA_DIR/common-config" - -if [ $STAGE = "setup-start" ]; then - mount -t tmpfs overlay /var/lib/schroot/union/overlay -elif [ $STAGE = "setup-recover" ]; then - mount -t tmpfs overlay /var/lib/schroot/union/overlay -elif [ $STAGE = "setup-stop" ]; then - umount -f /var/lib/schroot/union/overlay -fi -EOF :mode #o755)) + if [ $STAGE = "setup-start" ]; then + mount -t tmpfs overlay /var/lib/schroot/union/overlay + elif [ $STAGE = "setup-recover" ]; then + mount -t tmpfs overlay /var/lib/schroot/union/overlay + elif [ $STAGE = "setup-stop" ]; then + umount -f /var/lib/schroot/union/overlay + fi + EOF :mode #o755)) (:unapply (file:does-not-exist "/etc/schroot/setup.d/04tmpfs"))) diff --git a/src/reader.lisp b/src/reader.lisp index e4f15b9..f744fa4 100644 --- a/src/reader.lisp +++ b/src/reader.lisp @@ -1,6 +1,6 @@ ;;; Consfigurator -- Lisp declarative configuration management system -;;; Copyright (C) 2021 Sean Whitton +;;; Copyright (C) 2021, 2023 Sean Whitton ;;; This file is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -17,20 +17,64 @@ (in-package :consfigurator) +(defun lines (text &optional trimfun (trimchars '(#\Space #\Tab))) + (with-input-from-string (stream text) + (let (bolp buffer) + (flet ((trim (line) + (if trimfun (funcall trimfun trimchars line) line)) + (reset () + (setq bolp t + buffer (make-array 0 :fill-pointer 0 + :element-type 'character)))) + ;; Split on either , or ; would mean split + ;; with a blank line in between. Drop a single trailing blank line. + (loop initially (reset) + for char = (read-char stream nil nil) + if char + if (member char '(#\Return #\Newline) :test #'char=) + collect (trim buffer) + and do (reset) + (when (char= char #\Return) + (when-let ((next (peek-char nil stream nil nil))) + (when (char= next #\Newline) + (read-char stream)))) + else do (setq bolp nil) + (vector-push-extend char buffer) + end + else + unless bolp collect (trim buffer) end + and do (loop-finish)))))) + +(defun unlines (lines) + (format nil "~{~A~%~}" lines)) + (defun read-heredoc (stream char arg) - "Like CL-HEREDOC:READ-HEREDOC but treat #>EOF> and #>>EOF>> differently: -#>>EOF>> skips over the remainder of the current line and its newline. -For the sake of future extension, the remainder of the line after the #>>EOF>> -should not contain anything other than a single-line comment." - (if (char= (peek-char nil stream t :eof t) char) - ;; #>>EOF>> -- ignore the rest of the line. - (progn (read-char stream t :eof t) - (let* ((delim (make-string 2 :initial-element char)) - (ender (cl-heredoc:read-until-match stream delim))) - (read-line stream t :eof t) - (cl-heredoc:read-until-match stream ender))) - ;; #>EOF> -- just use the normal READ-HEREDOC. - (cl-heredoc:read-heredoc stream char arg))) + "Like CL-HEREDOC:READ-HEREDOC, with some additional features. + +Treat #>EOF> and #>>EOF>> differently: #>>EOF>> skips over the remainder of +the current line and its newline. For the sake of future extension, the +remainder of the line after the #>>EOF>> must not contain anything other than +a single-line comment. + +Preceding the specification of the terminating string with a tilde means an +indented heredoc; see perlop(1)." + (declare (ignore arg)) + (let* ((>> (and (char= char (peek-char nil stream t :eof t)) + (read-char stream t :eof t))) + (indented (and (char= #\~ (peek-char nil stream t :eof t)) + (read-char stream t :eof t))) + (delim (if >> (make-string 2 :initial-element char) (string char))) + (ender (cl-heredoc:read-until-match stream delim))) + (when >> + (read-line stream t :eof t)) + (let ((heredoc (cl-heredoc:read-until-match stream ender))) + (if indented + (loop with lines = (lines heredoc) + with indent = (length (lastcar lines)) + for (line . rest) on lines while rest + collect (subseq line (min indent (length line))) into accum + finally (return (unlines accum))) + heredoc)))) (named-readtables:defreadtable :consfigurator (:merge :standard) diff --git a/src/util.lisp b/src/util.lisp index 47ce5ac..20a3714 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -38,37 +38,6 @@ for result in new and i upfrom 0 do (setf (aref results i) (nreconc result (aref results i)))))) -(defun lines (text &optional trimfun (trimchars '(#\Space #\Tab))) - (with-input-from-string (stream text) - (let (bolp buffer) - (flet ((trim (line) - (if trimfun (funcall trimfun trimchars line) line)) - (reset () - (setq bolp t - buffer (make-array 0 :fill-pointer 0 - :element-type 'character)))) - ;; Split on either , or ; would mean split - ;; with a blank line in between. Drop a single trailing blank line. - (loop initially (reset) - for char = (read-char stream nil nil) - if char - if (member char '(#\Return #\Newline) :test #'char=) - collect (trim buffer) - and do (reset) - (when (char= char #\Return) - (when-let ((next (peek-char nil stream nil nil))) - (when (char= next #\Newline) - (read-char stream)))) - else do (setq bolp nil) - (vector-push-extend char buffer) - end - else - unless bolp collect (trim buffer) end - and do (loop-finish)))))) - -(defun unlines (lines) - (format nil "~{~A~%~}" lines)) - (defun words (text) (delete "" (split-string text) :test #'string=)) diff --git a/tests/reader.lisp b/tests/reader.lisp new file mode 100644 index 0000000..a56c6c0 --- /dev/null +++ b/tests/reader.lisp @@ -0,0 +1,36 @@ +(in-package :consfigurator/tests) +(named-readtables:in-readtable :consfigurator) +(in-consfig "consfigurator/tests") + +(deftest read-heredoc.1 + #>EOF>yesEOF + "yes") + +(deftest read-heredoc.2 + #>>EOF>>yes + yesEOF + " yes") + +(deftest read-heredoc.3 + #>>EOF>> ; well +line 1 +EOF + "line 1 +") + +(deftest read-heredoc.4 + #>~EOF> blah + blah + EOF + "blah +blah +") + +(deftest read-heredoc.5 + #>>~EOF>> + line 1 + line 2 + EOF + "line 1 +line 2 +") -- cgit v1.2.3