summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--deps.edn3
-rw-r--r--src/jester/compiler.clj39
-rw-r--r--src/jester/expansion.clj528
-rw-r--r--src/jester/operators/timestamp.clj76
-rw-r--r--src/jester/types.clj2
-rw-r--r--test/jester/types_test.clj37
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"