(ns buddho.core.meta
  (:require [buddho.core.dhamma :as d]
            [buddho.core.state :as s]))

(s/describe-property! [:dhamma :singleton] "Dhamma is a singleton.")

(def empty-registry {:meta {}
                     :singletons {}
                     :singleton-fns {}})

(defonce registry (atom empty-registry))

(defn register-meta! [name & {:keys [aspects singleton-fn]}]
  (swap! registry update-in [:meta] assoc name
         {:aspects (or aspects {})
          :singleton (boolean singleton-fn)})
  (when singleton-fn
    (swap! registry update-in [:singleton-fns] assoc name singleton-fn)))

(defn instantiate-singletons! []
  (doseq [[name fun] (:singleton-fns @registry)]
    (when-not (-> @registry :singletons name)
      (let [dhamma (s/reference (fun))]
        (swap! registry update-in [:singletons] assoc name dhamma)
        (s/register-property! dhamma [:dhamma :singleton])))))

(defn free-singletons! []
  (doseq [[_name dhamma] (:singletons @registry)]
    (d/remove-dhamma! dhamma)))

(defn reset-registry! []
  (free-singletons!)
  (reset! registry empty-registry))

;; TODO proper error handling when registry not complete
(defn implement-aspects! []
  (doseq [[name meta] (:meta @registry)]
    (doseq [[stage asps] (:aspects meta)]
      (doseq [aspect asps]
        (let [singleton (get-in @registry [:singletons aspect])
              property (vec (concat stage [name]))]
          (d/register-aspect! singleton property))))))

(defn implement-meta! []
  (free-singletons!)
  (instantiate-singletons!)
  (implement-aspects!))
