Initial commit

1 files changed, 281 insertions, 0 deletions

diff --git a/test/jester/types_test.clj b/test/jester/types_test.clj
new file mode 100644
index 0000000..84b28fe
--- /dev/null
+++ b/test/jester/types_test.clj
@@ -0,0 +1,281 @@
+(ns jester.types-test
+  (:require [clojure.test :refer [deftest testing is are]]
+            [clojure.test.check :refer [quick-check]]
+            [clojure.test.check.generators :as gen]
+            [clojure.test.check.properties :refer [for-all]]
+            [jester.types :as sut]))
+
+(def string-enum-gen (gen/fmap #(cons 'enum %) (gen/vector gen/string)))
+(def number-enum-gen (gen/fmap #(cons 'enum %) (gen/vector gen/double)))
+(def boolean-enum-gen (gen/fmap #(cons 'enum %) (gen/vector gen/boolean)))
+(def enum-gen (gen/one-of [string-enum-gen
+                           number-enum-gen
+                           boolean-enum-gen]))
+
+(def atomic-type-gen
+  (gen/one-of [(gen/return 'any)
+               (gen/return 'none)
+               (gen/return 'string)
+               (gen/return 'number)
+               (gen/return 'boolean)
+               enum-gen]))
+
+(defn optional-type-gen [subgen]
+  (gen/fmap #(list 'optional %) subgen))
+
+(defn list-type-gen [subgen]
+  (gen/fmap #(list 'list %) subgen))
+
+(defn array-type-gen [subgen]
+  (gen/recursive-gen (fn [gen]
+                       (gen/fmap (fn [[main rest]]
+                                   (into main (when rest ['& rest])))
+                                 (gen/tuple (gen/vector gen)
+                                            (gen/one-of
+                                             [(gen/return nil)
+                                              (array-type-gen gen)
+                                              (list-type-gen gen)]))))
+                     subgen))
+
+(defn map-type-gen [keygen valgen]
+  (gen/fmap #(cons 'map %) (gen/tuple keygen valgen)))
+
+(defn func-type-gen [argsgen resultgen]
+  (gen/fmap #(cons '-> %) (gen/tuple argsgen resultgen)))
+
+(defn record-type-gen [subgen]
+  (gen/map gen/symbol subgen))
+
+(defn compound-type-gen [subgen]
+  (gen/one-of [(optional-type-gen subgen)
+               (list-type-gen subgen)
+               (array-type-gen subgen)
+               (map-type-gen subgen subgen)
+               (func-type-gen (array-type-gen subgen) subgen)
+               (record-type-gen subgen)]))
+
+(gen/sample (compound-type-gen atomic-type-gen))
+
+(deftest assert-type
+  (testing "happy paths"
+    (are [object type]
+        (nil? (sut/assert-type 'object 'type))
+
+        nil  any
+        "a"  any
+        10   any
+        true any
+
+        "b"   string
+        12    number
+        false boolean
+
+        "b"  (enum "b")
+        14   (enum 14)
+        true (enum true)
+
+        nil (optional string)
+        "a" (optional string)
+
+        nil (optional number)
+        16  (optional number)
+
+        nil   (optional boolean)
+        false (optional boolean)
+
+        ["a" "b"]   [string string]
+        ["a" false] [string boolean]
+        ["a" false] [string & (list boolean)]
+
+        [true false] (list boolean)
+        [10 20]      (list number)
+
+        {"a" 30} (map string number)
+        {a 30}   {a number}))
+
+  (testing "failure cases"
+    (are [object type msg]
+        (thrown-with-msg? clojure.lang.ExceptionInfo msg (sut/assert-type 'object 'type))
+
+        nil  none #"No value can satisfy none"
+        "a"  none #"No value can satisfy none"
+        10   none #"No value can satisfy none"
+        true none #"No value can satisfy none"
+
+        "b"  number  #"Expected a number, but got \"b\""
+        12   boolean #"Expected a boolean, but got 12"
+        true string  #"Expected a string, but got true"
+
+        "b"   (enum "a")  #"Expected \"a\", but got \"b\""
+        2     (enum 1)    #"Expected 1, but got 2"
+        false (enum true) #"Expected true, but got false"
+
+        "b" (enum "a" "c" "d") #"Expected \"a\", \"c\", or \"d\", but got \"b\""
+        2   (enum 1 3)         #"Expected 1 or 3, but got 2"
+
+        "a" (optional number) #"Expected a number, but got \"a\""
+
+        ["a" "b"]     [string number]          #"Expected a number, but got \"b\""
+        ["a" "b"]     [string & (list number)] #"Expected a number, but got \"b\""
+        ["a" "b"]     [string]                 #"Expected at most 1 item, but got 2"
+        ["a" "b" "c"] [string string]          #"Expected at most 2 items, but got 3"
+        []            [string]                 #"Expected at least 1 item, but got 0"
+        ["a"]         [string string]          #"Expected at least 2 items, but got 1"
+
+        ["a" 2] (list string) #"Expected a string, but got 2"
+
+        {"a" 20} (map number number) #"Expected a number, but got \"a\""
+        {"a" 20} (map string string) #"Expected a string, but got 20"
+
+        {a 10} {a string} #"Expected a string, but got 10")))
+
+
+(defn ^:privat grounded-bounds
+  "Return the current [lower upper] bounds of `type`."
+  [type]
+  [(sut/ground-type type :argument)
+   (sut/ground-type type :return)])
+
+(deftest any-type
+  (testing 'assert-type
+    (are [object] (nil? (sut/assert-type 'object 'any))
+      nil
+      1
+      "a"
+      true
+      [1]
+      {a "a"}
+      {"a" "b"}))
+  (testing 'subtype?
+    (are [type] (sut/subtype? 'type 'any)
+      none
+      string
+      number
+      boolean
+      (list string)
+      (map number boolean)
+      (-> [string] number)
+      {a number})
+    (are [type] (not (sut/subtype? 'any 'type))
+      none
+      string
+      number
+      boolean
+      (list string)
+      (map number boolean)
+      (-> [string] number)
+      {a number}))
+  (testing '(constrain ground)
+    (sut/in-constraint-environment
+      (sut/constrain '(var n) 'any)
+      (is (= ['any 'any] (grounded-bounds '(var n)))))
+    (sut/in-constraint-environment
+      (sut/constrain 'any '(var n))
+      (is (= ['any 'any] (grounded-bounds '(var n)))))
+    (sut/in-constraint-environment
+      (is (= ['any 'any] (grounded-bounds '(var n)))))))
+
+(deftest enum-type
+  (testing 'assert-type
+    (are [object type] (nil? (sut/assert-type 'object 'type))
+      "a"  (enum "a")
+      "a"  (enum "a" "b")
+      1    (enum 1)
+      1    (enum 1 2)
+      true (enum true)
+      true (enum false true))
+    (are [object type msg]
+        (thrown-with-msg? clojure.lang.ExceptionInfo msg
+                          (sut/assert-type 'object 'type))
+      "a"  (enum "b" "c" "d") #"Expected \"b\", \"c\", or \"d\", but got \"a\""
+      1    (enum 2 3)         #"Expected 2 or 3, but got 1"
+      true (enum false)       #"Expected false, but got true"
+      nil  (enum 1)           #"Expected 1, but got nil"
+      []   (enum 1)           #"Expected 1, but got \[\]"
+      {}   (enum 1)           #"Expected 1, but got \{\}"))
+  (testing 'subtype?
+    (are [sub super] (sut/subtype? 'sub 'super)
+      none        (enum)
+      (enum)      any
+      (enum "a")  (enum "a")
+      (enum "a")  (enum "a" "b")
+      (enum 1)    (enum 1)
+      (enum 1)    (enum 1 2)
+      (enum true) (enum true)
+      (enum true) (enum true false)
+      (enum)      (enum "a"))
+    (are [sub super] (not (sut/subtype? 'sub 'super))
+      (enum "a")  (enum "b")
+      (enum 1)    (enum 2)
+      (enum true) (enum false)
+      (enum "a")  (enum)))
+  (testing '(constrain ground)
+    (sut/in-constraint-environment
+      (sut/constrain '(var a) '(enum "a" "b" "c"))
+      (sut/constrain '(var a) '(enum "a"))
+      (is (= '[(enum "a") any] (grounded-bounds '(var a)))))
+    (sut/in-constraint-environment
+      (sut/constrain '(enum "a" "b" "c") '(var a))
+      (sut/constrain '(enum "a") '(var a))
+      (is (= '[(optional string) (enum "b" "c" "a")] (grounded-bounds '(var a)))))
+    (sut/in-constraint-environment
+      (sut/constrain '(var a) '(enum "a" "b" "c"))
+      (sut/constrain '(var a) '(enum "x"))
+      (is (= '[none any] (grounded-bounds '(var a)))))))
+
+(deftest subtype?
+  (testing "when there is a subtyping relationship"
+    (are [subtype supertype]
+        (is (sut/subtype? 'subtype 'supertype))
+      string any
+      none   string
+
+      string     string
+      number     number
+      boolean    boolean
+      (enum "a") (enum "a")
+      (enum 1)   (enum 1)
+      (enum 2)   (enum 2)
+
+      (enum "a")   string
+      (enum 1)     number
+      (enum false) boolean
+
+      string      (optional string)
+      (enum "a")  (optional string)
+      number      (optional number)
+      (enum 1)    (optional number)
+      boolean     (optional boolean)
+      (enum true) (optional boolean)
+
+      (optional string)      (optional string)
+      (optional (enum "a"))  (optional string)
+      (optional number)      (optional number)
+      (optional (enum 1))    (optional number)
+      (optional boolean)     (optional boolean)
+      (optional (enum true)) (optional boolean)
+
+      [string]                        [string]
+      [string string]                 [string string]
+      [string]                        [string & (list string)]
+      [string string]                 [string & (list string)]
+      [number string]                 [number & (list string)]
+      [number & (list string)]        [number & (list string)]
+      [number string & (list string)] [number & (list string)]
+      (map string number)   (map string number)
+      (map string (enum 1)) (map (enum "a") number)
+
+      (-> [string number] boolean)              (-> [string number] boolean)
+      (-> [string & (list number)] (enum true)) (-> [string number] boolean)
+
+      {a string}           {a string}
+      {a string, b string} {a string}
+      {a string, b string} {a (optional string)}))
+  (testing "when there isn't a subtyping relationship"
+    ))
+
+(deftest failing-case
+  (sut/in-constraint-environment
+    (sut/constrain '[(var a) & (var n)] '[(enum 1) & [(enum 3) (enum 4)]])
+    (is (= '[(enum 1) any] (grounded-bounds '(var a))))
+    (is (= '[[(enum 3) (enum 4)] any] (grounded-bounds '(var n))))))