eihli
/
prhyme
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add constraints to protocols

Browse Source
main
Eric Ihli 4 years ago
parent 5c1242eccb
commit 3782b6072a
3 changed files with 97 additions and 62 deletions
Show Stats Download Patch File Download Diff File

47
src/com/owoga/frp/infrastructure.clj
Unescape Escape View File

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

72
src/com/owoga/prhyme/tar_pit.org
Unescape Escape View File

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

8
test/com/owoga/frp/infrastructure-test.clj
Unescape Escape View File

@ -16,9 +16,13 @@
(is (= @Offer #{{:address "123 Fake St." :price 1.5e5}}))))) (is (= @Offer #{{:address "123 Fake St." :price 1.5e5}})))))
(deftest test-defrelvar (deftest test-defrelvar
(testing "macro works" (testing "failed constraint raises"
(let [Offer (frp/defrelvar Offer (fn [offers] (map #(> (:price %) 0) offers)))] (let [Offer (frp/defrelvar Offer (fn [offers] (map #(> (:price %) 0) offers)))]
(is (thrown-with-msg? (is (thrown-with-msg?
Exception Exception
#"Constraint 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}})))))

Write Preview
Loading…
Cancel
Save