(ns buddho.core.state
  (:require [clojure.set :refer [intersection]]
            [clojure.string :as str]))

(def empty-state
  {:_properties {}
   :_descriptions
   {:_properties "Property-to-idea mapping."
    :property {}
    :property_fns {}}})

(defonce state
  (atom empty-state))

(defprotocol Idea
  (fn-liberal [idea fn]
    "Apply function `fn` to `idea`,
accepting both identifiers and values for the latter;
mind that keys are functions.")
  (reference [idea] "Reference, i.e. symbol, for `idea`.")
  (value [idea] "Value, i.e. map, of `idea`."))

(extend-protocol Idea
  cljs.core/PersistentHashMap
  (fn-liberal [dhamma fn]
    (fn dhamma))
  (reference [idea] (:_reference idea))
  (value [idea] idea)

  cljs.core/PersistentArrayMap
  (fn-liberal [dhamma fn]
    (fn dhamma))
  (reference [idea] (:_reference idea))
  (value [idea] idea)

  Symbol
  (fn-liberal [idea fn]
    (fn-liberal (value idea) fn))
  (reference [idea] idea)
  (value [idea] (get @state idea)))

(defn apply-fn [fn idea] (fn-liberal idea fn))

;; TODO better error handling
(defn copy [idea] (assoc (value idea) :_reference nil))

(defn- register-idea! [iid]
  (swap! state assoc-in [iid :_properties] #{})
  (swap! state assoc-in [iid :_reference] iid)
  iid)

(defn properties [idea]
  (:_properties (value idea)))

(defn with-property [property]
  (get-in @state (concat [:_properties] property [:_node])))

(defn has-property? [idea property]
  (contains? (properties idea) property))

(defn have-idea! [& [prefix count]]
  (let [pf (or prefix "idea_")
        fun #(register-idea! (gensym pf))]
    (if-not count
      (fun)
      (take count (repeatedly fun)))))

(defn update-idea! [idea data]
  (swap! state update idea merge data)
  idea)

(defn register-property! [idea & properties]
  (let [property (first properties)
        tail (rest properties)
        iid (reference idea)]
    (when property
      (reduce (fn [acc property]
                (swap! state update-in (conj acc property :_node) (fnil conj #{}) iid)
                (swap! state update-in [iid :_properties] (fnil conj #{}) (conj (vec (rest acc)) property))
                (conj acc property))
              [:_properties] property))
    (when tail
      (run! #(register-property! idea %) tail))
    idea))

(defn- remove-property-node! [idea property]
  (swap! state update-in
         (concat [:_properties] property [:_node])
         disj (reference idea)))

(defn child-properties [property]
  (map #(conj property %)
       (-> @state :_properties (get-in property)
           keys set (disj :_node))))

(defn- rm-prop! [idea property]
  (let [;; XXX can also be done using prefix checking if slow
        children (intersection
                  (set (child-properties property))
                  (properties idea))]
    (swap! state update-in [idea :_properties] disj property)
    (remove-property-node! idea property)
    (run! #(rm-prop! idea %) children)))

(defn remove-property! [idea & properties]
  (let [property (first properties)
        tail (rest properties)
        iid (reference idea)]
    (when property
      (rm-prop! iid property))
    (when tail
      (run! #(rm-prop! iid %) tail))))

(defn forget-idea! [idea]
  (let [iid (reference idea)]
    (apply remove-property! iid (properties idea))
    (swap! state dissoc iid)))

(defn elem [idea element]
  (get (value idea) element))

(defn rm-elem! [idea & elements]
  (run! #(swap! state update idea dissoc %) elements))

(defn describe-property! [property description & [fun]]
  (swap! state assoc-in [:_descriptions :property property] description)
  (when fun
    (swap! state assoc-in [:_descriptions :property-fn property] fun)))

(defn describe-dhamma! [dh-kw description]
  (swap! state assoc-in [:_descriptions :dhamma dh-kw] description))

(defn prop-desc [prop & [idea]]
  (let [desc (get-in @state [:_descriptions :property prop])]

    (if-let [fun (get-in @state [:_descriptions :property-fn prop])]
      (str desc "\n" (fun idea))
      desc)))

(defn dh-desc [dh-kw]
  (get-in @state [:_descriptions :dhamma dh-kw]))

(defn singleton-value [property]
  (when-let [idea (first (with-property property))]
    (value idea)))

;; TODO error handling in case multiple singletons/exact match
(defn set-singleton! [property data]
  (let [idea (or (singleton-value property) (have-idea!))]
    (update-idea! idea data)
    (register-property! idea property)))

(defn reset-state! []
  (reset! state empty-state)
  (describe-property! [:_properties] "Property-to-idea mapping.")
  (describe-property! [:_reference] "Lookup key for idea.")
  (describe-property! [:_aspect_of] "Dhamma: Aspect properties this is an aspect of.")
  (describe-property! [:dhamma] "Idea is a dhamma." #(str "teste")))
