kapluni
11/30/2012 - 3:02 PM

Hierarchies in Datomic

Hierarchies in Datomic

[
 {:db/id #db/id [db.part/db]
  :db/ident :section/name
  :db/valueType :db.type/string
  :db/unique :db.unique/value
  :db/cardinality :db.cardinality/one
  :db.install/_attribute :db.part/db}
 {:db/id #db/id [db.part/db]
  :db/ident :section/parent
  :db/valueType :db.type/ref
  :db/cardinality :db.cardinality/one
  :db.install/_attribute :db.part/db}
 {:db/id #db/id [db.part/db]
  :db/ident :section/sort
  :db/valueType :db.type/long
  :db/cardinality :db.cardinality/one
  :db.install/_attribute :db.part/db}]

[
  {:db/id #db/id [:db.part/user -1]  :section/name "ROOT"}
  {:db/id #db/id [:db.part/user -10] :section/parent #db/id [:db.part/user -1]  :section/name "A"       :section/sort 1}
  {:db/id #db/id [:db.part/user -11] :section/parent #db/id [:db.part/user -10] :section/name "A/A"     :section/sort 2}
  {:db/id #db/id [:db.part/user -12] :section/parent #db/id [:db.part/user -10] :section/name "A/B"     :section/sort 1}
  {:db/id #db/id [:db.part/user -13] :section/parent #db/id [:db.part/user -12] :section/name "A/B/A"   :section/sort 2}
  {:db/id #db/id [:db.part/user -14] :section/parent #db/id [:db.part/user -12] :section/name "A/B/B"   :section/sort 1}
  {:db/id #db/id [:db.part/user -15] :section/parent #db/id [:db.part/user -14] :section/name "A/B/B/A" :section/sort 1}]
(use 'datomic.samples.repl)
(easy!)

(def conn (scratch-conn))
(transact-all conn (io/resource "day-of-datomic/outline.dtm"))

(def rules
  '[[(ancestors ?section ?ancestor) [?section :section/parent ?ancestor]]
    [(ancestors ?section ?ancestor) [?section :section/parent ?parent]
     (ancestors ?parent ?ancestor)]
    [(descendants ?section ?descendant) [?descendant :section/parent ?cat]]
    [(descendants ?section ?descendant) [?child :section/parent ?cat]
     (descendants ?child ?descendant)]])

(def root (find-by (d/db conn) :section/name "ROOT"))

(def abba (find-by (d/db conn) :section/name "A/B/B/A"))

; ancestors of abba
(d/q '[:find
       ?name
       :in $ % ?start
       :where
       (ancestors ?start ?a)
       [?a :section/name ?name]]
     (d/db conn)
     rules
     (:db/id abba))

; descendants of root
(d/q '[:find
       ?name
       :in $ % ?start
       :where
       (descendants ?start ?d)
       [?d :section/name ?name]]
     (d/db conn)
     rules
     (:db/id root))

(d/q '[:find
       ?name ?sort ?p
       :in $ % ?start
       :where
       (descendants ?start ?d)
       [?d :section/name ?name]
       [?d :section/sort ?sort]
       [?d :section/parent ?p]]
     (d/db conn)
     rules
     (:db/id root))

(defn render [node sort-key]
  (when (:section/_parent node)
    [:ul
     (for [kid (sort-by sort-key (:section/_parent node))]
       (vector :li (:section/name kid) (render kid sort-key)))]))

(def expected-result
  '[:ul
    [:li "A"
     [:ul
      [:li "A/B"
       [:ul
        [:li "A/B/B"
         [:ul
          [:li "A/B/B/A"]]]
        [:li "A/B/A"]]]
      [:li "A/A"]]]])

(require '[hiccup.core :as h])
(=
 (h/html (render root :section/sort))
 (h/html expected-result))