(ns org.sonatype.maven.polyglot.clojure.dsl.writer
 (:use org.sonatype.maven.polyglot.clojure.dsl.util)
 (:use org.sonatype.maven.polyglot.clojure.dsl.pretty-printer))

;;; Copied from clojure-contrib to avoid the dependency

;; group-by written by Rich Hickey;
;; see http://paste.lisp.org/display/64190
(defn- group-by
  "Returns a sorted map of the elements of coll keyed by the result of
f on each element. The value at each key will be a vector of the
corresponding elements, in the order they appeared in coll."
  [f coll]
  (reduce
    (fn [ret x]
      (let [k (f x)]
        (assoc ret k (conj (get ret k []) x))))
    (sorted-map) coll))

; Most of these are generated by the defmodel-write macro
(defmulti reify-field-value class)

(defmethod reify-field-value java.util.Properties [value]
  (apply hash-map (apply concat (for [x (.entrySet value)] [(keyword (.getKey x)) (.getValue x)]))))

(defmethod reify-field-value :default [value] value)

(defn- reify-scalar-field [accum value kw]
  (if (nil? value)
    accum
    (merge { kw (reify-field-value value) } accum)))

(defn- reify-list-field [accum value kw]
  (if (or (nil? value) (.isEmpty value))
    accum
    (merge { kw (vec (map reify-field-value value)) } accum)))

(defn- properties-to-map [value]
    (apply hash-map (apply concat (for [x (.entrySet value)] [(keyword (.getKey x)) (.getValue x)]))))

(defn- reify-properties-field [accum value]
  (if (or (nil? value) (= 0 (.size value)))
    accum
    (merge accum { :properties (properties-to-map value) })))

(defn- child-nodes-can-be-simple-value-vector [parent]
  (let [required-name (singular-form-of-name (.getName parent))]
    (every?
      (fn [n] (and (= 0 (.getChildCount n)) (= required-name (.getName n))))
      (.getChildren parent))))

; TODO namespace names
; TODO attributes
(defn- reify-xml-value [value]
  [ (keyword (.getName value))
   (cond
     (= 0 (.getChildCount value)) (str (.getValue value))

     (child-nodes-can-be-simple-value-vector value)
     (vec (map #(.getValue %) (.getChildren value)))

     :else (vec (map reify-xml-value (.getChildren value))))])

(defn- class-has-property? [klass property-name]
  (try (.getMethod klass (str "get" (capitalize-first-letter property-name)) nil)
    (catch NoSuchMethodException ex false)))

(defn- xml-nodes-all-safe-to-hoist [object nodes]
  (not (some #(class-has-property? (class object) (.getName %)) nodes)))

(defn- xml-nodes-all-safe-for-map [nodes]
  (every? #(= 0 (count (.getAttributeNames %))) nodes))

(defn- reify-configuration-field [accum value object]
  (cond
    (or (nil? value) (= 0 (.getChildCount value))) accum
    
    (xml-nodes-all-safe-to-hoist object (.getChildren value))
    (merge accum (apply hash-map (apply concat (map reify-xml-value (.getChildren value)))))

    (xml-nodes-all-safe-for-map (.getChildren value))
    (merge accum { :configuration (apply hash-map (apply concat (map reify-xml-value (.getChildren value)))) })

    :else (merge accum { :configuration (vec (map reify-xml-value (.getChildren value))) })
    ))

(defn- reify-dependency-group [accum value kw]
  (if value
    (merge accum { kw value })
    accum))

(defn- reify-dependencies-field [accum value]
  (let [scopes (group-by (fn [dep] (or (.getScope dep) "compile")) value)]
    (->
      accum
      (reify-list-field (scopes "compile") :dependencies)
      (reify-list-field (scopes "test") :test-dependencies)
      (reify-list-field (scopes "provided") :provided-dependencies)
      (reify-list-field (scopes "runtime") :runtime-dependencies)
      (reify-list-field (scopes "system") :system-dependencies))))

(defn- reify-field [accum object descriptor]
  (let [name (capitalize-first-letter (.getName descriptor))
        kw (keyword (from-camel-case name))
        value (.invoke (.getReadMethod descriptor) object (make-array Object 0))]
    (cond
      (= name "Properties") (reify-properties-field accum value)
      (= name "Dependencies") (reify-dependencies-field accum value)
      (= name "Configuration") (reify-configuration-field accum value object)
      (instance? java.util.List value) (reify-list-field accum value kw)
      :else (reify-scalar-field accum value kw))))

(defn- reify-fields [object]
  (let [introspector (java.beans.Introspector/getBeanInfo (class object))
        descriptors (.getPropertyDescriptors introspector)
        writable-descriptors (filter #(.getWriteMethod %) descriptors)]
    (reduce (fn [accum d] (reify-field accum object d)) {} writable-descriptors)))

(defn- remove-default-fields [fields defaults]
  (reduce (fn [f [k v]] (if (or (= v (f k)) (= v :any)) (dissoc f k) f)) fields defaults))

(defn- map-to-vector-with-order [a-map order]
  (let [reducer (fn [[head mid tail] key]
                  (if (= key :*)
                    [tail mid head]
                    (if (contains? mid key)
                      [head (dissoc mid key) (conj (conj tail key) (key mid))]
                      [head mid tail])))
        [head mid tail] (reduce reducer [[] a-map []] order)]
    (concat head (apply concat (vec mid)) tail)))

(defn- convert-fields-to-vector [fields field-order]
  (let [artifact-id (:artifact-id fields)
        [header f] (if artifact-id
                     (let [group-id (:group-id fields)
                           ga-symbol (list 'quote (if (or (nil? group-id) (= group-id artifact-id))
                                                    (symbol artifact-id)
                                                    (symbol group-id artifact-id)))
                           version (:version fields)]
                       [(if version [ga-symbol version] [ga-symbol])
                        (dissoc fields :group-id :artifact-id :version)])
                     [[] fields])]
    (vec (concat header (map-to-vector-with-order f field-order)))))

; TODO: hoist configuration after removing default fields so that hoisted
; configuration keys don't accidentally removed.
(defn- reify-model-object [object default-fields field-order]
  (convert-fields-to-vector (remove-default-fields (reify-fields object) default-fields) field-order))

(defmacro defmodel-writer [class-name default-fields field-order]
  (let [full-class-name (str "org.apache.maven.model." class-name)]
    `(defmethod reify-field-value ~(symbol full-class-name) [v#]
       (reify-model-object v# ~default-fields ~field-order))))

; These may need to be refined further on a per-object basis
(def *field-defaults*
  {:inherited true
   :type "jar"
   :priority 0
   :optional false
   :extensions false
   :model-encoding "UTF-8"})

(def *field-order* [])

(defmodel-writer Activation *field-defaults* *field-order*)
(defmodel-writer ActivationFile *field-defaults* *field-order*)
(defmodel-writer ActivationOS *field-defaults* *field-order*)
(defmodel-writer ActivationProperty *field-defaults* *field-order*)
(defmodel-writer Build *field-defaults* *field-order*)
(defmodel-writer BuildBase *field-defaults* *field-order*)
(defmodel-writer CiManagement *field-defaults* *field-order*)
(defmodel-writer Contributor *field-defaults* *field-order*)
(defmodel-writer Dependency (merge {:scope :any} *field-defaults*) *field-order*)
(defmodel-writer DependencyManagement *field-defaults* *field-order*)
(defmodel-writer DeploymentRepository *field-defaults* *field-order*)
(defmodel-writer Developer *field-defaults* *field-order*)
(defmodel-writer DistributionManagement *field-defaults* *field-order*)
(defmodel-writer Exclusion *field-defaults* *field-order*)
(defmodel-writer Extension *field-defaults* *field-order*)
(defmodel-writer IssueManagement *field-defaults* *field-order*)
(defmodel-writer License *field-defaults* *field-order*)
(defmodel-writer MailingList *field-defaults* *field-order*)

(defmodel-writer Model *field-defaults*
  [:model-version :name :description :packaging :properties 
   :dependencies :test-dependencies :runtime-dependences :provided-dependencies :system-dependencies
   :* :build])

(defmodel-writer Notifier *field-defaults* *field-order*)
(defmodel-writer Organization *field-defaults* *field-order*)
(defmodel-writer Parent *field-defaults* *field-order*)
(defmodel-writer Plugin *field-defaults* [ :* :executions ])
(defmodel-writer PluginExecution *field-defaults* [ :id :phase :goals :* ])
(defmodel-writer PluginManagement *field-defaults* *field-order*)
(defmodel-writer Prerequisites *field-defaults* *field-order*)
(defmodel-writer Profile *field-defaults* *field-order*)
(defmodel-writer Relocation *field-defaults* *field-order*)
(defmodel-writer ReportPlugin *field-defaults* *field-order*)
(defmodel-writer ReportSet *field-defaults* *field-order*)
(defmodel-writer Reporting *field-defaults* *field-order*)
(defmodel-writer Repository (merge { :layout "default" } *field-defaults*) [ :id :url :* ])
(defmodel-writer RepositoryPolicy *field-defaults* *field-order*)
(defmodel-writer Resource *field-defaults* *field-order*)
(defmodel-writer Scm *field-defaults* *field-order*)
(defmodel-writer Site *field-defaults* *field-order*)

(defn write-model [#^org.apache.maven.model.Model model #^java.io.Writer writer]
  (print-object-to-writer (list* 'defmaven (reify-field-value model)) writer)
  (.flush writer))