Snapshot

6 files changed, 398 insertions, 287 deletions

diff --git a/deps.edn b/deps.edn
index 9059de7..ac8bdee 100644
--- a/deps.edn
+++ b/deps.edn
@@ -1,2 +1 @@
-{:deps {org.clojure/core.match {:mvn/version "1.0.0"}}
- :aliases {:dev {:extra-deps {org.clojure/test.check {:mvn/version "1.1.0"}}}}}
+{:aliases {:dev {:extra-deps {org.clojure/test.check {:mvn/version "1.1.0"}}}}}
diff --git a/src/jester/compiler.clj b/src/jester/compiler.clj
new file mode 100644
index 0000000..1cf4549
--- /dev/null
+++ b/src/jester/compiler.clj
@@ -0,0 +1,39 @@
+(ns jester.compiler
+  (:require [jester.types :refer [assert-type]]
+            [jester.expansion :refer [expand-form]]))
+
+(defn ^:private keys->keywords [map]
+  (persistent! (reduce-kv #(assoc! %1 (keyword %2) %3) (transient {}) map)))
+
+(defn compile-form
+  "Compile a Jester form into a Clojure function. Inputs are provided as
+  a map, with keyword keys matching the symbol names used in the
+  form. Returns a function that executes the logic of the Jester form,
+  with metadata reflecting the input and output shapes.
+
+    > (def f (compile-form '(string= a b.c)))
+    > (meta f)
+    ;;=> {:inputs {a string, b {c string}}, :output boolean}
+    > (f {:a \"ten\", :b '{c \"ten\"}})
+    ;;=> true
+    > (f {:a \"ten\", :b '{c \"twenty\"}})
+    ;;=> false
+    > (f {:a \"ten\", :b \"thirty\"})
+    ;;=throws> \"Invalid object provided as input b\"
+  "
+  ([form] (compile-form form nil))
+  ([form namespaces]
+   (let [expanded (expand-form form namespaces)
+         inputs   (:inputs (meta expanded))]
+     (with-meta (eval `(fn [{:keys [~@(keys inputs)]}]
+                         ~@(for [input (keys inputs)]
+                             `(try
+                                (assert-type ~input '~(get inputs input))
+                                (catch Exception ex#
+                                  (throw (ex-info ~(str "Invalid object provided as input " (keyword input))
+                                                  {:object ~input}
+                                                  ex#)))))
+                         ~expanded))
+       (-> (meta expanded)
+           (dissoc :inputs)
+           (assoc :input (keys->keywords inputs)))))))
diff --git a/src/jester/expansion.clj b/src/jester/expansion.clj
index b6c915b..990ee13 100644
--- a/src/jester/expansion.clj
+++ b/src/jester/expansion.clj
@@ -5,12 +5,13 @@
                                         number= number<
                                         boolean=]]
             [jester.match :refer [type-match]]
-            [jester.types :refer [in-constraint-environment
+            [jester.types :refer [assert-type
+                                  in-constraint-environment
                                   constrain
                                   ground-type
                                   type-variable]]))
 
-(defn ^:private type-of
+(defn type-of
   "Return the type of an expanded form. This relies on the metadata,
   except for primitive types where metadata can't be stored."
   [expanded-form]
@@ -20,74 +21,76 @@
         (nil? expanded-form)     `(optional ~(type-variable))
         :else                    (::type (meta expanded-form))))
 
-(defn ^:private with-type [object type]
+(defn ^:private quote-type [type escape?]
+  (cond
+    (escape? type)
+    type
+    (seq? type)
+    (cons 'list (map #(quote-type % escape?) type))
+    ;; Reduce over sequences, vectors, and sets
+    (or (vector? type))
+    (reduce (fn [result item]
+              (conj result (quote-type item escape?)))
+            [] type)
+    ;; Reduce over the values in maps
+    (map? type)
+    (reduce-kv (fn [result key value]
+                 (assoc result key (quote-type value)))
+               {} type)
+    ;; Return everything else quoted.
+    :else
+    (list 'quote type)))
+
+(defn with-type [object type]
   (with-meta object {::type type}))
 
 (def ^:private ^:dynamic *parameters*)
 
 (declare expand-form*)
 
-(defn regex-start-index
-  "Return the index of the first character in `string` which matches the
-  start of an instance of `regex`."
-  [regex string]
-  (let [matcher (re-matcher #"\??\." string)]
-    (when (.find matcher)
-      (.start matcher))))
-
 (defn expand-symbol [form]
-  (let [string (name form)]
-    (if-let [sep-index (regex-start-index #"\??\." string)]
-      (let [root     (.substring string 0 sep-index)
-            rest     (.substring string sep-index)
-            root-sym (symbol root)]
-        (expand-form* `(~(symbol rest)
-                        ~root-sym)))
-      (with-type form
-        (or (get *parameters* form)
-            (let [type (type-variable)]
-              (set! *parameters* (assoc *parameters* form type))
-              type))))))
+  (if-let [[_ bare-name dotted-accessor]
+           (re-find #"^([^?.]+)(\??\..+)$" (name form))]
+    (expand-form* `(~(symbol dotted-accessor)
+                    ~(symbol bare-name)))
+    (with-type form
+      (or (get *parameters* form)
+          (let [type (type-variable)]
+            (set! *parameters* (assoc *parameters* form type))
+            type)))))
 
 (defn getter-expander [form]
-  (let [[head arg] form
-        string     (name head)]
-    (when-not (or (str/starts-with? string ".")
-                  (str/starts-with? string "?."))
+  (let [[dotted-accessor argument] form
+        string                     (name dotted-accessor)]
+    (if (or (str/starts-with? string ".")
+            (str/starts-with? string "?."))
+      (let [;; We drop off the head, because we know that the string
+            ;; starts with either a "." or a "?." (from the condition
+            ;; above).
+            [_ & parts] (str/split string #"\.")]
+        (:argument
+         (reduce (fn [{:keys [argument optional]} ^String part]
+                   (let [t-var       (type-variable)
+                         part-sym    (if (str/ends-with? part "?")
+                                       (keyword (.substring part 0 (dec (.length part))))
+                                       (keyword part))
+                         object-type {part-sym (if (str/ends-with? part "?")
+                                                 `(optional ~t-var)
+                                                 t-var)}
+                         result-type (if (or optional (str/ends-with? part "?"))
+                                       `(optional ~t-var)
+                                       t-var)]
+                     (constrain (type-of argument)
+                                (if optional
+                                  `(optional ~object-type)
+                                  object-type))
+                     {:argument (with-type `(get ~argument ~part-sym) result-type)
+                      :optional (or optional (str/ends-with? part "?"))}))
+                 {:argument (expand-form* argument)
+                  :optional (str/starts-with? string "?")}
+                 parts)))
       (throw (ex-info "Unknown value in head of form"
-                      {:form form})))
-    (let [;; This complicated regex splits the string into parts
-          ;; starting with either "?" or "?."
-          parts (str/split string #"(?=\?\.|(?<!\?)\.)")
-          part  ^String (last parts)
-          rest  (butlast parts)]
-      (cond
-        (str/starts-with? part ".")
-        (let [type     (type-variable)
-              part-sym (symbol (.substring part 1))
-              expanded (expand-form*
-                        (if (empty? rest)
-                          arg
-                          `(~(symbol (str/join rest)) ~arg)))]
-          (constrain (type-of expanded) {part-sym type})
-          (with-type `(get ~expanded '~part-sym)
-            type))
-        (str/starts-with? part "?.")
-        (let [type     (type-variable)
-              part-sym (symbol (.substring part 2))
-              expanded (expand-form*
-                        (if (empty? rest)
-                          arg
-                          `(~(symbol (str/join rest)) ~arg)))]
-          (constrain (type-of expanded)
-                                `(optional {~part-sym (optional ~type)}))
-          (with-type `(get ~expanded '~part-sym)
-            `(optional ~type)))
-        :else
-        (throw (ex-info "Invalid head for getter"
-                        {:head head
-                         :part part
-                         :rest rest}))))))
+                      {:form form})))))
 
 (defn expand-map [form]
   (let [expressions (reduce-kv (fn [acc k value-form]
@@ -103,15 +106,38 @@
     (with-type terms
       (mapv #(type-of %) terms))))
 
-(def expanders {})
-(def operators {})
+(def ^:dynamic *syntax* {})
+(def ^:dynamic *operators* {})
+
+(defn ^:private split-rest [coll]
+  (let [[main rest] (split-with #(not= % '&) coll)]
+    (if (seq rest)
+      (do (assert (= (count rest) 2) "Tail must consist of only one element")
+          [main (second rest)])
+      [main nil])))
 
 (defn expand-operator-form [operator form]
-  (let [result (type-variable)
-        args   (map expand-form* (rest form))]
-    (constrain ((:type operator)) `(-> ~(mapv type-of args) ~result))
-    (with-type `(~(:name operator) ~@args)
-      result)))
+  (letfn [(wrap-optional [type]
+            (if (:optional? operator)
+              (list 'optional type)
+              type))]
+    (let [result (type-variable)
+          args   (map expand-form* (rest form))]
+      (constrain (type-match ((:type operator))
+                   (-> parameters return)
+                   (let [[pre rest] (split-rest parameters)]
+                     `(-> ~(vec (concat (mapv wrap-optional pre)
+                                        ['& (type-match rest
+                                              (list x) `(list ~(wrap-optional x))
+                                              x        x)]))
+                          ~(wrap-optional return))))
+                 `(-> ~(mapv type-of args) ~result))
+      (with-type (if (:optional? operator)
+                   (let [syms (map #(do % (gensym)) args)]
+                     `(let [~@(mapcat #(vector %1 %2) syms args)]
+                        (and ~@syms (~(:name operator) ~@syms))))
+                   `(~(:name operator) ~@args))
+        result))))
 
 (defn expand-form* [form]
   (cond
@@ -123,16 +149,16 @@
     (map? form)     (expand-map form)
     (vector? form)  (expand-vector form)
     (seq? form)     (if (symbol? (first form))
-                      (if-let [operator (get operators (first form))]
-                        (if (get expanders (first form))
-                          (throw (ex-info (format "Found both an operator and an expander for %s"
-                                                  (pr-str (first form)))
-                                          {:head (first form)
-                                           :form form}))
-                          (expand-operator-form operator form))
-                        (if-let [expander (get expanders (first form))]
-                          (expander form)
-                          (getter-expander form)))
+                      (let [operator (get *operators* (first form))
+                            expander (get *syntax* (first form))]
+                        (cond
+                          (and operator expander) (throw (ex-info (format "Found both an operator and syntax for %s"
+                                                                          (pr-str (first form)))
+                                                                  {:head (first form)
+                                                                   :form form}))
+                          operator                (expand-operator-form operator form)
+                          expander                (expander form)
+                          :else                   (getter-expander form)))
                       (throw (ex-info "Invalid form"
                                       {:form form})))
     :else           (throw (ex-info "Invalid form"
@@ -166,30 +192,61 @@
     :else
     obj))
 
-(defn expand-form [form]
-  (binding [*parameters* {}]
-    (in-constraint-environment
-      (let [expanded (force-all (expand-form* form))
-            grounded (ground-type *parameters* :argument)]
-        ;; Once we've solved the input types, add constraints to
-        ;; ensure that information is captured when we solve the
-        ;; output type. We only need to add them as lower bounds,
-        ;; because :return grounding solves for the greatest lower
-        ;; bound.
-        (doseq [[param type] grounded]
-          (constrain type (get *parameters* param)))
-        (if (instance? clojure.lang.IMeta expanded)
-          (with-meta expanded
-            {:input  grounded
-             :output (ground-type (type-of expanded) :return)})
-          expanded)))))
-
-(defmacro define-expander
+(declare jester-operators jester-syntax)
+
+(defn expand-form
+  ([form]
+   (expand-form form nil))
+  ([form namespaces]
+   (doseq [ns namespaces]
+     (require ns))
+   (binding [*parameters* {}
+             *operators*  (into jester-operators
+                                (map #(deref (or (ns-resolve % 'jester-operators)
+                                                 (atom nil))))
+                                namespaces)
+             *syntax*     (into jester-syntax
+                                (map #(deref (or (ns-resolve % 'jester-syntax)
+                                                 (atom nil))))
+                                namespaces)]
+     (in-constraint-environment
+       (let [expanded (force-all (expand-form* form))
+             grounded (ground-type *parameters* :argument)]
+         ;; Once we've solved the input types, add constraints to
+         ;; ensure that information is captured when we solve the
+         ;; output type. We only need to add them as lower bounds,
+         ;; because :return grounding solves for the greatest lower
+         ;; bound.
+         (doseq [[param type] grounded]
+           (constrain type (get *parameters* param)))
+         (if (instance? clojure.lang.IMeta expanded)
+           (with-meta expanded
+             {:inputs grounded
+              :output (ground-type (type-of expanded) :return)})
+           expanded))))))
+
+(defn compile-form
+  "Compile a Jester form into a Clojure function"
+  ([form]
+   (compile-form form nil))
+  ([form {:keys [unsafe?]}]
+   (let [expanded (expand-form form)
+         inputs   (:inputs (meta expanded))]
+     (with-meta (eval `(fn [{:keys ~(vec (keys inputs))}]
+                         ~@(for [[input type] inputs]
+                             `(assert-type ~input '~type))
+                         ~expanded))
+       (assoc (meta expanded)
+              :arglists (list (vec (keys inputs))))))))
+
+(defmacro define-syntax
   {:style/indent 2}
   [operator-name [& args] & body]
-  `(alter-var-root #'expanders
-                   assoc '~operator-name (fn [[_# ~@args]]
-                                           ~@body)))
+  `(do
+     (defonce ~'jester-syntax {})
+     (alter-var-root #'~'jester-syntax
+                     assoc '~operator-name (fn [[_# ~@args]]
+                                             ~@body))))
 
 (defn ^:private resolve-symbol [sym]
   (let [resolved (meta (ns-resolve *ns* sym))
@@ -206,7 +263,7 @@
      (throw (ex-info (format "Cannot resolve symbol for operator: %s" (pr-str name))
                      {:namespace *ns*
                       :symbol    name}))))
-  ([name operator-symbol type]
+  ([name operator-symbol type & options]
    (let [type (type-match type
                 (∀ args value)
                 `(let [~@(mapcat #(list % `(list 'var (gensym '~%))) args)]
@@ -214,13 +271,21 @@
                 _
                 (list 'quote type))]
      (if (namespace operator-symbol)
-       `(alter-var-root #'operators assoc '~name
-                        {:type (fn [] ~type)
-                         :name '~operator-symbol})
+       `(do
+          (defonce ~'jester-operators {})
+          (alter-var-root #'~'jester-operators assoc '~name
+                          {:type      (fn [] ~type)
+                           :optional? false
+                           :name      '~operator-symbol})
+          ~@(when-not (some #{:no-optional} options)
+              [`(alter-var-root #'~'jester-operators assoc '~(symbol (str "?" name))
+                                {:type      (fn [] ~type)
+                                 :optional? true
+                                 :name      '~operator-symbol})]))
        (throw (ex-info (format "Operator symbol must have a namespace" (pr-str name))
                        {:symbol operator-symbol}))))))
 
-(defn ^:private e-use [form type]
+(defn expand-use [form type]
   (let [result (expand-form* form)]
     (constrain (type-of result) type)
     result))
@@ -236,127 +301,105 @@
              (set! *parameters* (assoc *parameters* ~parameter old#))
              (set! *parameters* (dissoc *parameters* ~parameter))))))))
 
-(defn ? [optional default]
+(defn ! [optional default]
   (if (nil? optional) default optional))
-
-(define-simple-operator ?
-    (∀ [x] (-> [(optional x) x] x)))
-
-(define-simple-operator string= (-> [string string] boolean))
-(define-simple-operator string=? (-> [(optional string) (optional string)] (optional boolean)))
-
-(define-expander find [[var & {list :in condition :when}] value]
+(define-simple-operator ! jester.expansion/!
+  (∀ [x] (-> [(optional x) x] x))
+  :no-optional)
+
+(defn !f [optional]
+  (if (nil? optional) false optional))
+(define-simple-operator !f jester.expansion/!f
+  (-> [(optional boolean)] boolean)
+  :no-optional)
+
+(defn !t [optional]
+  (if (nil? optional) true optional))
+(define-simple-operator !t jester.expansion/!t
+  (-> [(optional boolean)] boolean)
+  :no-optional)
+
+(define-syntax find [[var & {list :in condition :when}] value]
   (let [type   (type-variable)
         result (with-temporary-parameter-type [var type]
                  (expand-form* value))]
     (with-type `(reduce (fn [_# ~var]
                           (when ~(with-temporary-parameter-type [var type]
-                                   (e-use (or condition true) '(optional boolean)))
+                                   (expand-use (or condition true) 'boolean))
                             (reduced ~result)))
-                        nil ~(e-use list `(list ~type)))
+                        nil ~(expand-use list `(list ~type)))
       `(optional ~(type-of result)))))
 
-(define-expander for [[var & {list :in condition :when}] value]
+(define-syntax for [[var & {list :in condition :when}] value]
   (let [type (type-variable)
         result (with-temporary-parameter-type [var type]
                  (expand-form* value))]
     (with-type `(reduce (fn [acc# ~var]
                           (if ~(with-temporary-parameter-type [var type]
-                                 (e-use (or condition true) '(optional boolean)))
+                                 (expand-use (or condition true) 'boolean))
                             (conj acc# ~result)
                             acc#))
-                        [] ~(e-use list `(list ~type)))
+                        [] ~(expand-use list `(list ~type)))
       `(list ~(type-of result)))))
 
-(define-expander all-of [[var & {list :in condition :when}] value]
+(define-syntax build-map [[var & {list :in condition :when}] {:syms [key value]}]
+  (let [type  (type-variable)
+        key   (with-temporary-parameter-type [var type]
+                (expand-form* key))
+        value (with-temporary-parameter-type [var type]
+                (expand-form* value))]
+    (with-type `(reduce (fn [acc# ~var]
+                          (if ~(with-temporary-parameter-type [var type]
+                                 (expand-use (or condition true) 'boolean))
+                            (assoc acc# ~key ~value)
+                            acc#))
+                        {} ~(expand-use list `(list ~type)))
+      `(map ~(type-of key) ~(type-of value)))))
+
+(define-syntax all-of [[var & {list :in condition :when}] value]
   (let [type (type-variable)]
     (with-type `(reduce (fn [_# ~var]
                           (if ~(with-temporary-parameter-type [var type]
-                                 `(or (not ~(e-use (or condition true) '(optional boolean)))
-                                      ~(e-use value 'boolean)))
+                                 `(or (not ~(expand-use (or condition true) 'boolean))
+                                      ~(expand-use value 'boolean)))
                             true
                             (reduced false)))
-                        true ~(e-use list `(list ~type)))
+                        true ~(expand-use list `(list ~type)))
       'boolean)))
 
-(define-expander one-of [[var & {list :in condition :when}] value]
+(define-syntax one-of [[var & {list :in condition :when}] value]
   (let [type (type-variable)]
     (with-type `(reduce (fn [_# ~var]
                           (if ~(with-temporary-parameter-type [var type]
-                                 `(or (not ~(e-use (or condition true) '(optional boolean)))
-                                      ~(e-use value 'boolean)))
-                            true
-                            (reduced false)))
-                        true ~(e-use list `(list ~type)))
+                                 `(and ~(expand-use (or condition true) 'boolean)
+                                       ~(expand-use value 'boolean)))
+                            (reduced true)
+                            false))
+                        false ~(expand-use list `(list ~type)))
       'boolean)))
 
-(define-expander with-optional [[var optional] value]
+(define-syntax with-optional [[var optional] value]
   (assert (symbol? var) "Binding in with-optional must be a symbol")
   (let [type   (type-variable)
         result (with-temporary-parameter-type [var type]
                  (expand-form* value))]
-    (with-type `(let [~var ~(e-use optional `(optional ~type))]
+    (with-type `(let [~var ~(expand-use optional `(optional ~type))]
                   (when (some? ~var)
                     ~result))
       `(optional ~(type-of result)))))
 
-(defn ^:private quote-type [type escape?]
-  (cond
-    (escape? type)
-    type
-    (seq? type)
-    (cons 'list (map #(quote-type % escape?) type))
-    ;; Reduce over sequences, vectors, and sets
-    (or (vector? type))
-    (reduce (fn [result item]
-              (conj result (quote-type item escape?)))
-            [] type)
-    ;; Reduce over the values in maps
-    (map? type)
-    (reduce-kv (fn [result key value]
-                 (assoc result key (quote-type value)))
-               {} type)
-    ;; Return everything else quoted.
-    :else
-    (list 'quote type)))
-
-(define-simple-operator number= (-> [number number] boolean))
-(def number=? number=)
-(define-simple-operator number=? (-> [(optional number) (optional number)] (optional boolean)))
-
-;; Working out how exactly these should behave in the presence of
-;; optionals is a bit tricky, mostly because of short-circuiting. The
-;; easiest option is to not short circuit and define it as: "and? is
-;; nil if any argument is nil, false if any argument is false, and
-;; true otherwise". The obvious question then is "why does nil win
-;; over false? Why not have it false, then nil, then true?" Working
-;; out which makes the most sense might require some thinking.
-;; TODO: work this out.
-(define-simple-operator and
+(defmacro jester-and [& args]
+  `(and ~@args true))
+(define-simple-operator and jester.expansion/jester-and
   (-> [& (list boolean)] boolean))
-(define-simple-operator and? clojure.core/and
-  (-> [& (list (optional boolean))] (optional boolean)))
 
-(define-simple-operator or
+(defmacro jester-or [& args]
+  `(or ~@args false))
+(define-simple-operator or jester.expansion/jester-or
   (-> [& (list boolean)] boolean))
-(defmacro or? [& values]
-  (if-let [[x & xs] (seq values)]
-    `(let [val# ~x]
-       (cond (nil? val#)  nil
-             (true? val#) true
-             :else `(or? ~@xs)))
-    false))
-(define-simple-operator or?
-  (-> [& (list (optional boolean))] (optional boolean)))
 
 (define-simple-operator not
   (-> [boolean] boolean))
-(defn not? [value]
-  (cond (nil? value)  nil
-        (true? value) false
-        :else         true))
-(define-simple-operator not?
-  (-> [(optional boolean)] (optional boolean)))
 
 (define-simple-operator get
   (∀ [k v] (-> [(map k v) k] (optional v))))
@@ -364,97 +407,38 @@
 (define-simple-operator str
   (-> [& (list string)] string))
 
-(def str? str)
-(define-simple-operator str?
-  (-> [& (list (optional string))] string))
-
 (define-simple-operator count
   (-> [(list any)] number))
 
-(def has? some?)
-(define-simple-operator has?
-  (-> [(optional any)] boolean))
-
-
-
-(import java.time.OffsetDateTime
-        java.time.ZonedDateTime
-        java.time.temporal.ChronoField
-        java.time.format.DateTimeFormatterBuilder)
-
-(def date-time-format
-  (-> (DateTimeFormatterBuilder.)
-      (.parseCaseInsensitive)
-      (.appendValue ChronoField/YEAR)
-      (.appendLiteral "-")
-      (.appendValue ChronoField/MONTH_OF_YEAR)
-      (.appendLiteral "-")
-      (.appendValue ChronoField/DAY_OF_MONTH)
-      (-> .optionalStart
-          (.appendLiteral "T")
-          (.appendValue ChronoField/HOUR_OF_DAY)
-          (.appendLiteral ":")
-          (.appendValue ChronoField/MINUTE_OF_HOUR)
-          (-> .optionalStart
-              (.appendLiteral ":")
-              (.appendValue ChronoField/SECOND_OF_MINUTE)
-              .optionalEnd)
-          .optionalEnd)
-      (-> .optionalStart
-          (.appendOffset "+HH:mm" "Z")
-          .optionalEnd)
-      (.parseDefaulting ChronoField/HOUR_OF_DAY 0)
-      (.parseDefaulting ChronoField/MINUTE_OF_HOUR 0)
-      (.parseDefaulting ChronoField/SECOND_OF_MINUTE 0)
-      (.toFormatter)
-      (.withZone java.time.ZoneOffset/UTC)))
-
-(defn parse-timestamp [string]
-  (.withOffsetSameInstant (OffsetDateTime/parse string date-time-format)
-                          (java.time.ZoneOffset/UTC)))
-
-(parse-timestamp "2021-02-23")
-
-(define-simple-operator parse-timestamp
-  (-> [string] timestamp))
-
-(defn time-unit->chrono-unit [time-unit]
-  (condp #(.equalsIgnoreCase ^String %1 ^String %2)
-      time-unit
-    "second"  java.time.temporal.ChronoUnit/SECONDS
-    "minute"  java.time.temporal.ChronoUnit/MINUTES
-    "hour"    java.time.temporal.ChronoUnit/HOURS
-    "day"     java.time.temporal.ChronoUnit/DAYS
-    "month"   java.time.temporal.ChronoUnit/MONTHS
-    "year"    java.time.temporal.ChronoUnit/YEARS))
-(defn truncate-timestamp [^OffsetDateTime time time-unit]
-  (.truncatedTo time (time-unit->chrono-unit time-unit)))
-(defn truncate-timestamp? [time time-unit]
-  (and time time-unit (truncate-timestamp time time-unit)))
-
-(define-simple-operator truncate-timestamp
-  (-> [timestamp (enum "second" "minute" "hour" "day" "month" "year")] timestamp))
-(define-simple-operator truncate-timestamp?
-  (-> [(optional timestamp)
-       (optional (enum "second" "minute" "hour" "day" "month" "year"))]
-      (optional timestamp)))
-
-(define-simple-operator then jester.core/then
-  (∀ [x y] (-> [x y] y)))
-
-;; (alter-var-root #'operators
-;;                 assoc 'str {:type #(quote (-> [& (list string)] string))
-;;                             :name 'str})
-
-;; ;; (alter-var-root #'operators
-;; ;;                 assoc 'get {:type #(let [k (type-variable)
-;; ;;                                          v (type-variable)]
-;; ;;                                      `(-> [(map ~k ~v) ~k] (optional ~v)))})
-
-;; (alter-var-root #'operators
-;;                 assoc 'str? {:type #(quote (-> [& (list (optional string))] string))
-;;                              :name 'str})
-
-;; (alter-var-root #'operators
-;;                 assoc 'count {:type #(quote (-> [(list any)] number))
-;;                              :name 'count})
+(define-simple-operator has? clojure.core/some?
+  (-> [(optional any)] boolean)
+  :no-optional)
+
+(define-simple-operator number=
+  (-> [number number] boolean))
+
+(define-simple-operator number<
+  (-> [number number] boolean))
+
+(define-simple-operator string=
+  (-> [string string] boolean))
+
+(define-simple-operator string<
+  (-> [string string] boolean))
+
+(define-simple-operator boolean=
+  (-> [boolean boolean] boolean))
+
+(comment
+  (let [expanded (expand-form '(build-map (x :in list
+                                             :when (!t (?timestamp< x.a? now)))
+                                          {key x.a? value x})
+                              '[jester.operators.timestamp])]
+    (eval `(let [~'list [{'~'a (java.time.OffsetDateTime/parse "2021-03-09T00:00Z")}
+                         {}]
+                 ~'now (java.time.OffsetDateTime/parse "2021-03-09T00:01Z")]
+             ~expanded)))
+
+  (meta (expand-form '(?string= (get x.a "ten")
+                                (get x.a "twelve"))
+                     '[jester.operators.timestamp])))
diff --git a/src/jester/operators/timestamp.clj b/src/jester/operators/timestamp.clj
new file mode 100644
index 0000000..9a1b797
--- /dev/null
+++ b/src/jester/operators/timestamp.clj
@@ -0,0 +1,76 @@
+(ns jester.operators.timestamp
+  (:require [jester.expansion :refer [with-type
+                                      expand-use
+                                      define-simple-operator
+                                      define-syntax]])
+  (:import (java.time OffsetDateTime
+                      ZonedDateTime
+                      temporal.ChronoField
+                      format.DateTimeFormatterBuilder)))
+
+(def date-time-format
+  (-> (DateTimeFormatterBuilder.)
+      (.parseCaseInsensitive)
+      (.appendValue ChronoField/YEAR)
+      (.appendLiteral "-")
+      (.appendValue ChronoField/MONTH_OF_YEAR)
+      (.appendLiteral "-")
+      (.appendValue ChronoField/DAY_OF_MONTH)
+      (-> .optionalStart
+          (.appendLiteral "T")
+          (.appendValue ChronoField/HOUR_OF_DAY)
+          (.appendLiteral ":")
+          (.appendValue ChronoField/MINUTE_OF_HOUR)
+          (-> .optionalStart
+              (.appendLiteral ":")
+              (.appendValue ChronoField/SECOND_OF_MINUTE)
+              .optionalEnd)
+          .optionalEnd)
+      (-> .optionalStart
+          (.appendOffset "+HH:mm" "Z")
+          .optionalEnd)
+      (.parseDefaulting ChronoField/HOUR_OF_DAY 0)
+      (.parseDefaulting ChronoField/MINUTE_OF_HOUR 0)
+      (.parseDefaulting ChronoField/SECOND_OF_MINUTE 0)
+      (.toFormatter)
+      (.withZone java.time.ZoneOffset/UTC)))
+
+(defn parse-timestamp [string]
+  (.withOffsetSameInstant (OffsetDateTime/parse string date-time-format)
+                          (java.time.ZoneOffset/UTC)))
+(define-syntax parse-timestamp [string]
+  (when (string? string)
+    ;; Verify that we can parse it at compile time, so invalid
+    ;; literals don't slip through.
+    (parse-timestamp string))
+  (with-type `(parse-timestamp ~(expand-use string 'string))
+    (if (string? string)
+      'timestamp
+      '(optional timestamp))))
+;; (define-simple-operator parse-timestamp
+;;   (-> [string] timestamp))
+
+(defn time-unit->chrono-unit [time-unit]
+  (condp #(.equalsIgnoreCase ^String %1 ^String %2)
+      time-unit
+      "second"  java.time.temporal.ChronoUnit/SECONDS
+      "minute"  java.time.temporal.ChronoUnit/MINUTES
+      "hour"    java.time.temporal.ChronoUnit/HOURS
+      "day"     java.time.temporal.ChronoUnit/DAYS
+      "month"   java.time.temporal.ChronoUnit/MONTHS
+      "year"    java.time.temporal.ChronoUnit/YEARS))
+(defn truncate-timestamp [^OffsetDateTime time time-unit]
+  (.truncatedTo time (time-unit->chrono-unit time-unit)))
+
+(define-simple-operator truncate-timestamp
+  (-> [timestamp (enum "second" "minute" "hour" "day" "month" "year")] timestamp))
+
+(defn timestamp< [^OffsetDateTime a, ^OffsetDateTime b]
+  (.isBefore a b))
+(define-simple-operator timestamp<
+  (-> [timestamp timestamp] boolean))
+
+(defn timestamp> [^OffsetDateTime a, ^OffsetDateTime b]
+  (.isAfter a b))
+(define-simple-operator timestamp>
+  (-> [timestamp timestamp] boolean))
diff --git a/src/jester/types.clj b/src/jester/types.clj
index 9451ea5..d6f2e36 100644
--- a/src/jester/types.clj
+++ b/src/jester/types.clj
@@ -211,7 +211,7 @@
     (reduce-kv (fn [_ prop prop-type]
                  (or (subtype? (get subtype prop) prop-type)
                      (reduced false)))
-               nil supertype)
+               true supertype)
 
     (and (symbol? subtype) (symbol? supertype))
     (= (name subtype) (name supertype))
diff --git a/test/jester/types_test.clj b/test/jester/types_test.clj
index 84b28fe..da57047 100644
--- a/test/jester/types_test.clj
+++ b/test/jester/types_test.clj
@@ -3,10 +3,13 @@
             [clojure.test.check :refer [quick-check]]
             [clojure.test.check.generators :as gen]
             [clojure.test.check.properties :refer [for-all]]
+            [clojure.test.check.clojure-test :refer [defspec]]
             [jester.types :as sut]))
 
+(alter-meta! #'for-all assoc :style/indent 1)
+
 (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 number-enum-gen (gen/fmap #(cons 'enum %) (gen/vector (gen/double* {:NaN? false}))))
 (def boolean-enum-gen (gen/fmap #(cons 'enum %) (gen/vector gen/boolean)))
 (def enum-gen (gen/one-of [string-enum-gen
                            number-enum-gen
@@ -27,15 +30,13 @@
   (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))
+  (gen/fmap (fn [[main rest]]
+              (into main (when rest ['& rest])))
+            (gen/tuple (gen/vector subgen 0 5)
+                       (gen/one-of
+                        [(gen/return nil)
+                         ;; (array-type-gen subgen)
+                         (list-type-gen subgen)]))))
 
 (defn map-type-gen [keygen valgen]
   (gen/fmap #(cons 'map %) (gen/tuple keygen valgen)))
@@ -44,7 +45,7 @@
   (gen/fmap #(cons '-> %) (gen/tuple argsgen resultgen)))
 
 (defn record-type-gen [subgen]
-  (gen/map gen/symbol subgen))
+  (gen/map gen/keyword subgen))
 
 (defn compound-type-gen [subgen]
   (gen/one-of [(optional-type-gen subgen)
@@ -54,7 +55,19 @@
                (func-type-gen (array-type-gen subgen) subgen)
                (record-type-gen subgen)]))
 
-(gen/sample (compound-type-gen atomic-type-gen))
+(def type-gen (gen/recursive-gen compound-type-gen atomic-type-gen))
+
+(defspec any-supertype-of-all 200
+  (for-all [type type-gen]
+    (sut/subtype? type 'any)))
+
+(defspec optional-supertype-of-raw-type 200
+  (for-all [type type-gen]
+    (sut/subtype? type `(optional ~type))))
+
+(defspec array-subtype-of-list-if-all-types-are-subtypes 200
+  (for-all [array-type (array-type-gen string-enum-gen)]
+    (sut/subtype? array-type '(list string))))
 
 (deftest assert-type
   (testing "happy paths"