Skip to content

Commit

Permalink
Add real-range-realm.
Browse files Browse the repository at this point in the history
  • Loading branch information
@mikesperber
mikesperber committed Mar 7, 2024
1 parent 11c3475 commit b4ee40b
Show file tree
Hide file tree
Showing 5 changed files with 159 additions and 1 deletion.
93 changes: 92 additions & 1 deletion src/active/data/realm.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -134,6 +134,7 @@
(def-record ^{:doc "Realm for integer ranges."}
integer-from-to-realm
:extends Realm
; FIXME: bounds optional, have this cover natural and integer
[integer-from-to-realm-from integer-from-to-realm-to])

(defn integer-from-to?
Expand All @@ -151,7 +152,97 @@
(<= x to)))
metadata {}))

(defn realm-seq-description
(def-record ^{:doc "Realm for integer ranges."}
real-range-realm
:extends Realm
; clusive is either :in or :ex
[real-range-realm-clusive-left
real-range-realm-left ; may be nil
real-range-realm-right
real-range-realm-clusive-right])

(defn- make-real-range
[clusive-left left right clusive-right]
(real-range-realm description (if (and (nil? left) (nil? right))
"real"
(str "real range "
(case clusive-left
(:in) "["
(:ex) "(")
(or left "")
", "
(or right "")
(case clusive-right
(:in) "]"
(:ex) ")")))
real-range-realm-clusive-left clusive-left
real-range-realm-left left
real-range-realm-right right
real-range-realm-clusive-right clusive-right
predicate (cond
(and left right)
(case clusive-left
(:in) (case clusive-right
(:in)
(fn [n]
(and (real? n)
(<= left n right)))
(:ex)
(fn [n]
(and (real? n)
(<= left n)
(< n right))))
(:ex) (case clusive-right
(:in)
(fn [n]
(and (real? n)
(< left n)
(<= n right)))
(:ex)
(fn [n]
(and (real? n)
(< left n right)))))

left
(case clusive-left
(:in)
(fn [n]
(and (real? n)
(<= left n)))
(:ex)
(fn [n]
(and (real? n)
(< left n))))

right
(case clusive-right
(:in)
(fn [n]
(and (real? n)
(<= n right)))
(:ex)
(fn [n]
(and (real? n)
(< n right))))

:else
real?)
metadata {}))

(defn real-range
([clusive-left left right clusive-right]
(make-real-range clusive-left left right clusive-right))
([lr1 lr2]
(case lr1
(:in :ex) (make-real-range lr1 lr2 nil :ex)
(case lr2
(:in :ex) (make-real-range :ex nil lr1 lr2)))))

(defn real-range?
[thing]
(is-a? real-range? thing))

(defn- realm-seq-description
[realms]
(str "["
(string/join ", " (map description realms))
Expand Down
2 changes: 2 additions & 0 deletions src/active/data/realm/realms.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@
(def from-predicate (realm/record->record-realm realm/from-predicate-realm))
(def optional (realm/record->record-realm realm/optional-realm))
(def integer-from-to (realm/record->record-realm realm/integer-from-to-realm))
(def real-range (realm/record->record-realm realm/real-range-realm))
(def union (realm/record->record-realm realm/union-realm))
(def intersection (realm/record->record-realm realm/intersection-realm))
(def enum (realm/record->record-realm realm/enum-realm))
Expand Down Expand Up @@ -51,6 +52,7 @@
from-predicate
optional
integer-from-to
real-range
union
intersection
enum
Expand Down
5 changes: 5 additions & 0 deletions src/active/data/realm/schema.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,11 @@
(fn [n]
(<= from n to))))

realms/real-range
(schema/constrained schema/Num
(realm/predicate realm))


realms/union
(loop [realms (realm/union-realm-realms realm)
args (transient [])]
Expand Down
10 changes: 10 additions & 0 deletions test/active/data/realm/schema_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,16 @@
(is (thrown? #?(:clj Exception :cljs js/Error) (schema/validate s 11)))
(is (thrown? #?(:clj Exception :cljs js/Error) (schema/validate s "11")))))

(deftest float-range-test
(let [s (schema (realm/real-range :in 1 10 :in))]
(is (some? (schema/validate s 1)))
(is (some? (schema/validate s 5)))
(is (some? (schema/validate s 10)))

(is (thrown? #?(:clj Exception :cljs js/Error) (schema/validate s 0)))
(is (thrown? #?(:clj Exception :cljs js/Error) (schema/validate s 11)))
(is (thrown? #?(:clj Exception :cljs js/Error) (schema/validate s "11")))))

(deftest union-test
(let [s (schema (realm/union realm/string realm/keyword realm/integer))]
(is (some? (schema/validate s "foo")))
Expand Down
50 changes: 50 additions & 0 deletions test/active/data/realm_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -88,6 +88,22 @@
(deftest description-test
(is (= "optional integer"
(realm/description (realm/optional realm/integer))))
(is (= "real range [5, 10]"
(realm/description (realm/real-range :in 5 10 :in))))
(is (= "real range (5, 10]"
(realm/description (realm/real-range :ex 5 10 :in))))
(is (= "real range [5, 10)"
(realm/description (realm/real-range :in 5 10 :ex))))
(is (= "real range (5, 10)"
(realm/description (realm/real-range :ex 5 10 :ex))))
(is (= "real range (5, )"
(realm/description (realm/real-range :ex 5))))
(is (= "real range [5, )"
(realm/description (realm/real-range :in 5))))
(is (= "real range (, 5)"
(realm/description (realm/real-range 5 :ex))))
(is (= "real range (, 5]"
(realm/description (realm/real-range 5 :in))))
(is (= "integer from 5 to 10"
(realm/description (realm/integer-from-to 5 10))))
(is (= "union of [integer, real]"
Expand Down Expand Up @@ -156,6 +172,40 @@
(is (not ((realm/predicate (realm/integer-from-to 5 7)) 8)))
(is (not ((realm/predicate (realm/integer-from-to 5 7)) "5")))

(is ((realm/predicate (realm/real-range :in 5 7 :in)) 5))
(is ((realm/predicate (realm/real-range :in 5 7 :in)) 7))
(is (not ((realm/predicate (realm/real-range :in 5 7 :in)) 4.9)))
(is (not ((realm/predicate (realm/real-range :in 5 7 :in)) 7.1)))

(is ((realm/predicate (realm/real-range :in 5 7 :ex)) 5))
(is (not ((realm/predicate (realm/real-range :in 5 7 :ex)) 7)))
(is (not ((realm/predicate (realm/real-range :in 5 7 :ex)) 4.9)))

(is (not ((realm/predicate (realm/real-range :ex 5 7 :in)) 5)))
(is ((realm/predicate (realm/real-range :ex 5 7 :in)) 7))
(is (not ((realm/predicate (realm/real-range :ex 5 7 :in)) 7.1)))

(is ((realm/predicate (realm/real-range :ex 5 7 :ex)) 6))
(is (not ((realm/predicate (realm/real-range :ex 5 7 :ex)) 5)))
(is (not ((realm/predicate (realm/real-range :ex 5 7 :ex)) 7)))

(is ((realm/predicate (realm/real-range :ex 5)) 6))
(is (not ((realm/predicate (realm/real-range :ex 5)) 5)))

(is ((realm/predicate (realm/real-range :in 5)) 5))
(is (not ((realm/predicate (realm/real-range :in 5)) 4.9)))

(is ((realm/predicate (realm/real-range 5 :ex)) 4))
(is (not ((realm/predicate (realm/real-range 5 :ex)) 5)))

(is ((realm/predicate (realm/real-range 5 :in)) 5))
(is (not ((realm/predicate (realm/real-range 5 :in)) 6)))

(is (not ((realm/predicate (realm/real-range :in 5 7 :in)) "5")))
(is (not ((realm/predicate (realm/real-range :in 5 7 :ex)) "5")))
(is (not ((realm/predicate (realm/real-range :ex 5 7 :in)) "5")))
(is (not ((realm/predicate (realm/real-range :ex 5 7 :ex)) "5")))

(is ((realm/predicate (realm/union realm/integer realm/string)) 5))
(is ((realm/predicate (realm/union realm/integer realm/string)) "5"))
(is (not ((realm/predicate (realm/union realm/integer realm/string)) :five)))
Expand Down

0 comments on commit b4ee40b

Please sign in to comment.