tray_tail.clj

#!/usr/bin/env bb
(ns tray-tail
  (:require [clojure.java.io :as io]
            [clojure.string :as str]
            [cheshire.core :as json]
            [babashka.http-client :as http])
  (:import (java.io File)
           (java.net URLEncoder)
           (java.time ZonedDateTime)
           (java.time.format DateTimeFormatter)
           (java.util.regex Pattern)))

(defn read-conf-file [v]
  (let [candidates [["$XDG_CONFIG_HOME" "labtail" v]
                    ["$HOME" ".config" "labtail" v]
                    ["$HOME" (str "." v)]]
        resolve-env (fn [p]
                      (if (str/starts-with? p "$")
                        (System/getenv (subs p 1))
                        p))
        cand->file (fn [x] (str/join File/separator (map resolve-env x)))
        conf-file (->> (map cand->file candidates)
                       (filter #(.exists (io/file %)))
                       first)]
    (if conf-file
      (str/trim (slurp conf-file))
      (do (println "Could not read config file" v)
          (println "Tried:")
          (doseq [cand candidates]
            (println (str/join File/separator cand)))
          nil))))

(defn strip-trailing-slash [v]
  (when v
    (if (str/ends-with? v "/")
      (subs v 0 (dec (count v)))
      v)))

(defn gitlab-token
  []
  (read-conf-file "gitlab-token"))

(defn all-parents [^File fil]
  (lazy-seq
    (cons (.getAbsoluteFile fil)
          (some->> (.getAbsoluteFile fil)
                   (.getParentFile)
                   (all-parents)))))

(defn git-config-file [& [^String wd]]
  (let [^String wd (or wd (System/getenv "PWD"))]
    (some->> (all-parents (File. wd))
             (map #(io/file ^File % ".git/config"))
             (filter #(.exists ^File %))
             (first))))

(defn git-host-group-and-project-name [line]
  (cond
    (str/starts-with? line (str \tab "url = git@"))
    (let [rest-line (subs line (count (str \tab "url = git@")))]
      [{:host (first (str/split rest-line (Pattern/compile (Pattern/quote ":"))))
        :project (-> rest-line
                     (str/split (Pattern/compile (Pattern/quote ":")))
                     (second)
                     (str/split (Pattern/compile (Pattern/quote ".git")))
                     (first))
        :line line}])

    :else nil))

(defn deduce-project-settings [& [wd]]
  (some->> (git-config-file wd)
           (slurp)
           (str/split-lines)
           (mapcat git-host-group-and-project-name)
           (first)))

(defn deduce-project-name [& [wd]]
  (get (deduce-project-settings) :project))

(defn gitlab-https-host
  []
  (str "https://"
       (strip-trailing-slash (get (deduce-project-settings) :host))))

(defn uri-encode
  [string]
  (some-> string str (URLEncoder/encode "UTF-8") (.replace "+" "%20")))

(def status->color
  {"created" "orange"
   "waiting_for_resource" "orange"
   "preparing" "orange"
   "pending" "orange"
   "running" "orange"
   "success" "green"
   "failed" "red"
   "canceled" "green"
   "skipped" "green"
   "manual" "green"
   "scheduled" "green"})

(def pat (DateTimeFormatter/ofPattern "yyyy-MM-dd HH:mm:ss"))

(defn info [& args]
  (apply println (into [(.format pat (ZonedDateTime/now))] args)))

(defn error [& args]
  (apply println (into [(.format pat (ZonedDateTime/now))] args)))

(defn poll-once []
  (let [url (str (gitlab-https-host)
                 "/api/v4/projects/"
                 (uri-encode (:project (deduce-project-settings)))
                 "/pipelines")
        resp (try
               (http/get url {:headers {"PRIVATE-TOKEN" (gitlab-token)
                                        "Accept" "application/json"}})
               (catch Throwable t
                 {:status 0}))]
    (when-not (= 200 (:status resp))
      (info url "=> HTTP status" (:status resp)))
    (let [{:keys [web_url status]} (first (json/parse-string (:body resp) keyword))]
      (info "status is" status)
      (if-let [color (get status->color status)]
        (http/get (str "http://localhost:17999/api?img=" color "&link=" web_url))
        (info "unhandled status:" (pr-str status)))
      (Thread/sleep 1000)
      (when (not= status "success")
        (recur)))))

; printf "$HOME/code/tray-tail/src/tray_tail.clj" | entr -r tray_tail.clj

(defn main
  "Entrypoint for labtail app"
  [args]
  (info "tray-tail Starting ...")

  (when-not (gitlab-https-host)
    (info "Please create config file")
    (System/exit 1))
  (when-not (gitlab-token)
    (info "Please create token file")
    (System/exit 1))
  #_(let [start-time (System/currentTimeMillis)])
        ;uptime-ms (fn [] (- (System/currentTimeMillis) start-time))]
  (while true
    (try
      (poll-once)
      (catch Throwable t
        (error "Poller crashed with message:" (ex-message t))
        (Thread/sleep 1000))))
  (info "Exiting..."))

(when (contains? (System/getProperties) "babashka.version")
  (main (into (sorted-set) *command-line-args*)))