Babashka script to create Gantt report from Jira

jira_gantt_report.clj

(ns jira-gantt-report
  "Create Gantt EDN-report from Jira"
  (:require
    [babashka.cli :as cli]
    [babashka.curl :as curl]
    [babashka.fs :as fs]
    [babashka.process :refer [check pb pipeline process sh]]
    [cheshire.core :as json]
    [clojure.string :as string]
    [clojure.walk]
    [rewrite-clj.zip :as z])
  (:import
    (java.net
      URLEncoder)
    (java.time
      LocalDate
      LocalDateTime)
    (java.time.format
      DateTimeFormatter)
    (java.time.temporal
      ChronoUnit)
    (java.util
      Locale)))


;; Login and password for Jira
(def login (-> (System/getenv) (get "LOGNAME")))
(def password (-> (str (fs/home) "/.credpwd") slurp string/trim))

(def jql-rest-url "https://jira.mycompany.ru/rest/api/2/search?maxResults=1000&jql=")
(def task-rest-url "https://jira.mycompany.ru/rest/api/2/issue/")
(def task-ui-url "https://jira.mycompany.ru/browse/")
(def cljstyle-program "cljstyle")


(defn prf
  [& args]
  (println (apply format args)))


(defn get-raw-issue
  "Get raw Jira issue by key using REST API via curl"
  ([issue-key] (get-raw-issue issue-key task-rest-url))
  ([issue-key task-url] (get-raw-issue issue-key task-url login password))
  ([issue-key task-url login password]
   (try
     (let [resp (curl/get (str task-url issue-key)
                  {:basic-auth [login password]
                   :headers    {"Accept" "application/json"}})]
       (when (= 200 (:status resp))
         (-> resp
           :body
           (json/parse-string true))))
     (catch Exception e
       (println "Exception message" (.getMessage e) "issue:" issue-key)))))


(defn extract-fields
  "Returns map of common attributes from raw Jira issue or nil if error"
  [raw-issue]
  (some->> raw-issue
    ((juxt
       (fn [x] (-> x :key))
       (fn [x] (some->> x :fields :subtasks (mapv :key)))
       (fn [x] (-> x :fields :customfield_11501))
       (fn [x] (-> x :fields :priority :name))
       (fn [x] (some-> x :fields :customfield_11102 int))
       (fn [x] (-> x :fields :issuetype :name))
       (fn [x] (-> x :fields :summary))
       (fn [x] (-> x :fields :status :name))
       (fn [x] (-> x :fields :resolution :name))
       (fn [x] (-> x :fields :labels))
       (fn [x] (-> x :fields :created))
       (fn [x] (-> x :fields :updated))
       (fn [x] (-> x :fields :resolutiondate))
       (fn [x] (-> x :fields :customfield_18602))
       (fn [x] (-> x :fields :customfield_18603))
       (fn [x] (-> x :fields :customfield_18611))
       (fn [x] (-> x :fields :duedate))
       (fn [x] (-> x :fields :assignee :name))))
    (zipmap
      [:key :subtasks :parent-epic :priority :techcom-priority :issue-type :summary :status :resolution :labels
       :created-at :updated-at :resolved-at :planned-start-at
       :planned-end-at :velocity :duedate :assignee])))


(defn jira-rest-search
  "Make search request to Jira using REST API via curl
  Params:
    * jql-url - Jira endpoint for search. Example: https://jira.mydomain.ru/rest/api/2/search?jql=
    * jql-query - JQL query request. Example: \"project=ABC AND creator=mylogin\""
  [login password jql-url ^String jql-query]
  (let [resp (curl/get (str jql-url (URLEncoder/encode jql-query "UTF-8"))
               {:basic-auth [login password]
                :headers    {"Accept" "application/json"}})]
    (when (= 200 (:status resp))
      (-> resp
        :body
        (json/parse-string true)))))


(defn search
  "Make a raw JQL with predefined params: login, password, jql-url"
  [jql-query]
  (jira-rest-search login password jql-rest-url jql-query))


(defn task-search
  "Make a query for tasks search"
  [query-string]
  (->>
    query-string
    search
    :issues
    (map extract-fields)))


(defn date-str
  [s]
  (subs s 0 10))


(defn diff-between-days
  "Calculate difference in days between two dates."
  [date1 date2]
  (let [df (DateTimeFormatter/ofPattern "yyyy-MM-dd" Locale/ROOT)
        d1 (if (string? date1) (LocalDate/parse date1 df) date1)
        d2 (if (string? date2) (LocalDate/parse date2 df) date2)]
    (.between ChronoUnit/DAYS d1 d2)))


(defn calc-percent
  [_ _]
  50)


(defn issue-color
  [issue-type frame-color]
  (cond
    (#{"эпик" "epic"} issue-type) (str "Yellow/" frame-color)
    (#{"история" "story"} issue-type) (str "GreenYellow/" frame-color)
    (#{"задача" "task"} issue-type) (str "LightSkyBlue/" frame-color)
    (#{"подзадача" "sub-task"} issue-type) (str "LightSkyBlue/" frame-color)
    (#{"ошибка" "bug" "error"} issue-type) (str "Crimson/" frame-color)
    :else "Magenta"))


(defn make-task-entry
  "Convert Jira data to task entry for Gantt program format"
  [jira-task-entry]
  (if (empty? jira-task-entry)
    {:separator ""}
    (let [resolution         (some-> jira-task-entry :resolution string/lower-case)
          status             (some-> jira-task-entry :status string/lower-case)
          planned-start-date (or (:planned-start-at jira-task-entry) (:created-at jira-task-entry) (str (LocalDate/now)))
          planned-end-date   (or (:planned-end-at jira-task-entry) (str (LocalDate/now)))
          due-date           (:duedate jira-task-entry)
          assignee           (:assignee jira-task-entry)
          velocity           (:velocity jira-task-entry)
          alias              (-> jira-task-entry :key string/lower-case keyword)
          issue-type         (string/lower-case (:issue-type jira-task-entry))
          result             (cond->

                               {:task             (-> jira-task-entry :summary (string/replace #"\[|\]|\"" " ") string/trim (str " " (string/upper-case (name alias))))
                                :issue-type       issue-type
                                :alias            alias
                                :starts-at        (date-str planned-start-date)
                                :ends-at          (date-str planned-end-date)
                                :links-to         (str task-ui-url (-> jira-task-entry :key))
                                :color            (issue-color issue-type "Gray")
                                :percent-complete (cond
                                                    (#{"решено" "done"} resolution) 100
                                                    :else (calc-percent planned-start-date planned-end-date))}

                               (and
                                 assignee
                                 (number? velocity)
                                 (pos? velocity)) (assoc :resources [(format "%s:%s%%" assignee (int velocity))])

                               (and
                                 (nil? planned-end-date)
                                 (not (#{"closed" "закрыто" "done"} status))) (assoc :color (issue-color issue-type "Red"))

                               (and
                                 (.isAfter (LocalDate/now) (LocalDate/parse (date-str planned-end-date)))
                                 (not (#{"closed" "закрыто" "done"} status))) (assoc :color (issue-color issue-type "Red")))]
      (if due-date
        [result
         {:milestone  (str ":" alias)
          :happens-at (date-str due-date)}]
        result))))


(defn make-hierarchy-ordered-issues
  "Make issues order according to their hierarchy"
  [unordered-issues-vec]
  (let [issues-map                     (reduce (fn [acc i] (assoc acc (:key i) i)) {} unordered-issues-vec)
        epics                          (mapv :key (filterv #(#{"epic" "эпик"} (-> % :issue-type string/lower-case)) unordered-issues-vec))
        sub-task-map                   (reduce (fn [acc i]
                                                 (let [sub-tasks    (mapv :key (filterv #(#{i} (-> % :parent-epic)) unordered-issues-vec))
                                                       sub-task-map (reduce (fn [acc2 i2] (assoc acc2 i2 (:subtasks (get issues-map i2)))) {} sub-tasks)]
                                                   (assoc acc i sub-task-map))) {} epics)
        a                              (atom [])
        _                              (clojure.walk/postwalk #(cond
                                                                 (string? %) (swap! a conj (get issues-map %))
                                                                 :else %) sub-task-map)
        ordered-issues-map             (reduce (fn [acc i] (assoc acc (:key i) i)) {} @a)
        diff-map                       (reduce (fn [acc i] (dissoc acc i)) issues-map (keys ordered-issues-map))
        task-stories-keys-without-epic (mapv
                                         :key
                                         (filterv
                                           #(#{"task" "story" "задача" "история"}
                                             (-> % :issue-type string/lower-case))
                                           (vals diff-map)))
        sub-task-map2                  (reduce (fn [acc i]
                                                 (let [subtask-vec (:subtasks (get diff-map i))]
                                                   (when (seq subtask-vec)
                                                     (assoc acc i subtask-vec)))) {} task-stories-keys-without-epic)
        a2                             (atom [])
        _                              (clojure.walk/postwalk #(cond
                                                                 (string? %) (swap! a2 conj (get issues-map %))
                                                                 :else %) sub-task-map2)
        ordered-issues-map2            (reduce (fn [acc i] (assoc acc (:key i) i)) {} @a2)
        diff-map2                      (reduce (fn [acc i] (dissoc acc i)) diff-map (keys ordered-issues-map2))
        result                         (remove nil? (into [] (concat @a @a2 (vals diff-map2))))
        result-count                   (count (into #{} (map :key result)))
        unordered-count                (count (into #{} (map :key unordered-issues-vec)))]
    (when-not (= result-count unordered-count)
      #_(prn (clojure.set/difference (into #{} (map :key result)) (into #{} (map :key unordered-issues-vec))))
      (throw (ex-info (format "Business logic is broken: ordered = %s, unordered = %s" result-count unordered-count)
               {:desc "ordered != unordered"})))
    result))


(defn update-file
  "Fetch all tasks from Jira using JQL in a given EDN file.
  Returns modified EDN filename"
  [^String edn-filename]
  (prf "Updating file: %s" edn-filename)
  (let [edn-string                   (slurp edn-filename)
        root-zloc                    (z/of-string edn-string)
        jql-queries-vec              (-> root-zloc (z/find-value z/next :jql-queries) z/next z/sexpr)
        project-header-zloc          (-> root-zloc (z/find-value z/next :project-header) z/next)
        modified-project-header-zloc (if project-header-zloc
                                       (z/replace project-header-zloc (->> (-> (LocalDateTime/now) (.format (DateTimeFormatter/ofPattern "yyyy-MM-dd HH:mm:ss"))) (str "Дата создания: ")))
                                       root-zloc)
        project-starts-zloc          (-> (z/up modified-project-header-zloc) (z/find-value z/next :project-starts) z/next)
        modified-project-starts-zloc (if project-starts-zloc
                                       #_(z/replace project-starts-zloc (-> (LocalDate/now) (.minus 30 ChronoUnit/DAYS) str))
                                       modified-project-header-zloc
                                       modified-project-header-zloc)
        modified-root-zloc           modified-project-starts-zloc
        tasks-vec-zloc               (-> modified-root-zloc (z/find-value z/next :project-content) z/next)
        new-tasks-vec                (->> jql-queries-vec (map task-search) flatten make-hierarchy-ordered-issues (map make-task-entry) flatten vec)
        new-content                  (z/root-string (z/replace tasks-vec-zloc new-tasks-vec))
        new-content'                 (string/replace new-content ", :" "\n :")
        new-content''                (string/replace new-content' "} {:" "}\n\n{:")
        updated-content-string       (->
                                       (process ["echo" new-content''])
                                       (process [cljstyle-program "pipe"] {:out :string})
                                       deref
                                       :out)]
    (spit edn-filename updated-content-string)
    (println "Success.")
    edn-filename))


(defn generate-report
  "Find particular EDN files in a given path, fetch Jira tasks and update EDN files.
   JQL query should be in :jql-queries vector inside EDN files."
  [^String path]

  (let [report-file-type "report"]
    (prf "Generating reports for `**%s*.edn` files from Jira..." report-file-type)

    (cond
      (not (fs/exists? path)) (prf "Path must exist: %s" path)

      (fs/directory? path) (let [edn-files (mapv str (fs/glob path (format "**%s*.edn" report-file-type)))]
                             (run! update-file edn-files))

      (fs/regular-file? path) (if (-> path fs/file-name str (string/includes? report-file-type)) ; we want to update only *current*.edn files
                                (update-file path)
                                (prf "File should contain `%s` in the name" report-file-type))

      :else (prf "Path should be file or folder: %s" path))))


;;
;; Entry point to program
;;

(def spec
  {:help {:desc  "Print help"
          :alias :h}

   :path {:desc     "Path to Gantt EDN files to transform."
          :coerce   :string
          :validate string?
          :alias    :p}})


(defn exec
  "Exec script to generate Gantt report."
  [opts]

  (when (-> cljstyle-program fs/which str string/blank?)
    (prf "This script requires %s program. Install it before use." cljstyle-program)
    (System/exit -1))

  (let [help-str (str "Usage:\n" (cli/format-opts {:spec spec :order [:path :help]}))]
    (cond
      (:help opts) (println help-str)
      (:path opts) (generate-report (:path opts))
      :else (println help-str))))


(defn -main
  [& args]
  (prf "Gantt report builder for Jira. Start time: %s" (-> (LocalDateTime/now) (.format (DateTimeFormatter/ofPattern "yyyy-MM-dd HH:mm:ss"))))
  (exec (cli/parse-opts args {:spec spec})))


(apply -main *command-line-args*)


(comment
  (task-search "project=PRJ")
  (task-search "parent=PRJ-31")                             ;; story -> sub-task
  (task-search "project=PRJ AND issuetype=Story AND 'Epic link'=PRJ-18") ;; epic -> story

  (task-search "project=PRJ AND parent=PRJ-18")             ;; story -> sub-task
  
  
  (-> "PRJ-229" get-raw-issue extract-fields)
  (-main "-p" "/Users/myusername/projects/process/service1/plan/")
  (-main "-h"))

project-report.edn

{:inline-text-begin  "language ru"

 :scale              "1200*800"
 :project-title      "PRJNAME, S+ project"
 :project-starts     "2022-06-13"
 :project-header     "Creation date: 2022-08-05 15:05:09"
 :project-scale-zoom {:scale :weekly :zoom 3}

 :closed-days        #{:saturday :sunday}
 :holidays           ["2022-06-13"]

 :today              {:color "#AAF"}

 :jql-queries
 [;; epic and story
  ;; "issuekey=MLCQ-103 OR 'Epic link'=MLCQ-103 OR parent in (\"MLCQ-103\") OR issue IN subtasksOf('\"Epic link\" = MLCQ-103 ')"

  ;;  epic,story,task,subtask
  "issuekey=MLCQ-103 OR 'Epic link'=MLCQ-103 OR parent in (\"MLCQ-103\") OR issue IN subtasksOf('\"Epic link\" = MLCQ-103 ') OR issueFunction in subtasksOf('\"Epic link\" = MLCQ-103')"

  ;; Epic, story and all linked issues in other projects
  ;; "issue = MLCQ-103 OR issueFunction in linkedIssuesOfAllRecursiveLimited(\"issue = MLCQ-103\", 1)"
  ]

 :project-content    []
 }

Output EDN file is processed by https://github.com/redstarssystems/gantt