diff options
| -rw-r--r-- | deps.edn | 3 | ||||
| -rw-r--r-- | src/jester/compiler.clj | 39 | ||||
| -rw-r--r-- | src/jester/expansion.clj | 528 | ||||
| -rw-r--r-- | src/jester/operators/timestamp.clj | 76 | ||||
| -rw-r--r-- | src/jester/types.clj | 2 | ||||
| -rw-r--r-- | test/jester/types_test.clj | 37 |
6 files changed, 398 insertions, 287 deletions
@@ -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" |