#!/usr/bin/env bb

;; TODO: rewrite with fewer assumptions about the filesystem structure.  Perhaps
;; we can achieve near-atomicity by doing to bulk of the work with a function
;; `erase-home-darlings : FileSystem -> Maybe FileSystem`, which will not do any
;; IO.

;; TODO: option to either move OR copy

(require '[clojure.core.match :refer [match]]
         '[babashka.cli :as cli]
         '[clojure.pprint :as pp]
         '[clojure.tools.logging :as l]
         '[babashka.process :refer [shell check process] :as p])

(defn get-files [{:keys [rollback-to dataset]}]
  (let [snapshot (str dataset "@" rollback-to)
        diff (:out (shell {:out :string}
                          "zfs diff -HF"
                          snapshot
                          dataset))]
    ;; See zfs-diff(8) to understand what we're parsing here.
    (->> diff
         str/split-lines
         (map #(str/split % #"\s"))
         (filter #(and
                   ;; We only care to preserve /new/ content.
                   (contains? #{"+" "M"} (first %))
                   ;; We only bother with plain old files.  No directories,
                   ;; symlinks, etc.
                   (= (second %) "F")))
         (map #(nth % 2)))))

(defn move-out-of-my-way [file]
  ;; No TCO. }:<
  (let [maximum-attempts 50]
    (loop [n 0]
      (let [file' (format "%s-%d" file n)]
        (if (fs/exists? file')
          (do (printf (str "Failed to rename `%s' to `%s', "
                           "because the latter already exists.\n")
                      file file')
              (if (< n maximum-attempts)
                (recur (inc n))
                (do (printf (str "We've tried to rename `%s' %d "
                                 "without success.  This should "
                                 "never happen!  Abort!")
                            file (inc n))
                    (System/exit 127))))
          (do (fs/move file file')
              file'))))))

(defn archive-files [{:keys [archive-to]} files]
  (let [new-archive (fs/path archive-to "new-archive")]
    (when (fs/exists? new-archive)
      (println "Warning: `new-archive' already exists... we'll rename it for you?")
      (move-out-of-my-way new-archive))
    (doseq [file files]
      (let [destination (fs/path
                         new-archive
                         (fs/relativize "/home" (fs/parent file)))]
        (fs/create-dirs destination)
        (fs/move file destination)))))

;; FIXME: This code could be a lot easier on the eyes. }:\
(defn cycle-archives [{:keys [archive-to archive-limit]}]
  "Delete the oldest archive path, and increment each previous path by one.
More precisely,
 - Delete the archive path labeled `n` (the oldest allowed).
 - For each remaining path labeled 'i', relabel to 'i + 1'.
 - Lastly, we delete the path labeled `new-archive`, if it exists."
  (let [gp (memoize #(fs/path archive-to (str %)))]
    (when (fs/exists? (gp archive-limit))
      (fs/delete-tree (gp archive-limit)))
    (doseq [i (range (dec archive-limit) 0 -1)]
      (when (fs/exists? (gp i))
        (fs/move (gp i) (gp (inc i)))))
    (when (fs/exists? (gp "new-archive"))
      (fs/move (gp "new-archive") (gp 1)))))

(defn do-rollback [{:keys [dataset rollback-to]}]
  (let [proc (shell "zfs" "rollback" "-r" (str dataset "@" rollback-to))]
    (if (= (:exit proc) 0)
      (println (str "Successfully rolled back /home.  "
                    "Enjoy that fresh filesystem smell!  }:D"))
      (println "Something went wrong rolling back /home... D:{"))))

(def zfs-dataset?
  ;; We memoise an anonymous procedure because we want the command to be run on
  ;; the first invocation of `zfs-dataset?`, *not* when this file's top-level is
  ;; first evaluated.  Naïvely, it's reasonable to think we should instead do
  ;; something like
  ;;   (def zfs-dataset?
  ;;     (let [datasets <call zfs list>]
  ;;       (fn [x] (contains? datasets x))))
  ;; but that would call zfs (and potentially throw) far too early to make sense.
  (let [get-datasets (memoize
                      (fn []
                        (->> (:out (shell {:out :string} "ls" "-la"))
                             str/split-lines
                             (map #(first (str/split % #"\s")))
                             set)))]
    (fn [x]
      (contains? (get-datasets) x))))

(def cli-spec
  {:spec
   {:archive-limit {:coerce :int
                    :alias :n
                    :validate #(pos? %)
                    :default 3
                    :desc "Number of archives to save at a time."}
    :dataset {:coerce :string
              ;; :validate zfs-dataset?
              :require true
              :desc "Dataset to be archived and rolled back."}
    :rollback-to {:coerce :string
                  ;; TODO: Validate snapshot.
                  :require true
                  :desc "Snapshot to rollback to."}
    :archive-to {:coerce :string
                 :default "/persist/previous/home"
                 :desc "The path under which archives will be stored."}
    :error-fn
    (fn [{:keys [spec type cause msg option] :as data}]
      (when (= :org.babashka/cli type)
        (case cause
          :require
          (println
           (format "Missing required argument: %s\n" option))))
      (System/exit 1))}})

(defmacro with-echoed-shell-commands [& body]
  (let [print-cmd #(println (str "+ " (str/join (:cmd %))))]
    `(binding [p/*defaults* {:pre-start-fn ~print-cmd}]
             ~@body)))

(defmacro with-echoed-shell-commands [& body]
  `(do ~@body))

(defn -main [opts]
  (pp/pprint opts)
  (with-echoed-shell-commands
    (shell "mount" (:dataset opts) "/home")
    (let [files (get-files opts)]
      (archive-files opts files)
      (cycle-archives opts)
      (do-rollback opts))))

#_
(def fs-ops
  {:zfs {:get-files zfs-get-files
         :rollback zfs-rollback}})

#_
(defn -main [opts]
  (let [test-bin (fn [x]
                   (printf "%s: %s\n"
                           x (map str (fs/which-all x))))]
    (test-bin "mount")
    (test-bin "findmnt")
    (test-bin "zfs"))

  (shell "mount")
  (shell "ls -la /home"))

(-main (cli/parse-opts *command-line-args* cli-spec))