From aa2cd9398e385b5006853cd982c34e7dd6c7ec75 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Wed, 8 Jul 2015 11:07:27 +0100
Subject: [PATCH] Lisp: Change Lisp-to-JSON conventions.

Now a Lisp list is assumed to be an alist, and printed as a JSON
mapping; a JSON list is produced from a Lisp vector.  Also, `nil' is now
mapped to JSON `null'.

  * Implement these changes in `print-json-simple'.

  * Change the lists in `hosts.lisp' to be vectors.

  * Modify `host-defs.lisp' to handle vectors instead of lists.
---
 bin/ansible-inventory | 21 ++++++++++++++++-----
 hosts/host-defs.lisp  | 13 +++++++++----
 hosts/hosts.lisp      | 24 ++++++++++++------------
 3 files changed, 37 insertions(+), 21 deletions(-)

diff --git a/bin/ansible-inventory b/bin/ansible-inventory
index 6ffb17a..25ad961 100755
--- a/bin/ansible-inventory
+++ b/bin/ansible-inventory
@@ -72,11 +72,22 @@
 
 (defun print-json-simple (value)
   (typecase value
-    (list (print-json-list (dolist (i value) (print-json-simple i))))
-    (hash-table (print-json-map (maphash (lambda (k v)
-					   (print-json-mapping k
-					     (print-json-simple v)))
-					 value)))
+    ((and vector (not string))
+     (print-json-list
+       (dotimes (i (length value)) (print-json-simple (aref value i)))))
+    (null
+     (princ "null"))
+    (list
+     (print-json-map
+       (dolist (i value)
+	 (print-json-mapping (car i)
+	   (print-json-simple (cdr i))))))
+    (hash-table
+     (print-json-map
+       (maphash (lambda (k v)
+		  (print-json-mapping k
+		    (print-json-simple v)))
+		value)))
     (t
      (print-json-itemstart)
      (etypecase value
diff --git a/hosts/host-defs.lisp b/hosts/host-defs.lisp
index ae5fd1e..1b69df6 100644
--- a/hosts/host-defs.lisp
+++ b/hosts/host-defs.lisp
@@ -10,7 +10,12 @@
       (when foundp
 	(hostprop-default vmhost :vm-role :host)
 	(hostprop-default host :vm-role :guest)
-	(pushnew host (hostprop vmhost :guests))
+	(let ((guests (or (hostprop vmhost :guests)
+			  (setf (hostprop vmhost :guests)
+				(make-array 16
+					    :adjustable t
+					    :fill-pointer 0)))))
+	  (vector-push-extend host guests))
 	(dolist (prop '(:location :hypervisor))
 	  (multiple-value-bind (value foundp) (hostprop vmhost prop)
 	    (when foundp (hostprop-default host prop value))))))))
@@ -44,12 +49,12 @@
 (defhook (prio-groups)
   (let ((server-roles nil))
     (dohosts (host)
-      (dolist (role (hostprop host :server))
-	(pushnew role server-roles)))
+      (map 'nil (lambda (role) (pushnew role server-roles))
+	   (hostprop host :server)))
     (dolist (r server-roles)
       (let ((role r))
 	(add-group (intern (concatenate 'string (string role) "-SERVERS"))
 		   :predicate (lambda (h)
-				(member role (hostprop h :server))))))))
+				(find role (hostprop h :server))))))))
 
 ;;;----- That's all, folks --------------------------------------------------
diff --git a/hosts/hosts.lisp b/hosts/hosts.lisp
index b8436a2..2d3724e 100644
--- a/hosts/hosts.lisp
+++ b/hosts/hosts.lisp
@@ -9,39 +9,39 @@
   :hypervisor :kvm
   :os :debian
   :location house
-  :server (:multihome :ntp))
+  :server #(:multihome :ntp))
 
 (defhost radius
   :vm-host ibanez
   :os :debian
-  :server (:router :dns :syslog :vpn))
+  :server #(:router :dns :syslog :vpn))
 
 (defhost roadstar
   :vm-host ibanez
   :os :debian
-  :server (:multihome :dns :ftp :http :nfs :www-cache :rsync :munin))
+  :server #(:multihome :dns :ftp :http :nfs :www-cache :rsync :munin))
 
 (defhost jem
   :vm-host ibanez
   :os :debian
-  :server (:multihome :login :rsync :http :nfs :mail))
+  :server #(:multihome :login :rsync :http :nfs :mail))
 
 (defhost artist
   :vm-host ibanez
   :os :debian
-  :server (:router :login :http :rsync :mail))
+  :server #(:router :login :http :rsync :mail))
 
 ;; Other servers.
 
 (defhost vampire
   :os :debian
   :location house
-  :server (:router :ntp :vpn :nfs))
+  :server #(:router :ntp :vpn :nfs))
 
 (defhost groove
   :os :debian
   :location house
-  :server (:http))
+  :server #(:http))
 
 ;; Clients.
 
@@ -64,26 +64,26 @@
   :hypervisor :kvm
   :os :debian
   :location jump
-  :server (:multihome :ntp))
+  :server #(:multihome :ntp))
 
 (defhost precision
   :vm-host fender
   :os :debian
-  :server (:router :dns :vpn))
+  :server #(:router :dns :vpn))
 
 (defhost telecaster
   :vm-host fender
   :os :debian
-  :server (:multihome :dns :ftp :http :rsync :munin :nfs))
+  :server #(:multihome :dns :ftp :http :rsync :munin :nfs))
 
 (defhost stratocaster
   :vm-host fender
   :os :debian
-  :server (:multihome :login :rsync :http :nfs :mail-hub))
+  :server #(:multihome :login :rsync :http :nfs :mail-hub))
 
 (defhost jazz
   :vm-host fender
   :os :debian
-  :server (:multihome :login :http :mail :vpn))
+  :server #(:multihome :login :http :mail :vpn))
 
 ;;;----- That's all, folks --------------------------------------------------
-- 
2.11.0