(ns leiningen.debian.dh-clojure-lein
  "A leiningen middleware to help adjust upstream projects for debian.

  See dh-clojure-lein(7) for more information."
  (:require
   [clojure.edn :as edn]
   [clojure.java.io :as io]
   [clojure.pprint :refer [pprint]]
   [clojure.set :as set]
   [clojure.string :as str]
   [leiningen.core.classpath :as classpath]
   [leiningen.core.main :as main]
   [leiningen.core.project :as proj])
  (:import
   [java.io FileNotFoundException PushbackReader]))

;; We assume that data is strictly validated "at the edges", e.g. when
;; the data is read from the config file it must be strictly validated
;; so that all subsequent code may assume it's in a valid format.

(defn- abort [& msg] (apply main/abort "dh-clojure-lein:" msg))
(defn- info [& msg] (apply main/info "dh-clojure-lein:" msg))
(defn- debug [& msg] (apply main/debug "dh-clojure-lein:" msg))

(defn- validate-top-edit [k v path]
  (let [invalid #(abort "invalid :edit" (pr-str v) "of" (pr-str k) "in" (pr-str path))]
    (cond
      (= v '-) true
      (vector? v)
      (let [[op & args] v]
        (case op
          (+ =) (when-not (= 1 (count args)) (invalid))
          (invalid)))
      :else (invalid))))

(defn- validate-dep-opts [opts allowed-key? mod? where path]
  (assert (sequential? opts))
  (when (seq opts)
    (when (odd? (count opts))
      (abort "odd number of dependency options in" (pr-str where)
             "in" (pr-str path)))
    (when-not (every? keyword? (take-nth 2 opts))
      (abort "non-keyword option names in" (pr-str where) "in" (pr-str path)))
    (let [m (apply hash-map opts)]
      (when-not (= (count m) (/ (count opts) 2))
        (abort "duplicate dependency options in" (pr-str where)
               "in" (pr-str path)))
      (when-let [invalid (seq (set/difference (-> m keys set) allowed-key?))]
        (abort "invalid dependency" (if (= (count invalid) 1) "option" "options")
               (str/join " "invalid)
               "in" (pr-str where) "in" (pr-str path)))
      (doseq [opt [:classifier :extension]
              :when (contains? m opt)
              :let [v (opt m)]]
        (if (nil? v)
          (when-not mod?
            (abort "nil" (name opt) "in" (pr-str where) "in" (pr-str path)))
          (when-not (string? v)
            (abort "non-string" (name opt) "in" (pr-str where) "in" (pr-str path)))))
      (when (contains? m :exclusions)
        (let [ex (m :exclusions)]
          (if (nil? ex)
            (when-not mod?
              (abort "nil exclusions in" (pr-str where) "in" (pr-str path)))
            (do
              (when-not (vector? ex)
                (abort "non-vector exclusions in" (pr-str where) "in" (pr-str path)))
              (when-not (every? symbol? ex)
                (abort "non-symbol exclusions in" (pr-str where) "in" (pr-str path))))))))))

(defn- validate-dep-key-spec [s where path]
  (or (symbol? s)
      (do
        (when-not (vector? s)
          (abort "non-vector dependency in" (pr-str where) "in" (pr-str path)))
        (when (empty? s)
          (abort "empty dependency in" (pr-str where) "in" (pr-str path)))
        (when-not (-> s first symbol?)
          (abort "non-symbol artifact id" (pr-str where) "in" (pr-str path)))
        (when (> (count s) 1)
          (validate-dep-opts (rest s) #{:classifier :extension} false where path)))))

(defn- validate-dep-spec [s mod? where path]
  (or (symbol? s)
      (do
        (when-not (vector? s)
          (abort "non-vector dependency in" (pr-str where) "in" (pr-str path)))
        (when (empty? s)
          (abort "empty dependency in" (pr-str where) "in" (pr-str path)))
        (when-not (-> s first symbol?)
          (abort "non-symbol artifact id" (pr-str where) "in" (pr-str path)))
        ;; version is required when not a modification
        (when-not mod?
          (when-not (> (count s) 1)
            (abort "dependency missing version in" (pr-str where) "in" (pr-str path)))
          (when-not (-> s second string?)
            (abort "dependency version not string in" (pr-str where) "in" (pr-str path))))
        (when mod?
          (when-not (> (count s) 1)
            (abort "dependency modification has no changes" (pr-str where) "in" (pr-str path)))
          (when-not (or (-> s second string?)
                        (-> s second keyword?))
            (abort "second argument not version string or option key in"
                   (pr-str where) "in" (pr-str path))))
        (validate-dep-opts (drop (if (-> s second string?) 2 1) s)
                           #{:classifier :exclusions :extension} mod?
                           where path))))

(defn- validate-deps-edit [edits path]
  (when-not (vector? edits)
    (abort "non-vector :dependencies :edit in" (pr-str path)))
  (doseq [edit edits]
    (when-not (vector? edit)
      (abort "non-vector :dependencies :edit" (pr-str edit) "in" (pr-str path)))
    (when (zero? (count edit))
      (abort "empty :dependencies :edit" (pr-str edit) "in" (pr-str path)))
    (case (first edit)
      - (do
          (when-not (and (= 2 (count edit)))
            (abort "more than one argument in" (pr-str edit) "in" (pr-str path)))
          (validate-dep-key-spec (second edit) edit path))
      + (do
          (when-not (and (= 2 (count edit)))
            (abort "more than one argument in" (pr-str edit) "in" (pr-str path)))
          (validate-dep-spec (second edit) false edit path))
      = (do
          (when-not (and (= 2 (count edit)))
            (abort "more than one argument in" (pr-str edit) "in" (pr-str path)))
          (validate-dep-spec (second edit) true edit path))
      (abort "unrecognized :dependencies :edit operator" (pr-str edit) "in" (pr-str path)))))

(defn- validate-config [config path]
  (when-not (map? config) (abort "spec in" (pr-str path) "is not a map"))
  (when-not (some-> config :debian.dh-clojure-lein/version zero?)
    (abort "missing or incorrect debian.dh-clojure-lein/version in" (pr-str path)))
  (when-let [unexpected (seq (set/difference (-> config keys set)
                                             #{:debian.dh-clojure-lein/version
                                               :project}))]
    (abort "unexpected top-level keys" (pr-str unexpected) "in" (pr-str path)))
  (doseq [[proj spec] (:project config)]
    (when-not (symbol? proj)
      (abort "project name" (pr-str proj) "is not a symbol in" (pr-str path)))
    (when-let [unexpected (-> spec (dissoc :edit) keys seq)]
      (abort "unexpected keys" unexpected "in" proj "project spec in" (pr-str path)))
    (when-not (map? (:edit spec))
      (abort "project" proj ":edit is not a map in" (pr-str path)))
    (doseq [[k v] (:edit spec)]
      (case k
        ;; FIXME: managed-dependencies plugins?
        (:dependencies :managed-dependencies :plugins) (validate-deps-edit v path)
        (validate-top-edit k v path))))
  config)

(defn read-config [rdr path]
  (let [eof (Object.)
        read-edn (fn read-edn []
                   (try
                     (edn/read {:eof eof} rdr)
                     ;; throws these for say unmatched delimiters
                     (catch RuntimeException ex
                       (abort (pr-str path) "read failed;" (.getMessage ex)))))
        config (read-edn)]
    (when (= config eof)
      (abort "empty config file" (pr-str path)))
    (when-not (= eof (read-edn))
      (abort "more than one form in" (pr-str path)))
    (validate-config config path)
    config))

(defn- adjust-deps [deps]
  (->> deps (mapv proj/dependency-map) (mapv proj/dependency-vec)))

(defn edit-any
  [proj what how]
  (let [op (if (sequential? how) (first how) how)]
    (case op
      - (if-not (contains? proj what)
          (abort "- applied to missing" what "key")
          (dissoc proj what))
      + (if (contains? proj what)
          (abort "+ applied to existing" what "key")
          (assoc proj what (second how)))
      = (if-not (contains? proj what)
          (abort "= applied to missing" what "key")
          (assoc proj what (second how)))
      (abort "unrecognized edit" (pr-str how) "requested for" (pr-str what)))))

(defn dep-map-key [m]
  ;; See proj/dep-key
  (select-keys m [:group-id :artifact-id :classifier :extension]))

(defn dep-vecs->map [deps]
  (reduce (fn add-dep-map [m dep]
            (let [dm (proj/dependency-map dep)]
              (assoc m (dep-map-key dm) dm)))
          {}
          deps))

(defn map->dep-vecs [m]
  (mapv proj/dependency-vec (vals m)))

(defn normalize-dep [dep]
  ;; leiningen can handle a missing version, but always expects a vec
  (if (symbol? dep) [dep] dep))

(defn dep- [m dep-vec]
  (let [k (-> dep-vec normalize-dep proj/dep-key)]
    (when-not (contains? m k)
      (abort "- applied to missing dependency" (pr-str dep-vec)))
    (dissoc m k)))

(defn dep+ [m dep-vec]
  (let [dm (-> dep-vec normalize-dep proj/dependency-map)
        dk (dep-map-key dm)]
    (when (contains? m dk)
      (abort "+ applied to existing dependency" (-> dep-vec first pr-str)))
    (assoc m dk dm)))

(defn dep= [m dep-vec]
  (let [dm (-> dep-vec normalize-dep proj/dependency-map)
        dk (dep-map-key dm)]
    (doseq [x [:classifier :extension]]
      (when (nil? (get dk x :nope))
        (abort "= dependency edit" x "cannot be nil")))
    (when-not (contains? m dk)
      (abort "= applied to missing dependency" (pr-str dep-vec)))
    (update m dk
            (fn [cur-dm]
              (reduce-kv
               (fn apply-dep=-edit [result opt v]
                 (case opt
                   (:artifact-id :group-id) result
                   ;; spec with no :version produces a nil dm :version
                   :version (if-not v result (assoc result opt v))
                   :exclusions
                   (if-not (seq v)
                     (dissoc result opt)
                     (assoc result opt v))
                   (:classifier :extension)
                   (do
                     ;; should be impossible (checked in the key above)
                     (assert (not (nil? v)))
                     (assoc result opt v))))
               cur-dm
               dm)))))

(defn edit-dep [m [op & args]]
  (case op
    - (apply dep- m args)
    + (apply dep+ m args)
    = (apply dep= m args)))

(defn edit-deps-map [m edits]
  (reduce edit-dep m edits))

(defn set-default-dep-map-versions [dep-map]
  (reduce-kv (fn set-default-version [result dep-k info]
               (assoc result dep-k
                      (assoc info :version
                             (case [(:group-id dep-k) (:artifact-id dep-k)]
                               ["org.clojure" "clojure"] "1.x"
                               "debian"))))
             {} dep-map))

(defn set-default-dep-versions [dep-vecs]
  (-> dep-vecs dep-vecs->map set-default-dep-map-versions map->dep-vecs))

(defn set-default-versions
  [proj]
  (cond-> proj
    (contains? proj :dependencies) (update :dependencies set-default-dep-versions)
    (contains? proj :managed-dependencies) (update :managed-dependencies set-default-dep-versions)
    (contains? proj :plugins) (update :plugins set-default-dep-versions)))

(defn edit-deps [proj what edits]
  ;; Assume we know what and edits are valid constructs
  (assoc proj what
         (-> proj what dep-vecs->map (edit-deps-map edits) map->dep-vecs)))

(defn apply-edits
  [proj spec]
  (letfn [(edit [proj what how]
            (if (#{:dependencies :managed-dependencies :plugins} what)
              (edit-deps proj what how)
              (edit-any proj what how)))]
    (reduce-kv edit proj (:edit spec))))

(defn adjust-project
  [proj spec]
  (-> proj set-default-versions (apply-edits spec)))

(defn middleware
  [project]
  (let [config-path "debian/dh-clojure-lein.edn"
        rdr (try (io/reader config-path) (catch FileNotFoundException _))
        config (when rdr
                 (with-open [rdr (PushbackReader. rdr)]
                   (read-config rdr config-path)))
        name-sym (symbol (project :group) (project :name))
        spec (some-> config :project (get name-sym))]
    (if-not spec
      (info "no" name-sym "config (applying defaults)")
      (do
        (info "found" name-sym "config")
        (when main/*debug*
          (debug (str/trim-newline (with-out-str (pprint spec)))))))
    (let [project (adjust-project project spec)]
      (when main/*debug*
        (debug "adjusted project")
        (main/debug (str/trim-newline (with-out-str (pprint project)))))
      project)))
