recursive-unions.cljs

(ns ontotype.core
  (:require [goog.dom :as gdom]
            [om.next :as om :refer-macros [defui]]
            [om.dom :as dom]
            [sablono.core :refer-macros [html]]
            [datascript.core :as d]))

(enable-console-print!)

;;;; Datascript ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def entity-schema {:db/valueType :db.type/ref
                    :db/cardinality :db.cardinality/many})

(def schema {:content entity-schema})

(def conn (d/create-conn schema))

(d/transact! conn
  [{:db/id -1
    :type :doc
    :title "Prototype Document"
    :content [-2 -3 -4]}
   {:db/id -2
    :type :table
    :title "Table"
    :data [1 2 3 4 5]}
   {:db/id -3
    :type :image
    :title "Image"
    :data ":D"
    :caption "Woot!"}
   {:db/id -4
    :type :section
    :title "Section"
    :content [-5]}
   {:db/id -5
    :type :narrative
    :title "Narrative"
    :text "Some more text."}])

;;;; Parser ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn event->value
  [e]
  (.. e -target -value))

(def type-q
  '[:find ?id .
    :in $ ?type
    :where
    [?id :type ?type]])

(defn pull-refs
  [state k id]
  (k (d/pull (d/db state) [{k [:db/id :type]}] id)))

(defmulti read*
  "These methods implement general recursive query parsing. When a
  union is encountered it is bound to a key, and all subsequent joins
  on that key are treated as unions. This allows for recursive union
  parsing via the `...' expression. These methods do not yet
  implement query parameters, however a user can explicitly handle
  specific keys by defining a `read' method (see :root below)."
  (fn [{:keys [query ast db/id]} k _]
    (println id k ast)                    ; DEBUG
    (cond
      (nil? query)      :property
      (map? query)      :union
      (vector? query)   :join
      :else             :default)))

(defmethod read* :property
  [{:keys [state db/id]} k _]
  {:value (k (d/pull (d/db state) [k] id))})

(defmethod read* :join
  [{:keys [state parser query unions db/id] :as env} k _]
  (let [union-q (k unions)
        parse (fn [{:keys [db/id type]}]
                (let [q (if union-q (type union-q) query)]
                  (parser (assoc env :db/id id) q)))]
    {:value (mapv parse (pull-refs state k id))}))

(defmethod read* :union
  [{:keys [state parser query unions db/id] :as env} k _]
  (let [env' (assoc-in env [:unions k] query)
        parse (fn [{:keys [db/id type]}]
                (parser (assoc env' :db/id id) (type query)))]
    {:value (mapv parse (pull-refs state k id))}))

(defmethod read* :default
  [_ _ _]
  {:value :no-value})

(defmulti read om/dispatch)

(defmethod read :root
  [{:keys [state parser query] :as env} _ _]
  (let [id (d/q type-q (d/db state) :doc)
        env' (-> env (dissoc :query) (assoc :db/id id))]
    {:value (parser env' query)}))

(defmethod read :default
  [env k params]
  (read* env k params))

(defmulti mutate om/dispatch)

(defmethod mutate 'attr/edit
  [{:keys [state]} _ {:keys [id val attr]}]
  {:action #(d/transact! state [{:db/id id attr val}])})

;;;; Components ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defui Image
  static om/Ident
  (ident [this {:keys [db/id]}]
    [:db/id id])
  static om/IQuery
  (query [this]
    [:db/id :type :title :data :caption])
  Object
  (render [this]
    (let [{:keys [db/id title data caption]} (om/props this)]
      (html
        [:div
         [:h4 title]
         [:h4 data]
         [:p caption]]))))

(def image (om/factory Image))

(defui Narrative
  static om/Ident
  (ident [this {:keys [db/id]}]
    [:db/id id])
  static om/IQuery
  (query [this]
    [:db/id :type :title :text])
  Object
  (render [this]
    (let [{:keys [db/id title text]} (om/props this)]
      (html
        [:input {:value text
                 :on-change #(om/transact! this
                               `[(attr/edit ~{:val (event->value %)
                                              :id id
                                              :attr :text})])}]))))

(def narrative (om/factory Narrative))

(defui Table
  static om/Ident
  (ident [this {:keys [db/id]}]
    [:db/id id])
  static om/IQuery
  (query [this]
    [:db/id :type :title :data])
  Object
  (render [this]
    (let [{:keys [title data]} (om/props this)]
      (html
        [:div
         [:h4 title]
         [:div (str data)]]))))

(def table (om/factory Table))

(declare cont)

(defui Section
  static om/Ident
  (ident [this {:keys [db/id]}]
    [:db/id id])
  static om/IQuery
  (query [this]
    [:db/id :type :title :index {:content '...}])
  Object
  (render [this]
    (let [{:keys [title index content]} (om/props this)]
      (html
        [:div
         [:h2 (str title " " index)]
         (map cont content)]))))

(def section (om/factory Section))

(defui Content
  static om/Ident
  (ident [this {:keys [db/id]}]
    [:db/id id])
  static om/IQuery
  (query [this]
    (zipmap
      [:narrative :table :image :section]
      [(om/get-query Narrative)
       (om/get-query Table)
       (om/get-query Image)
       (om/get-query Section)]))
  Object
  (render [this]
    (let [{:keys [type]} (om/props this)]
      (({:narrative narrative
         :table table
         :image image
         :section section}
        type)
       (om/props this)))))

(def cont (om/factory Content))

(defui Doc
  static om/Ident
  (ident [this {:keys [db/id]}]
    [:db/id id])
  static om/IQuery
  (query [this]
    [:db/id :type :title {:content (om/get-query Content)}])
  Object
  (render [this]
    (let [{:keys [title content]} (om/props this)]
      (html
        [:div
         [:h1 title]
         (map cont content)]))))

(def doc (om/factory Doc))

(defui Root
  static om/IQuery
  (query [this]
    [{:root (om/get-query Doc)}])
  Object
  (render [this]
    (let [{:keys [root]} (om/props this)]
      (doc root))))

(def reconciler
  (om/reconciler
    {:state conn
     :parser (om/parser {:read read :mutate mutate})}))

(om/add-root! reconciler Root (gdom/getElement "app"))