new file mode 100644

@@ -0,0 +1 @@

+jira-client

new file mode 100644

@@ -0,0 +1,26 @@

+(in-package #:jira-api) 

+

+; curl -u user:password https://atomampd.atlassian.net/rest/api/2/issue/ATOMOS-212 | jq .

+(defparameter *endpoint* "https://atomampd.atlassian.net/rest/api/2/")

+

+(defun api-get-call (auth method &rest parameters)

+  "Connect to a GET REST endpoint specified by method and return a stream from

+   which the response can be read."

+  (let ((drakma:*text-content-types* (acons "application" "json" drakma:*text-content-types*)))

+    (drakma:http-request (puri:merge-uris method *endpoint*)

+                         :parameters (alexandria:plist-alist parameters)

+                         :basic-authorization auth

+                         :want-stream t)))

+

+(defun api-post-call (auth method post-data)

+  "Connect to a GET REST endpoint specified by method and return a stream from

+   which the response can be read."

+  (let ((drakma:*text-content-types* (acons "application" "json" drakma:*text-content-types*)))

+    (drakma:http-request (puri:merge-uris method *endpoint*)

+                         :method :POST

+                         :content-type "application/json"

+                         :content post-data

+                         :basic-authorization auth

+                         :want-stream t)))

+

+

@@ -14,5 +14,7 @@

   :serial t

   :components ((:file "package")

                (:file "prompt")

+               (:file "api-handler")

+               (:file "sheeple-protos")

                (:file "jira-api")))

@@ -1,32 +1,8 @@

 ;;;; jira-api.lisp

+(declaim (optimize (debug 3)))

 (in-package #:jira-api)

-;;; "jira-api" goes here. Hacks and glory await!

-

-; curl -u user:password https://atomampd.atlassian.net/rest/api/2/issue/ATOMOS-212 | jq .

-(defparameter *endpoint* "https://socraticum.atlassian.net/rest/api/2/")

-

-(defun api-get-call (auth method &rest parameters)

-  "Connect to a GET REST endpoint specified by method and return a stream from

-   which the response can be read."

-  (let ((drakma:*text-content-types* (acons "application" "json" drakma:*text-content-types*)))

-    (drakma:http-request (puri:merge-uris method *endpoint*)

-                         :parameters (alexandria:plist-alist parameters)

-                         :basic-authorization auth

-                         :want-stream t)))

-

-(defun api-post-call (auth method post-data)

-  "Connect to a GET REST endpoint specified by method and return a stream from

-   which the response can be read."

-  (let ((drakma:*text-content-types* (acons "application" "json" drakma:*text-content-types*)))

-    (drakma:http-request (puri:merge-uris method *endpoint*)

-                         :method :POST

-                         :content-type "application/json"

-                         :content post-data

-                         :basic-authorization auth

-                         :want-stream t)))

-

 (defun get-issues (auth)

   (api-get-call auth "search"))

@@ -80,30 +56,8 @@

              (when description

                (list description))))))

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

-

-(defun json2sheeple (json)

-  (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))

-      (handle-parsed (yason:parse json)))))

-

 (defun show-person (person title)

-  (sheeple:with-properties (displayname emailaddress) person

-    (format t "~&~4t~a: \"~a\" <~a>~%" title displayname emailaddress)))

+  (format t "~&~4t~a: ~a~%" title (show person)))

 (defun show-labels (labels)

   (format t "~&~4tLabels: ~{~a~}~%" (coerce labels 'list)))

@@ -137,69 +91,35 @@

       (princ #\space))))

 (defun classify-issues (sheeple-issues &optional (classify-by '(status name)))

-   (sheeple:with-properties (issues) sheeple-issues

-     (loop with classes = (make-hash-table :test 'equalp)

-           for issue across issues

-           do (sheeple:with-properties (fields) issue

-                (loop for classification in classify-by

-                      for thing = (sheeple:property-value fields classification)

-                          then (sheeple:property-value thing classification)

-                      finally (push issue (gethash thing classes))))

-           finally (return classes))))

-

-(defun show-issues (sheeple-issues)

   (sheeple:with-properties (issues) sheeple-issues

-    (loop for issue across issues

-          do (show-issue-short issue))))

+    (loop with classes = (make-hash-table :test 'equalp)

+          for issue across issues

+          do (loop for classification in classify-by

+                   for thing = (sheeple:property-value (fields issue) classification)

+                       then (sheeple:property-value thing classification)

+                   finally (push issue (gethash thing classes)))

+          finally (return classes))))

 (defun show-issue-short (issue)

-  (sheeple:with-properties (key fields self) issue

-    (sheeple:with-properties (summary status) fields

-      (sheeple:with-properties ((status-name name)) status

-        (format t "~&~a ~a (~a)~%" self key status-name))

+  (sheeple:with-properties (key self) issue

+    (let* ((fields (fields issue))

+           (status (name (status fields)))

+           (summary (summary fields)))

+      (format t "~&~a ~a (~a)~%" self key status)

       (show-summary summary)

       (fresh-line))))

-(defun show-issue (issue)

-  (declare (optimize (debug 3)))

-  (sheeple:with-properties (fields key id self) issue

-    (sheeple:with-properties (summary description reporter creator assignee status labels) fields

-      (sheeple:with-properties ((status-name name)) status

-        (format t "~a (~a) <~a>~%" key status-name self))

-

-      (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

-        (show-description description)))))

+(defun show-issues (sheeple-issues)

+  (sheeple:with-properties (issues) sheeple-issues

+    (loop for issue across issues

+          do (ensure-parent issue =issue=)

+          do (show-issue-short issue))))

-(defun show-issuetype (issuetype)

-  (sheeple:with-properties (description name) issuetype

-    (pprint-logical-block (*standard-output* (tokens description))

-      (pprint-indent :block 15 *standard-output*)

-      (pprint-exit-if-list-exhausted)

-      (format *standard-output* "~4t~10@a: " name)

-      (loop

-        (princ (pprint-pop))

-        (pprint-exit-if-list-exhausted)

-        (pprint-newline :fill *standard-output*)

-        (princ #\space)))))

-

-(defun show-project (project)

-  (sheeple:with-properties (name key issuetypes) project

-    (format t "~a: ~a~%" key name)

-    (loop for issuetype across issuetypes

-          do (show-issuetype issuetype)

-          do (terpri))))

+(defun print-on-own-line (str)

+  (format t "~&~a~&" str))

 (defun show-projects (projects)

   (sheeple:with-properties (projects) projects

     (loop for project across projects

-          do (show-project project))))

+          do (ensure-parent project =project=)

+          do (print-on-own-line (show project)))))

new file mode 100644

@@ -0,0 +1,120 @@

+(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))

+(sheeple:defmessage show (object &rest args))

+(sheeple:defmessage fields-labels (fields))

+(sheeple:defreply fields-labels ((fields =fields=))

+  (sheeple:with-properties (labels) fields

+    labels))

+

+(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=)

+      (ensure-parent (creator fields) =person=)

+      (ensure-parent (assignee fields) =person= :err-if-nil nil))))

+

+(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)))

+

+(sheeple:defreply show ((issue =issue=) &rest args)

+  (declare (ignorable args))

+  (with-output-to-string (*standard-output*)

+    (if-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)

+                (self issue))

+

+        (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))))

+      (fresh-line))))

+

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

+

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

+

+(sheeple:defreply sheeple:shared-init :after ((project =project=) &key)

+                  (declare (optimize (debug 3)))

+  (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)))

+

@@ -58,12 +58,14 @@

       ((getopt :long-name "help") (help))

       ((getopt :long-name "version") (format t "~&~a~%" *version*))

       ((getopt :long-name "get-issue") (let ((options (remainder)))

-                                         (jira-api::show-issue

-                                           (jira-api::json2sheeple

-                                             (jira-api::get-issue *auth*

-                                                                  (format nil "~a-~a"

-                                                                          (car options)

-                                                                          (cadr options)))))))

+                                         (format t "~&~a~&"

+                                                 (jira-api::show

+                                                   (jira-api::json2sheeple

+                                                     (jira-api::get-issue *auth*

+                                                                          (format nil "~a-~a"

+                                                                                  (car options)

+                                                                                  (cadr options)))

+                                                     jira-api::=issue=)))))

       ((getopt :long-name "get-issues")

        (let ((options (remainder)))

          (let ((issues (jira-api::json2sheeple (jira-api::get-issues *auth*))))