Implement status

2 files changed, 64 insertions, 2 deletions

diff --git a/.gitignore b/.gitignore
index 880ac59..f612412 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,3 @@
 build/
 .DS_Store
+json-server.json
diff --git a/desmoctl.scm b/desmoctl.scm
index b9302da..074dfaa 100644
--- a/desmoctl.scm
+++ b/desmoctl.scm
@@ -6,6 +6,7 @@
 	(chicken condition)
 	(chicken port)
 	(chicken io)
+	srfi-13
 	medea
         matchable
         test
@@ -137,6 +138,10 @@
    (test "returns parse-ok for -f foo.txt" '(parse-ok subcmd-apply ((apply-config-path "foo.txt")))
 	 (parse-subcommand-apply '("-f" "foo.txt")))))
 
+;;;;;;;;;;;;;;;;;
+;; API adapter ;;
+;;;;;;;;;;;;;;;;;
+
 (define (mock-post-fn . rest)
   (print (format "mock-post-fn called with: ~A" rest))
   rest)
@@ -148,12 +153,29 @@
 		 headers: (headers `((x-api-key ,api-key))))
    json read-string))
 
+(define (mock-get-fn . rest)
+  (print (format "mock-get-fn called with: ~A" rest))
+  rest)
+
+(define (get-fn url api-key)
+  (with-input-from-request
+   (make-request method: 'GET
+		 uri: (uri-reference url)
+		 headers: (headers `((x-api-key ,api-key))))
+   #f read-string))
+
 (define (post-prison post-fn cfg prison-json)
   (let* ((api-url (cadr (assoc 'mgmt-api-url cfg)))
 	 (api-key (cadr (assoc 'mgmt-api-key cfg)))
 	 (req-url (string-append api-url "/prisons")))
     (post-fn req-url api-key prison-json)))
 
+(define (get-prisons get-fn cfg)
+  (let* ((api-url (cadr (assoc 'mgmt-api-url cfg)))
+	 (api-key (cadr (assoc 'mgmt-api-key cfg)))
+	 (req-url (string-append api-url "/prisons")))
+    (get-fn req-url api-key)))
+
 (define (run-apply cfg)
   (define apply-config-content
     (let* ((path (cadr (assoc 'apply-config-path cfg)))
@@ -190,6 +212,46 @@
 
   (print "Apply complete"))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Parse and eval "status" subcommand ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (alist-keys alist)
+  (map (lambda (elem) (symbol->string (car elem))) alist))
+
+(define (string-repeat s n)
+  (if (<= n 0)
+      ""
+      (string-append s (repeat-string s (- n 1)))))
+
+(define (pretty-print-alists alists)
+  (define (pp alist)
+    (define (pp-pair pair)
+      (print (format "~A: ~A" (symbol->string (car pair)) (cdr pair))))
+
+    (print "")
+    (for-each pp-pair alist))
+
+  (if (null? alists)
+      "No data"
+      (for-each pp alists))
+  )
+
+(define (run-status cfg)
+  (print "Fetching status of all prisons...")
+
+  (define api-response
+    (get-prisons get-fn cfg))
+
+  (define prisons (vector->list (from-json-string api-response)))
+
+  (define (debug-print-prison prison)
+    ;; TODO improve this
+    (debug-print (format "~a" prison)))
+  
+  (for-each debug-print-prison prisons)
+  (pretty-print-alists prisons))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Parse flags and subcommand ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -268,8 +330,7 @@
 (define (eval-subcommand subcmd cfg)
   (match subcmd
     ['subcmd-apply (run-apply cfg)]
-    ['subcmd-status (print "TODO status")
-		    (exit 1)]
+    ['subcmd-status (run-status cfg)]
     ['subcmd-logs (print "TODO logs")
 		  (exit 1)]
     ['subcmd-help