edn-value-type.clj

(defprotocol SchemaRedirect
  (freeze [this v])
  (thaw [this v]))

(defmulti redirect identity)

(defmethod redirect :default [a]
  (reify SchemaRedirect
    (freeze [this v] v)
    (thaw [this v] v)))

(defmethod redirect :db.type/edn [a]
  (reify SchemaRedirect
    (freeze [this v] (when v (pr-str v)))
    (thaw [this v] (when v (read-string v)))))

(defmethod redirect :db.type/symbol [a]
  (reify SchemaRedirect
    (freeze [this v]
      (when v 
        (when-not (symbol? v)
          (throw (ex-info "Value is not a symbol" {:val v})))
        (pr-str v)))
    (thaw [this v] (when v (read-string v)))))

(defn attribute->redirect [db a]
  (some->> a
    (d/entid db)
    (d/entity db)
    :db/redirect
    redirect))

(defn ref-attribute? [db a]
  (or (#{:db/id} a)
      (->> a
        (d/entid db)
        (d/entity db)
        :db/valueType
        #{:db.type/ref}
        boolean)))

(defn many-attribute? [db a]
  (->> a
    (d/entid db)
    (d/entity db)
    :db/cardinality
    #{:db.cardinality/many}
    boolean))

(declare freeze*)
(declare thaw*)

(defn redirect-tx
  "Changes registered types into their base types"
  [db tx-data]
  (vec
    (for [d tx-data]
      (cond
        (vector? d)
        (let [[op e a v] d]
          [op e a (freeze* db a v)])

        (map? d)
        (let [id (:db/id d)]
          (as-> d %
            (dissoc % :db/id)
            (map (fn [[a v]] [a (freeze* db a v)]) %)
            (into {} %)
            (assoc % :db/id (freeze* db :db/id id))))
      
        :else
        (throw (UnsupportedOperationException.))))))

(deftype Entity [^datomic.Entity e]
  clojure.lang.Seqable
  (seq [this]
    (map (fn [[k v]]
           (clojure.lang.MapEntry. k (thaw* (.db e) k v)))
         (.seq ^clojure.lang.Seqable e)))

  clojure.lang.IPersistentCollection
  (count [this]
    (.count ^clojure.lang.IPersistentCollection e))
  (cons [this o]
    (.cons ^clojure.lang.IPersistentCollection e o))
  (empty [this]
    (.empty ^clojure.lang.IPersistentCollection e))
  (equiv [this o]
    (boolean
      (and (instance? Entity o)
           (.equiv ^clojure.lang.IPersistentCollection e (.e ^Entity o)))))
  
  clojure.lang.ILookup
  (valAt [this key]
    (let [val (.valAt ^clojure.lang.ILookup e key)]
      (thaw* (.db e) key val)))
  (valAt [this key notFound]
    (let [val (.valAt ^clojure.lang.ILookup e key ::not-found)]
      (if (= val ::not-found)
        notFound
        (thaw* (.db e) key val))))
  
  clojure.lang.Associative
  (containsKey [this key] (.containsKey ^clojure.lang.Associative e key))
  (entryAt [this key]
    (let [[k v] (.entryAt ^clojure.lang.Associative e key)]
      (clojure.lang.MapEntry. k (thaw* (.db e) k v))))
  (assoc [this key val]
    (.assoc ^clojure.lang.Associative e key (freeze* (.db e) key val)))
  
  datomic.Entity
  (db [this] (.db e))
  (get [this key]
    (let [val (.get e key)]
      (thaw* (.db e) key val)))
  (keySet [this]
    (.keySet e))
  (touch [this]
    (.touch e))
  
  Object
  (toString [this] (.toString e)))

(defn entity [db eid]
  (when-let [e (d/entity db eid)]
    (Entity. e)))

(defn freeze* [db a v]    
  (if-let [redirect (attribute->redirect db a)]
    (if (ref-attribute? db a)
      (if (vector? v)
        (let [[ident v'] v]
          [ident (freeze redirect v')])
        v)
      (freeze redirect v))
    v))

(defn thaw* [db a v]
  (if (ref-attribute? db a)
    (when v
      (if (many-attribute? db a)
        (map #(Entity. %) v)
        (Entity. v)))
    (if-let [redirect (attribute->redirect db a)]
      (thaw redirect v)
      v)))



(deftest test-redirect-tx
  (let [conn (new-db
               {:db/id (d/tempid :db.part/db)
                :db/ident :db/redirect
                :db/valueType :db.type/keyword
                :db/cardinality :db.cardinality/one
                :db.install/_attribute :db.part/db})
        _ @(d/transact conn [{:db/id (d/tempid :db.part/db)
                              :db/ident :node/value
                              :db/valueType :db.type/string
                              :db/redirect :db.type/edn
                              :db/cardinality :db.cardinality/one
                              :db.install/_attribute :db.part/db}])
        tx-data [{:db/id (d/tempid :db.part/user)
                  :node/value {:a [1 2 3 "foo"]}}]
        db (d/db conn)
        tx-data' (de/redirect-tx db tx-data)
        db' (:db-after @(d/transact conn tx-data'))
        [e] (first (q '{:find [?n]
                        :where [[?n :node/value]]}
                      db'))
        e' (de/entity db' e)]
    (is (= (keys e')
           '(:node/value)))
    (is (= (:node/value e')
           {:a [1 2 3 "foo"]}))))