git.fiddlerwoaroof.com
Raw Blame History
(in-package :jira-api)

(defun ensure-parent (object parent &key (err-if-nil t))
  (when (and (not err-if-nil) (null object))
    (return-from ensure-parent object))

  (unless (sheeple:parentp parent object)
    (push parent (sheeple:object-parents object))
    (sheeple:shared-init object))
  object)

(sheeple:defproto =status= () (name))
(sheeple:defproto =person= () (displayname emailaddress))
(sheeple:defproto =issue= () (fields key id self))
(sheeple:defproto =fields= () (summary description reporter creator assignee status comment))
(sheeple:defproto =issues= () (issues))
(sheeple:defmessage show (object &rest args))
(sheeple:defmessage fields-labels (fields))
(sheeple:defreply fields-labels ((fields =fields=))
  (sheeple:with-properties (labels) fields
    labels))

(sheeple:defproto =comment= () (self id author body))

(sheeple:defmessage points (issue))
(sheeple:defreply points ((issue =issue=))
  (sheeple:property-value (fields issue)
                          'customfield_10002))

(sheeple:defreply sheeple:shared-init ((issues =issues=) &key)
  (map nil (op (ensure-parent _ =issue=))
       (issues issues)))

(sheeple:defreply sheeple:shared-init :after ((comment =comment=) &key)
  (with-accessors ((author author)) comment
      (ensure-parent author =person= :err-if-nil nil)))

(sheeple:defreply sheeple:shared-init :after ((issue =issue=) &key)
  (with-accessors ((fields fields)) issue
    (when fields
      (ensure-parent fields =fields=)
      (ensure-parent (status fields) =status=)
      (ensure-parent (reporter fields) =person= :err-if-nil nil)
      (ensure-parent (creator fields) =person= :err-if-nil nil)
      (ensure-parent (assignee fields) =person= :err-if-nil nil)
      (sheeple:with-properties (comment) fields
        (when comment
          (sheeple:with-properties (comments) comment
            (map 'nil (lambda (comment) (ensure-parent comment =comment=))
                 comments)))))))

(sheeple:defreply show ((person =person=) &rest args)
  (declare (ignore args))
  (format nil "\"~a\" <~a>" (displayname person) (emailaddress person)))

(sheeple:defreply show ((status =status=) &rest args)
  (declare (ignore args))
  (format nil "~a" (name status)))

(defun show-description (description)
  (pprint-logical-block (*standard-output* (mapcar (compose 'tokens 'trim-whitespace)
                                                 (lines description)))
    (pprint-indent :block 4 *standard-output*)
    (pprint-newline :mandatory *standard-output*)
    (loop
      (pprint-exit-if-list-exhausted)
      (let ((line (pprint-pop)))
        (pprint-logical-block (*standard-output* line)
          (loop
            (princ (pprint-pop) *standard-output*)
            (pprint-exit-if-list-exhausted)
            (princ #\space *standard-output*)
            (pprint-indent :block 3)
            (pprint-newline :fill *standard-output*)))
        (pprint-newline :mandatory *standard-output*)))))

(defun show-summary (summary &optional (stream *standard-output*))
  (pprint-logical-block (stream (funcall (compose 'tokens 'trim-whitespace) summary))
    (pprint-indent :block 8 *standard-output*)
    (pprint-exit-if-list-exhausted)
    (format stream "~4tSummary: ")
    (loop
      (princ (pprint-pop) stream)
      (pprint-exit-if-list-exhausted)
      (pprint-newline :fill stream)
      (princ #\space stream))))

(sheeple:defreply show ((issue =issue=) &rest args)
  (declare (ignorable args))
  (with-output-to-string (*standard-output*)
    (when-let ((fields (fields issue)))
      (with-accessors ((status status) (summary summary) (reporter reporter)
                                       (creator creator) (assignee assignee)
                                       (labels fields-labels)) fields

        (format t "~a (~a) <~a>~%"
                (key issue)
                (show status)
                (princ-to-string (puri:merge-uris (format nil "/browse/~a" (key issue))
                                                  *hostname*)))

        (show-summary summary)

        (show-person reporter "Reporter")
        (show-person creator "Creator")
        (when assignee
          (show-person assignee "Assignee"))

        (when (< 0 (length labels))
          (show-labels labels))

        (when (description fields)
          (show-description (description fields))))

      ; The head of the arguments determines whether or not
      ; we show the comments
      (when (and (car args))
        (if-let ((comment (comment fields)))
          (sheeple:with-properties (comments) comment
            (loop for comment across comments
                  do (format t "~&~a:~% ~<   ~@;~{~{~a~^ ~:_~}~2%~}~:>~&"
                             (show (author comment))
                             (list (map 'list #'tokens
                                        (split-sequence #\newline
                                                        (body comment)))))))))

      (fresh-line))))

(sheeple:defproto =project= () (name key issuetypes))

(sheeple:defproto =issuetype= () (description name))

(sheeple:defreply sheeple:shared-init :after ((project =project=) &key)
  (with-accessors ((issuetypes issuetypes)) project
    (when issuetypes
      (map nil
           (lambda (issuetype) (ensure-parent issuetype =issuetype=))
           issuetypes))))

(sheeple:defreply show ((issuetype =issuetype=) &rest arg)
  (declare (ignore args))
  (with-output-to-string (*standard-output*)
    (pprint-logical-block (*standard-output* (tokens (description issuetype)))
      (pprint-indent :block 15 *standard-output*)
      (pprint-exit-if-list-exhausted)
      (format *standard-output* "~4t~10@a: " (name issuetype))
      (loop
        (princ (pprint-pop))
        (pprint-exit-if-list-exhausted)
        (pprint-newline :fill *standard-output*)
        (princ #\space)))))

(sheeple:defreply show ((project =project=) &rest args)
  (declare (ignore args))
  (with-output-to-string (*standard-output*)
    (format t "~a: ~a~%~{~a~&~}" (key project) (name project)
            (map 'list #'show (issuetypes project)))))

(deftype vector-of-objects () '(vector (or hash-table sheeple:object) *))

(defun json2sheeple (json &optional parent)
  (labels
      ((handle-parsed (parsed-json)
         (typecase parsed-json
           (vector-of-objects (map 'vector #'handle-parsed parsed-json))
           (hash-table
            (let ((result (sheeple:object)))
              (loop for json-prop being the hash-keys of parsed-json using (hash-value json-value)
                 do (setf (sheeple:property-value result
                                                  (intern (string-upcase json-prop) :jira-api))
                          (typecase json-value
                            (hash-table (handle-parsed json-value))
                            (vector-of-objects (map 'vector #'handle-parsed json-value))
                            (t json-value)))
                 finally (return result))))
           (t parsed-json))))
    (let* ((yason:*parse-json-arrays-as-vectors* t)
           (result (handle-parsed (yason:parse json))))
      (when parent
        (ensure-parent result parent))
      result)))