support indented heredocs, add new "Reader macros" manual section

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

11 files changed, 206 insertions, 82 deletions

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) <https://perldoc.perl.org/perlop>`_
+
+- `inferior-shell <https://cliki.net/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 <https://wiki.debian.org/sbuild>.
-       (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 <https://wiki.debian.org/sbuild>."
   (: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 <spwhitton@spwhitton.name>
+;;; Copyright (C) 2021, 2023  Sean Whitton <spwhitton@spwhitton.name>
 
 ;;; 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 <CR>, <LF> or <CR><LF>; <LF><CR> 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 <CR>, <LF> or <CR><LF>; <LF><CR> 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
+")