add dep on Anaphora and use APROG1, ALET & AAND in various places

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

15 files changed, 70 insertions, 61 deletions

diff --git a/consfigurator.asd b/consfigurator.asd
index 6edb70e..b3977c0 100644
--- a/consfigurator.asd
+++ b/consfigurator.asd
@@ -4,7 +4,8 @@
   :author "Sean Whitton <spwhitton@spwhitton.name>"
   :licence "GPL-3+"
   :serial t
-  :depends-on (#:alexandria
+  :depends-on (#:anaphora
+               #:alexandria
                #:babel
                #:babel-streams
                #:cl-ppcre
diff --git a/debian/changelog b/debian/changelog
index 8e2153b..eb35a0f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,10 @@
+consfigurator (0.11.0-1) UNRELEASED; urgency=medium
+
+  * New upstream release.
+  * Add dep and build-dep on cl-anaphora.
+
+ -- Sean Whitton <spwhitton@spwhitton.name>  Sat, 04 Sep 2021 15:42:01 -0700
+
 consfigurator (0.10.0-1) unstable; urgency=medium
 
   * New upstream release.
diff --git a/debian/control b/debian/control
index 6ce608b..3a20237 100644
--- a/debian/control
+++ b/debian/control
@@ -4,6 +4,7 @@ Priority: optional
 Maintainer: Sean Whitton <spwhitton@spwhitton.name>
 Build-Depends:
  cl-alexandria,
+ cl-anaphora,
  cl-babel,
  cl-cffi,
  cl-heredoc,
@@ -30,6 +31,7 @@ Package: cl-consfigurator
 Architecture: all
 Depends:
  cl-alexandria,
+ cl-anaphora,
  cl-babel,
  cl-cffi,
  cl-heredoc,
diff --git a/src/connection.lisp b/src/connection.lisp
index efd86ad..0e80fff 100644
--- a/src/connection.lisp
+++ b/src/connection.lisp
@@ -526,8 +526,8 @@ subclass to the :HOSTATTRS subroutine of properties calling this."
 
 (defun empty-remote-directory (directory)
   "Recursively delete the contents of DIRECTORY, but not DIRECTORY itself."
-  (let ((d (escape-sh-token (drop-trailing-slash (unix-namestring directory)))))
-    (mrun (format nil "rm -rf -- ~A/* ~A/.[!.]* ~A/..?*" d d d))))
+  (alet (escape-sh-token (drop-trailing-slash (unix-namestring directory)))
+    (mrun (format nil "rm -rf -- ~A/* ~A/.[!.]* ~A/..?*" it it it))))
 
 (defun remote-exists-p (&rest paths)
   "Does each of PATHS exists?
diff --git a/src/connection/chroot.lisp b/src/connection/chroot.lisp
index 8b144cb..70a603d 100644
--- a/src/connection/chroot.lisp
+++ b/src/connection/chroot.lisp
@@ -81,10 +81,9 @@ should be the mount point, without the chroot's root prefixed.")
           when (and (subtypep (type-of volume) 'disk:filesystem)
                     (slot-boundp volume 'disk:mount-point)
                     (subpathp (disk:mount-point volume) into))
-            collect (let ((copy (disk:copy-volume-and-contents volume)))
-                      (setf (disk:mount-point copy)
-                            (in-chroot-pathname (disk:mount-point copy) into))
-                      copy)
+            collect (aprog1 (disk:copy-volume-and-contents volume)
+                      (setf (disk:mount-point it)
+                            (in-chroot-pathname (disk:mount-point it) into)))
           else collect volume)))
 
 (defmethod propagate-connattr
diff --git a/src/connection/ssh.lisp b/src/connection/ssh.lisp
index 38fd2ae..f4d30cc 100644
--- a/src/connection/ssh.lisp
+++ b/src/connection/ssh.lisp
@@ -24,9 +24,8 @@
                                    user)
   (declare (ignore remaining))
   (informat 1 "~&Establishing SSH connection to ~A" hop)
-  (let ((connection (make-instance 'ssh-connection :hostname hop :user user)))
-    (mrun "ssh" (ssh-host connection) ":")
-    connection))
+  (aprog1 (make-instance 'ssh-connection :hostname hop :user user)
+    (mrun "ssh" (ssh-host it) ":")))
 
 (defclass ssh-connection (shell-wrap-connection)
   ((hostname
diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp
index 4c817f8..da50673 100644
--- a/src/connection/sudo.lisp
+++ b/src/connection/sudo.lisp
@@ -62,14 +62,13 @@
    'sudo-connection
    :connattrs `(:remote-user ,user)
    :password-file (and password
-                       (let ((file (mktemp)))
+                       (aprog1 (mktemp)
                          ;; We'll send the password followed by ^M, then the
                          ;; real stdin.  Use CODE-CHAR in this way so that we
                          ;; can be sure ASCII ^M is what will get emitted.
-                         (writefile file (strcat (passphrase password)
-                                                 (string (code-char 13)))
-                                    :mode #o600)
-                         file))))
+                         (writefile it (strcat (passphrase password)
+                                               (string (code-char 13)))
+                                    :mode #o600)))))
 
 (defmethod connection-teardown :after ((connection sudo-connection))
   (when-let ((file (slot-value connection 'password-file)))
diff --git a/src/data.lisp b/src/data.lisp
index fa814f0..d87e648 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -201,10 +201,9 @@ This function is called by property :APPLY and :UNAPPLY subroutines."
        (informat 3 "~&Obtaining ~S | ~S from a data source" iden1 iden2)
        (values
         (lambda ()
-          (let ((from-source-data (funcall (cdr from-source))))
-            (when (subtypep (type-of from-source-data) 'string-data)
-              (setf (gethash idenpair *string-data*) from-source-data))
-            from-source-data))
+          (aprog1 (funcall (cdr from-source))
+            (when (subtypep (type-of it) 'string-data)
+              (setf (gethash idenpair *string-data*) it))))
         from-source-version))
       ((and local-cached
             (or (not from-source) (version>= local-cached-version
diff --git a/src/package.lisp b/src/package.lisp
index 7b526ea..31288d2 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1,7 +1,7 @@
 (in-package :cl-user)
 
 (defpackage :consfigurator
-  (:use #:cl #:alexandria #:cffi)
+  (:use #:cl #:anaphora #:alexandria #:cffi)
   (:local-nicknames (#:re #:cl-ppcre))
   (:shadowing-import-from #:uiop
                           #:strcat
@@ -470,7 +470,7 @@
            #:os-bootstrapped.))
 
 (defpackage :consfigurator.property.disk
-  (:use #:cl #:alexandria #:consfigurator)
+  (:use #:cl #:anaphora #:alexandria #:consfigurator)
   (:local-nicknames (#:re      #:cl-ppcre)
                     (#:chroot  #:consfigurator.property.chroot)
                     (#:cmd     #:consfigurator.property.cmd)
@@ -534,7 +534,11 @@
            #:volumes))
 
 (defpackage :consfigurator.property.fstab
-  (:use #:cl #:alexandria #:consfigurator #:consfigurator.property.disk)
+  (:use #:cl
+        #:anaphora
+        #:alexandria
+        #:consfigurator
+        #:consfigurator.property.disk)
   (:local-nicknames (#:os    #:consfigurator.property.os)
                     (#:file  #:consfigurator.property.file))
   (:export #:volume->entry
@@ -543,7 +547,11 @@
            #:entries-for-opened-volumes))
 
 (defpackage :consfigurator.property.crypttab
-  (:use #:cl #:alexandria #:consfigurator #:consfigurator.property.disk)
+  (:use #:cl
+        #:anaphora
+        #:alexandria
+        #:consfigurator
+        #:consfigurator.property.disk)
   (:local-nicknames (#:re    #:cl-ppcre)
                     (#:os    #:consfigurator.property.os)
                     (#:file  #:consfigurator.property.file))
@@ -779,7 +787,7 @@
            #:masked))
 
 (defpackage :consfigurator.property.firewalld
-  (:use #:cl #:alexandria #:consfigurator)
+  (:use #:cl #:anaphora #:alexandria #:consfigurator)
   (:local-nicknames (#:cmd          #:consfigurator.property.cmd)
                     (#:file         #:consfigurator.property.file)
                     (#:apt          #:consfigurator.property.apt)
@@ -841,12 +849,14 @@
 (defpackage :consfigurator.connection.ssh
   (:use #:cl
         #:consfigurator
+        #:anaphora
         #:alexandria
         #:consfigurator.connection.shell-wrap))
 
 (defpackage :consfigurator.connection.sudo
   (:use #:cl
         #:consfigurator
+        #:anaphora
         #:alexandria
         #:consfigurator.connection.shell-wrap))
 
@@ -857,6 +867,7 @@
 
 (defpackage :consfigurator.connection.chroot
   (:use #:cl
+        #:anaphora
         #:alexandria
 	#:consfigurator
 	#:consfigurator.connection.fork
diff --git a/src/property.lisp b/src/property.lisp
index cf4fbb1..e846c46 100644
--- a/src/property.lisp
+++ b/src/property.lisp
@@ -105,10 +105,9 @@
 
 (defun propapply (prop &rest args)
   (with-some-errors-are-failed-change
-    (let ((check (get prop 'check)))
-      (if (and check (apply check args))
-          :no-change
-          (apply (get prop 'papply (constantly :no-change)) args)))))
+    (if (aand (get prop 'check) (apply it args))
+        :no-change
+        (apply (get prop 'papply (constantly :no-change)) args))))
 
 (defun propappapply (propapp)
   (if propapp
@@ -452,18 +451,17 @@ You will usually be able to use DEFPROPLIST instead of DEFPROPSPEC.  However,
 sometimes you will need to fall back on DEFPROPSPEC.  For example, an
 unevaluated property application specification cannot express passing values
 other than constant values and propapps to property combinators."
-  (let ((propspec
-          (loop for remaining on properties
-                for car = (car remaining)
-                if (or (stringp car)
-                       (and (listp car)
-                            (member (car car)
-                                    '(:desc :check :hostattrs declare))))
-                  collect car into begin
-                else
-                  return (nreverse
-                          (cons `(props eseqprops ,@remaining) begin)))))
-    `(defpropspec ,name ,type ,lambda ,@propspec)))
+  (alet (loop for remaining on properties
+              for car = (car remaining)
+              if (or (stringp car)
+                     (and (listp car)
+                          (member (car car)
+                                  '(:desc :check :hostattrs declare))))
+                collect car into begin
+              else
+                return (nreverse
+                        (cons `(props eseqprops ,@remaining) begin)))
+    `(defpropspec ,name ,type ,lambda ,@it)))
 
 
 ;;;; hostattrs in property subroutines
diff --git a/src/property/crypttab.lisp b/src/property/crypttab.lisp
index a24ac26..28bcaf7 100644
--- a/src/property/crypttab.lisp
+++ b/src/property/crypttab.lisp
@@ -70,9 +70,8 @@ except that if the second field of the existing entry is not \"none\" and the
 corresponding member of ENTRIES is \"none\" or \"PLACEHOLDER\", use the
 existing field value."
   (:desc
-   (let ((devices
-           (loop for entry in entries collect (car (split-string entry)))))
-     (format nil "crypttab entr~@P for ~{~A~^, ~}" (length devices) devices)))
+   (alet (loop for entry in entries collect (car (split-string entry)))
+     (format nil "crypttab entr~@P for ~{~A~^, ~}" (length it) it)))
   (:apply (file:update-unix-table #P"/etc/crypttab" 1 0 entries)))
 
 (defprop entries-for-opened-volumes :posix ()
diff --git a/src/property/disk.lisp b/src/property/disk.lisp
index 3fa97ee..04393ce 100644
--- a/src/property/disk.lisp
+++ b/src/property/disk.lisp
@@ -925,10 +925,9 @@ filesystems will be incrementally updated when other properties change."
             if (and physical-disk-p (not found)
                     (slot-boundp volume 'volume-contents))
               do (setq found t)
-              and collect (let ((copy (copy-volume-and-contents volume)))
-                            (change-class copy 'raw-disk-image)
-                            (setf (image-file copy) image-pathname)
-                            copy)
+              and collect (aprog1 (copy-volume-and-contents volume)
+                            (change-class it 'raw-disk-image)
+                            (setf (image-file it) image-pathname))
             else unless physical-disk-p
                    collect volume
             finally
diff --git a/src/property/firewalld.lisp b/src/property/firewalld.lisp
index a39b22c..f4d7a25 100644
--- a/src/property/firewalld.lisp
+++ b/src/property/firewalld.lisp
@@ -37,13 +37,12 @@
    (flet ((run ()
             (let ((output (mrun "firewall-cmd" args)))
               (and warning (search warning output) :no-change))))
-     (let ((result (if file
-                       (with-change-if-changes-file
-                           ((merge-pathnames file #P"/etc/firewalld/")) (run))
-                       (run))))
-       (unless (eql result :no-change)
-         (mrun "firewall-cmd" "--reload"))
-       result))))
+     (aprog1 (if file
+                 (with-change-if-changes-file
+                     ((merge-pathnames file #P"/etc/firewalld/")) (run))
+                 (run))
+       (unless (eql it :no-change)
+         (mrun "firewall-cmd" "--reload"))))))
 
 
 ;;;; Setting contents of XML configuration files
diff --git a/src/property/fstab.lisp b/src/property/fstab.lisp
index a4eaf98..5a8feef 100644
--- a/src/property/fstab.lisp
+++ b/src/property/fstab.lisp
@@ -85,10 +85,8 @@ member of ENTRIES is \"none\", or \"PLACEHOLDER\", use the existing field value.
 
 This makes it easy to update mount options without having to specify the
 partition or filesystem UUID in your consfig."
-  (:desc
-   (let ((mount-points (mapcar (compose #'cadr #'words) entries)))
-     (format nil "fstab entr~@P for ~{~A~^, ~}"
-             (length mount-points) mount-points)))
+  (:desc (alet (mapcar (compose #'cadr #'words) entries)
+           (format nil "fstab entr~@P for ~{~A~^, ~}" (length it) it)))
   (:apply (file:update-unix-table #P"/etc/fstab" 0 1 entries)))
 
 (defprop entries-for-volumes :posix (&optional volumes)
diff --git a/src/propspec.lisp b/src/propspec.lisp
index e1607af..1fa6744 100644
--- a/src/propspec.lisp
+++ b/src/propspec.lisp
@@ -76,9 +76,8 @@ manual."
                 (lambda (form env &aux (c (and (listp form) (car form))))
                   (declare (ignore env))
                   (cond ((and c (isprop c))
-                         (let ((gensym (gensym)))
-                           (push (cons gensym form) replaced-propapps)
-                           gensym))
+                         (aprog1 (gensym)
+                           (push (cons it form) replaced-propapps)))
                         ;; We also look for any symbols without function or
                         ;; property definitions occurring in function call
                         ;; positions.  These could potentially be properties