git.fiddlerwoaroof.com
aws-result.lisp
e4881c6a
 (defpackage :daydreamer.aws-result
cc02973e
   (:use :cl :fw.lu :alexandria :st)
   (:export
    #:stack
    #:outputs
    #:reader
    #:creation-time
    #:notification-arns
    #:stack-id
    #:stack-name
    #:description
    #:stack-status
    #:disable-rollback
    #:tags
    #:deletion-time
    #:rollback-configuration
    #:drift-information
    #:enable-termination-protection
    #:parameters
    #:start-date-time
    #:end-date-time
    #:creation-date-time
    #:extract-timeline
    #:extract-list
    #:extract-stack
ea8450da
    #:timeline
    #:tagged-kv-formatter))
e4881c6a
 (in-package :daydreamer.aws-result)
cc02973e
 
 (defun find-all-indices (pred str &optional accum (start (or (car accum) 0)))
   (check-type pred function)
   (check-type str string)
   (check-type start fixnum)
 
   (tagbody start-loop
      (if (= start (length str))
          (return-from find-all-indices (nreverse accum))
          (let ((pos (position-if pred str :start start)))
            (if pos
                (progn (psetf accum (cons pos accum)
                              start (1+ pos))
                       (go start-loop))
                (return-from find-all-indices (nreverse accum)))))))
 
 (defun transform-by-function-map (function-map key value &optional (default-transform 'identity))
   (funcall (gethash key
                     function-map
                     default-transform)
            value))
 
 (defun decamelize (v)
   (let* ((indices (or (find-all-indices #'upper-case-p v) '(0)))
          (parts (mapcar (serapeum:op (string-downcase (subseq v _ _)))
                         (if (= (car indices) 0) indices (cons 0 indices))
                         (if (/= (car indices) 0) indices (append (cdr indices)
                                                                  (list (length v)))))))
     (serapeum:string-join parts "-")))
 
 
 (defmacro tagged-kv-formatter (tag)
   `(formatter ,(format nil "~a ~~a ~~a~~%" tag)))
 
 (defun alist-to-initargs (alist value-map)
   (mapcan (destructuring-lambda ((key . value))
             (let* ((key (string-case:string-case (key :default key)
                           ("NotificationARNs" "NotificationArns")))
                    (initarg (make-keyword (string-upcase (decamelize key)))))
               (list initarg
                     (transform-by-function-map value-map
                                                initarg
                                                value))))
           alist))
 
 
 (defclass stack ()
3c0af7c8
   ((%outputs :initarg :outputs :reader outputs :initform (list))
cc02973e
    (%capabilities :initarg :capabilities :reader capabilities)
3c0af7c8
    (%last-updated-time :initarg :last-updated-time :reader last-updated-time)
cc02973e
    (%creation-time :initarg :creation-time :reader creation-time)
    (%notification-arns :initarg :notification-arns :reader notification-arns)
    (%stack-id :initarg :stack-id :reader stack-id)
    (%stack-name :initarg :stack-name :reader stack-name)
    (%description :initarg :description :reader description)
    (%stack-status :initarg :stack-status :reader stack-status)
    (%disable-rollback :initarg :disable-rollback :reader disable-rollback)
    (%tags :initarg :tags :reader tags)
    (%deletion-time :initarg :deletion-time :reader deletion-time)
    (%rollback-configuration :initarg :rollback-configuration :reader rollback-configuration)
    (%drift-information :initarg :drift-information :reader drift-information)
    (%enable-termination-protection :initarg :enable-termination-protection :reader enable-termination-protection)
8e5bcff6
    (%template-description :initarg :template-description :reader template-description)
9804b881
    (%parameters :initarg :parameters :reader parameters :initform (list))))
cc02973e
 
 (defclass timeline ()
   ((%start-date-time :initarg :start-date-time :reader start-date-time)
    (%end-date-time :initarg :end-date-time :reader end-date-time)
    (%creation-date-time :initarg :creation-date-time :reader creation-date-time)))
 
 (defun extract-timeline (aws-result)
   (labels ((cdr-assoc (key list) (cdr (assoc key list :test #'equal)))
            (get-in (keys alist)
              #+null
              (reduce (lambda (accum next)
                        ())
                      )
              (loop
                 for key in keys
                 for cur-alist = alist then accum
                 for accum = (cdr-assoc key cur-alist)
                 finally (return-from get-in accum))))
     (apply #'make-instance 'timeline
            (alist-to-initargs (get-in '("Status" "Timeline")
                                       aws-result)
                               (make-hash-table)))))
 
 (defun extract-list (aws-result)
   (mapcar (destructuring-lambda ((list-item-marker . items))
             (if (string= list-item-marker "member")
                 items
                 (error 'invalid-result)))
           aws-result))
 
 (defun extract-stack (aws-result)
   (flet ((as-keyword (v) (alexandria:make-keyword (car v))))
     (apply #'make-instance 'stack
            (alist-to-initargs aws-result
                               (fw.lu:alist-string-hash-table
                                `((:outputs . extract-list)
                                  (:capabilities . extract-list)
                                  (:creation-time . car)
                                  (:notification-arns . car)
                                  (:stack-id . car)
                                  (:stack-name . car)
                                  (:description . car)
                                  (:stack-status . ,#'as-keyword)
                                  (:disable-rollback . car)
                                  (:tags . extract-list)
                                  (:rollback-configuration . car)
                                  (:drift-information . car)
                                  (:enable-termination-protection . car)
8e5bcff6
                                  (:template-description . car)
cc02973e
                                  (:parameters . extract-list)))))))
 
8e5bcff6
 (defparameter *stack-statuses*
   '("CREATE_COMPLETE" "CREATE_IN_PROGRESS" "CREATE_FAILED"
     "DELETE_COMPLETE" "DELETE_FAILED" "DELETE_IN_PROGRESS"
     "REVIEW_IN_PROGRESS"
     "ROLLBACK_COMPLETE" "ROLLBACK_FAILED" "ROLLBACK_IN_PROGRESS"
     "UPDATE_COMPLETE" "UPDATE_COMPLETE_CLEANUP_IN_PROGRESS" "UPDATE_IN_PROGRESS"
     "UPDATE_ROLLBACK_COMPLETE" "UPDATE_ROLLBACK_COMPLETE_CLEANUP_IN_PROGRESS" "UPDATE_ROLLBACK_FAILED" "UPDATE_ROLLBACK_IN_PROGRESS"))
 
 #+nil
 (aws-sdk/services/cloudformation:list-stacks 
  :stack-status-filter '("UPDATE_COMPLETE" "UPDATE_IN_PROGRESS"
                         "UPDATE_COMPLETE_CLEANUP_IN_PROGRESS" "UPDATE_ROLLBACK_COMPLETE"
                         "UPDATE_ROLLBACK_IN_PROGRESS" "UPDATE_ROLLBACK_FAILED" 
                         "UPDATE_ROLLBACK_COMPLETE_CLEANUP_IN_PROGRESS" "CREATE_FAILED"
                         "CREATE_COMPLETE" "CREATE_IN_PROGRESS"))
cc02973e
 
 (defgeneric initialize-date (value)
   (:method ((value cons)) (local-time:parse-timestring (car value)))
   (:method (value) value))
 
 (defmethod initialize-instance :after ((instance timeline) &key)
   (with-slots ((s-sdt %start-date-time)
                (s-edt %end-date-time)
                (s-cdt %creation-date-time)) instance
     (setf s-sdt (initialize-date s-sdt)
           s-edt (initialize-date s-edt)
           s-cdt (initialize-date s-cdt))))
ea8450da
 
 
 (deftest decamelize ()
   (should be equal "a" (decamelize "A"))
   (should be equal "a" (decamelize "a"))
   (should be equal "outputs" (decamelize "Outputs"))
   (should be equal "outputs-outputs" (decamelize "OutputsOutputs"))
   (should be equal "a-b-c" (decamelize "ABC")))
8e5bcff6