apt pinning properties: rework specifying suites to pin

This means that we can do away with defining OS:DEBIAN-UNSTABLE etc. as both
properties and functions, which led to confusing SLIME echo area hints.

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

2 files changed, 25 insertions, 19 deletions

diff --git a/src/property/apt.lisp b/src/property/apt.lisp
index 7486d45..6003a7c 100644
--- a/src/property/apt.lisp
+++ b/src/property/apt.lisp
@@ -283,6 +283,14 @@ after BASENAME.  CONTENT is as the content argument to FILE:HAS-CONTENT."
 
 ;;;; Pinning
 
+(defmethod suite-specifier-to-os ((suite-specifier os:debian))
+  suite-specifier)
+
+(defmethod suite-specifier-to-os ((suite-specifier cons))
+  (destructuring-bind (type &optional (suite nil suite-supplied-p))
+      suite-specifier
+    (apply #'make-instance type (and suite-supplied-p `(:suite ,suite)))))
+
 (defmethod suite-pin ((os os:debian-stable))
   (strcat "n=" (os:debian-suite os)))
 
@@ -296,22 +304,27 @@ after BASENAME.  CONTENT is as the content argument to FILE:HAS-CONTENT."
     ,(format nil "Pin-Priority: ~D" pin-priority)))
 
 (defpropspec suites-available-pinned :posix (&rest pairs)
-  "Where PAIRS is a list of even length of alternating instances of OS:DEBIAN
-and apt pin priorities, add an apt source for the instance of OS:DEBIAN and
+  "Where PAIRS is a list of even length of alternating Debian suite specifiers
+and apt pin priorities, add an apt source for the specified Debian suite and
 pin that suite to a given pin value (see apt_preferences(5)).  Unapply to drop
 the source and unpin the suite.
 
+A Debian suite specifier is either an instance of a subclass of OS:DEBIANLIKE
+or a list (TYPE &optional SUITE) where TYPE names a subclass of OS:DEBIANLIKE
+and SUITE is a string.  For example, '(os:debian-stable \"bullseye\").
+
 If the OS:DEBIAN is the host's OS, the suite is pinned, but no source is
 added.  That apt source should already be available, or you can use a property
 like APT:STANDARD-SOURCES.LIST."
   (:desc (loop for (os pin) on pairs by #'cddr
-               for suite = (os:debian-suite os)
+               for suite = (os:debian-suite (suite-specifier-to-os os))
                collect #?{Debian "${suite}" pinned, priority ${pin}}
                  into accum
                finally (return (format nil "~{~A~^; ~}" accum))))
   (:hostattrs (os:required 'os:debian))
   `(eseqprops
-    ,@(loop for (os pin) on pairs by #'cddr
+    ,@(loop for (suite-specifier pin) on pairs by #'cddr
+            for os = (suite-specifier-to-os suite-specifier)
             for suite = (os:debian-suite os)
             do (check-type pin integer)
             collect `(file:exists-with-content
@@ -333,9 +346,13 @@ like APT:STANDARD-SOURCES.LIST."
 (defpropspec pinned :posix (preferences &rest pairs)
   "Pins a list of packages, package wildcards and/or regular expressions,
 PREFERENCES, to a list of suites and corresponding pin priorities.  Unapply to
-unpin.  PAIRS is a list of even length of alternating instances of OS:DEBIAN
+unpin.  PAIRS is a list of even length of alternating Debian suite specifiers
 and apt pin priorities.
 
+A Debian suite specifier is either an instance of a subclass of OS:DEBIANLIKE
+or a list (TYPE &optional SUITE) where TYPE names a subclass of OS:DEBIANLIKE
+and SUITE is a string.  For example, '(os:debian-stable \"bullseye\").
+
 Each package, package wildcard or regular expression will be pinned to all of
 the specified suites.  Each of PREFERENCES is the name of a package, a glob to
 match the names of packages, or a regexp surrounded by slashes to match the
@@ -356,7 +373,7 @@ in testing, you could use:
                 (os:debian-testing)  100
                 (os:debian-unstable) 50)"
   (:desc (loop for (os pin) on pairs by #'cddr
-               for suite = (os:debian-suite os)
+               for suite = (os:debian-suite (suite-specifier-to-os os))
                collect #?{Debian "${suite}", priority ${pin}} into accum
                finally (return (format nil "~{~A~^, ~} pinned to ~{~A~^; ~}"
                                        preferences accum))))
@@ -370,7 +387,8 @@ in testing, you could use:
                              ".pref")
                      (nbutlast
                       (loop for (os pin) on pairs by #'cddr
-                            nconc (suite-pin-block preference os pin)
+                            nconc (suite-pin-block
+                                   preference (suite-specifier-to-os os) pin)
                             collect ""))))))
 
 
diff --git a/src/property/os.lisp b/src/property/os.lisp
index 7fd5f25..d04c262 100644
--- a/src/property/os.lisp
+++ b/src/property/os.lisp
@@ -45,9 +45,6 @@
 
 (defclass debian-stable (debian) ())
 
-(defun debian-stable (suite)
-  (make-instance 'debian-stable :suite suite))
-
 (defprop debian-stable :posix (suite architecture)
   (:desc
    (declare (ignore architecture))
@@ -60,9 +57,6 @@
 (defclass debian-testing (debian)
   ((suite :initform "testing")))
 
-(defun debian-testing ()
-  (make-instance 'debian-testing))
-
 (defprop debian-testing :posix (architecture)
   (:desc
    (declare (ignore architecture))
@@ -75,9 +69,6 @@
 (defclass debian-unstable (debian)
   ((suite :initform "unstable")))
 
-(defun debian-unstable ()
-  (make-instance 'debian-unstable))
-
 (defprop debian-unstable :posix (architecture)
   (:desc
    (declare (ignore architecture))
@@ -90,9 +81,6 @@
 (defclass debian-experimental (debian)
   ((suite :initform "experimental")))
 
-(defun debian-experimental ()
-  (make-instance 'debian-experimental))
-
 (defmethod debian-architecture ((os linux))
   "Return a string representing the architecture of OS as used by Debian."
   (string-downcase (symbol-name (linux-architecture os))))