(ns microformats.parser
  (:require [net.cgrand.enlive-html :as html]
            [clojure.zip :as z]
            [clojure.core.reducers :as r]
            [clojure.string :as str]
            [clojurewerkz.urly.core :as url]))

(defmacro anacond
  [& clauses]
  (when clauses
    (list 'if-let ['% (first clauses)]
          (if (next clauses)
            (second clauses)
            (throw (IllegalArgumentException.
                    "anacond requires an even number of forms")))
          (cons 'anacond (next (next clauses))))))

(defn prefixed-by?
  [prefix]
  #(.startsWith % prefix))

(defn remove-mf-prefix
  "Remove microformats prefixes from a class attribute"
  [prefix]
  #(apply str (drop (count prefix) %)))

(defn- split-ws-attribute
  "Split a whitespace-separated attribute."
  [class]
  (str/split class #"\s+"))

(defn classes-to-props
  "Convert class list to list of microformat property keywords"
  [prefix]
  (comp (r/map keyword)
        (r/map (remove-mf-prefix prefix))
        (r/filter (prefixed-by? prefix))))

(defn element-to-classes
  "Get list of classes from an element"
  [el] (some-> el
               :attrs
               :class
               split-ws-attribute))

(defn element-to-rels
  "Get list of rels from an element"
  [el] (-> el
           :attrs
           :rel
           split-ws-attribute))

(defn- node-to-html
  "Turn a node into a list of HTML strings"
  [el]
  (map #(if (string? %)
          %
          (apply str (persistent! (html/emit-tag % (transient []))))) el))

(defn- node-to-text
  "Turn a node into a text string"
  [content]
  (->> content
       html/texts
       (map #(str/replace % #"\s+" " "))
       (apply str)
       str/trim))

(defn get-base-url
  "Find the base-url of a document."
  [document]
  (or (-> document
          (html/select [:head :> [:base (html/attr? :href)]])
          first
          :attrs
          :href)
      ""))

(defn normalise-url
  "Normalise a URL"
  [root url]
  (url/resolve (get-base-url root) url))

(defn get-value-class
  "Get the value class of elements"
  [elements]
  (str/join " " (into [] ((comp (r/map (partial apply str))
                                (r/map node-to-text)
                                (r/map :content))
                          elements))))

(defn find-value-class
  "Find and get the value class of elements"
  [el]
  (when-let [values (seq (html/select el [html/root :> :.value]))]
    (get-value-class values)))

(declare parse-h)

(defn get-child-mf-properties
  [element]
  (assoc (parse-h element) :value (-> element :content node-to-text)))

(defn remove-property-classes
  [element]
  (into {} (html/transform (list element) [html/root]
                           (apply html/remove-class (filter (prefixed-by? "p-")
                                                            (element-to-classes element))))))

(defn- find-child-mf
  "Find child property microformats of an element."
  [element]
  (when (-> element :attrs :class (.indexOf "h-") (>= 0))
    (-> element remove-property-classes get-child-mf-properties)))

(defn get-p-value
  "Get the p-x property value of an element"
  [el]
  (or (find-child-mf el)
      (str/trim (or (find-value-class el)
                    (case (:tag el)
                      :img (-> el :attrs :alt)
                      :area (-> el :attrs :alt)
                      :abbr (-> el :attrs :title)
                      :data (-> el :attrs :value)
                      :input (-> el :attrs :value)
                      nil)
                    (node-to-text (:content el))
                    ""))))

(defn get-u-value
  "Get the u-x property value of an element"
  [el]
  (str/trim (or (find-value-class el)
                (case (:tag el)
                  :a (-> el :attrs :href)
                  :area (-> el :attrs :href)
                  :img (-> el :attrs :src)
                  :object (-> el :attrs :data)
                  (get-p-value el))
            (node-to-text (:content el))
            "")))

(defn get-dt-value
  "Get the dt-x property value of an element"
  [el]
  (str/trim (or (find-value-class el)
                (case (:tag el)
                  :time (-> el :attrs :datetime)
                  :ins  (-> el :attrs :datetime)
                  :del  (-> el :attrs :datetime)
                  :abbr (-> el :attrs :title)
                  :data (-> el :attrs :value)
                  :input (-> el :attrs :value)
                  nil)
                (node-to-text (:content el))
                "")))

(defn get-e-value
  "Get the e-x propery value of an element"
  [el]
  (let [content (:content el)]
    (list {:html (apply str (node-to-html content))
           :value (apply str (node-to-text content))})))

(defn parse-p
  "Parse p-* classes within HTML element."
  [element]
  (->> element
       element-to-classes
       ((classes-to-props "p-"))
       (r/map #(hash-map % (list (get-p-value element))))
       (into {})))

(defn parse-u
  "Parse u-* classes within HTML element"
  [element]
  (->> element
       element-to-classes
       ((classes-to-props "u-"))
       (r/map #(hash-map % (list (get-u-value element))))
       (into {})))

(defn parse-dt
  "Parse dt-* classes within HTML element"
  [element]
  (->> element
       element-to-classes
       ((classes-to-props "dt-"))
       (r/map #(hash-map % (list (get-dt-value element))))
       (into {})))

(defn parse-e
  "Parse e-* classes within HTML element"
  [element]
  (->> element
       element-to-classes
       ((classes-to-props "e-"))
       (r/map #(hash-map % (get-e-value element)))
       (into {})))

(defn- get-mf-names
  "Get the microformat names from an element"
  [element]
  (->> element
       element-to-classes
       (filter (prefixed-by? "h-"))))

(defn- parse-implied-name
  "Get the implied name of an entity"
  [element]
  (case (:tag element)
    :abbr (-> element :attrs :title)
    :img (-> element :attrs :alt)
    (anacond
     (first (html/select element [html/root :> [:img html/only-child]]))
     (-> % :attrs :alt)
     (first (html/select element [html/root :> [:abbr html/only-child (html/attr? :title)]]))
     (-> % :attrs :title)
     (first (html/select element [html/root :> html/only-child :> [:img html/only-child]]))
     (-> % :attrs :alt)
     (first (html/select element [html/root :> html/only-child :> [:abbr html/only-child (html/attr? :title)]]))
     (-> % :attrs :title)
     true (node-to-text (:content element)))))

(defn- parse-implied-url
  [element]
  (case (:tag element)
    :a (-> element :attrs :href)
    (if-let [% (first (html/select element [html/root :> [:a (html/attr? :href) html/only-of-type (html/but-node (html/attr-contains :class "h-"))]]))]
      (-> % :attrs :href))))

(defn- parse-implied-photo
  [element]
  (case (:tag element)
    :img (-> element :attrs :src)
    :object (-> element :attrs :data)
    (anacond
     (first (html/select element [html/root :> [:img (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
     (-> % :attrs :src)
     (first (html/select element [html/root :> [:object (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
     (-> % :attrs :data)
     (first (html/select element [html/root :> html/only-child :> [:img (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
     (-> % :attrs :src)
     (first (html/select element [html/root :> html/only-child :> [:object (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
     (-> % :attrs :data)
     )))

(def empty-ish
  #(not (str/blank? (first (second %)))))

(defn parse-implied
  "Parse implied properties of a HTML element"
  [element]
  (into {} (filter empty-ish
                   {:name (list (parse-implied-name element))
                    :url (list (parse-implied-url element))
                    :photo (list (parse-implied-photo element))})))

(defn- select-p
  [element] (html/select element [[(html/but-node #{:br :hr}) (html/attr-contains :class "p-")]]))

(defn- select-u
  [element] (html/select element [[(html/but-node #{:br :hr}) (html/attr-contains :class "u-")]]))

(defn- select-dt
  [element] (html/select element [[(html/but-node #{:br :hr}) (html/attr-contains :class "dt-")]]))

(defn- select-e
  [element] (html/select element [[(html/but-node #{:br :hr}) (html/attr-contains :class "e-")]]))

(defn get-mf-properties
  "Parse children of a microformat, returning a map of properties"
  [element]
  (let [cappend (partial merge-with concat)]
    (merge (parse-implied element)
           (apply cappend (map parse-p (select-p element)))
           (apply cappend (map parse-u (select-u element)))
           (apply cappend (map parse-dt (select-dt element)))
           (apply cappend (map parse-e (select-e element))))))

(defn parse-h
  "Parse h-* classes within a HTML element."
  [element]
  (hash-map :type (get-mf-names element)
            :properties (get-mf-properties element)))

(defn map-h
  "Map fn to top-level h-* elements within a HTML element."
  [fn loc]
  (if (some->> loc z/node :attrs :class (re-matcher #"(?:^|\s) h-\w"))
    (list (fn (z/node loc)))
    (when (not (z/end? loc))
      (recur fn (z/next loc)))))

(defn parse-rel
  "Parse rel attributes of an HTML link element"
  [element]
  (->> element
       element-to-rels
       (map keyword)
       (map #(hash-map % [(-> element :attrs :href)]))
       (into {})))

(defn select-rels
  "Select linking HTML elements with rel attributes"
  [html] (html/select html [[#{:a :link} (html/attr? :rel)]]))

(defn parse-rels
  "Parse rel attibutes of a set of HTML link elements"
  [elements]
  (or (apply merge-with into (map parse-rel (select-rels elements))) {}))

(defn parse
  "Parse a HTML string with microformats"
  [html]
  (let [document (html/html-snippet (str/trim html))]
    {:items (some->> document first z/xml-zip (map-h parse-h)) :rels (parse-rels document)}))