Permalink
Browse files

Merge branch 'f/edge-types' into develop

  • Loading branch information...
2 parents 4a8dd3b + 0743cfe commit b59aacb29e0ed45de7128563e80c2a3c9fb249f1 @amalloy amalloy committed Jun 8, 2012
Showing with 185 additions and 89 deletions.
  1. +2 −2 project.clj
  2. +3 −2 src/jiraph/delete.clj
  3. +0 −9 src/jiraph/formats.clj
  4. +6 −5 src/jiraph/merge.clj
  5. +68 −0 src/jiraph/typed.clj
  6. +59 −56 src/jiraph/wrapped_layer.clj
  7. +47 −15 test/jiraph/formats_test.clj
View
@@ -1,7 +1,7 @@
-(defproject jiraph "0.8.0-beta5"
+(defproject jiraph "0.8.0-beta6"
:description "embedded graph db library for clojure"
:dependencies [[clojure "1.4.0"]
- [useful "0.8.2-alpha2"]
+ [useful "0.8.3-alpha3"]
[masai "0.7.0-alpha9"]
[cereal "0.2.0-alpha3"]
[ordered "1.2.2"]
View
@@ -1,8 +1,9 @@
(ns jiraph.delete
- (:use jiraph.layer retro.core
- [jiraph.core :only [layer]]
+ (:use [jiraph.core :only [layer]]
+ [jiraph.layer :only [Basic Optimized get-node]]
[jiraph.utils :only [meta-keyseq? edges-keyseq deleted-edge-keyseq deleted-node-keyseq]]
[jiraph.wrapped-layer :only [defwrapped]]
+ [retro.core :only [dotxn]]
[useful.map :only [map-vals-with-keys update update-in*]]
[useful.fn :only [fix fixing]]
[useful.utils :only [adjoin]]
View
@@ -59,15 +59,6 @@
vals)))
(frame identity identity))))))
-(def ^{:dynamic true, :doc "When bound to false, codecs created by wrap-typing will ignore types."}
- *honor-layer-types* true)
-
-(defn wrap-typing [format-fn accept-id?]
- (fn [opts]
- (when (or (not *honor-layer-types*)
- (accept-id? (:id opts)))
- (format-fn opts))))
-
(defn special-codec [format key]
(or (get format key)
(get format :codec)))
View
@@ -1,5 +1,5 @@
(ns jiraph.merge
- (:use jiraph.layer retro.core
+ (:use [jiraph.layer :only [Basic Optimized query-fn get-node]]
[jiraph.core :only [layer]]
[jiraph.utils :only [meta-keyseq? meta-id? meta-id base-id edges-keyseq]]
[jiraph.wrapped-layer :only [defwrapped]]
@@ -9,7 +9,8 @@
[useful.utils :only [adjoin verify]]
[useful.datatypes :only [assoc-record]]
[ego.core :only [type-key]])
- (:require [jiraph.graph :as graph]))
+ (:require [jiraph.graph :as graph]
+ [retro.core :as retro]))
(declare merge-ids merge-head merge-position)
@@ -132,7 +133,7 @@
(verify (not tail-merged)
(format "cannot merge %s into %s because %1$s is already merged into %s"
tail-id head-id tail-merged))
- (let [revision (current-revision merge-layer)
+ (let [revision (retro/current-revision merge-layer)
tail-ids (cons tail-id (merged-into merge-layer tail-id))]
(reduce (fn [layer [pos id]]
(graph/update-node layer id adjoin
@@ -150,7 +151,7 @@
(merge-node! *default-merge-layer-name* head-id tail-id))
([merge-layer head-id tail-id]
(let [merge-layer (fix merge-layer keyword? layer)]
- (dotxn merge-layer
+ (retro/dotxn merge-layer
(merge-node merge-layer head-id tail-id)))))
(defn- delete-merges-after
@@ -189,7 +190,7 @@
(unmerge-node! *default-merge-layer-name* head-id tail-id))
([merge-layer head-id tail-id]
(let [merge-layer (fix merge-layer keyword? layer)]
- (dotxn merge-layer
+ (retro/dotxn merge-layer
(unmerge-node merge-layer head-id tail-id)))))
(def ^{:private true} sentinel (Object.))
View
@@ -0,0 +1,68 @@
+(ns jiraph.typed
+ (:use [jiraph.core :only [layer]]
+ [jiraph.layer :only [Basic Optimized Schema get-node schema update-fn assoc-node!]]
+ [jiraph.utils :only [meta-keyseq? edges-keyseq deleted-edge-keyseq deleted-node-keyseq]]
+ [jiraph.wrapped-layer :only [defwrapped]]
+ [retro.core :only [dotxn]]
+ [clojure.core.match :only [match]]
+ [useful.map :only [map-vals-with-keys update update-in*]]
+ [useful.fn :only [fix fixing]]
+ [useful.utils :only [adjoin]]
+ [useful.experimental :only [prefix-lookup]]
+ [useful.datatypes :only [assoc-record]])
+ (:require [jiraph.graph :as graph]))
+
+(defn edge-validator [layer id]
+ (or ((:type-lookup layer) id)
+ (throw (IllegalArgumentException. (format "%s is not a valid node on layer %s"
+ id (pr-str layer))))))
+
+(defn validate-edges [layer from-id to-ids valid?]
+ (when-let [broken-edges (seq (remove valid? to-ids))]
+ (throw (IllegalArgumentException.
+ (format "%s can't have edges to %s on layer %s"
+ from-id (pr-str broken-edges) (pr-str layer))))))
+
+;; the multimap is for bookkeeping/reference only; the type-lookup function is derived from it at
+;; construction time, and is always used instead because it is much faster. type-lookup is a
+;; function taking a node-id and returning (if the node's type is valid as a from-edge on this
+;; layer) another function. That function takes in a node-id and returns truthy iff it is a valid
+;; destination node for an edge from the first node-id.
+(defwrapped TypedLayer [layer type-multimap type-lookup]
+ Basic
+ (assoc-node! [this id attrs]
+ (validate-edges this id (keys (:edges attrs)) (edge-validator this id))
+ (assoc-node! layer id attrs))
+
+ Optimized
+ (update-fn [this keyseq f]
+ (when-let [layer-update-fn (update-fn layer keyseq f)]
+ (if (meta-keyseq? keyseq)
+ layer-update-fn
+ (let [from-id (first keyseq)
+ validate-edge (edge-validator this from-id)]
+ (if-let [get-edge-ids (match (rest keyseq)
+ ([] :seq) (comp keys :edges)
+ ([:edges] :seq) keys
+ ([:edges to-id & _] :seq) (constantly [to-id]))]
+ (if-not (= adjoin f)
+ (throw (IllegalArgumentException.
+ (format "Can't guarantee typing of %s on typed layer" f)))
+ (fn [arg]
+ (validate-edges this from-id (get-edge-ids arg) validate-edge)
+ (layer-update-fn arg)))
+ layer-update-fn)))))
+
+ Schema
+ (schema [this node-id]
+ (when (type-lookup node-id)
+ (schema layer node-id))))
+
+(defn typed-layer [base-layer types]
+ (TypedLayer. base-layer types
+ (prefix-lookup (for [[from-type to-types] types]
+ [from-type (prefix-lookup (for [to-type to-types]
+ [to-type true]))]))))
+
+(defn without-typing [^TypedLayer typed-layer]
+ (.layer typed-layer))
@@ -1,62 +1,65 @@
(ns jiraph.wrapped-layer
- (:use [useful.map :only [merge-in]]
+ (:use jiraph.layer retro.core
+ [useful.map :only [merge-in]]
+ [useful.datatypes :only [assoc-record]]
[useful.experimental.delegate :only [parse-deftype-specs emit-deftype-specs]]))
-(def default-specs
- (parse-deftype-specs
- '(Object
- (toString [this] (pr-str this))
-
- Enumerate
- (node-id-seq [this] (node-id-seq layer))
- (node-seq [this] (node-seq layer))
-
- Basic
- (get-node [this id not-found] (get-node layer id not-found))
- (assoc-node! [this id attrs] (assoc-node! layer id attrs))
- (dissoc-node! [this id] (dissoc-node! layer id))
-
- Optimized
- (query-fn [this keyseq not-found f] (query-fn layer keyseq not-found f))
- (update-fn [this keyseq f] (update-fn layer keyseq f))
-
- Layer
- (open [this] (open layer))
- (close [this] (close layer))
- (sync! [this] (sync! layer))
- (optimize! [this] (optimize! layer))
- (truncate! [this] (truncate! layer))
-
- Schema
- (schema [this id] (schema layer id))
- (verify-node [this id attrs] (verify-node layer id attrs))
-
- ChangeLog
- (get-revisions [this id] (get-revisions layer id))
- (get-changed-ids [this rev] (get-changed-ids layer rev))
-
- WrappedTransactional
- (txn-wrap [this f]
- (let [wrapped (txn-wrap layer ; let layer wrap transaction, but call f with this
- (fn [_]
- (f this)))]
- (fn [layer]
- (wrapped (:layer layer)))))
-
- Revisioned
- (at-revision [this rev] (assoc-record this :layer (at-revision layer rev)))
- (current-revision [this] (current-revision layer))
-
- OrderedRevisions
- (max-revision [this] (max-revision layer))
-
- Preferences
- (manage-changelog? [this] (manage-changelog? layer))
- (manage-incoming? [this] (manage-incoming? layer))
- (single-edge? [this] (single-edge? layer)))))
-
-(defmacro defwrapped [name fields & specs]
+(defn default-specs [layer-sym]
+ (let [layer-key (keyword layer-sym)]
+ (parse-deftype-specs
+ `(Object
+ (toString [this#] (pr-str this#))
+
+ Enumerate
+ (node-id-seq [this#] (node-id-seq ~layer-sym))
+ (node-seq [this#] (node-seq ~layer-sym))
+
+ Basic
+ (get-node [this# id# not-found#] (get-node ~layer-sym id# not-found#))
+ (assoc-node! [this# id# attrs#] (assoc-node! ~layer-sym id# attrs#))
+ (dissoc-node! [this# id#] (dissoc-node! ~layer-sym id#))
+
+ Optimized
+ (query-fn [this# keyseq# not-found# f#] (query-fn ~layer-sym keyseq# not-found# f#))
+ (update-fn [this# keyseq# f#] (update-fn ~layer-sym keyseq# f#))
+
+ Layer
+ (open [this#] (open ~layer-sym))
+ (close [this#] (close ~layer-sym))
+ (sync! [this#] (sync! ~layer-sym))
+ (optimize! [this#] (optimize! ~layer-sym))
+ (truncate! [this#] (truncate! ~layer-sym))
+
+ Schema
+ (schema [this# id#] (schema ~layer-sym id#))
+ (verify-node [this# id# attrs#] (verify-node ~layer-sym id# attrs#))
+
+ ChangeLog
+ (get-revisions [this# id#] (get-revisions ~layer-sym id#))
+ (get-changed-ids [this# rev#] (get-changed-ids ~layer-sym rev#))
+
+ WrappedTransactional
+ (txn-wrap [this# f#]
+ (fn [layer#] ; stolen from masai-layer: see relevant comments there
+ (let [wrapped# (txn-wrap ~layer-sym
+ (fn [_#]
+ (f# layer#)))]
+ (wrapped# (~layer-key layer#)))))
+
+ Revisioned
+ (at-revision [this# rev#] (assoc-record this# ~layer-key (at-revision ~layer-sym rev#)))
+ (current-revision [this#] (current-revision ~layer-sym))
+
+ OrderedRevisions
+ (max-revision [this#] (max-revision ~layer-sym))
+
+ Preferences
+ (manage-changelog? [this#] (manage-changelog? ~layer-sym))
+ (manage-incoming? [this#] (manage-incoming? ~layer-sym))
+ (single-edge? [this#] (single-edge? ~layer-sym))))))
+
+(defmacro defwrapped [name [wrapped-layer-fieldname :as fields] & specs]
`(defrecord ~name [~@fields]
~@(emit-deftype-specs
- (merge-in default-specs
+ (merge-in (default-specs wrapped-layer-fieldname)
(parse-deftype-specs specs)))))
@@ -6,6 +6,7 @@
[jiraph.layer :as layer]
[jiraph.graph :as graph]
[jiraph.codex :as codex]
+ [jiraph.typed :as typing]
[masai.tokyo :as tokyo]
[ego.core :as ego]
[jiraph.formats.protobuf :as proto])
@@ -33,7 +34,6 @@
(deftest typed-layers
(let [base (revisioned-clojure-format adjoin)
- wrapped (wrap-typing base (comp #{:profile} ego/type-key))
id "person-1"]
(masai/with-temp-layer [base-layer :format-fns {:node base}]
(let [l (at-revision base-layer 1)]
@@ -42,20 +42,52 @@
(graph/assoc-node id {:foo :blah})))
(is (= {:foo :blah}
(graph/get-node l id)))
- (is (= [1] (graph/get-revisions l id)))))
- (masai/with-temp-layer [wrapped-layer :format-fns {:node wrapped}]
- (let [l (at-revision wrapped-layer 1)]
- (is (thrown? Exception ;; due to no codec for writing "person"s
- (dotxn l
- (-> l
- (graph/assoc-node id {:foo :blah})))))
- (let [id "profile-1"]
- (dotxn l
- (-> l
- (graph/assoc-node id {:foo :blah})))
- (is (= {:foo :blah}
- (graph/get-node l id)))
- (is (= [1] (graph/get-revisions l id))))))))
+ (is (= [1] (graph/get-revisions l id))))
+ (let [wrapped-layer (typing/typed-layer base-layer {:profile #{:photo :biography}})
+ rev (memoize (fn [rev]
+ (at-revision wrapped-layer rev)))]
+ (is (thrown? Exception ;; refuses to write "person"s
+ (graph/assoc-node! (rev 2) id {:foo :blah})))
+
+ (let [l (rev 2)
+ id "profile-2"]
+ (graph/assoc-node! l id {:foo :blah})
+ (is (= {:foo :blah} (graph/get-node l id)))
+ (is (= [2] (graph/get-revisions l id))))
+
+ (let [l (rev 3)
+ id "profile-8"
+ bad-data {:edges {"whatever-10" {:attr :value}}}]
+ (are [keyseq] (thrown? Exception
+ (graph/update-in-node! l (cons id keyseq) adjoin
+ (get-in bad-data keyseq)))
+ []
+ [:edges]
+ [:edges "whatever-10"]
+ [:edges "whatever-10" :attr])
+ (let [data {:foo :bar, :edges {"photo-1" {:location "whatever"}}}]
+ (graph/assoc-node! l id data)
+ (is (= data (graph/get-node l id)))
+ (is (= [3] (graph/get-revisions l id)))))
+
+ (testing "Should work with functional interface"
+ (let [l (rev 4)]
+ (is (thrown? Exception
+ (dotxn l
+ (-> l
+ (graph/assoc-node "person-4" {:foo :bar})))))
+ (let [id "profile-7"]
+ (dotxn l
+ (-> l
+ (graph/assoc-node id {:foo :bar})))
+ (is (= {:foo :bar} (graph/get-node l id))))))
+
+ (testing "Can disable type-checking"
+ (let [l (typing/without-typing (rev 5))]
+ (graph/assoc-node! l "person-8" {:blah :baz})
+ (graph/update-node! l "profile-22" adjoin {:edges {"nobody" {:data "stuff"}}})
+ (is (= {:blah :baz} (graph/get-node l "person-8")))
+ (is (= {:data "stuff"} (graph/get-in-node l ["profile-22" :edges "nobody"])))))))))
(deftest protobuf-sets
(let [real-adjoin adjoin

0 comments on commit b59aacb

Please sign in to comment.