From 3782b6072a52dee50783ef0a23930b377d0b96ed Mon Sep 17 00:00:00 2001 From: Eric Ihli Date: Mon, 19 Oct 2020 13:37:25 -0700 Subject: [PATCH] Add constraints to protocols --- src/com/owoga/frp/infrastructure.clj | 63 +++++++++------- src/com/owoga/prhyme/tar_pit.org | 88 +++++++++++++--------- test/com/owoga/frp/infrastructure-test.clj | 8 +- 3 files changed, 97 insertions(+), 62 deletions(-) diff --git a/src/com/owoga/frp/infrastructure.clj b/src/com/owoga/frp/infrastructure.clj index 6513b34..59d1861 100644 --- a/src/com/owoga/frp/infrastructure.clj +++ b/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] - (project- this (map #(select-keys % attributes)))) + [this attributes constraints] + (project- this (map #(select-keys % attributes)) constraints)) (restrict - [this criteria] - (restrict- this (filter criteria))) + [this criteria constraints] + (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] - (project- this (map #(select-keys % attributes)))) + [this attributes constraints] + (project- this (map #(select-keys % attributes)) constraints)) (restrict - [this criteria] - (restrict- this (filter criteria))) + [this criteria constraints] + (restrict- this (filter criteria) constraints)) PRelations (load! [this relations] (reset! store relations)) (insert! [this relation] - (run! - (fn [constraint] - (when (constraint @this) - (throw (ex-info "Constraint Exception" {})))) - constraints) - (swap! store conj relation)) + (let [new-relation (conj @store relation)] + (run! + (fn [constraint] + (when (not (every? true? (constraint new-relation))) + (throw (ex-info "Constraint Exception" {})))) + constraints) + (reset! store new-relation))) (insert! [this & relations] - (run! - (fn [constraint] - (when (constraint @this) - (throw (ex-info "Constraint Exception" {})))) - constraints) - (swap! store set/union (into #{} relations))) + (let [new-relation (set/union @store (into #{} relations))] + (run! + (fn [constraint] + (when (not (every? true? (constraint new-relation))) + (throw (ex-info "Constraint Exception" {})))) + constraints) + (reset! store new-relation))) clojure.lang.IDeref (deref [_] @store)) -(defn project- [relvar xf] - (->RelVar relvar xf)) +(defn project- [relvar xf constraints] + (->RelVar relvar xf constraints)) -(defn restrict- [relvar xf] - (->RelVar relvar xf)) +(defn restrict- [relvar xf constraints] + (->RelVar relvar xf constraints)) (def *constraints* (atom {})) diff --git a/src/com/owoga/prhyme/tar_pit.org b/src/com/owoga/prhyme/tar_pit.org index 229ada9..d176c10 100644 --- a/src/com/owoga/prhyme/tar_pit.org +++ b/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 <> @@ -164,11 +173,11 @@ implementing these types/functions. clojure.lang.IDeref (deref [_] @store)) -(defn project- [relvar xf] - (->RelVar relvar xf)) +(defn project- [relvar xf constraints] + (->RelVar relvar xf constraints)) -(defn restrict- [relvar xf] - (->RelVar relvar xf)) +(defn restrict- [relvar xf constraints] + (->RelVar relvar xf 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] - (project- this (map #(select-keys % attributes)))) + [this attributes constraints] + (project- this (map #(select-keys % attributes)) constraints)) (restrict - [this criteria] - (restrict- this (filter criteria))) + [this criteria constraints] + (restrict- this (filter criteria) constraints)) #+END_SRC #+NAME: relational algebra for base relvars #+BEGIN_SRC clojure (project - [this attributes] - (project- this (map #(select-keys % attributes)))) + [this attributes constraints] + (project- this (map #(select-keys % attributes)) constraints)) (restrict - [this criteria] - (restrict- this (filter criteria))) + [this criteria constraints] + (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! - (fn [constraint] - (when (constraint @this) - (throw (ex-info "Constraint Exception" {})))) - constraints) - (swap! store conj relation)) + (let [new-relation (conj @store relation)] + (run! + (fn [constraint] + (when (not (every? true? (constraint new-relation))) + (throw (ex-info "Constraint Exception" {})))) + constraints) + (reset! store new-relation))) (insert! [this & relations] - (run! - (fn [constraint] - (when (constraint @this) - (throw (ex-info "Constraint Exception" {})))) - constraints) - (swap! store set/union (into #{} relations))) + (let [new-relation (set/union @store (into #{} relations))] + (run! + (fn [constraint] + (when (not (every? true? (constraint new-relation))) + (throw (ex-info "Constraint Exception" {})))) + 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 - (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 diff --git a/test/com/owoga/frp/infrastructure-test.clj b/test/com/owoga/frp/infrastructure-test.clj index c3e3503..0e032fe 100644 --- a/test/com/owoga/frp/infrastructure-test.clj +++ b/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}})))))