target determination for jujutsu and buck2

determinator.clj

(require '[babashka.cli :as cli])
(require '[babashka.fs :as fs])
(require '[babashka.process :as process])
(require '[clojure.data :as data])
(require '[clojure.set :as set])

(def cli-opts {
  :mode {:default "paths_and_contents"}
  :from {:coerce :string :require true}
  :to   {:coerce :string :default "@"}
  :help {:coerce :boolean}
})

;; `buck2 targets` outputs in a format like 'cell//path/to:target abcdefg' where
;; the second column is the hash; this parses that and returns an assoc that
;; maps target-name -> hash
(defn parse-target-hashes [ls]
  (loop [ks {}
         l (first ls)
         ls (rest ls)]
    (cond
      (nil? l) ks
      :else (let [[k v] (str/split l #"\s+")]
        (recur (assoc ks k v) (first ls) (rest ls))))))

;; run `buck2 targets` on the given directory, and return a map of target-name
;; -> hash
(defn buck2-target-hashes [dir opts]
  (let* [cmd ["buck2" "-v0" "targets"
              (str "--target-hash-file-mode=" (:mode opts))
              "--show-unconfigured-target-hash"
              ; TODO FIXME (aseipp): remove/consolidate repeated cell names
              "root//..." "third-party//..." "cellar//..." "tilde//..."]
         ls (-> (apply process/shell (concat [{:dir dir :out :string :err :string}] cmd)) :out str/split-lines)
         hs (parse-target-hashes ls)]
    ; NOTE (aseipp): kill the daemon before returning, so we don't pollute the
    ; users system to an insane degree
    (process/shell {:dir dir :out :string :err :string} "buck2" "kill")
    hs))

;; temporary name generator; used for workspace names
(defn gen-name [& {:keys [len] :or {len 12}}]
  (apply str (repeatedly len #(rand-nth "abcdeghijklmnopqrsuvwxyz0123456789"))))

;; get the change_id of a workspace
(defn get-workspace-cid [ws-name]
  (-> (process/shell
          {:out :string :err :string}
          "jj" "log" "--no-graph" "-T" "change_id" "-r" (str ws-name "@"))
      :out
      str/trim))

;; main entry point
(let [opts (cli/parse-opts *command-line-args* {:spec cli-opts})]
  (cond
    (:help opts) (prn opts) ; TODO FIXME (aseipp): implement
    :else
      (let [from-rev (:from opts)
            to-rev   (:to opts)

            rand-suffix (gen-name)
            basename    (str "td-" rand-suffix)
            from-name   (str basename "f")
            from-ws     (str "work/" from-name)
            to-name     (str basename "t")
            to-ws       (str "work/" to-name)]
        (println "Performing target determination, from base to given:")
        (println " ├─  base:" from-ws "⇜ " from-rev)
        (println " └─ given:" to-ws   "⇜ " to-rev)
        (println)

        (doseq [[name ws rev] [[from-name from-ws from-rev] [to-name to-ws to-rev]]]
          (process/shell {:out :string :err :string} "jj" "workspace" "add" "-r" rev ws)
         ;(println "Created workspace" name "at" (str ws ", r='" rev "'"))
          nil)
       ;(println)

        (println "Performing target hash comparison between workspaces...")
        (let [from-assoc (buck2-target-hashes from-ws opts)
              to-assoc   (buck2-target-hashes to-ws opts)
              [l r same] (data/diff from-assoc to-assoc)]
          (if (= [l r same] [nil nil from-assoc])
            (println "No target differences found.")
            (let [left-keys   (set (keys l))
                  right-keys  (set (keys r))
                  deleted-targets  (set/difference left-keys right-keys)
                  modified-targets (set/intersection left-keys right-keys)
                  added-targets    (set/difference right-keys left-keys)

                  display-targets (fn [name is-last targets]
                    (let [edge (if is-last "└" "├")
                          fork (if (= 0 (count targets)) "─" "┬")]
                      (println (str "   " edge "─" fork " " name ":") (count targets))
                      (if (not= 0 (count targets))
                        (loop [x (first targets)
                               xs (rest targets)]
                          (let [prefix (if is-last "     " "   │ ")]
                            (cond
                              (empty? xs) (println (str prefix "└─⇝  " x))
                              :else (do
                                (println (str prefix "├─⇝  " x))
                                (recur (first xs) (rest xs)))))))))]

              (println "Differences DETECTED:")
              (display-targets "DELETED"  false deleted-targets)
              (display-targets "MODIFIED" false modified-targets)
              (display-targets "ADDED"    true  added-targets))))
        (println)

        (let [from-cid (get-workspace-cid (str basename "f"))
              to-cid   (get-workspace-cid (str basename "t"))]
          (doseq [[name ws cid] [[(str basename "f") from-ws from-cid] [(str basename "t") to-ws to-cid]]]
            (println "Removing workspace" (str "'" name "'"))
            (process/shell {:out :string :err :string} "jj" "workspace" "forget" name)
            (println " ├─" (str "`jj abandon " cid "`"))
            (process/shell {:out :string :err :string} "jj" "abandon" cid)
            (println " └─ Deleting workspace tree" ws)
            (fs/delete-tree ws))
          (println "Done.")
          nil))))