new file mode 100644

@@ -0,0 +1,2 @@

+An implementation of part of JIRA's API and a simple client for listing and searching issues.

+

new file mode 100644

@@ -0,0 +1,18 @@

+;;;; jira-api.asd

+

+(asdf:defsystem #:jira-api

+  :description "Describe jira-api here"

+  :author "Your Name <your.name@example.com>"

+  :license "Specify license here"

+  :depends-on (#:fwoar.lisputils

+               #:alexandria

+               #:serapeum

+               #:drakma

+               #:xhtmlambda

+               #:yason

+               #:sheeple)

+  :serial t

+  :components ((:file "package")

+               (:file "prompt")

+               (:file "jira-api")))

+

new file mode 100644

@@ -0,0 +1,205 @@

+;;;; jira-api.lisp

+

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

+

+(defun get-issue (auth key &rest params &key expand)

+  (declare (ignore expand))

+  (apply 'api-get-call auth (format nil "issue/~a" key) params))

+

+(defun get-projects (auth)

+  (api-get-call auth "issue/createmeta"))

+

+(defun make-issue (project-key summary &key (description nil description-p) (issue-type "Bug"))

+  (let* ((issue (make-hash-table :test 'equal))

+         (project (alist-string-hash-table `(("key" . ,project-key))))

+         (issue-type (alist-string-hash-table `(("name" . ,issue-type)))))

+    (setf (gethash "fields" issue)

+          (alist-string-hash-table

+            `(("project" . ,project)

+              ("summary" . ,summary)

+              ,@(when description-p

+                  (list

+                    (cons "description" description)))

+              ("issuetype" . ,issue-type))))

+    issue))

+

+(defun post-issue (auth issue)

+  (let-each (:be *)

+    issue

+    (with-output-to-string (s)

+      (yason:encode * s))

+    (api-post-call auth "issue" *)))

+

+(defun post-issue-from-fields (auth project-key summary &key

+                        (description nil description-p)

+                        (issue-type nil issue-type-p))

+  (let ((optional-arguments '()))

+    (when issue-type-p

+      (push issue-type optional-arguments))

+    (when description-p

+      (push description optional-arguments))

+

+    (let-each (:be *)

+      (apply #'make-issue project-key summary optional-arguments)

+      (post-issue auth *))))

+

+(defun read-issue (&optional (iostream *query-io*))

+  (let ((project-key (prompt :project-key iostream))

+        (summary (prompt :summary iostream))

+        (description (optional-prompt iostream :description "Add a description? ")))

+    (apply #'make-issue project-key summary

+           (list*

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

+

+(defun show-labels (labels)

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

+

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

+  (pprint-logical-block (*standard-output* (funcall (compose 'tokens 'trim-whitespace) summary))

+    (pprint-indent :block 8 *standard-output*)

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

+    (format *standard-output* "~4tSummary: ")

+    (loop

+      (princ (pprint-pop))

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

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

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

+

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

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

+  (sheeple:with-properties (projects) projects

+    (loop for project across projects

+          do (show-project project))))

new file mode 100644

@@ -0,0 +1,12 @@

+;;;; package.lisp

+

+(defpackage #:jira-api.cli

+  (:use :cl :anaphora :alexandria :serapeum :fw.lu)

+  (:export #:prompt-for-lines

+           #:prompt-for-line

+           #:optional-prompt

+           #:prompt))

+

+(defpackage #:jira-api

+  (:use #:cl #:serapeum #:alexandria #:fw.lu #:jira-api.cli))

+

new file mode 100644

@@ -0,0 +1,49 @@

+(in-package #:jira-api.cli)

+

+(defparameter *prompt-stream* (make-synonym-stream '*query-io*))

+

+(defun prompt-for-line (stream prompt &rest args)

+  (apply #'format stream prompt args)

+  (force-output stream)

+  (read-line stream nil :done))

+(trace prompt-for-line)

+

+(defun prompt-for-lines (stream initial-prompt continuation-prompt &rest args)

+  "Not finished ... see :description below"

+  (loop with lines = (make-array 10 :adjustable t :fill-pointer 0)

+        for line = (prompt-for-line stream initial-prompt args)

+        then (prompt-for-line stream continuation-prompt)

+        for trim-line = (trim-whitespace line)

+        until (equal trim-line ".")

+        do (vector-push-extend trim-line lines)

+        finally (return (string-join lines #\space))))

+

+(defun prompt-for-boolean (stream prompt &rest args)

+  (let ((input (string-downcase (prompt-for-line stream prompt args))))

+    (ecase (elt input 0)

+      (#\y t)

+      (#\n nil))))

+

+(defgeneric prompt (field-name &optional stream))

+

+(defun optional-prompt (stream field-name test-prompt &rest args)

+  (when (apply #'prompt-for-boolean stream test-prompt args)

+    (prompt field-name stream)))

+

+

+(defmethod prompt ((field-name (eql :project-key)) &optional (stream *prompt-stream*))

+  (funcall #'string-upcase (prompt-for-line stream "Project Key (e.g. ATOMOS)? ")))

+

+(defmethod prompt ((field-name (eql :summary)) &optional (stream *prompt-stream*))

+  (prompt-for-line stream "Summary? "))

+

+(defmethod prompt ((field-name (eql :description)) &optional (stream *prompt-stream*))

+  (loop with lines = (make-array 10 :adjustable t :fill-pointer 0)

+        for line = (prompt-for-line stream "Enter a description end with \".\" on its own line~%? ")

+        then (prompt-for-line stream "? ")

+        for trim-line = (when (stringp line)

+                          (trim-whitespace line))

+        until (or (eql trim-line :done) (equal trim-line "."))

+        do (vector-push-extend trim-line lines)

+        finally (return (string-join lines #\newline))))

+

new file mode 100755

@@ -0,0 +1,87 @@

+#!/usr/bin/sbcl --script

+(require :sb-posix)

+(load #p"~/quicklisp/setup.lisp")

+(eval-when (:load-toplevel :compile-toplevel :execute)

+  (push (truename ".") asdf:*central-registry*)

+  (ql:quickload :ubiquitous)

+  (sb-posix:setenv "CC" "gcc" 1)

+  (ql:quickload :net.didierverna.clon)

+  (ql:quickload :jira-api))

+

+(defpackage #:jira-api.client

+  (:use #:cl #:serapeum #:alexandria #:fw.lu #:jira-api.cli #:jira-api #:net.didierverna.clon))

+

+(in-package #:jira-api.client)

+(defparameter *version* (format nil "0.1-init")) 

+

+(defparameter *endpoint-template* "https://~a.atlassian.net/rest/api/2/")

+

+(eval-when (:compile-toplevel :load-toplevel :execute)

+  (ubiquitous:restore :jira-api))

+

+(defsynopsis (:postfix "ARGUMENTS...")

+  (text :contents "A command line client for Jira issues")

+  (group (:header "Main actions")

+         (flag :short-name "lp" :long-name "list-projects"

+               :description "List available JIRA projects")

+         (flag :short-name "is"

+               :long-name "get-issues"

+               :description "list issues")

+         (flag :short-name "i"

+               :long-name "get-issue"

+               :description "show an issue")

+         (flag :short-name "pi" :long-name "post-issue"

+               :description "post and issue"))

+  (group (:header "JIRA options")

+         (stropt :long-name "jira-account"

+                 :description "The jira account to use."

+                 :argument-name "URL-SUBDOMAIN"

+                 :default-value (ubiquitous:value :jira :account)))

+  (group (:header "Filtering Issues")

+         (stropt :short-name "s" :long-name "status"

+                 :description "Only show issues with a certain status"))

+  (group (:header "Other options")

+         (flag :short-name "h" :long-name "help"

+               :description "Show this help") 

+         (flag :short-name "v" :long-name "version"

+               :description "Show the program version")))

+

+(defvar *auth*)

+

+(defun main ()

+  (ubiquitous:restore :jira-api) 

+  (setf *auth* (ubiquitous:value :jira :creds))

+  (make-context)

+  

+  (let ((jira-api::*endpoint* (format nil *endpoint-template* (getopt :long-name "jira-account"))))

+    (cond

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

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

+       (let ((options (remainder)))

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

+           (alexandria:if-let ((status (getopt :long-name "status")))

+             (setf issues 

+                   (sheeple:defobject ()

+                                      ((jira-api::issues

+                                         (apply 'vector

+                                                (gethash status

+                                                         (jira-api::classify-issues issues))))))))

+           (jira-api::show-issues issues))))

+      ((getopt :long-name "list-projects") (jira-api::show-projects

+                                             (jira-api::json2sheeple

+                                               (jira-api::get-projects *auth*))))

+      ((getopt :long-name "post-issue") (yason:encode (jira-api::read-issue)))

+      (t   (do-cmdline-options (option name value source)

+                               (print (list option name value source)))

+           (terpri)

+           (exit)))))

+

+(dump "jira-client" main)