Lisp: Change Lisp-to-JSON conventions.

[distorted-ansible] / bin / ansible-inventory

diff --git a/bin/ansible-inventory b/bin/ansible-inventory
index 053f9bf..25ad961 100755 (executable)
--- a/bin/ansible-inventory
+++ b/bin/ansible-inventory
@@ -2,11 +2,12 @@
 ;;; -*-lisp-*-
 
 (cl:defpackage #:ansible-inventory
-  (:use #:common-lisp)
-  (:import-from #:cl-launch #:*arguments*))
+  (:use #:common-lisp))
 
 (in-package #:ansible-inventory)
 
+(declaim (optimize debug))
+
 ;;;--------------------------------------------------------------------------
 ;;; General utilities.
 
@@ -71,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
@@ -217,9 +229,15 @@
 (defvar *progname*
   #.(or *compile-file-pathname* *load-pathname*))
 
-(let ((pkg (make-package "ANSIBLE-INVENTORY-USER"
-                        :use '("CL" "ANSIBLE-INVENTORY")))
-      (args *arguments*))
+(defvar *user-package*
+  (make-package "ANSIBLE-INVENTORY-USER"
+               :use '("CL" "ANSIBLE-INVENTORY")))
+
+(defun load-input (file)
+  (let ((*package* *user-package*))
+    (load file :verbose nil)))
+
+(defun parse-command-line (args)
   (loop (let* ((arg (pop args))
               (len (length arg)))
          (cond ((string= arg "--") (return))
@@ -235,46 +253,54 @@
                                  (args
                                   (pop args))
                                  (t
-                                  (error "missing argument"))))))
-                  (case (char arg i)
-                    (#\h (format t "usage: ~A FILE ...~%"
-                                 (pathname-name *progname*)))
-                    (t (error "unknown option `-~A'" (char arg i))))))
+                                  (error "missing argument")))))
+                    (case (char arg i)
+                      (#\h (format t "usage: ~A FILE ...~%"
+                                   (pathname-name *progname*)))
+                      (t (error "unknown option `-~A'" (char arg i)))))))
                (t (push arg args) (return)))))
-  (format t ";; remaining args = ~S~%" args)
-  (dolist (arg args)
-    (let ((*package* pkg))
-      (load arg :verbose nil))))
+  (mapc #'load-input args))
 
 ;;;--------------------------------------------------------------------------
 ;;; Run the hooks.
 
-(setf *hostproc-hooks* (sort *hostproc-hooks* #'< :key #'hook-entry-prio))
-(mapc (compose #'hook-entry-func #'funcall) *hostproc-hooks*)
+(defun run-hooks ()
+  (setf *hostproc-hooks* (sort *hostproc-hooks* #'< :key #'hook-entry-prio))
+  (mapc (compose #'hook-entry-func #'funcall) *hostproc-hooks*))
 
 ;;;--------------------------------------------------------------------------
 ;;; Output the definitions.
 
-(setf *print-right-margin* 77)
-(print-json
-  (print-json-map
-    (print-json-mapping "all"
-      (print-json-list (maphosts #'print-json-simple)))
-    (dolist (assoc *groups*)
-      (print-json-mapping (car assoc)
-       (print-json-list
-         (mapc #'print-json-simple (cdr assoc)))))
-    (print-json-mapping "_meta"
+(defun output ()
+  (let ((*print-right-margin* 77))
+    (print-json
       (print-json-map
-       (print-json-mapping "hostvars"
+       (print-json-mapping "all"
+         (print-json-list (maphosts #'print-json-simple)))
+       (dolist (assoc *groups*)
+         (print-json-mapping (car assoc)
+           (print-json-list
+             (mapc #'print-json-simple (cdr assoc)))))
+       (print-json-mapping "_meta"
          (print-json-map
-           (maphash (lambda (host plist)
-                      (print-json-mapping host
-                        (print-json-map
-                          (do ((plist plist (cddr plist)))
-                              ((endp plist))
-                            (print-json-mapping (car plist)
-                              (print-json-simple (cadr plist)))))))
-                    *hosts*)))))))
+           (print-json-mapping "hostvars"
+             (print-json-map
+               (maphash (lambda (host plist)
+                          (print-json-mapping host
+                            (print-json-map
+                              (do ((plist plist (cddr plist)))
+                                  ((endp plist))
+                                (print-json-mapping (car plist)
+                                  (print-json-simple (cadr plist)))))))
+                        *hosts*)))))))))
+
+;;;--------------------------------------------------------------------------
+;;; Main program.
+
+#+cl-launch
+(progn
+  (parse-command-line cl-launch:*arguments*)
+  (run-hooks)
+  (output))
 
 ;;;----- That's all, folks --------------------------------------------------