Don't read this

git.clj

#!/usr/bin/env bb

; Explanation for the `mini-stats` command in this script:
; - I customised my shell prompt to show the output of `git.clj mini-stats .`
;
; - Then I get in my prompt information like:
;   `main` - if the current branch is main and there are no unpushed changes, in any branch.
;
;   Or something more complicated like:
;   `main 2/4/hack(2),bugfix(5)`
;   Meaning that:
;   - the current branch is main
;   - there are 2 untracked files
;   - there are 4 modified but not-committed files
;   - there are 2 unpushed commits on branch `hack`
;   - there are 5 unpushed commits on branch `bugfix`

(ns henri.bin.git)

(load-file (str (System/getenv "HOME") "/bin/utils.clj"))

(require '[babashka.deps :as deps])
(deps/add-deps '{:deps {selmer {:mvn/version "1.12.52"}}})

(require
 '[babashka.fs :as fs]
 '[babashka.process :as p]
 '[clojure.string :as str]
 '[taoensso.timbre :as timbre :refer [spy]]
 '[henri.bin.utils :refer [exit pather home home-path]])

(def script-name (fs/file-name *file*))

(def cache-path (pather home ".cache" script-name))
(def src-path (pather home "src"))

(defn- sh-or-throw [& cmd]
  #_(spy p/*defaults*)
  (let [proc (p/process cmd {:out :string})
        status (:exit @proc)]
    (if (zero? status)
      @proc
      (throw (ex-info (str "exit " status) {})))))

(defn- sh-out
  "Returns trimmed stdout for command, exception on failure"
  [& argv]
  (let [res (apply sh-or-throw argv)
        out (:out res)]
    (when-not (empty? out)
      (str/trim out))))

(defmacro with-dir
  [dir & forms]
  `(binding [p/*defaults* (merge p/*defaults*
                                 ; FIXME multiple evals of dir
                                 {:dir (if (string? ~dir)
                                         ~dir
                                         (str ~dir))})]
     ~@forms))

(defn- git-url-for-dir
  "Returns url or nil"
  [dir]
  (let [config (fs/path dir ".git" "config")]
    (when (fs/exists? config)
      (let [_ (->> config str slurp)]
        (->> config
             str
             slurp
             (re-find #"\s+url\s*=\s*([^\s]+)\s+")
             second)))))

(defn- git-branches-stats
  "Returns seq of maps with stats about each branch"
  [dir]
  (letfn [(branch-stats [local remote]
            (with-dir dir
              (let [cmd ["git" "rev-list" "--left-right" (str local "..." remote) "--"]
                    out (apply sh-out cmd)]
                (when out
                  (let [lines (str/split out #"\n")
                        ;_ (spy lines)
                        count-prefix (fn [lines prefix]
                                       (count (filter #(str/starts-with? % prefix)
                                                      lines)))
                        ahead (count-prefix lines "<")
                        behind (count-prefix lines ">")]
                    {:ahead ahead
                     :behind behind
                     :local local
                     :remote remote})))))]
    (with-dir dir
      (let [; [[local remote] ...]
            local-remotes (when-let [out (sh-out "git" "for-each-ref"
                                                 "--format=%(refname:short) %(upstream:short)"
                                                 "refs/heads")]
                            (map #(str/split % #"\s+")
                                 (str/split out #"\n")))
            branches-stats (map #(let [[local remote] %]
                                   (branch-stats local remote))
                                local-remotes)]
        (filter boolean branches-stats)))))

(defn- git-stats
  "Returns map describing dir state"
  [dir]
  (with-dir dir
    (let [branches-stats (git-branches-stats dir)
          branch (let [out (or (sh-out "git" "branch") "")
                       lines (str/split out #"\n")
                       current-line (filter #(str/starts-with? % "*") lines)]
                   (when (seq current-line)
                     (second (str/split (first current-line) #"\s+"))))
          status-lines (if-let [out (sh-out "git" "status" "-s")]
                         (str/split out #"\n")
                         [])
          untracked (if-let [out (sh-out "git" "status" "-s")]
                      (count (filter #(str/starts-with? % "?")
                                     (str/split out #"\n")))
                      0)
          modified (- (count status-lines) untracked)]
      {:branches-stats branches-stats
       :branch branch
       :modified modified
       :untracked untracked})))

(defn- parse-dir-git
  "Returns map with some git stats, or nil if not a git repo"
  [dir]
  (when (fs/exists? (fs/path dir ".git"))
    (let [stats (git-stats dir)
          ;_ (spy stats)
          {branches-stats :branches-stats
           branch :branch
           modified :modified
           untracked :untracked} stats
          branches-stats (filter #(> (:ahead %) 0) branches-stats)
          branch-aheads (map :ahead branches-stats)
          total-branch-ahead (apply + branch-aheads)
          ahead-summary (when (seq branches-stats)
                          (str/join "," (map #(str (:local %) "(" (:ahead %) ")") branches-stats)))
          total-issues (+ modified untracked total-branch-ahead)]
      {:branch branch
       :branches-stats branches-stats
       :total-issues total-issues
       :modified modified
       :untracked untracked
       :ahead-summary ahead-summary
       :total-branch-ahead total-branch-ahead})))

(defn- parse-dir
  "Returns [type long-msg short-msg]"
  [dir]
  (let [dir (sh-out "readlink" "-f" dir)
        stats (parse-dir-git dir)]
    (cond
      (str/ends-with? dir "-tmp") [:throwaway-dir "throwaway dir" nil]
      (not stats) [:no-git-dir "no git" nil]
      (not (git-url-for-dir dir)) [:no-remote-dir "no remote" nil]
      :else (let [{branch :branch
                   _branches-stats :branches-stats
                   total-issues :total-issues
                   modified :modified
                   untracked :untracked
                   ahead-summary :ahead-summary
                   _total-branch-ahead :total-branch-ahead} stats]
              (if (pos-int? (+ untracked modified (if ahead-summary 1 0)))
                [:unpushed-dir
                 (str total-issues " changes: " branch "/" untracked "/" modified "/" (or ahead-summary 0)
                      #_"\tbranch/untracked/modified/commits ahead")
                 (str branch " " untracked "/" modified "/" (or ahead-summary "0"))]
                [:pushed-dir
                 (str "0 changes: " branch " branch")
                 branch])))))

(defn check-dir
  "WARNING don't fuck it up, dangerous - used atm by alias `srm`, maybe by other things
   Exits 0 if deletable, else exits 1"
  [dir]
  (let [[type long-msg _short-msg] (parse-dir dir)]
    (case type
      :pushed-dir (exit 0 long-msg)
      :throwaway-dir (exit 0 long-msg)
      (exit 1 long-msg))))

(defn- print-dirs-stats [& dirs]
  (let [prefix? (> (count dirs) 1)]
    (doseq [dir dirs]
      (let [[type long-msg _short-msg] (parse-dir dir)]
        (when-not (some #{type} [:throwaway-dir :pushed-dir])
          (println (str (if prefix?
                          (str dir ": \n\t")
                          "")
                        long-msg)))))))

(defn- print-mini-stats [dir]
  (let [[_ _ short-msg] (parse-dir dir)]
    (when short-msg
      (println short-msg))))

(defn- git-status [dirs]
  (let [parsed-dirs (map parse-dir dirs)
        with-issues (filter #(some #{(first %)} [:no-git-dir :no-remote-dir :unpushed-dir])
                            parsed-dirs)
        issues-count (count with-issues)]
    (println (if (zero? issues-count)
               "ok"
               (str issues-count " dirty")))))

(defn- commit-push []
  (let [{branches-stats :branches-stats
         modified :modified} (git-stats ".")]
    (when-not (zero? (:exit @(p/process ["git" "status" "-s"]
                                        {:inherit true})))
      (exit 1 "git status error"))
    (when-not (or (seq branches-stats) (> modified 0))
      (exit 0 "Nothing to push"))
    (let [p (p/process ["git" "diff"] {:inherit true})
          status (:exit @p)]
      (when-not (zero? status)
        (exit 1 "git diff error")))
    (print "Commit and push? (y/n) ")
    (flush)
    (when (= (read) 'y)
      (when (zero? (:exit @(p/process ["git" "commit" "-amx"]
                                      {:inherit true})))
        @(p/process ["git" "push"]
                    {:inherit true})))
    (sh-or-throw "status_bar.clj" "trigger" "git")
    nil))

(when (= *file* (System/getProperty "babashka.file"))
  (let [[cmd & args] *command-line-args*
        default-dirs (list* (home-path) (fs/list-dir (home-path "src")))]
    (case cmd
      "mini-stats" (apply print-mini-stats args)
      "stats" (apply print-dirs-stats (or args default-dirs))
      "status" (git-status default-dirs)
      "check-dir" (apply check-dir args)
      "commit-push" (commit-push)
      ; for dev
      "parse-git-dir" (prn (parse-dir-git (first args)))
      "git-branches-stats" (prn (git-branches-stats (first args)))
      "git-stats" (prn (git-stats (first args)))
      "parse-dir" (prn (parse-dir (first args)))
      (println (str script-name ": unknown command: " cmd)))))