Add constraints to protocols

src/com/owoga/frp/infrastructure.clj

@@ -11,25 +11,34 @@
 
 (defprotocol PRelVar
   (restrict [this criteria])
+  (restrict [this criteria & constraints])
   (project [this attributes])
+  (project [this attributes & constraints])
   (product [this relvar])
+  (product [this relvar & constraints])
   (union [this relvar])
+  (union [this relvar & constraints])
   (intersection [this relvar])
+  (intersection [this relvar & contstraints])
   (difference [this relvar])
+  (difference [this relvar & constraints])
   (join [this relvar])
+  (join [this relvar & constraints])
   (divide [this relvar])
-  (rename [this renames]))
+  (divide [this relvar & constraints])
+  (rename [this renames])
+  (rename [this renames & constraints]))
 (declare project-)
 (declare restrict-)
 
-(deftype RelVar [relvar xf]
+(deftype RelVar [relvar xf constraints]
   PRelVar
   (project
-   [this attributes]
+   [this attributes constraints]
-   (project- this (map #(select-keys % attributes))))
+   (project- this (map #(select-keys % attributes)) constraints))
   (restrict
-   [this criteria]
+   [this criteria constraints]
-   (restrict- this (filter criteria)))
+   (restrict- this (filter criteria) constraints))
 
   clojure.lang.IDeref
   (deref [_] (into #{} xf @relvar)))
@@ -37,39 +46,41 @@
 (deftype BaseRelVar [relvar-name store constraints]
   PRelVar
   (project
-   [this attributes]
+   [this attributes constraints]
-   (project- this (map #(select-keys % attributes))))
+   (project- this (map #(select-keys % attributes)) constraints))
   (restrict
-   [this criteria]
+   [this criteria constraints]
-   (restrict- this (filter criteria)))
+   (restrict- this (filter criteria) constraints))
 
   PRelations
   (load! [this relations] (reset! store relations))
   (insert!
    [this relation]
-   (run!
+   (let [new-relation (conj @store relation)]
-    (fn [constraint]
+     (run!
-      (when (constraint @this)
+      (fn [constraint]
-        (throw (ex-info "Constraint Exception" {}))))
+        (when (not (every? true? (constraint new-relation)))
-    constraints)
+          (throw (ex-info "Constraint Exception" {}))))
-   (swap! store conj relation))
+      constraints)
+     (reset! store new-relation)))
   (insert!
    [this & relations]
-   (run!
+   (let [new-relation (set/union @store (into #{} relations))]
-    (fn [constraint]
+     (run!
-      (when (constraint @this)
+      (fn [constraint]
-        (throw (ex-info "Constraint Exception" {}))))
+        (when (not (every? true? (constraint new-relation)))
-    constraints)
+          (throw (ex-info "Constraint Exception" {}))))
-   (swap! store set/union (into #{} relations)))
+      constraints)
+     (reset! store new-relation)))
 
   clojure.lang.IDeref
   (deref [_] @store))
 
-(defn project- [relvar xf]
+(defn project- [relvar xf constraints]
-  (->RelVar relvar xf))
+  (->RelVar relvar xf constraints))
 
-(defn restrict- [relvar xf]
+(defn restrict- [relvar xf constraints]
-  (->RelVar relvar xf))
+  (->RelVar relvar xf constraints))
 
 (def *constraints* (atom {}))
 

src/com/owoga/prhyme/tar_pit.org

@@ -108,14 +108,23 @@ every time the relations of its base relvar are updated.
 
 (defprotocol PRelVar
   (restrict [this criteria])
+  (restrict [this criteria & constraints])
   (project [this attributes])
+  (project [this attributes & constraints])
   (product [this relvar])
+  (product [this relvar & constraints])
   (union [this relvar])
+  (union [this relvar & constraints])
   (intersection [this relvar])
+  (intersection [this relvar & contstraints])
   (difference [this relvar])
+  (difference [this relvar & constraints])
   (join [this relvar])
+  (join [this relvar & constraints])
   (divide [this relvar])
-  (rename [this renames]))
+  (divide [this relvar & constraints])
+  (rename [this renames])
+  (rename [this renames & constraints]))
 #+END_SRC
 
 ** Part 1. of Infrastructure for Essential State
@@ -147,7 +156,7 @@ implementing these types/functions.
 (declare project-)
 (declare restrict-)
 
-(deftype RelVar [relvar xf]
+(deftype RelVar [relvar xf constraints]
   PRelVar
   <<relational algebra for derived relvars>>
 
@@ -164,11 +173,11 @@ implementing these types/functions.
   clojure.lang.IDeref
   (deref [_] @store))
 
-(defn project- [relvar xf]
+(defn project- [relvar xf constraints]
-  (->RelVar relvar xf))
+  (->RelVar relvar xf constraints))
 
-(defn restrict- [relvar xf]
+(defn restrict- [relvar xf constraints]
-  (->RelVar relvar xf))
+  (->RelVar relvar xf constraints))
 
 <<constraints>>
 #+END_SRC
@@ -180,21 +189,21 @@ map/select-keys can be replaced by =set/project=.
 #+NAME: relational algebra for derived relvars
 #+BEGIN_SRC clojure
 (project
- [this attributes]
+ [this attributes constraints]
- (project- this (map #(select-keys % attributes))))
+ (project- this (map #(select-keys % attributes)) constraints))
 (restrict
- [this criteria]
+ [this criteria constraints]
- (restrict- this (filter criteria)))
+ (restrict- this (filter criteria) constraints))
 #+END_SRC
 
 #+NAME: relational algebra for base relvars
 #+BEGIN_SRC clojure
 (project
- [this attributes]
+ [this attributes constraints]
- (project- this (map #(select-keys % attributes))))
+ (project- this (map #(select-keys % attributes)) constraints))
 (restrict
- [this criteria]
+ [this criteria constraints]
- (restrict- this (filter criteria)))
+ (restrict- this (filter criteria) constraints))
 #+END_SRC
 
 #+NAME: relations manipulations
@@ -202,20 +211,22 @@ map/select-keys can be replaced by =set/project=.
 (load! [this relations] (reset! store relations))
 (insert!
  [this relation]
- (run!
+ (let [new-relation (conj @store relation)]
-  (fn [constraint]
+   (run!
-    (when (constraint @this)
+    (fn [constraint]
-      (throw (ex-info "Constraint Exception" {}))))
+      (when (not (every? true? (constraint new-relation)))
-  constraints)
+        (throw (ex-info "Constraint Exception" {}))))
- (swap! store conj relation))
+    constraints)
+   (reset! store new-relation)))
 (insert!
  [this & relations]
- (run!
+ (let [new-relation (set/union @store (into #{} relations))]
-  (fn [constraint]
+   (run!
-    (when (constraint @this)
+    (fn [constraint]
-      (throw (ex-info "Constraint Exception" {}))))
+      (when (not (every? true? (constraint new-relation)))
-  constraints)
+        (throw (ex-info "Constraint Exception" {}))))
- (swap! store set/union (into #{} relations)))
+    constraints)
+   (reset! store new-relation)))
 #+END_SRC
 
 ** Relvar infrastructure
@@ -271,6 +282,21 @@ loaded
   `(->BaseRelVar '~relvar-name (atom #{}) [~@constraints]))
 #+END_SRC
 
+#+NAME: test defrelvar
+#+BEGIN_SRC clojure
+(deftest test-defrelvar
+  (testing "failed constraint raises"
+    (let [Offer (frp/defrelvar Offer (fn [offers] (map #(> (:price %) 0) offers)))]
+      (is (thrown-with-msg?
+           Exception
+           #"Constraint Exception"
+           (frp/insert! Offer {:price -1})))))
+  (testing "passed constraint doesn't raise"
+    (let [Offer (frp/defrelvar Offer (fn [offers] (map #(> (:price %) 0) offers)))]
+      (frp/insert! Offer {:price 20})
+      (is (= @Offer #{{:price 20}})))))
+#+END_SRC
+
 #+NAME: essential state infrastructure
 #+BEGIN_SRC clojure :noweb no-export
 
@@ -473,7 +499,7 @@ Despite this the intention is not for observers to be used as a substitute for t
 
 * Tests
 
-#+BEGIN_SRC clojure :tangle ../../../../test/com/owoga/frp/infrastructure-test.clj
+#+BEGIN_SRC clojure :noweb yes :tangle ../../../../test/com/owoga/frp/infrastructure-test.clj
 (ns com.owoga.frp.infrastructure-test
   (:require [com.owoga.frp.infrastructure :as frp]
             [clojure.test :refer [deftest is testing]]))
@@ -491,11 +517,5 @@ Despite this the intention is not for observers to be used as a substitute for t
       (frp/insert! Offer {:address "123 Fake St." :price 1.5e5})
       (is (= @Offer #{{:address "123 Fake St." :price 1.5e5}})))))
 
-(deftest test-defrelvar
+<<test defrelvar>>
-  (testing "macro works"
-    (let [Offer (frp/defrelvar Offer (fn [offers] (map #(> (:price %) 0) offers)))]
-      (is (thrown-with-msg?
-           Exception
-           #"Constraint Exception"
-           (frp/insert! Offer {:price -1}))))))
 #+END_SRC

test/com/owoga/frp/infrastructure-test.clj

@@ -16,9 +16,13 @@
       (is (= @Offer #{{:address "123 Fake St." :price 1.5e5}})))))
 
 (deftest test-defrelvar
-  (testing "macro works"
+  (testing "failed constraint raises"
     (let [Offer (frp/defrelvar Offer (fn [offers] (map #(> (:price %) 0) offers)))]
       (is (thrown-with-msg?
            Exception
            #"Constraint Exception"
-           (frp/insert! Offer {:price -1}))))))
+           (frp/insert! Offer {:price -1})))))
+  (testing "passed constraint doesn't raise"
+    (let [Offer (frp/defrelvar Offer (fn [offers] (map #(> (:price %) 0) offers)))]
+      (frp/insert! Offer {:price 20})
+      (is (= @Offer #{{:price 20}})))))