diff --git a/project.clj b/project.clj index ae67a11..bdb67f7 100644 --- a/project.clj +++ b/project.clj @@ -2,13 +2,29 @@ :description "Clojure library to keep you away from bugs with precise schemas (refined types with runtime checks)" :Url "https://github.com/KitApps/schema-refined" :license {:name "The MIT License" - :url "http://opensource.org/licenses/MIT"} + :url "http://opensource.org/licenses/MIT"} :dependencies [[prismatic/schema "1.1.9"]] - :profiles {:dev {:dependencies [[org.clojure/clojure "1.7.0"]]} - :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]} - :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]} + :plugins [[lein-doo "0.1.8"] + [lein-cljsbuild "1.1.7" + :exclusions [org.clojure/clojure]]] + + :clean-targets ^{:protect false} [:target-path "test-out"] + + :cljsbuild {:builds [{:id "test" + :source-paths ["src" "test"] + :compiler {:main schema-refined.runner + :output-to "test-out/schema-refined.test.js" + :optimizations :none + :target :nodejs + :source-map true + :source-map-timestamp true}}]} + + :profiles {:dev {:dependencies [[org.clojure/clojure "1.7.0"] + [org.clojure/clojurescript "1.10.329"]]} + :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]} + :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]} :1.10 {:dependencies [[org.clojure/clojure "1.10.0-alpha4"]]}} :deploy-repositories {"clojars" {:sign-releases false}}) diff --git a/src/schema_refined/cljs.clj b/src/schema_refined/cljs.clj new file mode 100644 index 0000000..d80d121 --- /dev/null +++ b/src/schema_refined/cljs.clj @@ -0,0 +1,125 @@ +(ns schema-refined.cljs + (:require [schema-refined.core :as sr])) + +;; based on potemkin's def-map-type +;; but for cljs + +(defprotocol RefinedMapType + (empty* [m]) + (get* [m k default]) + (assoc* [m k v]) + (dissoc* [m k]) + (keys* [m]) + (with-meta* [o mta]) + (meta* [o])) + +(defmacro -def-map-type + {:style/indent [2 :form :form [1]]} + [name params & body] + `(deftype ~name ~params + RefinedMapType + ~@body + + cljs.core.ICollection + (-conj [this# o#] + (cond + (map? o#) + (reduce #(apply assoc %1 %2) this# o#) + + (instance? js/Map o#) + (reduce #(apply assoc %1 %2) this# (into {} o#)) + + :else + (if-let [[k# v#] (seq o#)] + (assoc this# k# v#) + this#))) + + cljs.core.IWithMeta + (-with-meta [this# m#] + (schema-refined.cljs/with-meta* this# m#)) + + cljs.core.IMeta + (-meta [this#] + (schema-refined.cljs/meta* this#)) + + cljs.core.ICounted + (-count [this#] + (count (schema-refined.cljs/keys* this#))) + + cljs.core.ISeqable + (-seq [this#] + (seq + (map + #(vector % (get this# %) + (schema-refined.cljs/keys* this#))))) + + cljs.core.IReduce + (-reduce [this# f#] + (reduce f# (seq this#))) + (-reduce [this# f# v#] + (reduce f# v# (seq this#))) + + cljs.core.IHash + (-hash [this#] + (reduce + (fn [acc# [k# v#]] + (unchecked-add acc# (bit-xor (cljs.core/-hash k#) (cljs.core/-hash v#)))) + 0 + (seq this#))) + + cljs.core.IEquiv + (-equiv [this# x#] + (and + (or (instance? js/Map x#) (map? x#)) + (= x# (into {} this#)))) + + js/Object + (toString [this#] + (str (into {} this#))) + (equiv [this# x#] + (or (identical? this# x#) + (cljs.core/-equiv this# x#))) + + ;; js/Map + (get [this# k#] + (cljs.core/-lookup this# k#)) + (size [this#] + (count this#)) + (keys [this#] + (schema-refined.cljs/keys* this#)) + (set [~'_ ~'_ ~'_] + (throw (UnsupportedOperationException.))) + (delete [~'_ ~'_] + (throw (UnsupportedOperationException.))) + (values [this#] + (->> this# seq (map second))) + (entries [this#] + (seq this#)) + + cljs.core.ILookup + (-lookup [this# k#] + (cljs.core/-lookup this# k# nil)) + (-lookup [this# k# default#] + (schema-refined.cljs/get* this# k# default#)) + + cljs.core.IAssociative + (-contains-key? [this# k#] + (contains? (set (keys this#)) k#)) + (-assoc [this# k# v#] + (schema-refined.cljs/assoc* this# k# v#)) + + cljs.core.IEmptyableCollection + (-empty [this#] + (schema-refined.cljs/empty* this#)) + + cljs.core.IIterable + (-iterator [this#] + (cljs.core/seq-iter this#)) + + cljs.core.IMap + (-dissoc [this# k#] + (schema-refined.cljs/dissoc* this# k#)) + + cljs.core.IFn + (-invoke [this# k#] (get this# k#)) + (-invoke [this# k# not-found#] (get this# k# not-found#)))) diff --git a/src/schema_refined/cljs.cljs b/src/schema_refined/cljs.cljs new file mode 100644 index 0000000..50257f6 --- /dev/null +++ b/src/schema_refined/cljs.cljs @@ -0,0 +1,268 @@ +(ns schema-refined.cljs + (:require-macros [schema-refined.cljs :refer [-def-map-type]]) + (:require [schema.spec.core :as schema-spec] + [schema.core :as s] + [schema.utils :as schema-utils] + [clojure.string :as cstr] + [goog.string :as gs])) + +;; +;; guarded structs +;; + +(defprotocol RefinedMapType + (empty* [m]) + (get* [m k default]) + (assoc* [m k v]) + (dissoc* [m k]) + (keys* [m]) + (with-meta* [o mta]) + (meta* [o])) + +(defprotocol Guardable + (append-guard [this guard]) + (get-guards [this])) + +(defn cleanup-guards [guards k] + (remove #(contains? (:slice-set %) k) guards)) + +(-def-map-type StructMap [data guards mta] + (empty* [_] (StructMap. {} [] {})) + (get* [_ k default-value] (get data k default-value)) + (assoc* [_ k v] (StructMap. (assoc data k v) guards mta)) + (dissoc* [_ k] (StructMap. (dissoc data k) (cleanup-guards guards k) mta)) + (keys* [_] (keys data)) + (meta* [_] mta) + (with-meta* [_ m] (StructMap. data guards m))) + +(extend-type StructMap + Guardable + (append-guard [^StructMap this guard] + (StructMap. (.-data this) (conj (.-guards this) guard) (.-mta this))) + (get-guards [^StructMap this] (.-guards this)) + s/Schema + (spec [this] this) + (explain [^StructMap this] + (cons 'guarded-struct (map s/explain (.-data this)))) + schema-spec/CoreSpec + (subschemas [^StructMap this] + [(.-data this)]) + (checker [^StructMap this params] + (fn [x] + (let [main-checker (schema-spec/sub-checker {:schema (.-data this)} params) + tx (main-checker x)] + (if (schema-utils/error? tx) + tx + (reduce (fn [_ {:keys [slice guard name]}] + (let [x' (select-keys x slice) + next-schema (s/pred guard (or name 'not-complaint-with-guard)) + checker (schema-spec/sub-checker {:schema next-schema} params) + tx' (checker x')] + (when (schema-utils/error? tx') + (reduced tx')))) + nil + (get-guards this))))))) + +(defn guards->str [guards] + (if (empty? guards) + "" + (->> guards + (map (fn [{:keys [name slice]}] + (gs/format " <%s> over %s" name (pr-str slice)))) + (cstr/join "\n") + (gs/format "\n Guarded with\n%s")))) + +(defn map->struct [data] + (StructMap. data [] nil)) + +(defn Struct + "Defines map-like schema that you can further restrict with guards still having + the flexibility to add new fields or remove existing." + [& key-values] + {:pre [(even? (count key-values))]} + (map->struct (apply hash-map key-values))) + +(defn guard + "Restrict given Struct or StructDispatch the same way s/contrained does, but gives you + flexibility to transform structs whenever necessary by adding or removing fields (using + `assoc` and `dissoc` as you would do with the plain map). Note, that `dissoc` + operation cleans up guard when key under the question is mentioned in `keys-slice` + (that's actually the only reason you need to specify a slice of keys in advance, + as there is no way to compute them prior to executing checker function)." + ([struct keys-slice guard-fn] + (guard struct keys-slice guard-fn nil)) + ([struct keys-slice guard-fn guard-name] + {:pre [(satisfies? Guardable struct) + (ifn? guard-fn) + (not (empty? keys-slice)) + (or (nil? guard-name) (symbol? guard-name))]} + (let [new-guard {:slice keys-slice + :slice-set (set keys-slice) + :guard guard-fn + :name guard-name}] + (append-guard struct new-guard)))) + +(defn apply-struct-updates-to [updates base] + (reduce + (fn [state [op & args]] + (case op + :assoc (assoc state (first args) (second args)) + :dissoc (dissoc state (first args)))) + base + updates)) + +(defn append-guards-to [guards schema] + (reduce + (fn [state guard] + (append-guard state guard)) + schema + guards)) + +(-def-map-type StructDispatchMap [keys-slice + downstream-slice + dispatch-fn + options + guards + updates + mta] + (empty* [_] (StructDispatchMap. [] [] (constantly ::empty) [[::empty {}]] [] [] nil)) + (get* [_ k default-value] (get (apply-struct-updates-to updates {}) k default-value)) + (assoc* [_ k v] (StructDispatchMap. + keys-slice + downstream-slice + dispatch-fn + options + guards + (conj updates [:assoc k v]) + mta)) + (dissoc* [_ k] + (cond + (contains? keys-slice k) + (throw (js/Error. + (str "You are trying to dissoc key '" + k + "' that is used in dispatch function. " + "Even tho' it's doable theoratically, we are kindly encourage you " + "avoid such kind of manipulations. It's gonna be a mess."))) + + (contains? downstream-slice k) + (throw (js/Error. + (str "Meh. Would not work. One of the options provided actually " + "relies on the key '" k "'. Sorry, but I cannot take a risk here."))) + + :else + (StructDispatchMap. + keys-slice + downstream-slice + dispatch-fn + options + guards + (conj updates [:dissoc k]) + mta))) + (keys* [_] (keys (apply-struct-updates-to updates {}))) + (meta* [_] mta) + (with-meta* [_ m] (StructDispatchMap. + keys-slice + downstream-slice + dispatch-fn + options + guards + updates + m))) + +(extend-type StructDispatchMap + Guardable + (append-guard [^StructDispatchMap this guard] + (StructDispatchMap. + (.-keys-slice this) + (.-downstream-slice this) + (.-dispatch-fn this) + (.-options this) + (conj (.-guards this) guard) + (.-updates this) + (.-mta this))) + (get-guards [^StructDispatchMap this] (.-guards this)) + s/Schema + (spec [this] this) + (explain [^StructDispatchMap this] + (cons 'struct-dispatch (map s/explain (map second (.-options this))))) + schema-spec/CoreSpec + (subschemas [^StructDispatchMap this] + (map second (.-options this))) + (checker [^StructDispatchMap this params] + (fn [x] + (let [dispatch-value ((.-dispatch-fn this) (select-keys x (.-keys-slice this))) + dispatch-schema (or (->> (.-options this) + (filter #(= dispatch-value (first %))) + first) + ;; use `:else` branch when set + (let [[k v] (last (.-options this))] + (when (= :else k) [:else v])))] + (if (nil? dispatch-schema) + (schema-utils/error (gs/format "Dispatch value '%s' not found among options %s" + dispatch-value + (mapv first (.-options this)))) + (let [dispatch-schema' (->> dispatch-schema + second + (append-guards-to (get-guards this)) + (apply-struct-updates-to (.-updates this))) + checker (schema-spec/sub-checker {:schema dispatch-schema'} params)] + (checker x))))))) + +(defn StructDispatch + "Works the same way as `dispatch-on` but creates a data structure similar to struct + that might be updated with assoc/dissoc and guarded using `guard` function to created + delayed contrains. + + If dispatch function is not a keyword (read 'field') you need to specify keys slice + to prevent dissoc fields necessary to make a dispatch further. Each suboption should be + either map, StructMap or StructDispatch, map would be converted to Struct. + + Putting last option with ':else' as a dispatch result would match anything if the + appropriate value was not found earlier." + [& args] + (let [fa (first args) + [keys-slice dispatch-fn rest-args] + (if (keyword? fa) + [(set [fa]) fa (rest args)] + [(set fa) (second args) (drop 2 args)])] + (when (empty? rest-args) + (throw (js/Error. "no options provided"))) + + (when (odd? (count rest-args)) + (throw (js/Error. "dispatch argument could not be paired"))) + + (let [options (->> rest-args + (partition 2) + (map (fn [[k v]] + (cond + (instance? StructDispatchMap v) [k v] + (instance? StructMap v) [k v] + (map? v) [k (map->struct v)] + (satisfies? s/Schema v) [k v] + :else (throw + (js/Error. + (gs/format (str "Invalid dispatch subtype given for <%s>: %s\n" + "Should be one of the following: " + "StructMap, StructDispatch, map or any Schema") + k + v))))))) + overlap (->> options + (map first) + (frequencies) + (filter (fn [[k n]] (< 1 n))) + (map first)) + _ (when-not (empty? overlap) + (throw + (js/Error. + (gs/format "Some of the dispatch options listed more than once: %s" + overlap)))) + downstream-slice (->> options + (mapcat (fn [[k v]] + (if-not (instance? StructDispatchMap v) + [] + (into (.-keys-slice ^StructDispatchMap v) + (.-downstream-slice ^StructDispatchMap v))))) + (set))] + (StructDispatchMap. keys-slice downstream-slice dispatch-fn options [] [] nil)))) + diff --git a/src/schema_refined/clojure.clj b/src/schema_refined/clojure.clj new file mode 100644 index 0000000..ecd0449 --- /dev/null +++ b/src/schema_refined/clojure.clj @@ -0,0 +1,412 @@ +(ns schema-refined.clojure + (:require [schema.core :as s] + [schema.spec.core :as schema-spec] + [schema.utils :as schema-utils] + [clojure.string :as cstr])) + +;; +;; guarded structs +;; + +;; based on potemkin's def-map-type +(defprotocol RefinedMapType + (empty* [m]) + (get* [m k default]) + (assoc* [m k v]) + (dissoc* [m k]) + (keys* [m]) + (with-meta* [o mta]) + (meta* [o])) + +(defmacro -def-map-type + {:style/indent [2 :form :form [1]]} + [name params & body] + `(deftype ~name ~params + schema_refined.clojure.RefinedMapType + ~@body + + clojure.lang.MapEquivalence + + clojure.lang.IPersistentCollection + (equiv [this# x#] + (and (or (instance? java.util.Map x#) (map? x#)) + (= x# (into {} this#)))) + (cons [this# o#] + (cond + (map? o#) + (reduce #(apply assoc %1 %2) this# o#) + + (instance? java.util.Map o#) + (reduce #(apply assoc %1 %2) this# (into {} o#)) + + :else + (if-let [[k# v#] (seq o#)] + (assoc this# k# v#) + this#))) + + clojure.lang.IObj + (withMeta [this# m#] + (schema-refined.clojure/with-meta* this# m#)) + (meta [this#] + (schema-refined.clojure/meta* this#)) + + clojure.lang.Counted + (count [this#] + (count (schema-refined.clojure/keys* this#))) + + clojure.lang.Seqable + (seq [this#] + (seq + (map + #(.entryAt this# %) + (schema-refined.clojure/keys* this#)))) + + clojure.core.protocols.CollReduce + (coll-reduce [this# f#] + (reduce f# (seq this#))) + (coll-reduce [this# f# v#] + (reduce f# v# (seq this#))) + + clojure.lang.IHashEq + (hasheq [this#] + (hash-unordered-coll (or (seq this#) ()))) + + Object + (hashCode [this#] + (reduce + (fn [acc# [k# v#]] + (unchecked-add acc# (bit-xor (clojure.lang.Util/hash k#) + (clojure.lang.Util/hash v#)))) + 0 + (seq this#))) + (equals [this# x#] + (or (identical? this# x#) + (and + (or (instance? java.util.Map x#) (map? x#)) + (= x# (into {} this#))))) + (toString [this#] + (str (into {} this#))) + + clojure.lang.ILookup + (valAt [this# k#] + (.valAt this# k# nil)) + (valAt [this# k# default#] + (schema-refined.clojure/get* this# k# default#)) + + clojure.lang.Associative + (containsKey [this# k#] + (contains? (.keySet this#) k#)) + (entryAt [this# k#] + (when (contains? (.keySet this#) k#) + (clojure.lang.MapEntry. k# (get this# k#)))) + (assoc [this# k# v#] + (schema-refined.clojure/assoc* this# k# v#)) + (empty [this#] + (schema-refined.clojure/empty* this#)) + + java.util.Map + (get [this# k#] + (.valAt this# k#)) + (isEmpty [this#] + (empty? this#)) + (size [this#] + (count this#)) + (keySet [this#] + (set (schema-refined.clojure/keys* this#))) + (put [_ _ _] + (throw (UnsupportedOperationException.))) + (putAll [_ _] + (throw (UnsupportedOperationException.))) + (clear [_] + (throw (UnsupportedOperationException.))) + (remove [_ _] + (throw (UnsupportedOperationException.))) + (values [this#] + (->> this# seq (map second))) + (entrySet [this#] + (->> this# seq set)) + + java.util.Iterator + (iterator [this#] + (clojure.lang.SeqIterator. this#)) + + clojure.lang.IPersistentMap + (assocEx [this# k# v#] + (if (contains? this# k#) + (throw (Exception. "Key or value already present")) + (assoc this# k# v#))) + (without [this# k#] + (schema-refined.clojure/dissoc* this# k#)) + + clojure.lang.IFn + (invoke [this# k#] (get this# k#)) + (invoke [this# k# not-found#] (get this# k# not-found#)))) + +(defprotocol Guardable + (append-guard [this guard]) + (get-guards [this])) + +(defn cleanup-guards [guards k] + (remove #(contains? (:slice-set %) k) guards)) + +(-def-map-type StructMap [data guards mta] + (empty* [_] (StructMap. {} [] {})) + (get* [_ k default-value] (get data k default-value)) + (assoc* [_ k v] (StructMap. (assoc data k v) guards mta)) + (dissoc* [_ k] (StructMap. (dissoc data k) (cleanup-guards guards k) mta)) + (keys* [_] (keys data)) + (meta* [_] mta) + (with-meta* [_ m] (StructMap. data guards m))) + +(extend-type StructMap + Guardable + (append-guard [^StructMap this guard] + (StructMap. (.data this) (conj (.guards this) guard) (.mta this))) + (get-guards [^StructMap this] (.guards this)) + s/Schema + (spec [this] this) + (explain [^StructMap this] + (cons 'guarded-struct (map s/explain (.data this)))) + schema-spec/CoreSpec + (subschemas [^StructMap this] + [(.data this)]) + (checker [^StructMap this params] + (fn [x] + (let [main-checker (schema-spec/sub-checker {:schema (.data this)} params) + tx (main-checker x)] + (if (schema-utils/error? tx) + tx + (reduce (fn [_ {:keys [slice guard name]}] + (let [x' (select-keys x slice) + next-schema (s/pred guard (or name 'not-complaint-with-guard)) + checker (schema-spec/sub-checker {:schema next-schema} params) + tx' (checker x')] + (when (schema-utils/error? tx') + (reduced tx')))) + nil + (get-guards this))))))) + +(defn guards->str [guards] + (if (empty? guards) + "" + (->> guards + (map (fn [{:keys [name slice]}] + (format " <%s> over %s" name (pr-str slice)))) + (cstr/join "\n") + (format "\n Guarded with\n%s")))) + +(defmethod print-method StructMap + [^StructMap struct ^java.io.Writer writer] + (let [all-guards (get-guards struct) + f (format "#" + (.data struct) + (guards->str all-guards))] + (.write writer f))) + +(defn map->struct [data] + (StructMap. data [] nil)) + +(defn Struct + "Defines map-like schema that you can further restrict with guards still having + the flexibility to add new fields or remove existing." + [& key-values] + {:pre [(even? (count key-values))]} + (map->struct (apply hash-map key-values))) + +(defn guard + "Restrict given Struct or StructDispatch the same way s/contrained does, but gives you + flexibility to transform structs whenever necessary by adding or removing fields (using + `assoc` and `dissoc` as you would do with the plain map). Note, that `dissoc` + operation cleans up guard when key under the question is mentioned in `keys-slice` + (that's actually the only reason you need to specify a slice of keys in advance, + as there is no way to compute them prior to executing checker function)." + ([struct keys-slice guard-fn] + (guard struct keys-slice guard-fn nil)) + ([struct keys-slice guard-fn guard-name] + {:pre [(satisfies? Guardable struct) + (ifn? guard-fn) + (not (empty? keys-slice)) + (or (nil? guard-name) (symbol? guard-name))]} + (let [new-guard {:slice keys-slice + :slice-set (set keys-slice) + :guard guard-fn + :name guard-name}] + (append-guard struct new-guard)))) + +(defn apply-struct-updates-to [updates base] + (reduce + (fn [state [op & args]] + (case op + :assoc (assoc state (first args) (second args)) + :dissoc (dissoc state (first args)))) + base + updates)) + +(defn append-guards-to [guards schema] + (reduce + (fn [state guard] + (append-guard state guard)) + schema + guards)) + +(-def-map-type StructDispatchMap [keys-slice + downstream-slice + dispatch-fn + options + guards + updates + mta] + (empty* [_] (StructDispatchMap. [] [] (constantly ::empty) [[::empty {}]] [] [] nil)) + (get* [_ k default-value] (get (apply-struct-updates-to updates {}) k default-value)) + (assoc* [_ k v] (StructDispatchMap. + keys-slice + downstream-slice + dispatch-fn + options + guards + (conj updates [:assoc k v]) + mta)) + (dissoc* [_ k] + (cond + (contains? keys-slice k) + (throw (IllegalArgumentException. + (str "You are trying to dissoc key '" + k + "' that is used in dispatch function. " + "Even tho' it's doable theoratically, we are kindly encourage you " + "avoid such kind of manipulations. It's gonna be a mess."))) + + (contains? downstream-slice k) + (throw (IllegalArgumentException. + (str "Meh. Would not work. One of the options provided actually " + "relies on the key '" k "'. Sorry, but I cannot take a risk here."))) + + :else + (StructDispatchMap. + keys-slice + downstream-slice + dispatch-fn + options + guards + (conj updates [:dissoc k]) + mta))) + (keys* [_] (keys (apply-struct-updates-to updates {}))) + (meta* [_] mta) + (with-meta* [_ m] (StructDispatchMap. + keys-slice + downstream-slice + dispatch-fn + options + guards + updates + m))) + +(defmethod print-method StructDispatchMap + [^StructDispatchMap struct ^java.io.Writer writer] + (let [options (->> (.options struct) + (map (fn [[value option]] + (format " %s => %s" value option))) + (cstr/join "\n")) + all-guards (get-guards ^Guardable struct) + guarded (guards->str all-guards) + f (format "#" + (.dispatch-fn struct) + options + guarded)] + (.write writer f))) + +(extend-type StructDispatchMap + Guardable + (append-guard [^StructDispatchMap this guard] + (StructDispatchMap. + (.keys-slice this) + (.downstream-slice this) + (.dispatch-fn this) + (.options this) + (conj (.guards this) guard) + (.updates this) + (.mta this))) + (get-guards [^StructDispatchMap this] (.guards this)) + s/Schema + (spec [this] this) + (explain [^StructDispatchMap this] + (cons 'struct-dispatch (map s/explain (map second (.options this))))) + schema-spec/CoreSpec + (subschemas [^StructDispatchMap this] + (map second (.options this))) + (checker [^StructDispatchMap this params] + (fn [x] + (let [dispatch-value ((.dispatch-fn this) (select-keys x (.keys-slice this))) + dispatch-schema (or (->> (.options this) + (filter #(= dispatch-value (first %))) + first) + ;; use `:else` branch when set + (let [[k v] (last (.options this))] + (when (= :else k) [:else v])))] + (if (nil? dispatch-schema) + (schema-utils/error (format "Dispatch value '%s' not found among options %s" + dispatch-value + (mapv first (.options this)))) + (let [dispatch-schema' (->> dispatch-schema + second + (append-guards-to (get-guards this)) + (apply-struct-updates-to (.updates this))) + checker (schema-spec/sub-checker {:schema dispatch-schema'} params)] + (checker x))))))) + +(defn StructDispatch + "Works the same way as `dispatch-on` but creates a data structure similar to struct + that might be updated with assoc/dissoc and guarded using `guard` function to created + delayed contrains. + + If dispatch function is not a keyword (read 'field') you need to specify keys slice + to prevent dissoc fields necessary to make a dispatch further. Each suboption should be + either map, StructMap or StructDispatch, map would be converted to Struct. + + Putting last option with ':else' as a dispatch result would match anything if the + appropriate value was not found earlier." + [& args] + (let [fa (first args) + [keys-slice dispatch-fn rest-args] + (if (keyword? fa) + [(set [fa]) fa (rest args)] + [(set fa) (second args) (drop 2 args)])] + (when (empty? rest-args) + (throw (IllegalArgumentException. "no options provided"))) + + (when (odd? (count rest-args)) + (throw (IllegalArgumentException. "dispatch argument could not be paired"))) + + (let [options (->> rest-args + (partition 2) + (map (fn [[k v]] + (cond + (instance? StructDispatchMap v) [k v] + (instance? StructMap v) [k v] + (map? v) [k (map->struct v)] + (satisfies? s/Schema v) [k v] + :else (throw + (IllegalArgumentException. + (format (str "Invalid dispatch subtype given for <%s>: %s\n" + "Should be one of the following: " + "StructMap, StructDispatch, map or any Schema") + k + v))))))) + overlap (->> options + (map first) + (frequencies) + (filter (fn [[k n]] (< 1 n))) + (map first)) + _ (when-not (empty? overlap) + (throw + (IllegalArgumentException. + (format "Some of the dispatch options listed more than once: %s" + overlap)))) + downstream-slice (->> options + (mapcat (fn [[k v]] + (if-not (instance? StructDispatchMap v) + [] + (into (.keys-slice ^StructDispatchMap v) + (.downstream-slice ^StructDispatchMap v))))) + (set))] + (StructDispatchMap. keys-slice downstream-slice dispatch-fn options [] [] nil)))) diff --git a/src/schema_refined/core.clj b/src/schema_refined/core.clj deleted file mode 100644 index 374cf58..0000000 --- a/src/schema_refined/core.clj +++ /dev/null @@ -1,1254 +0,0 @@ -(ns schema-refined.core - (:require [schema.core :as s] - [schema.spec.core :as schema-spec] - [schema.spec.variant :as schema-variant] - [schema.utils :as schema-utils] - [clojure.string :as cstr]) - (:refer-clojure :exclude [boolean?]) - (:import (java.net URI URISyntaxException URL MalformedURLException))) - -;; -;; helpers & basic definitions -;; - -(defn boolean? - "Backported boolean? from Clojure 1.9" - [x] - (instance? Boolean x)) - -(defn starts-with? - "True if s starts with substr. Backported from Clojure 1.8" - [^CharSequence s ^String substr] - (.startsWith (.toString s) substr)) - -(defn ends-with? - "True if s ends with substr. Backported from Clojure 1.8" - [^CharSequence s ^String substr] - (.endsWith (.toString s) substr)) - -(defn includes? - "True if s includes substr. Backported from Clojure 1.8" - [^CharSequence s ^CharSequence substr] - (.contains (.toString s) substr)) - -(defn schema? [dt] - (satisfies? s/Schema dt)) - -(defprotocol Predicate - (predicate-apply [this value])) - -(defprotocol PredicateShow - (predicate-show [this sym])) - -(defn predicate? [p] - (satisfies? Predicate p)) - -(defn predicate->str - ([pred] (predicate->str pred "v" false)) - ([pred sym bounded?] - {:pre [(predicate? pred)]} - (let [pred-str (if (satisfies? PredicateShow pred) - (predicate-show pred sym) - (str pred))] - (cond->> pred-str - (and bounded? (not (starts-with? pred-str "("))) - (format "(%s)"))))) - -(defn predicate-print-method [pred ^java.io.Writer writer] - (.write writer (format "#Predicate{%s}" (predicate->str pred)))) - -(defrecord FunctionPredicate [pred] - Predicate - (predicate-apply [_ value] - (pred value)) - PredicateShow - (predicate-show [_ sym] - (format "(%s %s)" (schema-utils/fn-name pred) sym))) - -(defmethod print-method FunctionPredicate - [rs ^java.io.Writer writer] - (predicate-print-method rs writer)) - -(defrecord SchemaPredicate [schema] - Predicate - (predicate-apply [_ value] - (nil? (s/check schema value))) - PredicateShow - (predicate-show [_ sym] - (format "%s: %s" sym schema))) - -(defmethod print-method SchemaPredicate - [rs ^java.io.Writer writer] - (predicate-print-method rs writer)) - -(defrecord RefinedSchema [schema pred] - s/Schema - (spec [this] - (schema-variant/variant-spec - schema-spec/+no-precondition+ - [{:schema schema}] - nil - (schema-spec/precondition - this - (partial predicate-apply pred) - #(list (symbol (schema-utils/fn-name pred)) %)))) - (explain [_] (list 'refined (s/explain schema) (symbol (schema-utils/fn-name pred))))) - -;; Use common representation in the following format: -;; -;; #Refined{v: T | (P v)} -;; -;; where T is a type (schema) and (P v) is the respresentation of -;; appropriate predicate. -(defmethod print-method RefinedSchema - [^RefinedSchema rs ^java.io.Writer writer] - (let [schema (:schema rs) - schema-name (if (fn? schema?) - (schema-utils/fn-name schema) - schema) - f (format "#Refined{v: %s | %s}" schema-name (predicate->str (:pred rs)))] - (.write writer f))) - -(defn coerce - "Turn function or schema to appropriate predicates" - [pred] - {:pre [(or (predicate? pred) - (ifn? pred) - (schema? pred))]} - (cond - (predicate? pred) - pred - - (schema? pred) - (SchemaPredicate. pred) - - (ifn? pred) - (FunctionPredicate. pred))) - -(defn refined - "Takes type (schema) and a predicate, creating a type that - should satisfy both basic type and predicate. Note, that predicate might be - specified as Predicate (protocol), simple function from `dt` type - to boolean or another type (schema)" - [dt pred] - {:pre [(schema? dt)]} - (RefinedSchema. dt (coerce pred))) - -;; -;; boolean operations -;; - -(defrecord NotPredicate [pred] - Predicate - (predicate-apply [_ value] - (not (predicate-apply pred value))) - PredicateShow - (predicate-show [_ sym] - (format "(not %s)" (predicate->str pred sym true)))) - -(defn Not [p] - (NotPredicate. (coerce p))) - -(defmethod print-method NotPredicate - [p ^java.io.Writer writer] - (predicate-print-method p writer)) - -(defrecord AndPredicate [p1 p2] - Predicate - (predicate-apply [_ value] - (and (predicate-apply p1 value) (predicate-apply p2 value))) - PredicateShow - (predicate-show [_ sym] - (format "(and %s %s)" - (predicate->str p1 sym true) - (predicate->str p2 sym true)))) - -;; xxx: we can support > 2 arguments here -(defn And - "Creates predicate that ensures both predicates given are safisfied" - [p1 p2] - (AndPredicate. (coerce p1) (coerce p2))) - -(defmethod print-method AndPredicate - [p ^java.io.Writer writer] - (predicate-print-method p writer)) - -(defrecord OrPredicate [p1 p2] - Predicate - (predicate-apply [_ value] - (or (predicate-apply p1 value) (predicate-apply p2 value))) - PredicateShow - (predicate-show [_ sym] - (format "(or %s %s)" - (predicate->str p1 sym true) - (predicate->str p2 sym true)))) - -(defn Or - "Creates the predicate that ensures at least one predicate is satisfied" - [p1 p2] - (OrPredicate. (coerce p1) (coerce p2))) - -(defmethod print-method OrPredicate - [p ^java.io.Writer writer] - (predicate-print-method p writer)) - -(defrecord OnPredicate [on-fn pred] - Predicate - (predicate-apply [_ value] - (predicate-apply pred (on-fn value))) - PredicateShow - (predicate-show [_ sym] - (let [sym' (format "(%s %s)" (schema-utils/fn-name on-fn) sym)] - (predicate->str pred sym' false)))) - -(defn On - "Creates the predicate to ensure that the result of applying function - `on-fn` to the value satisfies the predicate `pred`" - [on-fn pred] - {:pre [(ifn? on-fn)]} - (OnPredicate. on-fn (coerce pred))) - -(defmethod print-method OnPredicate - [p ^java.io.Writer writer] - (predicate-print-method p writer)) - -;; -;; ordering predicates -;; - -(defrecord EqualPredicate [n] - Predicate - (predicate-apply [_ value] - (= value n)) - PredicateShow - (predicate-show [_ sym] - (format "%s = %s" sym n))) - -(defmethod print-method EqualPredicate - [p writer] - (predicate-print-method p writer)) - -(defn Equal - "A value that must be = n" - [n] - (EqualPredicate. n)) - -(defrecord LessPredicate [n] - Predicate - (predicate-apply [_ value] - (< value n)) - PredicateShow - (predicate-show [_ sym] - (format "%s < %s" sym n))) - -(defmethod print-method LessPredicate - [p writer] - (predicate-print-method p writer)) - -(defn Less - "A value that must be < n" - [n] - (LessPredicate. n)) - -(defrecord LessOrEqualPredicate [n] - Predicate - (predicate-apply [_ value] - (<= value n)) - PredicateShow - (predicate-show [_ sym] - (format "%s ≤ %s" sym n))) - -(defmethod print-method LessOrEqualPredicate - [p writer] - (predicate-print-method p writer)) - -(defn LessOrEqual - "A value that must be < n" - [n] - (LessOrEqualPredicate. n)) - -(defrecord GreaterPredicate [n] - Predicate - (predicate-apply [_ value] - (< n value)) - PredicateShow - (predicate-show [_ sym] - (format "%s < %s" n sym))) - -(defmethod print-method GreaterPredicate - [p writer] - (predicate-print-method p writer)) - -(defn Greater - "A value that must be > n" - [n] - (GreaterPredicate. n)) - -(defrecord GreaterOrEqualPredicate [n] - Predicate - (predicate-apply [_ value] - (<= n value)) - PredicateShow - (predicate-show [_ sym] - (format "%s ≤ %s" n sym))) - -(defmethod print-method GreaterOrEqualPredicate - [p writer] - (predicate-print-method p writer)) - -(defn GreaterOrEqual - "A value that must be >= n" - [n] - (GreaterOrEqualPredicate. n)) - -(defrecord OpenIntervalPredicate [a b] - Predicate - (predicate-apply [_ value] - (< a value b)) - PredicateShow - (predicate-show [_ sym] - (format "%s ∈ (%s, %s)" sym a b))) - -(defn OpenInterval - "a < value < b" - [a b] - {:pre [(< a b)]} - (OpenIntervalPredicate. a b)) - -(defrecord ClosedIntervalPredicate [a b] - Predicate - (predicate-apply [_ value] - (<= a value b)) - PredicateShow - (predicate-show [_ sym] - (format "%s ∈ [%s, %s]" sym a b))) - -(defn ClosedInterval - "a <= value <= b" - [a b] - {:pre [(<= a b)]} - (ClosedIntervalPredicate. a b)) - -(defrecord OpenClosedIntervalPredicate [a b] - Predicate - (predicate-apply [_ value] - (and (< a value) (<= value b))) - PredicateShow - (predicate-show [_ sym] - (format "%s ∈ (%s, %s]" sym a b))) - -(defn OpenClosedInterval - "a < value <= b" - [a b] - {:pre [(< a b)]} - (OpenClosedIntervalPredicate. a b)) - -(defrecord ClosedOpenIntervalPredicate [a b] - Predicate - (predicate-apply [_ value] - (and (<= a value) (< value b))) - PredicateShow - (predicate-show [_ sym] - (format "%s ∈ [%s, %s)" sym a b))) - -(defn ClosedOpenInterval - "a <= value < b" - [a b] - {:pre [(< a b)]} - (ClosedOpenIntervalPredicate. a b)) - -(defn Epsilon [center radius] - (OpenInterval (- center radius) (+ center radius))) - -;; -;; numeric predicates -;; - -(def Even (FunctionPredicate. even?)) - -(def Odd (FunctionPredicate. odd?)) - -(defrecord ModuloPredicate [div o] - Predicate - (predicate-apply [_ value] - (= o (mod value div))) - PredicateShow - (predicate-show [_ sym] - (format "%s mod %s = %s" sym div o))) - -(defn Modulo - "The value modulus by div = o" - [div o] - (ModuloPredicate. div o)) - -(defn DivisibleBy [n] - (Modulo n 0)) - -(defn NonDivisibleBy [n] - (Not (DivisibleBy n))) - -;; -;; numeric types -;; - -(defn PositiveOf [dt] - {:pre [(schema? dt)]} - (refined dt (Greater 0))) - -(defn NegativeOf [dt] - {:pre [(schema? dt)]} - (refined dt (Less 0))) - -(defn NonNegativeOf [dt] - {:pre [(schema? dt)]} - (refined dt (GreaterOrEqual 0))) - -(defn NonPositiveOf [dt] - {:pre [(schema? dt)]} - (refined dt (LessOrEqual 0))) - -(def PositiveInt (PositiveOf s/Int)) - -(def NegativeInt (NegativeOf s/Int)) - -(def NonNegativeInt (NonNegativeOf s/Int)) - -(def NonPositiveInt (NonPositiveOf s/Int)) - -(def PositiveDouble (PositiveOf double)) - -(def NegativeDouble (NegativeOf double)) - -(def NonNegativeDouble (NonNegativeOf double)) - -(def NonPositiveDouble (NonPositiveOf double)) - -(defn EpsilonOf [dt center radius] - {:pre [(schema? dt)]} - (refined dt (Epsilon center radius))) - -;; -;; ordering types -;; - -(defn OpenIntervalOf - "a < value < b" - [dt a b] - {:pre [(schema? dt)]} - (refined dt (OpenInterval a b))) - -(defn ClosedIntervalOf - "a <= value <= b" - [dt a b] - {:pre [(schema? dt)]} - (refined dt (ClosedInterval a b))) - -(defn OpenClosedIntervalOf - "a < value <= b" - [dt a b] - {:pre [(schema? dt)]} - (refined dt (OpenClosedInterval a b))) - -(defn ClosedOpenIntervalOf - "a <= value < b" - [dt a b] - {:pre [(schema? dt)]} - (refined dt (ClosedOpenInterval a b))) - -;; -;; strings & chars -;; - -(def NonEmptyStr - (refined s/Str (Not (FunctionPredicate. cstr/blank?)))) - -(defn BoundedSizeStr - ([min max] (BoundedSizeStr min max false)) - ([min max trimmed?] - {:pre [(<= min max) - (boolean? trimmed?)]} - (let [count-chars (if-not trimmed? - count - #(count (cstr/trim %1)))] - (refined s/Str (On count-chars (ClosedInterval min max)))))) - -(def DigitChar #"^[0-9]$") - -(def ASCIILetterChar #"^[a-zA-Z]$") - -(def ASCIILetterOrDigitChar #"^[0-9a-zA-Z]$") - -(def BitChar #"^[0|1]$") - -(def BitStr #"^[0|1]*$") - -(defn parsable-int? [s] - (try - (Integer/parseInt s) - true - (catch NumberFormatException _ false))) - -(def IntStr (refined NonEmptyStr parsable-int?)) - -(defn parsable-float? [s] - (try - (Float/parseFloat s) - true - (catch NumberFormatException _ false))) - -(def FloatStr (refined NonEmptyStr parsable-float?)) - -(defn parsable-uri? [uri] - (try - (URI. uri) - true - (catch URISyntaxException _ false))) - -(def Uri (FunctionPredicate. parsable-uri?)) - -(def UriStr (refined NonEmptyStr Uri)) - -(defn parsable-url? [url] - (try - (URL. url) - true - (catch MalformedURLException _ false))) - -(def Url (FunctionPredicate. parsable-url?)) - -(def UrlStr (refined NonEmptyStr Url)) - -;; -;; string predicates -;; - -(defn StartsWith [prefix] - (FunctionPredicate. #(starts-with? % prefix))) - -(defn StartsWithStr [prefix] - (refined s/Str (StartsWith prefix))) - -(defn EndsWith [suffix] - (FunctionPredicate. #(ends-with? % suffix))) - -(defn EndsWithStr [suffix] - (refined s/Str (EndsWith suffix))) - -(defn Includes [substr] - (FunctionPredicate. #(includes? % substr))) - -(defn IncludesStr [substr] - (refined s/Str (Includes substr))) - -(def LowerCased - (FunctionPredicate. #(= %1 (cstr/lower-case %1)))) - -(def LowerCasedStr - (refined s/Str LowerCased)) - -(def UpperCased - (FunctionPredicate. #(= %1 (cstr/upper-case %1)))) - -(def UpperCasedStr - (refined s/Str UpperCased)) - -;; -;; collection predicates -;; - -(def Empty - (reify - Predicate - (predicate-apply [_ value] - (empty? value)) - PredicateShow - (predicate-show [_ sym] - (format "%s = ∅" sym)))) - -(def NonEmpty - (reify - Predicate - (predicate-apply [_ value] - (not (empty? value))) - PredicateShow - (predicate-show [_ sym] - (format "%s ≠ ∅" sym)))) - -(defn BoundedSize [left right] - {:pre [(integer? left) - (integer? right) - (pos? left) - (pos? right)]} - (On count (ClosedInterval left right))) - -(defrecord DistinctByPredicate [f] - Predicate - (predicate-apply [_ value] - (or (empty? value) - (apply distinct? (map f value)))) - PredicateShow - (predicate-show [_ sym] - (if (= identity f) - (format "(distinct? %s)" sym) - (format "(distinct-by? %s %s)" (schema-utils/fn-name f) sym)))) - -(defmethod print-method DistinctByPredicate - [p ^java.io.Writer writer] - (predicate-print-method p writer)) - -(def Distinct - (DistinctByPredicate. identity)) - -(defn DistinctBy [f] - {:pre [(ifn? f)]} - (DistinctByPredicate. f)) - -(defrecord ForallPredicate [pred] - Predicate - (predicate-apply [_ value] - (every? (partial predicate-apply pred) value)) - PredicateShow - (predicate-show [_ sym] - (let [sym' (str sym "'")] - (format "∀%s ∊ %s: %s" sym' sym (predicate->str pred sym' false))))) - -(defmethod print-method ForallPredicate - [p ^java.io.Writer writer] - (predicate-print-method p writer)) - -(defn Forall [p] - (ForallPredicate. (coerce p))) - -(defrecord ExistsPredicate [pred] - Predicate - (predicate-apply [_ value] - (not (nil? (some (partial predicate-apply pred) value)))) - PredicateShow - (predicate-show [_ sym] - (let [sym' (str sym "'")] - (format "∃%s ∊ %s: %s" sym' sym (predicate->str pred sym' false))))) - -(defmethod print-method ExistsPredicate - [p ^java.io.Writer writer] - (predicate-print-method p writer)) - -(defn Exists [p] - (ExistsPredicate. (coerce p))) - -(defn First [p] - (On first (coerce p))) - -(defn Second [p] - (On second (coerce p))) - -(defrecord IndexPredicate [n pred] - Predicate - (predicate-apply [_ value] - (predicate-apply pred (nth value n))) - PredicateShow - (predicate-show [_ sym] - (let [sym' (str sym "'")] - (format "%s = %s[%s]: %s" sym' sym n (predicate->str pred sym' false))))) - -(defmethod print-method IndexPredicate - [p ^java.io.Writer writer] - (predicate-print-method p writer)) - -(defn Index [n p] - {:pre [(integer? n)]} - (IndexPredicate. n (coerce p))) - -(defn Rest [p] - (On rest (Forall p))) - -(defn Last [p] - (On last (coerce p))) - -(defn Butlast [p] - (On butlast (Forall p))) - -(defrecord PairwisePredicate [pred] - Predicate - (predicate-apply [_ value] - (->> (map vector value (rest value)) - (every? (partial predicate-apply pred)))) - PredicateShow - (predicate-show [_ sym] - (let [sym' (format "[%s[i], %s[i+1]]" sym sym)] - (format "∀i ∊ [0, (dec (count %s))): %s" - sym - (predicate->str pred sym' false))))) - -(defmethod print-method PairwisePredicate - [p ^java.io.Writer writer] - (predicate-print-method p writer)) - -(defn Pairwise [p] - (PairwisePredicate. (coerce p))) - -;; -;; more ordering predicates -;; - -(defn AscendingOn [f] - {:pre [(ifn? f)]} - (Pairwise (fn [[a b]] - (<= (compare (f a) (f b)) 0)))) - -(defn DescendingOn [f] - {:pre [(ifn? f)]} - (Pairwise (fn [[a b]] - (<= 0 (compare (f a) (f b)))))) - -(defn AscendingBy [f] - {:pre [(ifn? f)]} - (Pairwise #(<= (f (first %1) (second %1)) 0))) - -(defn DescendingBy [f] - {:pre [(ifn? f)]} - (Pairwise #(<= 0 (f (first %1) (second %1))))) - -(def Ascending - (AscendingBy compare)) - -(def Descending - (DescendingBy compare)) - -;; -;; collection types -;; - -(def EmptyList (refined [] Empty)) - -(def EmptySet (refined #{} Empty)) - -(def EmptyMap (refined {} Empty)) - -(defn NonEmptyListOf [dt] - {:pre [(schema? dt)]} - (refined [dt] NonEmpty)) - -(defn NonEmptyMapOf [key-dt value-dt] - {:pre [(schema? key-dt) - (schema? value-dt)]} - (refined {key-dt value-dt} NonEmpty)) - -(defn NonEmptySetOf [dt] - {:pre [(schema? dt)]} - (refined #{dt} NonEmpty)) - -(defn BoundedListOf - ([dt size] (BoundedListOf dt size size)) - ([dt left right] - {:pre [(schema? dt) - (<= 0 left right)]} - (refined [dt] (BoundedSize left right)))) - -(defn BoundedSetOf - ([dt size] (BoundedSetOf dt size size)) - ([dt left right] - {:pre [(schema? dt) - (<= 0 left right)]} - (refined #{dt} (BoundedSize left right)))) - -(defn BoundedMapOf - ([key-dt value-dt size] (BoundedMapOf key-dt value-dt size size)) - ([key-dt value-dt left right] - {:pre [(schema? key-dt) - (schema? value-dt) - (<= 0 left right)]} - (refined {key-dt value-dt} (BoundedSize left right)))) - -(defn SingleValueListOf [dt] - {:pre [(schema? dt)]} - (BoundedListOf dt 1)) - -(defn SingleValueSetOf [dt] - {:pre [(schema? dt)]} - (BoundedSetOf dt 1)) - -(defn SingleValueMapOf [key-dt value-dt] - {:pre [(schema? key-dt) - (schema? value-dt)]} - (BoundedMapOf key-dt value-dt 1)) - -(defn DistinctListOf [dt] - {:pre [(schema? dt)]} - (refined [dt] Distinct)) - -(defn NonEmptyDistinctListOf [dt] - {:pre [(schema? dt)]} - (refined (DistinctListOf dt) NonEmpty)) - -;; -;; maps -;; - -(defn AtLeastMap [dt] - {:pre [(map? dt)]} - (assoc dt s/Any s/Any)) - -(defn NonStrictMap [dt] - {:pre [(map? dt)]} - (->> dt - (map - (fn [[k v]] - [(s/optional-key k) (s/maybe v)])) - (into {}))) - -;; -;; simple sum type -;; - -(defn dispatch-on - "Define a conditional schema by specifying determinant function - (most likely a keyword) followed by the list of potential values - and appropriate schemas. Throws if the result of determinant - function does not confirm any listed value (the same as conditional - does when no match found). In case subtypes are maps, please consider - using Struct and StructDispatch, that would give you flexibility to deal - with constrains (guards). - - Last pair treats :else value the same way conditional does. - Has optional last symbol parameter to be returned in error if none of - conditions match. - - Quick example: - - (def Point (BoundedListOf double 2)) - (def Dot (SingleValueListOf Point)) - (def Line (BoundedListOf Point 2)) - (def Triangle (s/constrained (BoundedListOf Point 3) #(not (singular? %)))) - (def RandomShape (NonEmptyListOf Point)) - - (def Polygon - (dispatch-on count - 1 Dot - 2 Line - 3 Triangle - :else RandomShape))" - [key-fn & subtypes] - {:pre [(not (empty? subtypes)) - (or (even? (count subtypes)) - (and (symbol? (last subtypes)) - (>= (count subtypes) 3)))]} - (let [pairs (partition 2 subtypes) - [last-key last-type] (last pairs) - all-pairs (concat (mapcat (fn [[value type]] - [#(= value (key-fn %)) type]) - (butlast pairs)) - [(if (= :else last-key) - :else - #(= last-key (key-fn %))) - last-type] - (if (odd? (count subtypes)) - [(last subtypes)] - []))] - (apply s/conditional all-pairs))) - -;; -;; guarded structs -;; - -;; based on potemkin's def-map-type -(defprotocol RefinedMapType - (empty* [m]) - (get* [m k default]) - (assoc* [m k v]) - (dissoc* [m k]) - (keys* [m]) - (with-meta* [o mta]) - (meta* [o])) - -(defmacro -def-map-type - {:style/indent [2 :form :form [1]]} - [name params & body] - `(deftype ~name ~params - schema_refined.core.RefinedMapType - ~@body - - clojure.lang.MapEquivalence - - clojure.lang.IPersistentCollection - (equiv [this# x#] - (and (or (instance? java.util.Map x#) (map? x#)) - (= x# (into {} this#)))) - (cons [this# o#] - (cond - (map? o#) - (reduce #(apply assoc %1 %2) this# o#) - - (instance? java.util.Map o#) - (reduce #(apply assoc %1 %2) this# (into {} o#)) - - :else - (if-let [[k# v#] (seq o#)] - (assoc this# k# v#) - this#))) - - clojure.lang.IObj - (withMeta [this# m#] - (schema-refined.core/with-meta* this# m#)) - (meta [this#] - (schema-refined.core/meta* this#)) - - clojure.lang.Counted - (count [this#] - (count (schema-refined.core/keys* this#))) - - clojure.lang.Seqable - (seq [this#] - (seq - (map - #(.entryAt this# %) - (schema-refined.core/keys* this#)))) - - clojure.core.protocols.CollReduce - (coll-reduce [this# f#] - (reduce f# (seq this#))) - (coll-reduce [this# f# v#] - (reduce f# v# (seq this#))) - - clojure.lang.IHashEq - (hasheq [this#] - (hash-unordered-coll (or (seq this#) ()))) - - Object - (hashCode [this#] - (reduce - (fn [acc# [k# v#]] - (unchecked-add acc# (bit-xor (clojure.lang.Util/hash k#) - (clojure.lang.Util/hash v#)))) - 0 - (seq this#))) - (equals [this# x#] - (or (identical? this# x#) - (and - (or (instance? java.util.Map x#) (map? x#)) - (= x# (into {} this#))))) - (toString [this#] - (str (into {} this#))) - - clojure.lang.ILookup - (valAt [this# k#] - (.valAt this# k# nil)) - (valAt [this# k# default#] - (schema-refined.core/get* this# k# default#)) - - clojure.lang.Associative - (containsKey [this# k#] - (contains? (.keySet this#) k#)) - (entryAt [this# k#] - (when (contains? (.keySet this#) k#) - (clojure.lang.MapEntry. k# (get this# k#)))) - (assoc [this# k# v#] - (schema-refined.core/assoc* this# k# v#)) - (empty [this#] - (schema-refined.core/empty* this#)) - - java.util.Map - (get [this# k#] - (.valAt this# k#)) - (isEmpty [this#] - (empty? this#)) - (size [this#] - (count this#)) - (keySet [this#] - (set (schema-refined.core/keys* this#))) - (put [_ _ _] - (throw (UnsupportedOperationException.))) - (putAll [_ _] - (throw (UnsupportedOperationException.))) - (clear [_] - (throw (UnsupportedOperationException.))) - (remove [_ _] - (throw (UnsupportedOperationException.))) - (values [this#] - (->> this# seq (map second))) - (entrySet [this#] - (->> this# seq set)) - - java.util.Iterator - (iterator [this#] - (clojure.lang.SeqIterator. this#)) - - clojure.lang.IPersistentMap - (assocEx [this# k# v#] - (if (contains? this# k#) - (throw (Exception. "Key or value already present")) - (assoc this# k# v#))) - (without [this# k#] - (schema-refined.core/dissoc* this# k#)) - - clojure.lang.IFn - (invoke [this# k#] (get this# k#)) - (invoke [this# k# not-found#] (get this# k# not-found#)))) - -(defprotocol Guardable - (append-guard [this guard]) - (get-guards [this])) - -(defn cleanup-guards [guards k] - (remove #(contains? (:slice-set %) k) guards)) - -(-def-map-type StructMap [data guards mta] - (empty* [_] (StructMap. {} [] {})) - (get* [_ k default-value] (get data k default-value)) - (assoc* [_ k v] (StructMap. (assoc data k v) guards mta)) - (dissoc* [_ k] (StructMap. (dissoc data k) (cleanup-guards guards k) mta)) - (keys* [_] (keys data)) - (meta* [_] mta) - (with-meta* [_ m] (StructMap. data guards m))) - -(extend-type StructMap - Guardable - (append-guard [^StructMap this guard] - (StructMap. (.data this) (conj (.guards this) guard) (.mta this))) - (get-guards [^StructMap this] (.guards this)) - s/Schema - (spec [this] this) - (explain [^StructMap this] - (cons 'guarded-struct (map s/explain (.data this)))) - schema-spec/CoreSpec - (subschemas [^StructMap this] - [(.data this)]) - (checker [^StructMap this params] - (fn [x] - (let [main-checker (schema-spec/sub-checker {:schema (.data this)} params) - tx (main-checker x)] - (if (schema-utils/error? tx) - tx - (reduce (fn [_ {:keys [slice guard name]}] - (let [x' (select-keys x slice) - next-schema (s/pred guard (or name 'not-complaint-with-guard)) - checker (schema-spec/sub-checker {:schema next-schema} params) - tx' (checker x')] - (when (schema-utils/error? tx') - (reduced tx')))) - nil - (get-guards this))))))) - -(defn guards->str [guards] - (if (empty? guards) - "" - (->> guards - (map (fn [{:keys [name slice]}] - (format " <%s> over %s" name (pr-str slice)))) - (cstr/join "\n") - (format "\n Guarded with\n%s")))) - -(defmethod print-method StructMap - [^StructMap struct ^java.io.Writer writer] - (let [all-guards (get-guards struct) - f (format "#" - (.data struct) - (guards->str all-guards))] - (.write writer f))) - -(defn map->struct [data] - (StructMap. data [] nil)) - -(defn Struct - "Defines map-like schema that you can further restrict with guards still having - the flexibility to add new fields or remove existing." - [& key-values] - {:pre [(even? (count key-values))]} - (map->struct (apply hash-map key-values))) - -(defn guard - "Restrict given Struct or StructDispatch the same way s/contrained does, but gives you - flexibility to transform structs whenever necessary by adding or removing fields (using - `assoc` and `dissoc` as you would do with the plain map). Note, that `dissoc` - operation cleans up guard when key under the question is mentioned in `keys-slice` - (that's actually the only reason you need to specify a slice of keys in advance, - as there is no way to compute them prior to executing checker function)." - ([struct keys-slice guard-fn] - (guard struct keys-slice guard-fn nil)) - ([struct keys-slice guard-fn guard-name] - {:pre [(satisfies? Guardable struct) - (ifn? guard-fn) - (not (empty? keys-slice)) - (or (nil? guard-name) (symbol? guard-name))]} - (let [new-guard {:slice keys-slice - :slice-set (set keys-slice) - :guard guard-fn - :name guard-name}] - (append-guard struct new-guard)))) - -(defn apply-struct-updates-to [updates base] - (reduce - (fn [state [op & args]] - (case op - :assoc (assoc state (first args) (second args)) - :dissoc (dissoc state (first args)))) - base - updates)) - -(defn append-guards-to [guards schema] - (reduce - (fn [state guard] - (append-guard state guard)) - schema - guards)) - -(-def-map-type StructDispatchMap [keys-slice - downstream-slice - dispatch-fn - options - guards - updates - mta] - (empty* [_] (StructDispatchMap. [] [] (constantly ::empty) [[::empty {}]] [] [] nil)) - (get* [_ k default-value] (get (apply-struct-updates-to updates {}) k default-value)) - (assoc* [_ k v] (StructDispatchMap. - keys-slice - downstream-slice - dispatch-fn - options - guards - (conj updates [:assoc k v]) - mta)) - (dissoc* [_ k] - (cond - (contains? keys-slice k) - (throw (IllegalArgumentException. - (str "You are trying to dissoc key '" - k - "' that is used in dispatch function. " - "Even tho' it's doable theoratically, we are kindly encourage you " - "avoid such kind of manipulations. It's gonna be a mess."))) - - (contains? downstream-slice k) - (throw (IllegalArgumentException. - (str "Meh. Would not work. One of the options provided actually " - "relies on the key '" k "'. Sorry, but I cannot take a risk here."))) - - :else - (StructDispatchMap. - keys-slice - downstream-slice - dispatch-fn - options - guards - (conj updates [:dissoc k]) - mta))) - (keys* [_] (keys (apply-struct-updates-to updates {}))) - (meta* [_] mta) - (with-meta* [_ m] (StructDispatchMap. - keys-slice - downstream-slice - dispatch-fn - options - guards - updates - m))) - -(defmethod print-method StructDispatchMap - [^StructDispatchMap struct ^java.io.Writer writer] - (let [options (->> (.options struct) - (map (fn [[value option]] - (format " %s => %s" value option))) - (cstr/join "\n")) - all-guards (get-guards ^Guardable struct) - guarded (guards->str all-guards) - f (format "#" - (.dispatch-fn struct) - options - guarded)] - (.write writer f))) - -(extend-type StructDispatchMap - Guardable - (append-guard [^StructDispatchMap this guard] - (StructDispatchMap. - (.keys-slice this) - (.downstream-slice this) - (.dispatch-fn this) - (.options this) - (conj (.guards this) guard) - (.updates this) - (.mta this))) - (get-guards [^StructDispatchMap this] (.guards this)) - s/Schema - (spec [this] this) - (explain [^StructDispatchMap this] - (cons 'struct-dispatch (map s/explain (map second (.options this))))) - schema-spec/CoreSpec - (subschemas [^StructDispatchMap this] - (map second (.options this))) - (checker [^StructDispatchMap this params] - (fn [x] - (let [dispatch-value ((.dispatch-fn this) (select-keys x (.keys-slice this))) - dispatch-schema (or (->> (.options this) - (filter #(= dispatch-value (first %))) - first) - ;; use `:else` branch when set - (let [[k v] (last (.options this))] - (when (= :else k) [:else v])))] - (if (nil? dispatch-schema) - (schema-utils/error (format "Dispatch value '%s' not found among options %s" - dispatch-value - (mapv first (.options this)))) - (let [dispatch-schema' (->> dispatch-schema - second - (append-guards-to (get-guards this)) - (apply-struct-updates-to (.updates this))) - checker (schema-spec/sub-checker {:schema dispatch-schema'} params)] - (checker x))))))) - -(defn StructDispatch - "Works the same way as `dispatch-on` but creates a data structure similar to struct - that might be updated with assoc/dissoc and guarded using `guard` function to created - delayed contrains. - - If dispatch function is not a keyword (read 'field') you need to specify keys slice - to prevent dissoc fields necessary to make a dispatch further. Each suboption should be - either map, StructMap or StructDispatch, map would be converted to Struct. - - Putting last option with ':else' as a dispatch result would match anything if the - appropriate value was not found earlier." - [& args] - (let [fa (first args) - [keys-slice dispatch-fn rest-args] - (if (keyword? fa) - [(set [fa]) fa (rest args)] - [(set fa) (second args) (drop 2 args)])] - (when (empty? rest-args) - (throw (IllegalArgumentException. "no options provided"))) - - (when (odd? (count rest-args)) - (throw (IllegalArgumentException. "dispatch argument could not be paired"))) - - (let [options (->> rest-args - (partition 2) - (map (fn [[k v]] - (cond - (instance? StructDispatchMap v) [k v] - (instance? StructMap v) [k v] - (map? v) [k (map->struct v)] - (satisfies? s/Schema v) [k v] - :else (throw - (IllegalArgumentException. - (format (str "Invalid dispatch subtype given for <%s>: %s\n" - "Should be one of the following: " - "StructMap, StructDispatch, map or any Schema") - k - v))))))) - overlap (->> options - (map first) - (frequencies) - (filter (fn [[k n]] (< 1 n))) - (map first)) - _ (when-not (empty? overlap) - (throw - (IllegalArgumentException. - (format "Some of the dispatch options listed more than once: %s" - overlap)))) - downstream-slice (->> options - (mapcat (fn [[k v]] - (if-not (instance? StructDispatchMap v) - [] - (into (.keys-slice ^StructDispatchMap v) - (.downstream-slice ^StructDispatchMap v))))) - (set))] - (StructDispatchMap. keys-slice downstream-slice dispatch-fn options [] [] nil)))) diff --git a/src/schema_refined/core.cljc b/src/schema_refined/core.cljc new file mode 100644 index 0000000..2a702c5 --- /dev/null +++ b/src/schema_refined/core.cljc @@ -0,0 +1,914 @@ +(ns schema-refined.core + (:require [schema.core :as s] + [schema.spec.core :as schema-spec] + [schema.spec.variant :as schema-variant] + [schema.utils :as schema-utils] + [clojure.string :as cstr] + #?(:cljs [goog.string :refer [format]])) + #?(:clj (:refer-clojure :exclude [boolean?])) + #?(:cljs (:refer-clojure :exclude [Empty EmptyList])) + #?(:clj (:import (java.net URI URISyntaxException URL MalformedURLException)))) +;; +;; helpers & basic definitions +;; + +#?(:clj + (defn boolean? + "Backported boolean? from Clojure 1.9" + [x] + (instance? Boolean x))) + +(defn starts-with? + "True if s starts with substr. Backported from Clojure 1.8" + [^CharSequence s ^String substr] + (.startsWith (.toString s) substr)) + +(defn ends-with? + "True if s ends with substr. Backported from Clojure 1.8" + [^CharSequence s ^String substr] + (.endsWith (.toString s) substr)) + +(defn includes? + "True if s includes substr. Backported from Clojure 1.8" + [^CharSequence s ^CharSequence substr] + #?(:clj (.contains (.toString s) substr) + :cljs (.includes (.toString s) substr))) + +(defn schema? [dt] + (satisfies? s/Schema dt)) + +(defprotocol Predicate + (predicate-apply [this value])) + +(defprotocol PredicateShow + (predicate-show [this sym])) + +(defn predicate? [p] + (satisfies? Predicate p)) + +(defn predicate->str + ([pred] (predicate->str pred "v" false)) + ([pred sym bounded?] + {:pre [(predicate? pred)]} + (let [pred-str (if (satisfies? PredicateShow pred) + (predicate-show pred sym) + (str pred))] + (cond->> pred-str + (and bounded? (not (starts-with? pred-str "("))) + (format "(%s)"))))) + +(defn predicate-print-method [pred ^java.io.Writer writer] + (.write writer (format "#Predicate{%s}" (predicate->str pred)))) + +(defrecord FunctionPredicate [pred] + Predicate + (predicate-apply [_ value] + (pred value)) + PredicateShow + (predicate-show [_ sym] + (format "(%s %s)" (schema-utils/fn-name pred) sym))) + +#?(:clj + (defmethod print-method FunctionPredicate + [rs ^java.io.Writer writer] + (predicate-print-method rs writer))) + +(defrecord SchemaPredicate [schema] + Predicate + (predicate-apply [_ value] + (nil? (s/check schema value))) + PredicateShow + (predicate-show [_ sym] + (format "%s: %s" sym schema))) + +#?(:clj + (defmethod print-method SchemaPredicate + [rs ^java.io.Writer writer] + (predicate-print-method rs writer))) + +(defrecord RefinedSchema [schema pred] + s/Schema + (spec [this] + (schema-variant/variant-spec + schema-spec/+no-precondition+ + [{:schema schema}] + nil + (schema-spec/precondition + this + (partial predicate-apply pred) + #(list (symbol (schema-utils/fn-name pred)) %)))) + (explain [_] (list 'refined (s/explain schema) (symbol (schema-utils/fn-name pred))))) + +;; Use common representation in the following format: +;; +;; #Refined{v: T | (P v)} +;; +;; where T is a type (schema) and (P v) is the respresentation of +;; appropriate predicate. +#?(:clj + (defmethod print-method RefinedSchema + [^RefinedSchema rs ^java.io.Writer writer] + (let [schema (:schema rs) + schema-name (if (fn? schema?) + (schema-utils/fn-name schema) + schema) + f (format "#Refined{v: %s | %s}" schema-name (predicate->str (:pred rs)))] + (.write writer f)))) + +#?(:clj (defn coerce + "Turn function or schema to appropriate predicates" + [pred] + {:pre [(or (predicate? pred) + (ifn? pred) + (schema? pred))]} + (cond + (predicate? pred) + pred + + (schema? pred) + (SchemaPredicate. pred) + + (ifn? pred) + (FunctionPredicate. pred)))) + +#?(:cljs (defn coerce + "Turn function or schema to appropriate predicates" + [pred] + {:pre [(or (predicate? pred) + (ifn? pred) + (schema? pred))]} + (cond + (predicate? pred) + pred + + (ifn? pred) + (FunctionPredicate. pred) + + (schema? pred) + (SchemaPredicate. pred)))) + + + +(defn refined + "Takes type (schema) and a predicate, creating a type that + should satisfy both basic type and predicate. Note, that predicate might be + specified as Predicate (protocol), simple function from `dt` type + to boolean or another type (schema)" + [dt pred] + {:pre [(schema? dt)]} + (RefinedSchema. dt (coerce pred))) + +;; +;; boolean operations +;; + +(defrecord NotPredicate [pred] + Predicate + (predicate-apply [_ value] + (not (predicate-apply pred value))) + PredicateShow + (predicate-show [_ sym] + (format "(not %s)" (predicate->str pred sym true)))) + +(defn Not [p] + (NotPredicate. (coerce p))) + +#?(:clj + (defmethod print-method NotPredicate + [p ^java.io.Writer writer] + (predicate-print-method p writer))) + +(defrecord AndPredicate [p1 p2] + Predicate + (predicate-apply [_ value] + (and (predicate-apply p1 value) (predicate-apply p2 value))) + PredicateShow + (predicate-show [_ sym] + (format "(and %s %s)" + (predicate->str p1 sym true) + (predicate->str p2 sym true)))) + +;; xxx: we can support > 2 arguments here +(defn And + "Creates predicate that ensures both predicates given are safisfied" + [p1 p2] + (AndPredicate. (coerce p1) (coerce p2))) + +#?(:clj + (defmethod print-method AndPredicate + [p ^java.io.Writer writer] + (predicate-print-method p writer))) + +(defrecord OrPredicate [p1 p2] + Predicate + (predicate-apply [_ value] + (or (predicate-apply p1 value) (predicate-apply p2 value))) + PredicateShow + (predicate-show [_ sym] + (format "(or %s %s)" + (predicate->str p1 sym true) + (predicate->str p2 sym true)))) + +(defn Or + "Creates the predicate that ensures at least one predicate is satisfied" + [p1 p2] + (OrPredicate. (coerce p1) (coerce p2))) + +#?(:clj + (defmethod print-method OrPredicate + [p ^java.io.Writer writer] + (predicate-print-method p writer))) + +(defrecord OnPredicate [on-fn pred] + Predicate + (predicate-apply [_ value] + (predicate-apply pred (on-fn value))) + PredicateShow + (predicate-show [_ sym] + (let [sym' (format "(%s %s)" (schema-utils/fn-name on-fn) sym)] + (predicate->str pred sym' false)))) + +(defn On + "Creates the predicate to ensure that the result of applying function + `on-fn` to the value satisfies the predicate `pred`" + [on-fn pred] + {:pre [(ifn? on-fn)]} + (OnPredicate. on-fn (coerce pred))) + +#?(:clj + (defmethod print-method OnPredicate + [p ^java.io.Writer writer] + (predicate-print-method p writer))) + +;; +;; ordering predicates +;; + +(defrecord EqualPredicate [n] + Predicate + (predicate-apply [_ value] + (= value n)) + PredicateShow + (predicate-show [_ sym] + (format "%s = %s" sym n))) + +#?(:clj + (defmethod print-method EqualPredicate + [p writer] + (predicate-print-method p writer))) + +(defn Equal + "A value that must be = n" + [n] + (EqualPredicate. n)) + +(defrecord LessPredicate [n] + Predicate + (predicate-apply [_ value] + (< value n)) + PredicateShow + (predicate-show [_ sym] + (format "%s < %s" sym n))) + +#?(:clj + (defmethod print-method LessPredicate + [p writer] + (predicate-print-method p writer))) + +(defn Less + "A value that must be < n" + [n] + (LessPredicate. n)) + +(defrecord LessOrEqualPredicate [n] + Predicate + (predicate-apply [_ value] + (<= value n)) + PredicateShow + (predicate-show [_ sym] + (format "%s ≤ %s" sym n))) + +#?(:clj + (defmethod print-method LessOrEqualPredicate + [p writer] + (predicate-print-method p writer))) + +(defn LessOrEqual + "A value that must be < n" + [n] + (LessOrEqualPredicate. n)) + +(defrecord GreaterPredicate [n] + Predicate + (predicate-apply [_ value] + (< n value)) + PredicateShow + (predicate-show [_ sym] + (format "%s < %s" n sym))) + +#?(:clj + (defmethod print-method GreaterPredicate + [p writer] + (predicate-print-method p writer))) + +(defn Greater + "A value that must be > n" + [n] + (GreaterPredicate. n)) + +(defrecord GreaterOrEqualPredicate [n] + Predicate + (predicate-apply [_ value] + (<= n value)) + PredicateShow + (predicate-show [_ sym] + (format "%s ≤ %s" n sym))) + +#?(:clj + (defmethod print-method GreaterOrEqualPredicate + [p writer] + (predicate-print-method p writer))) + +(defn GreaterOrEqual + "A value that must be >= n" + [n] + (GreaterOrEqualPredicate. n)) + +(defrecord OpenIntervalPredicate [a b] + Predicate + (predicate-apply [_ value] + (< a value b)) + PredicateShow + (predicate-show [_ sym] + (format "%s ∈ (%s, %s)" sym a b))) + +(defn OpenInterval + "a < value < b" + [a b] + {:pre [(< a b)]} + (OpenIntervalPredicate. a b)) + +(defrecord ClosedIntervalPredicate [a b] + Predicate + (predicate-apply [_ value] + (<= a value b)) + PredicateShow + (predicate-show [_ sym] + (format "%s ∈ [%s, %s]" sym a b))) + +(defn ClosedInterval + "a <= value <= b" + [a b] + {:pre [(<= a b)]} + (ClosedIntervalPredicate. a b)) + +(defrecord OpenClosedIntervalPredicate [a b] + Predicate + (predicate-apply [_ value] + (and (< a value) (<= value b))) + PredicateShow + (predicate-show [_ sym] + (format "%s ∈ (%s, %s]" sym a b))) + +(defn OpenClosedInterval + "a < value <= b" + [a b] + {:pre [(< a b)]} + (OpenClosedIntervalPredicate. a b)) + +(defrecord ClosedOpenIntervalPredicate [a b] + Predicate + (predicate-apply [_ value] + (and (<= a value) (< value b))) + PredicateShow + (predicate-show [_ sym] + (format "%s ∈ [%s, %s)" sym a b))) + +(defn ClosedOpenInterval + "a <= value < b" + [a b] + {:pre [(< a b)]} + (ClosedOpenIntervalPredicate. a b)) + +(defn Epsilon [center radius] + (OpenInterval (- center radius) (+ center radius))) + +;; +;; numeric predicates +;; + +(def Even (FunctionPredicate. even?)) + +(def Odd (FunctionPredicate. odd?)) + +(defrecord ModuloPredicate [div o] + Predicate + (predicate-apply [_ value] + (= o (mod value div))) + PredicateShow + (predicate-show [_ sym] + (format "%s mod %s = %s" sym div o))) + +(defn Modulo + "The value modulus by div = o" + [div o] + (ModuloPredicate. div o)) + +(defn DivisibleBy [n] + (Modulo n 0)) + +(defn NonDivisibleBy [n] + (Not (DivisibleBy n))) + +;; +;; numeric types +;; + +(defn PositiveOf [dt] + {:pre [(schema? dt)]} + (refined dt (Greater 0))) + +(defn NegativeOf [dt] + {:pre [(schema? dt)]} + (refined dt (Less 0))) + +(defn NonNegativeOf [dt] + {:pre [(schema? dt)]} + (refined dt (GreaterOrEqual 0))) + +(defn NonPositiveOf [dt] + {:pre [(schema? dt)]} + (refined dt (LessOrEqual 0))) + +(def PositiveInt (PositiveOf s/Int)) + +(def NegativeInt (NegativeOf s/Int)) + +(def NonNegativeInt (NonNegativeOf s/Int)) + +(def NonPositiveInt (NonPositiveOf s/Int)) + +#?(:clj + (do + (def PositiveDouble (PositiveOf double)) + (def NegativeDouble (NegativeOf double)) + (def NonNegativeDouble (NonNegativeOf double)) + (def NonPositiveDouble (NonPositiveOf double)))) + +#?(:cljs + (do + (def PositiveDouble (PositiveOf s/Num)) + (def NegativeDouble (NegativeOf s/Num)) + (def NonNegativeDouble (NonNegativeOf s/Num)) + (def NonPositiveDouble (NonPositiveOf s/Num)))) + +(defn EpsilonOf [dt center radius] + {:pre [(schema? dt)]} + (refined dt (Epsilon center radius))) + +;; +;; ordering types +;; + +(defn OpenIntervalOf + "a < value < b" + [dt a b] + {:pre [(schema? dt)]} + (refined dt (OpenInterval a b))) + +(defn ClosedIntervalOf + "a <= value <= b" + [dt a b] + {:pre [(schema? dt)]} + (refined dt (ClosedInterval a b))) + +(defn OpenClosedIntervalOf + "a < value <= b" + [dt a b] + {:pre [(schema? dt)]} + (refined dt (OpenClosedInterval a b))) + +(defn ClosedOpenIntervalOf + "a <= value < b" + [dt a b] + {:pre [(schema? dt)]} + (refined dt (ClosedOpenInterval a b))) + +;; +;; strings & chars +;; + +(def NonEmptyStr + (refined s/Str (Not (FunctionPredicate. cstr/blank?)))) + +(defn BoundedSizeStr + ([min max] (BoundedSizeStr min max false)) + ([min max trimmed?] + {:pre [(<= min max) + (boolean? trimmed?)]} + (let [count-chars (if-not trimmed? + count + #(count (cstr/trim %1)))] + (refined s/Str (On count-chars (ClosedInterval min max)))))) + +(def DigitChar #"^[0-9]$") + +(def ASCIILetterChar #"^[a-zA-Z]$") + +(def ASCIILetterOrDigitChar #"^[0-9a-zA-Z]$") + +(def BitChar #"^[0|1]$") + +(def BitStr #"^[0|1]*$") + +#?(:clj + (defn parsable-int? [s] + (try + (Integer/parseInt s) + true + (catch NumberFormatException _ false))) + :cljs + (defn parsable-int? [s] + (.isInteger js/Number (js/parseInt s)))) + +(def IntStr (refined NonEmptyStr parsable-int?)) + +#?(:clj + (defn parsable-float? [s] + (try + (Float/parseFloat s) + true + (catch NumberFormatException _ false))) + :cljs + (defn parsable-float? [s] + (not (.isNaN js/Number (js/parseFloat s))))) + +(def FloatStr (refined NonEmptyStr parsable-float?)) + +#?(:clj + (defn parsable-uri? [uri] + (try + (URI. uri) + true + (catch URISyntaxException _ false)))) +#?(:cljs + (defn parsable-uri? [uri] + (try + (js/URI. uri) + true + (catch js/Error _ false)))) + +(def Uri (FunctionPredicate. parsable-uri?)) + +(def UriStr (refined NonEmptyStr Uri)) + +#?(:clj + (defn parsable-url? [url] + (try + (URL. url) + true + (catch MalformedURLException _ false)))) +#?(:cljs + (defn parsable-url? [url] + (try + (js/URL. url) + true + (catch js/Error _ false)))) + +(def Url (FunctionPredicate. parsable-url?)) + +(def UrlStr (refined NonEmptyStr Url)) + +;; +;; string predicates +;; + +(defn StartsWith [prefix] + (FunctionPredicate. #(starts-with? % prefix))) + +(defn StartsWithStr [prefix] + (refined s/Str (StartsWith prefix))) + +(defn EndsWith [suffix] + (FunctionPredicate. #(ends-with? % suffix))) + +(defn EndsWithStr [suffix] + (refined s/Str (EndsWith suffix))) + +(defn Includes [substr] + (FunctionPredicate. #(includes? % substr))) + +(defn IncludesStr [substr] + (refined s/Str (Includes substr))) + +(def LowerCased + (FunctionPredicate. #(= %1 (cstr/lower-case %1)))) + +(def LowerCasedStr + (refined s/Str LowerCased)) + +(def UpperCased + (FunctionPredicate. #(= %1 (cstr/upper-case %1)))) + +(def UpperCasedStr + (refined s/Str UpperCased)) + +;; +;; collection predicates +;; + +(def Empty + (reify + Predicate + (predicate-apply [_ value] + (empty? value)) + PredicateShow + (predicate-show [_ sym] + (format "%s = ∅" sym)))) + +(def NonEmpty + (reify + Predicate + (predicate-apply [_ value] + (not (empty? value))) + PredicateShow + (predicate-show [_ sym] + (format "%s ≠ ∅" sym)))) + +(defn BoundedSize [left right] + {:pre [(integer? left) + (integer? right) + (pos? left) + (pos? right)]} + (On count (ClosedInterval left right))) + +(defrecord DistinctByPredicate [f] + Predicate + (predicate-apply [_ value] + (or (empty? value) + (apply distinct? (map f value)))) + PredicateShow + (predicate-show [_ sym] + (if (= identity f) + (format "(distinct? %s)" sym) + (format "(distinct-by? %s %s)" (schema-utils/fn-name f) sym)))) + +#?(:clj + (defmethod print-method DistinctByPredicate + [p ^java.io.Writer writer] + (predicate-print-method p writer))) + +(def Distinct + (DistinctByPredicate. identity)) + +(defn DistinctBy [f] + {:pre [(ifn? f)]} + (DistinctByPredicate. f)) + +(defrecord ForallPredicate [pred] + Predicate + (predicate-apply [_ value] + (every? (partial predicate-apply pred) value)) + PredicateShow + (predicate-show [_ sym] + (let [sym' (str sym "'")] + (format "∀%s ∊ %s: %s" sym' sym (predicate->str pred sym' false))))) + +#?(:clj + (defmethod print-method ForallPredicate + [p ^java.io.Writer writer] + (predicate-print-method p writer))) + +(defn Forall [p] + (ForallPredicate. (coerce p))) + +(defrecord ExistsPredicate [pred] + Predicate + (predicate-apply [_ value] + (not (nil? (some (partial predicate-apply pred) value)))) + PredicateShow + (predicate-show [_ sym] + (let [sym' (str sym "'")] + (format "∃%s ∊ %s: %s" sym' sym (predicate->str pred sym' false))))) + +#?(:clj + (defmethod print-method ExistsPredicate + [p ^java.io.Writer writer] + (predicate-print-method p writer))) + +(defn Exists [p] + (ExistsPredicate. (coerce p))) + +(defn First [p] + (On first (coerce p))) + +(defn Second [p] + (On second (coerce p))) + +(defrecord IndexPredicate [n pred] + Predicate + (predicate-apply [_ value] + (predicate-apply pred (nth value n))) + PredicateShow + (predicate-show [_ sym] + (let [sym' (str sym "'")] + (format "%s = %s[%s]: %s" sym' sym n (predicate->str pred sym' false))))) + +#?(:clj + (defmethod print-method IndexPredicate + [p ^java.io.Writer writer] + (predicate-print-method p writer))) + +(defn Index [n p] + {:pre [(integer? n)]} + (IndexPredicate. n (coerce p))) + +(defn Rest [p] + (On rest (Forall p))) + +(defn Last [p] + (On last (coerce p))) + +(defn Butlast [p] + (On butlast (Forall p))) + +(defrecord PairwisePredicate [pred] + Predicate + (predicate-apply [_ value] + (->> (map vector value (rest value)) + (every? (partial predicate-apply pred)))) + PredicateShow + (predicate-show [_ sym] + (let [sym' (format "[%s[i], %s[i+1]]" sym sym)] + (format "∀i ∊ [0, (dec (count %s))): %s" + sym + (predicate->str pred sym' false))))) + +#?(:clj + (defmethod print-method PairwisePredicate + [p ^java.io.Writer writer] + (predicate-print-method p writer))) + +(defn Pairwise [p] + (PairwisePredicate. (coerce p))) + +;; +;; more ordering predicates +;; + +(defn AscendingOn [f] + {:pre [(ifn? f)]} + (Pairwise (fn [[a b]] + (<= (compare (f a) (f b)) 0)))) + +(defn DescendingOn [f] + {:pre [(ifn? f)]} + (Pairwise (fn [[a b]] + (<= 0 (compare (f a) (f b)))))) + +(defn AscendingBy [f] + {:pre [(ifn? f)]} + (Pairwise #(<= (f (first %1) (second %1)) 0))) + +(defn DescendingBy [f] + {:pre [(ifn? f)]} + (Pairwise #(<= 0 (f (first %1) (second %1))))) + +(def Ascending + (AscendingBy compare)) + +(def Descending + (DescendingBy compare)) + +;; +;; collection types +;; + +(def EmptyList (refined [] Empty)) + +(def EmptySet (refined #{} Empty)) + +(def EmptyMap (refined {} Empty)) + +(defn NonEmptyListOf [dt] + {:pre [(schema? dt)]} + (refined [dt] NonEmpty)) + +(defn NonEmptyMapOf [key-dt value-dt] + {:pre [(schema? key-dt) + (schema? value-dt)]} + (refined {key-dt value-dt} NonEmpty)) + +(defn NonEmptySetOf [dt] + {:pre [(schema? dt)]} + (refined #{dt} NonEmpty)) + +(defn BoundedListOf + ([dt size] (BoundedListOf dt size size)) + ([dt left right] + {:pre [(schema? dt) + (<= 0 left right)]} + (refined [dt] (BoundedSize left right)))) + +(defn BoundedSetOf + ([dt size] (BoundedSetOf dt size size)) + ([dt left right] + {:pre [(schema? dt) + (<= 0 left right)]} + (refined #{dt} (BoundedSize left right)))) + +(defn BoundedMapOf + ([key-dt value-dt size] (BoundedMapOf key-dt value-dt size size)) + ([key-dt value-dt left right] + {:pre [(schema? key-dt) + (schema? value-dt) + (<= 0 left right)]} + (refined {key-dt value-dt} (BoundedSize left right)))) + +(defn SingleValueListOf [dt] + {:pre [(schema? dt)]} + (BoundedListOf dt 1)) + +(defn SingleValueSetOf [dt] + {:pre [(schema? dt)]} + (BoundedSetOf dt 1)) + +(defn SingleValueMapOf [key-dt value-dt] + {:pre [(schema? key-dt) + (schema? value-dt)]} + (BoundedMapOf key-dt value-dt 1)) + +(defn DistinctListOf [dt] + {:pre [(schema? dt)]} + (refined [dt] Distinct)) + +(defn NonEmptyDistinctListOf [dt] + {:pre [(schema? dt)]} + (refined (DistinctListOf dt) NonEmpty)) + +;; +;; maps +;; + +(defn AtLeastMap [dt] + {:pre [(map? dt)]} + (assoc dt s/Any s/Any)) + +(defn NonStrictMap [dt] + {:pre [(map? dt)]} + (->> dt + (map + (fn [[k v]] + [(s/optional-key k) (s/maybe v)])) + (into {}))) + +;; +;; simple sum type +;; + +(defn dispatch-on + "Define a conditional schema by specifying determinant function + (most likely a keyword) followed by the list of potential values + and appropriate schemas. Throws if the result of determinant + function does not confirm any listed value (the same as conditional + does when no match found). In case subtypes are maps, please consider + using Struct and StructDispatch, that would give you flexibility to deal + with constrains (guards). + + Last pair treats :else value the same way conditional does. + Has optional last symbol parameter to be returned in error if none of + conditions match. + + Quick example: + + (def Point (BoundedListOf double 2)) + (def Dot (SingleValueListOf Point)) + (def Line (BoundedListOf Point 2)) + (def Triangle (s/constrained (BoundedListOf Point 3) #(not (singular? %)))) + (def RandomShape (NonEmptyListOf Point)) + + (def Polygon + (dispatch-on count + 1 Dot + 2 Line + 3 Triangle + :else RandomShape))" + [key-fn & subtypes] + {:pre [(not (empty? subtypes)) + (or (even? (count subtypes)) + (and (symbol? (last subtypes)) + (>= (count subtypes) 3)))]} + (let [pairs (partition 2 subtypes) + [last-key last-type] (last pairs) + all-pairs (concat (mapcat (fn [[value type]] + [#(= value (key-fn %)) type]) + (butlast pairs)) + [(if (= :else last-key) + :else + #(= last-key (key-fn %))) + last-type] + (if (odd? (count subtypes)) + [(last subtypes)] + []))] + (apply s/conditional all-pairs))) + diff --git a/test/schema_refined/core_test.clj b/test/schema_refined/core_test.clj index 9d08ba2..ea9e9e3 100644 --- a/test/schema_refined/core_test.clj +++ b/test/schema_refined/core_test.clj @@ -1,7 +1,8 @@ (ns schema-refined.core-test (:require [schema-refined.core :as r] - [clojure.test :as t] - [schema.core :as s])) + [schema.core :as s] + [schema-refined.clojure :as sr] + [clojure.test :as t])) (defmacro ok! [dt value] `(t/is (nil? (s/check ~dt ~value)))) @@ -719,13 +720,13 @@ (not-ok! (r/NonStrictMap {:foo s/Int}) {:foo 1 :bar 2}) (not-ok! (r/NonStrictMap {:foo s/Int}) {:bar 2})) -(def -Ticket (r/Struct :id r/NonEmptyStr +(def -Ticket (sr/Struct :id r/NonEmptyStr :rev r/NonEmptyStr :price (s/maybe s/Num) :paid? s/Bool)) (def Ticket - (r/guard + (sr/guard -Ticket '(:price :paid?) (fn [{:keys [paid? price]}] @@ -741,9 +742,9 @@ (not-ok! (dissoc Ticket :id :rev) {:paid? true :price nil}) (ok! (dissoc Ticket :price) {:id "1" :rev "2" :paid? true})) -(def -BaseCode (r/map->struct {:id r/NonEmptyStr - :rev r/NonEmptyStr - :name r/NonEmptyStr})) +(def -BaseCode (sr/map->struct {:id r/NonEmptyStr + :rev r/NonEmptyStr + :name r/NonEmptyStr})) ;; still struct (def UnlockCode (assoc -BaseCode @@ -759,16 +760,16 @@ (def SecretCode {:codeType (s/eq "secret") :noValues r/NonEmptyStr}) -(def Code (r/StructDispatch +(def Code (sr/StructDispatch :codeType "unlock" UnlockCode "discount" DiscountCode "secret" SecretCode - "downstream" (r/StructDispatch + "downstream" (sr/StructDispatch :fromDownstream false {:fromDownstream (s/eq false)} true {:fromDownstream (s/eq true)}) - "customSlice" (assoc (r/StructDispatch + "customSlice" (assoc (sr/StructDispatch '(:name) (fn [{:keys [name]}] (inc (count name))) 1 {:name r/NonEmptyStr} @@ -776,7 +777,7 @@ :codeType (s/eq "customSlice")))) -(def CounterWithElse (r/StructDispatch +(def CounterWithElse (sr/StructDispatch :num 1 {:num (s/eq 1)} 2 {:num (s/eq 2)} @@ -808,7 +809,7 @@ (t/testing "dispatch with duplicated options" (t/is (thrown? IllegalArgumentException - (r/StructDispatch + (sr/StructDispatch :fromDownstream true {:fromDownstream (s/eq false)} true {:fromDownstream (s/eq true)})))) diff --git a/test/schema_refined/core_test.cljs b/test/schema_refined/core_test.cljs new file mode 100644 index 0000000..542744d --- /dev/null +++ b/test/schema_refined/core_test.cljs @@ -0,0 +1,830 @@ +(ns schema-refined.core-test + (:require-macros [schema-refined.macros :refer [ok! not-ok!]]) + (:require [schema-refined.core :as r] + [schema.core :as s] + [schema-refined.cljs :as sr] + [cljs.test :as t])) + +(defn numeric-map [size] + (->> size + range + (map-indexed vector) + (into {}))) + +(t/testing "refined" + (let [LatCoord (r/refined s/Num (r/OpenClosedInterval -90.0 90.0)) + LngCoord (r/OpenClosedIntervalOf s/Num -180.0 180.0) + GeoPoint {:lat LatCoord :lng LngCoord} + Route (r/BoundedListOf GeoPoint 2 50) + + input [{:lat 47.3529 :lng 8.5199} + {:lat 51.5085 :lng -0.0762} + {:lat 41.8705 :lng 12.4750}]] + + (t/deftest refined-with-built-in-predicates + (ok! Route input)) + + (t/deftest refined-with-built-in-pred-generics + (let [InZurich {:lat (r/refined s/Num (r/OpenInterval 47.34 47.39)) + :lng (r/refined s/Num (r/OpenInterval 8.51 8.57))} + + InRome {:lat (r/refined s/Num (r/OpenInterval 41.87 41.93)) + :lng (r/refined s/Num (r/OpenInterval 12.46 12.51))} + + RouteFromZurich (r/refined Route (r/First InZurich)) + RouteToRome (r/refined Route (r/Last InRome)) + RouteFromZurichToRome (r/refined Route (r/And (r/First InZurich) (r/Last InRome))) + + FromZurichToRome (r/And (r/First InZurich) (r/Last InRome)) + RouteFromZurichToRomeWithLess3Hops (r/refined Route (r/And FromZurichToRome (r/BoundedSize 2 5)))] + (ok! RouteFromZurichToRome input) + (ok! RouteFromZurichToRomeWithLess3Hops input))) + + (t/deftest refined-with-on-predicate + (ok! (r/refined GeoPoint (r/On :lng r/NegativeDouble)) + {:lat 51.5085 :lng -0.0762}) + + (not-ok! (r/refined GeoPoint (r/On :lat r/NegativeDouble)) + {:lat 47.3529 :lng 8.5199}))) + + (t/deftest refined-with-boolean-predicates + (ok! (r/refined s/Int (r/Not r/NegativeInt)) 42) + (ok! (r/refined s/Int (r/And r/PositiveInt (r/Less 108))) 42) + (ok! (r/refined s/Int (r/Or r/PositiveInt (r/Less -7))) -42) + + (not-ok! (r/refined s/Int (r/Not r/NegativeInt)) -42) + (not-ok! (r/refined s/Int (r/And r/PositiveInt (r/Less 108))) 142) + (not-ok! (r/refined s/Int (r/Or r/PositiveInt (r/Less -7))) -3)) + + (t/deftest refined-with-equal-predicate + (ok! (r/refined s/Int (r/Equal 42)) 42) + (ok! (r/refined s/Str (r/Equal "doom")) "doom") + + (not-ok! (r/refined s/Int (r/Equal 42)) 43) + (not-ok! (r/refined s/Str (r/Equal "doom")) "Doom")) + + (t/deftest refined-with-less-predicate + (ok! (r/refined s/Int (r/Less 108)) 42) + (ok! (r/refined s/Num (r/Less 0.7)) 0.5) + + (not-ok! (r/refined s/Int (r/Less 108)) 108) + (not-ok! (r/refined s/Num (r/Less 0.7)) 3.14)) + + (t/deftest refined-with-less-or-equal-predicate + (ok! (r/refined s/Int (r/LessOrEqual 108)) 42) + (ok! (r/refined s/Int (r/LessOrEqual 108)) 108) + (ok! (r/refined s/Num (r/LessOrEqual 0.7)) 0.7) + + (not-ok! (r/refined s/Int (r/LessOrEqual 108)) 109) + (not-ok! (r/refined s/Num (r/LessOrEqual 0.7)) 3.14)) + + (t/deftest refined-with-greater-predicate + (ok! (r/refined s/Int (r/Greater 42)) 108) + (ok! (r/refined s/Num (r/Greater 0.5)) 0.7) + + (not-ok! (r/refined s/Int (r/Greater 108)) 108) + (not-ok! (r/refined s/Num (r/Greater 3.14)) 0.7)) + + (t/deftest refined-with-greater-or-equal-predicate + (ok! (r/refined s/Int (r/GreaterOrEqual 42)) 108) + (ok! (r/refined s/Int (r/GreaterOrEqual 108)) 108) + (ok! (r/refined s/Num (r/GreaterOrEqual 0.7)) 0.7) + + (not-ok! (r/refined s/Int (r/GreaterOrEqual 109)) 108) + (not-ok! (r/refined s/Num (r/GreaterOrEqual 3.14)) 0.7)) + + (t/deftest refined-with-open-interval-predicate + (ok! (r/refined s/Int (r/OpenInterval 0 43)) 42) + (ok! (r/refined s/Num (r/OpenInterval 0.0 1.0)) 0.7) + (ok! (r/refined s/Int (r/Epsilon 10 5)) 10) + (ok! (r/refined s/Int (r/Epsilon 10 5)) 13) + (ok! (r/refined s/Int (r/Epsilon 10 5)) 7) + + (not-ok! (r/refined s/Int (r/OpenInterval 0 43)) 0) + (not-ok! (r/refined s/Int (r/OpenInterval 0 43)) 43) + (not-ok! (r/refined s/Int (r/OpenInterval 0 43)) -7) + (not-ok! (r/refined s/Int (r/OpenInterval 0 43)) 108) + (not-ok! (r/refined s/Num (r/OpenInterval 0.0 1.0)) 0.0) + (not-ok! (r/refined s/Num (r/OpenInterval 0.0 1.0)) 1.0) + (not-ok! (r/refined s/Num (r/OpenInterval 0.0 1.0)) 3.14) + (not-ok! (r/refined s/Num (r/OpenInterval 0.0 1.0)) -3.14) + (not-ok! (r/refined s/Int (r/Epsilon 10 5)) 5) + (not-ok! (r/refined s/Int (r/Epsilon 10 5)) 15) + (not-ok! (r/refined s/Int (r/Epsilon 10 5)) -7) + (not-ok! (r/refined s/Int (r/Epsilon 10 5)) 108)) + + (t/deftest refined-with-closed-interval-predicate + (ok! (r/refined s/Int (r/ClosedInterval 0 43)) 42) + (ok! (r/refined s/Int (r/ClosedInterval 0 43)) 0) + (ok! (r/refined s/Int (r/ClosedInterval 0 43)) 43) + (ok! (r/refined s/Num (r/ClosedInterval 0.0 1.0)) 0.7) + (ok! (r/refined s/Num (r/ClosedInterval 0.0 1.0)) 0.0) + (ok! (r/refined s/Num (r/ClosedInterval 0.0 1.0)) 1.0) + + (not-ok! (r/refined s/Int (r/ClosedInterval 0 43)) -7) + (not-ok! (r/refined s/Int (r/ClosedInterval 0 43)) 108) + (not-ok! (r/refined s/Num (r/ClosedInterval 0.0 1.0)) 3.14) + (not-ok! (r/refined s/Num (r/ClosedInterval 0.0 1.0)) -3.14)) + + (t/deftest refined-with-open-closed-interval-predicate + (ok! (r/refined s/Int (r/OpenClosedInterval 0 43)) 42) + (ok! (r/refined s/Int (r/OpenClosedInterval 0 43)) 43) + (ok! (r/refined s/Num (r/OpenClosedInterval 0.0 1.0)) 0.7) + (ok! (r/refined s/Num (r/OpenClosedInterval 0.0 1.0)) 1.0) + + (not-ok! (r/refined s/Int (r/OpenClosedInterval 0 43)) -7) + (not-ok! (r/refined s/Int (r/OpenClosedInterval 0 43)) 108) + (not-ok! (r/refined s/Int (r/OpenClosedInterval 0 43)) 0) + (not-ok! (r/refined s/Num (r/OpenClosedInterval 0.0 1.0)) 3.14) + (not-ok! (r/refined s/Num (r/OpenClosedInterval 0.0 1.0)) -3.14) + (not-ok! (r/refined s/Num (r/OpenClosedInterval 0.0 1.0)) 0.0)) + + (t/deftest refined-with-closed-open-interval-predicate + (ok! (r/refined s/Int (r/ClosedOpenInterval 0 43)) 42) + (ok! (r/refined s/Int (r/ClosedOpenInterval 0 43)) 0) + (ok! (r/refined s/Num (r/ClosedOpenInterval 0.0 1.0)) 0.7) + (ok! (r/refined s/Num (r/ClosedOpenInterval 0.0 1.0)) 0.0) + + (not-ok! (r/refined s/Int (r/ClosedOpenInterval 0 43)) -7) + (not-ok! (r/refined s/Int (r/ClosedOpenInterval 0 43)) 108) + (not-ok! (r/refined s/Int (r/ClosedOpenInterval 0 43)) 43) + (not-ok! (r/refined s/Num (r/ClosedOpenInterval 0.0 1.0)) 3.14) + (not-ok! (r/refined s/Num (r/ClosedOpenInterval 0.0 1.0)) -3.14) + (not-ok! (r/refined s/Num (r/ClosedOpenInterval 0.0 1.0)) 1.0)) + + (t/deftest refined-with-even-predicate + (ok! (r/refined s/Int r/Even) 108) + + (not-ok! (r/refined s/Int r/Even) 13)) + + (t/deftest refined-with-odd-predicate + (ok! (r/refined s/Int r/Odd) 13) + + (not-ok! (r/refined s/Int r/Odd) 108)) + + (t/deftest refined-with-modulo-predicate + (ok! (r/refined s/Int (r/Modulo 7 3)) 24) + (ok! (r/refined s/Int (r/Modulo 7 3)) -25) + + (not-ok! (r/refined s/Int (r/Modulo 7 3)) 25) + (not-ok! (r/refined s/Int (r/Modulo 7 3)) -24)) + + (t/deftest refined-with-divisible-by-predicate + (ok! (r/refined s/Int (r/DivisibleBy 7)) 21) + (ok! (r/refined s/Int (r/DivisibleBy 7)) -28) + (ok! (r/refined s/Int (r/DivisibleBy 7)) 0) + (ok! (r/refined s/Int (r/DivisibleBy 7)) 7) + + (not-ok! (r/refined s/Int (r/DivisibleBy 7)) 25) + (not-ok! (r/refined s/Int (r/DivisibleBy 7)) -24)) + + (t/deftest refined-with-non-divisible-by-predicate + (ok! (r/refined s/Int (r/NonDivisibleBy 7)) 25) + (ok! (r/refined s/Int (r/NonDivisibleBy 7)) -24) + + (not-ok! (r/refined s/Int (r/NonDivisibleBy 7)) 21) + (not-ok! (r/refined s/Int (r/NonDivisibleBy 7)) -28) + (not-ok! (r/refined s/Int (r/NonDivisibleBy 7)) 0) + (not-ok! (r/refined s/Int (r/NonDivisibleBy 7)) 7)) + + (t/deftest refined-with-starts-with-predicate + (ok! (r/refined s/Str (r/StartsWith "https://")) "https://attendify.com") + + (not-ok! (r/refined s/Str (r/StartsWith "https://")) + "ftp://attendify.com/long-file-name.txt")) + + (t/deftest refined-with-ends-with-predicate + (ok! (r/refined s/Str (r/EndsWith ".com")) "https://attendify.com") + + (not-ok! (r/refined s/Str (r/EndsWith ".com")) + "ftp://attendify.com/long-file-name.txt")) + + (t/deftest refined-with-includes-predicate + (ok! (r/refined s/Str (r/Includes "attendify")) "https://attendify.com") + + (not-ok! (r/refined s/Str (r/Includes "attendify")) + "https://example.com")) + + (t/deftest refined-with-lower-cased-predicate + (ok! (r/refined s/Str r/LowerCased) "https://attendify.com") + + (not-ok! (r/refined s/Str r/LowerCased) "Hello")) + + (t/deftest refined-with-upper-cased-predicate + (ok! (r/refined s/Str r/UpperCased) "ACE") + + (not-ok! (r/refined s/Str r/UpperCased) "https://attendify.com")) + + (t/deftest refined-with-empty-predicate + (ok! (r/refined [s/Num] r/Empty) []) + (ok! (r/refined [s/Num] r/Empty) '()) + (ok! (r/refined s/Str r/Empty) "") + (ok! (r/refined {s/Keyword s/Str} r/Empty) {}) + + (not-ok! (r/refined s/Str r/Empty) "doom") + (not-ok! (r/refined [s/Num] r/Empty) [1 2 3]) + (not-ok! (r/refined {s/Keyword s/Str} r/Empty) {:boom "Doom"}) + (not-ok! (r/refined [s/Str] r/Empty) ["a" "b" "c"]) + (not-ok! (r/refined [s/Any] r/Empty) [["a"] ["b" "c"] ["c" "d"]]) + (not-ok! (r/refined s/Str r/Empty) nil) + (not-ok! (r/refined s/Str r/Empty) '())) + + (t/deftest refined-with-not-empty-predicate + (ok! (r/refined s/Str r/NonEmpty) "doom") + (ok! (r/refined [s/Num] r/NonEmpty) [1 2 3]) + (ok! (r/refined {s/Keyword s/Str} r/NonEmpty) {:boom "Doom"}) + (ok! (r/refined [(r/refined s/Str r/NonEmpty)] r/NonEmpty) ["a" "b" "c"]) + (ok! (r/refined [(r/refined [(r/refined s/Str r/NonEmpty)] r/NonEmpty)] r/NonEmpty) + [["a"] ["b" "c"] ["c" "d"]]) + + (not-ok! (r/refined [s/Num] r/NonEmpty) []) + (not-ok! (r/refined [s/Num] r/NonEmpty) '()) + (not-ok! (r/refined s/Str r/NonEmpty) nil) + (not-ok! (r/refined s/Str r/NonEmpty) '()) + (not-ok! (r/refined s/Str r/NonEmpty) "") + (not-ok! (r/refined {s/Keyword s/Str} r/NonEmpty) {})) + + (t/deftest refined-with-bounded-size-predicate + (let [min-size 1 + max-size 3 + BoundedSize (r/BoundedSize min-size max-size)] + (doseq [size (range min-size (inc max-size))] + (ok! (r/refined [s/Num] BoundedSize) (range size)) + (ok! (r/refined #{s/Num} BoundedSize) (set (range size))) + (ok! (r/refined {s/Num s/Num} BoundedSize) (numeric-map size))) + + (not-ok! (r/refined [s/Num] BoundedSize) []) + (not-ok! (r/refined #{s/Num} BoundedSize) #{}) + (not-ok! (r/refined {s/Num s/Num} BoundedSize) {}) + (not-ok! (r/refined [s/Num] BoundedSize) (range (inc max-size))) + (not-ok! (r/refined #{s/Num} BoundedSize) (-> max-size inc range set)) + (not-ok! (r/refined {s/Num s/Num} BoundedSize) (numeric-map (inc max-size))))) + + (t/deftest refined-with-distinct-predicate + (ok! (r/refined [s/Num] r/Distinct) (range 7)) + (ok! (r/refined [s/Num] r/Distinct) []) + + (not-ok! (r/refined [s/Num] r/Distinct) (repeat 7 1))) + + (t/deftest refined-with-distinct-by-predicate + (ok! (r/refined [{:foo s/Num}] (r/DistinctBy :foo)) (map #(-> {:foo %}) (range 7))) + (ok! (r/refined [{:foo s/Num}] (r/DistinctBy :foo)) []) + + (not-ok! (r/refined [{:foo s/Num}] (r/DistinctBy :foo)) + (->> 1 + (repeat 7) + (map #(-> {:foo %}))))) + + (t/deftest refined-with-forall-predicate + (ok! (r/refined [s/Int] (r/Forall odd?)) (range 1 10 2)) + (ok! (r/refined [s/Int] (r/Forall r/PositiveInt)) (range 1 10)) + (ok! (r/refined [s/Str] (r/Forall r/Empty)) (repeat 10 "")) + + (not-ok! (r/refined [s/Int] (r/Forall odd?)) (range 1 10)) + (not-ok! (r/refined [s/Int] (r/Forall r/PositiveInt)) (conj (range 1 10) -1)) + (not-ok! (r/refined [s/Str] (r/Forall r/Empty)) (into (repeat 10 "") ["a" ""]))) + + (t/deftest refined-with-exists-predicate + (ok! (r/refined [s/Int] (r/Exists odd?)) (into (range 0 10 2) [2 7 5])) + (ok! (r/refined [s/Int] (r/Exists r/PositiveInt)) (into (range -10 -5) [-4 1 0])) + (ok! (r/refined [s/Str] (r/Exists r/Empty)) (into (repeat 10 "a") ["a" "" "a"])) + + (not-ok! (r/refined [s/Int] (r/Exists odd?)) (range 0 10 2)) + (not-ok! (r/refined [s/Int] (r/Exists r/PositiveInt)) (range -10 -5)) + (not-ok! (r/refined [s/Str] (r/Exists r/Empty)) (repeat 10 "a"))) + + (t/deftest refined-with-first-predicate + (ok! (r/refined [s/Int] (r/First odd?)) (conj (range 0 10 2) 1)) + (ok! (r/refined [s/Int] (r/First r/PositiveInt)) (conj (range -10 -5) 1)) + (ok! (r/refined [s/Str] (r/First r/Empty)) (conj (repeat 10 "a") "")) + + (not-ok! (r/refined [s/Int] (r/First odd?)) (into (range 0 10 2) [1 2])) + (not-ok! (r/refined [s/Int] (r/First r/PositiveInt)) (into (range -10 -5) [1 -2])) + (not-ok! (r/refined [s/Str] (r/First r/Empty)) (into (repeat 10 "a") ["" "a"]))) + + (t/deftest refined-with-second-predicate + (ok! (r/refined [s/Int] (r/Second odd?)) (into (range 0 10 2) [1 2])) + (ok! (r/refined [s/Int] (r/Second r/PositiveInt)) (into (range -10 -5) [1 -2])) + (ok! (r/refined [s/Str] (r/Second r/Empty)) (into (repeat 10 "a") ["" "a"])) + + (not-ok! (r/refined [s/Int] (r/Second odd?)) (conj (range 0 10 2) 1)) + (not-ok! (r/refined [s/Int] (r/Second r/PositiveInt)) (conj (range -10 -5) 1)) + (not-ok! (r/refined [s/Str] (r/Second r/Empty)) (conj (repeat 10 "a") ""))) + + (t/deftest refined-with-index-predicate + (ok! (r/refined [s/Int] (r/Index 2 odd?)) (into (range 0 10 2) [1 2 4])) + (ok! (r/refined [s/Int] (r/Index 2 r/PositiveInt)) (into (range -10 -5) [1 -2 -3])) + (ok! (r/refined [s/Str] (r/Index 2 r/Empty)) (into (repeat 10 "a") ["" "a" "a"])) + + (not-ok! (r/refined [s/Int] (r/Index 2 odd?)) (conj (range 0 10 2) 1)) + (not-ok! (r/refined [s/Int] (r/Index 2 r/PositiveInt)) (conj (range -10 -5) 1)) + (not-ok! (r/refined [s/Str] (r/Index 2 r/Empty)) (conj (repeat 10 "a") ""))) + + (t/deftest refined-with-rest-predicate + (ok! (r/refined [s/Int] (r/Rest even?)) (conj (range 0 10 2) 1)) + (ok! (r/refined [s/Int] (r/Rest r/NegativeInt)) (conj (range -10 -5) 1)) + (ok! (r/refined [s/Str] (r/Rest r/NonEmpty)) (conj (repeat 10 "a") "")) + + (not-ok! (r/refined [s/Int] (r/Rest even?)) (into (range 0 10 2) [1 2])) + (not-ok! (r/refined [s/Int] (r/Rest r/NegativeInt)) (into (range -10 -5) [1 -2])) + (not-ok! (r/refined [s/Str] (r/Rest r/NonEmpty)) (into (repeat 10 "a") ["" "a"]))) + + (t/deftest refined-with-last-predicate + (ok! (r/refined [s/Int] (r/Last odd?)) (conj (vec (range 0 10 2)) 1)) + (ok! (r/refined [s/Int] (r/Last r/PositiveInt)) (conj (vec (range -10 -5)) 1)) + (ok! (r/refined [s/Str] (r/Last r/Empty)) (conj (vec (repeat 10 "a")) "")) + + (not-ok! (r/refined [s/Int] (r/Last odd?)) (into (range 0 10 2) [1 2])) + (not-ok! (r/refined [s/Int] (r/Last r/PositiveInt)) (into (range -10 -5) [1 -2])) + (not-ok! (r/refined [s/Str] (r/Last r/Empty)) (into (repeat 10 "a") ["" "a"]))) + + (t/deftest refined-with-butlast-predicate + (ok! (r/refined [s/Int] (r/Butlast even?)) (conj (vec (range 0 10 2)) 1)) + (ok! (r/refined [s/Int] (r/Butlast r/NegativeInt)) (conj (vec (range -10 -5)) 1)) + (ok! (r/refined [s/Str] (r/Butlast r/NonEmpty)) (conj (vec (repeat 10 "a")) "")) + + (not-ok! (r/refined [s/Int] (r/Butlast even?)) (into (range 0 10 2) [1 2])) + (not-ok! (r/refined [s/Int] (r/Butlast r/NegativeInt)) (into (range -10 -5) [1 -2])) + (not-ok! (r/refined [s/Str] (r/Butlast r/NonEmpty)) (into (repeat 10 "a") ["" "a"]))) + + (t/deftest refined-with-pairwise-predicate + (let [sum-equals-3? (fn [[a b]] (= 3 (+ a b)))] + (ok! (r/refined [s/Int] (r/Pairwise sum-equals-3?)) [1 2 1]) + (not-ok! (r/refined [s/Int] (r/Pairwise sum-equals-3?)) [1 1]))) + + (t/deftest refined-with-ascending-on-predicate + (ok! (r/refined [{:price s/Int}] (r/AscendingOn :price)) + (map #(-> {:price %}) (range 10))) + + (not-ok! (r/refined [{:price s/Int}] (r/AscendingOn :price)) + (conj (map #(-> {:price %}) (range 10)) {:price 5}))) + + (t/deftest refined-with-descending-on-predicate + (ok! (r/refined [{:price s/Int}] (r/DescendingOn :price)) + (map #(-> {:price %}) (range 10 0 -1))) + + (not-ok! (r/refined [{:price s/Int}] (r/DescendingOn :price)) + (conj (map #(-> {:price %}) (range 10 0 -1)) {:price 5}))) + + (let [SponsorshipLevel (s/enum "bronze" "silver" "gold") + better-sponsor? (fn [{a-level :level} {b-level :level}] + (cond + (= a-level b-level) 0 + (= a-level "bronze") -1 + (= b-level "gold") -1 + :else 1))] + (t/deftest refined-with-ascending-by-predicate + (ok! (r/refined [{:level SponsorshipLevel}] (r/AscendingBy better-sponsor?)) + [{:level "bronze"} {:level "silver"} {:level "silver"} {:level "gold"}]) + + (not-ok! (r/refined [{:level SponsorshipLevel}] (r/AscendingBy better-sponsor?)) + [{:level "bronze"} {:level "gold"} {:level "silver"}])) + + (t/deftest refined-with-descending-by-predicate + (ok! (r/refined [{:level SponsorshipLevel}] (r/DescendingBy better-sponsor?)) + [{:level "gold"} {:level "silver"} {:level "silver"} {:level "bronze"}]) + + (not-ok! (r/refined [{:level SponsorshipLevel}] (r/DescendingBy better-sponsor?)) + [{:level "gold"} {:level "bronze"} {:level "silver"}]))) + + (t/deftest refined-with-ascending-predicate + (ok! (r/refined [s/Int] r/Ascending) (range 10)) + + (not-ok! (r/refined [s/Int] r/Ascending) (conj (range 10) 5))) + + (t/deftest refined-with-descending-predicate + (ok! (r/refined [s/Int] r/Descending) (range 10 0 -1)) + + (not-ok! (r/refined [{:price s/Int}] r/Descending) (conj (range 10 0 -1) 5)))) + +(t/deftest validate-empty-values + (ok! r/EmptyList []) + (ok! r/EmptyList '()) + (ok! r/EmptyMap {}) + + (not-ok! r/EmptyList [1 2 3]) + (not-ok! r/EmptyMap {:boom "Doom"}) + (not-ok! r/EmptyList ["a" "b" "c"]) + (not-ok! r/EmptyList [["a"] ["b" "c"] ["c" "d"]])) + +(t/deftest validate-non-empty-values + (ok! r/NonEmptyStr "doom") + (ok! (r/NonEmptyListOf s/Num) [1 2 3]) + (ok! (r/NonEmptyMapOf s/Keyword s/Str) {:boom "Doom"}) + (ok! (r/NonEmptyListOf r/NonEmptyStr) ["a" "b" "c"]) + (ok! (r/NonEmptyListOf (r/NonEmptyListOf r/NonEmptyStr)) [["a"] ["b" "c"] ["c" "d"]]) + (not-ok! (r/NonEmptyListOf s/Num) []) + (not-ok! (r/NonEmptyListOf s/Num) '()) + (not-ok! r/NonEmptyStr nil) + (not-ok! r/NonEmptyStr '()) + (not-ok! r/NonEmptyStr "") + (not-ok! (r/NonEmptyMapOf s/Keyword s/Str) {})) + +(t/deftest validate-urls + (ok! r/UriStr "https://attendify.com") + (ok! r/UriStr "ftp://attendify.com/long-file-name.txt") + (not-ok! r/UriStr "attendify com") + + (ok! r/UrlStr "https://attendify.com") + (ok! r/UrlStr "ftp://attendify.com/long-file-name.txt") + (ok! r/UrlStr "ftp://") + (not-ok! r/UrlStr "attendify com")) + +(t/deftest range-length-string + (ok! (r/BoundedSizeStr 1 10) "a") + (ok! (r/BoundedSizeStr 1 10) "abcdeabcde") + (ok! (r/BoundedSizeStr 1 10) "abcde ") + (not-ok! (r/BoundedSizeStr 1 10) "") + (not-ok! (r/BoundedSizeStr 1 10) "abcdeabcdeabcde") + (not-ok! (r/BoundedSizeStr 1 10) "abcdeabcde ") + (ok! (r/BoundedSizeStr 1 10 true) "abcdeabcde ") + (not-ok! (r/BoundedSizeStr 1 10 true) " ")) + +(t/deftest validate-bounded-collections + (let [min-size 1 + max-size 3] + (doseq [size (range min-size (inc max-size))] + (ok! (r/BoundedListOf s/Num min-size max-size) (range size)) + (ok! (r/BoundedSetOf s/Num min-size max-size) (set (range size))) + (ok! (r/BoundedMapOf s/Num s/Num min-size max-size) (numeric-map size))) + + (not-ok! (r/BoundedListOf s/Num min-size max-size) []) + (not-ok! (r/BoundedSetOf s/Num min-size max-size) #{}) + (not-ok! (r/BoundedMapOf s/Num s/Num min-size max-size) {}) + (not-ok! (r/BoundedListOf s/Num min-size max-size) (range (inc max-size))) + (not-ok! (r/BoundedSetOf s/Num min-size max-size) (-> max-size inc range set)) + (not-ok! (r/BoundedMapOf s/Num s/Num min-size max-size) (numeric-map (inc max-size))) + + (ok! (r/BoundedListOf s/Num max-size) (range max-size)) + (ok! (r/BoundedSetOf s/Num max-size) + (set (range max-size))) + (ok! (r/BoundedMapOf s/Num s/Num max-size) + (->> max-size + range + (map-indexed vector) + (into {}))) + + (doseq [size (conj (range max-size) (inc max-size))] + (not-ok! (r/BoundedListOf s/Num max-size) (range size)) + (not-ok! (r/BoundedSetOf s/Num max-size) (-> size range set)) + (not-ok! (r/BoundedMapOf s/Num s/Num max-size) (numeric-map size))) + + (ok! (r/SingleValueListOf s/Num) [1]) + (ok! (r/SingleValueSetOf s/Num) #{1}) + (ok! (r/SingleValueMapOf s/Num s/Num) {1 1}) + + (doseq [size [0 2]] + (not-ok! (r/BoundedListOf s/Num max-size) (range size)) + (not-ok! (r/BoundedSetOf s/Num max-size) (-> size range set)) + (not-ok! (r/BoundedMapOf s/Num s/Num max-size) (numeric-map size))))) + +(t/deftest validate-digit-char + (doseq [i (range 10)] + (ok! r/DigitChar (str i))) + + (not-ok! r/DigitChar "attendify.com") + (not-ok! r/DigitChar "") + (not-ok! r/DigitChar ".") + (not-ok! r/DigitChar "j")) + +(t/deftest validate-ascii-letter-char + (doseq [i (map char (range (.charCodeAt \a) (inc (.charCodeAt \z))))] + (ok! r/ASCIILetterChar (str i))) + (doseq [i (map char (range (.charCodeAt \A) (inc (.charCodeAt \Z))))] + (ok! r/ASCIILetterChar (str i))) + + (not-ok! r/ASCIILetterChar "attendify.com") + (not-ok! r/ASCIILetterChar "") + (not-ok! r/ASCIILetterChar ".") + (not-ok! r/ASCIILetterChar "7")) + +(t/deftest validate-ascii-letter-or-digit-char + (doseq [i (map char (range (.charCodeAt \a) (inc (.charCodeAt \z))))] + (ok! r/ASCIILetterOrDigitChar (str i))) + (doseq [i (map char (range (.charCodeAt \A) (inc (.charCodeAt \Z))))] + (ok! r/ASCIILetterOrDigitChar (str i))) + (doseq [i (range 10)] + (ok! r/ASCIILetterOrDigitChar (str i))) + + (not-ok! r/ASCIILetterOrDigitChar "attendify.com") + (not-ok! r/ASCIILetterOrDigitChar "") + (not-ok! r/ASCIILetterOrDigitChar ".")) + +(t/deftest validate-bit-char + (ok! r/BitChar "0") + (ok! r/BitChar "1") + + (not-ok! r/BitChar "attendify.com") + (not-ok! r/BitChar "") + (not-ok! r/BitChar ".") + (not-ok! r/BitChar "j") + (not-ok! r/BitChar "7")) + +(t/deftest validate-bit-str + (ok! r/BitStr "0") + (ok! r/BitStr "1") + (ok! r/BitStr "0001") + (ok! r/BitStr "101010") + + (not-ok! r/BitStr "attendify.com") + (not-ok! r/BitStr " ") + (not-ok! r/BitStr "000000200") + (not-ok! r/BitStr "j") + (not-ok! r/BitStr "1111 ")) + +(t/deftest validate-int-str + (ok! r/IntStr "0") + (ok! r/IntStr "3") + (ok! r/IntStr "-401") + (ok! r/IntStr "101410") + (ok! r/IntStr "000000200") + (ok! r/IntStr "1111 ") + + (not-ok! r/IntStr "attendify.com") + (not-ok! r/IntStr " ") + (not-ok! r/IntStr "j")) + +(t/deftest validate-float-str + (ok! r/FloatStr "0") + (ok! r/FloatStr "3.14") + (ok! r/FloatStr "3_14") ;; JS weirdo + (ok! r/FloatStr "-123.203201") + (ok! r/FloatStr "101410") + (ok! r/FloatStr "1111 ") + + (not-ok! r/FloatStr "attendify.com") + (not-ok! r/FloatStr " ") + (not-ok! r/FloatStr "j")) + +(t/deftest validate-starts-with-str + (ok! (r/StartsWithStr "https://") "https://attendify.com") + + (not-ok! (r/StartsWithStr "https://") "ftp://attendify.com/long-file-name.txt")) + +(t/deftest validate-ends-with-str + (ok! (r/EndsWithStr ".com") "https://attendify.com") + + (not-ok! (r/EndsWithStr ".com") "ftp://attendify.com/long-file-name.txt")) + +(t/deftest validate-includes-str + (ok! (r/IncludesStr "attendify") "https://attendify.com") + + (not-ok! (r/IncludesStr "attendify") "https://example.com")) + +(t/deftest validate-lower-cased-str + (ok! r/LowerCasedStr "https://attendify.com") + + (not-ok! r/LowerCasedStr "Hello")) + +(t/deftest validate-upper-cased-str + (ok! r/UpperCasedStr "ACE") + + (not-ok! r/UpperCasedStr "https://attendify.com")) + +(t/deftest validate-positive-numeric + (ok! (r/PositiveOf s/Int) 42) + (ok! r/PositiveInt 42) + (ok! (r/PositiveOf s/Num) 3.14) + (ok! r/PositiveDouble 3.14) + + (not-ok! (r/PositiveOf s/Int) 0) + (not-ok! r/PositiveInt 0) + (not-ok! (r/PositiveOf s/Int) -7) + (not-ok! r/PositiveInt -7) + (not-ok! (r/PositiveOf s/Num) -3.14) + (not-ok! r/PositiveDouble -3.14)) + +(t/deftest validate-negative-numeric + (ok! (r/NegativeOf s/Int) -42) + (ok! r/NegativeInt -42) + (ok! (r/NegativeOf s/Num) -3.14) + (ok! r/NegativeDouble -3.14) + + (not-ok! (r/NegativeOf s/Int) 0) + (not-ok! r/NegativeInt 0) + (not-ok! (r/NegativeOf s/Int) 7) + (not-ok! r/NegativeInt 7) + (not-ok! (r/NegativeOf s/Num) 3.14) + (not-ok! r/NegativeDouble 3.14)) + +(t/deftest validate-non-negative-numeric + (ok! (r/NonNegativeOf s/Int) 42) + (ok! r/NonNegativeInt 42) + (ok! (r/NonNegativeOf s/Num) 3.14) + (ok! r/NonNegativeDouble 3.14) + (ok! (r/NonNegativeOf s/Int) 0) + (ok! r/NonNegativeInt 0) + + (not-ok! (r/NonNegativeOf s/Int) -7) + (not-ok! r/NonNegativeInt -7) + (not-ok! (r/NonNegativeOf s/Num) -3.14) + (not-ok! r/NonNegativeDouble -3.14)) + +(t/deftest validate-non-positive-numeric + (ok! (r/NonPositiveOf s/Int) -42) + (ok! r/NonPositiveInt -42) + (ok! (r/NonPositiveOf s/Num) -3.14) + (ok! r/NonPositiveDouble -3.14) + (ok! (r/NonPositiveOf s/Int) 0) + (ok! r/NonPositiveInt 0) + + (not-ok! (r/NonPositiveOf s/Int) 7) + (not-ok! r/NonPositiveInt 7) + (not-ok! (r/NonPositiveOf s/Num) 3.14) + (not-ok! r/NonPositiveDouble 3.14)) + +(t/deftest validate-numeric-open-interval + (ok! (r/OpenIntervalOf s/Int 0 43) 42) + (ok! (r/OpenIntervalOf s/Num 0.0 1.0) 0.7) + (ok! (r/EpsilonOf s/Int 10 5) 10) + (ok! (r/EpsilonOf s/Int 10 5) 13) + (ok! (r/EpsilonOf s/Int 10 5) 7) + + (not-ok! (r/OpenIntervalOf s/Int 0 43) 0) + (not-ok! (r/OpenIntervalOf s/Int 0 43) 43) + (not-ok! (r/OpenIntervalOf s/Int 0 43) -7) + (not-ok! (r/OpenIntervalOf s/Int 0 43) 108) + (not-ok! (r/OpenIntervalOf s/Num 0.0 1.0) 0.0) + (not-ok! (r/OpenIntervalOf s/Num 0.0 1.0) 1.0) + (not-ok! (r/OpenIntervalOf s/Num 0.0 1.0) 3.14) + (not-ok! (r/OpenIntervalOf s/Num 0.0 1.0) -3.14) + (not-ok! (r/EpsilonOf s/Int 10 5) 5) + (not-ok! (r/EpsilonOf s/Int 10 5) 15) + (not-ok! (r/EpsilonOf s/Int 10 5) -7) + (not-ok! (r/EpsilonOf s/Int 10 5) 108)) + +(t/deftest validate-numeric-closed-interval + (ok! (r/ClosedIntervalOf s/Int 0 43) 42) + (ok! (r/ClosedIntervalOf s/Int 0 43) 0) + (ok! (r/ClosedIntervalOf s/Int 0 43) 43) + (ok! (r/ClosedIntervalOf s/Num 0.0 1.0) 0.7) + (ok! (r/ClosedIntervalOf s/Num 0.0 1.0) 0.0) + (ok! (r/ClosedIntervalOf s/Num 0.0 1.0) 1.0) + + (not-ok! (r/ClosedIntervalOf s/Int 0 43) -7) + (not-ok! (r/ClosedIntervalOf s/Int 0 43) 108) + (not-ok! (r/ClosedIntervalOf s/Num 0.0 1.0) 3.14) + (not-ok! (r/ClosedIntervalOf s/Num 0.0 1.0) -3.14)) + +(t/deftest validate-numeric-open-closed-interval + (ok! (r/OpenClosedIntervalOf s/Int 0 43) 42) + (ok! (r/OpenClosedIntervalOf s/Int 0 43) 43) + (ok! (r/OpenClosedIntervalOf s/Num 0.0 1.0) 0.7) + (ok! (r/OpenClosedIntervalOf s/Num 0.0 1.0) 1.0) + + (not-ok! (r/OpenClosedIntervalOf s/Int 0 43) -7) + (not-ok! (r/OpenClosedIntervalOf s/Int 0 43) 108) + (not-ok! (r/OpenClosedIntervalOf s/Int 0 43) 0) + (not-ok! (r/OpenClosedIntervalOf s/Num 0.0 1.0) 3.14) + (not-ok! (r/OpenClosedIntervalOf s/Num 0.0 1.0) -3.14) + (not-ok! (r/OpenClosedIntervalOf s/Num 0.0 1.0) 0.0)) + +(t/deftest validate-numeric-closed-open-interval + (ok! (r/ClosedOpenIntervalOf s/Int 0 43) 42) + (ok! (r/ClosedOpenIntervalOf s/Int 0 43) 0) + (ok! (r/ClosedOpenIntervalOf s/Num 0.0 1.0) 0.7) + (ok! (r/ClosedOpenIntervalOf s/Num 0.0 1.0) 0.0) + + (not-ok! (r/ClosedOpenIntervalOf s/Int 0 43) -7) + (not-ok! (r/ClosedOpenIntervalOf s/Int 0 43) 108) + (not-ok! (r/ClosedOpenIntervalOf s/Int 0 43) 43) + (not-ok! (r/ClosedOpenIntervalOf s/Num 0.0 1.0) 3.14) + (not-ok! (r/ClosedOpenIntervalOf s/Num 0.0 1.0) -3.14) + (not-ok! (r/ClosedOpenIntervalOf s/Num 0.0 1.0) 1.0)) + +(t/deftest validate-distinct-list + (ok! (r/DistinctListOf s/Num) (range 7)) + (ok! (r/DistinctListOf s/Num) []) + (ok! (r/NonEmptyDistinctListOf s/Num) (range 7)) + + (not-ok! (r/DistinctListOf s/Num) (repeat 7 1)) + (not-ok! (r/NonEmptyDistinctListOf s/Num) [])) + +(t/deftest validate-at-least-map + (ok! (r/AtLeastMap {:foo s/Int}) {:foo 1}) + (ok! (r/AtLeastMap {:foo s/Int}) {:foo 1 :bar 2}) + + (not-ok! (r/AtLeastMap {:foo s/Int}) {}) + (not-ok! (r/AtLeastMap {:foo s/Int}) {:bar 2})) + +(t/deftest validate-non-strict-map + (ok! (r/NonStrictMap {:foo s/Int}) {:foo 1}) + (ok! (r/NonStrictMap {:foo s/Int}) {}) + + (not-ok! (r/NonStrictMap {:foo s/Int}) {:foo 1 :bar 2}) + (not-ok! (r/NonStrictMap {:foo s/Int}) {:bar 2})) + +(def -Ticket (sr/Struct :id r/NonEmptyStr + :rev r/NonEmptyStr + :price (s/maybe s/Num) + :paid? s/Bool)) + +(def Ticket + (sr/guard + -Ticket + '(:price :paid?) + (fn [{:keys [paid? price]}] + (or (false? paid?) + (and (some? price) (< 0 price)))) + 'paid-ticket-should-have-price)) + +(t/deftest struct-with-guards + (ok! Ticket {:id "1" :rev "2" :paid? true :price 10}) + (not-ok! Ticket {:id "1" :rev "2" :paid? true}) + (not-ok! Ticket {:id "1" :rev "2" :paid? true :price nil}) + (ok! (dissoc Ticket :id :rev) {:paid? true :price 10}) + (not-ok! (dissoc Ticket :id :rev) {:paid? true :price nil}) + (ok! (dissoc Ticket :price) {:id "1" :rev "2" :paid? true})) + +(def -BaseCode (sr/map->struct {:id r/NonEmptyStr + :rev r/NonEmptyStr + :name r/NonEmptyStr})) + +;; still struct +(def UnlockCode (assoc -BaseCode + :codeType (s/eq "unlock") + :code r/NonEmptyStr)) + +;; still struct +(def DiscountCode (assoc -BaseCode + :codeType (s/eq "discount") + :discountPercent (r/ClosedIntervalOf s/Int 0 100))) + +;; should be converted to strct inside Dispatch +(def SecretCode {:codeType (s/eq "secret") + :noValues r/NonEmptyStr}) + +(do + (def g + (sr/StructDispatch + '(:name) + (fn [{:keys [name]}] (inc (count name))) + 1 {:name r/NonEmptyStr} + 2 {:name r/NonEmptyStr})) + + (s/check g {:name ""})) + +(def Code (sr/StructDispatch + :codeType + "unlock" UnlockCode + "discount" DiscountCode + "secret" SecretCode + "downstream" (sr/StructDispatch + :fromDownstream + false {:fromDownstream (s/eq false)} + true {:fromDownstream (s/eq true)}) + "customSlice" (assoc (sr/StructDispatch + '(:name) + (fn [{:keys [name]}] (inc (count name))) + 1 {:name r/NonEmptyStr} + 2 {:name r/NonEmptyStr}) + :codeType + (s/eq "customSlice")))) + +(def CounterWithElse (sr/StructDispatch + :num + 1 {:num (s/eq 1)} + 2 {:num (s/eq 2)} + :else {:num s/Any})) + +(def CreateCodeRequest (dissoc Code :id :rev)) + +(t/deftest dispatch-struct + (ok! CreateCodeRequest {:codeType "unlock" + :name "First" + :code "Boom!"}) + (ok! CreateCodeRequest {:codeType "discount" + :name "Second" + :discountPercent 50}) + (ok! CreateCodeRequest {:codeType "secret" + :noValues "It's a secret!"}) + (not-ok! CreateCodeRequest {:id "1" + :codeType "unlock" + :name "Third" + :code "Fail :("}) + (not-ok! CreateCodeRequest {:codeType "unknown" + :name "Would not work"}) + + (t/testing "dissoc from keys slice for top-level dispatch" + (t/is (thrown? js/Error (dissoc Code :codeType)))) + + (t/testing "dissoc from downstream slices" + (t/is (thrown? js/Error (dissoc Code :fromDownstream)))) + + (t/testing "dispatch with duplicated options" + (t/is (thrown? js/Error) + (sr/StructDispatch + :fromDownstream + true {:fromDownstream (s/eq false)} + true {:fromDownstream (s/eq true)}))) + + (t/testing "custom keys slice" + (ok! CreateCodeRequest {:codeType "customSlice" + :name "z"}) + (not-ok! CreateCodeRequest {:codeType "customSlice" + :name "zzzz"})) + + (t/testing "else branch" + (ok! CounterWithElse {:num 1}) + (ok! CounterWithElse {:num 2}) + (ok! CounterWithElse {:num 100}))) diff --git a/test/schema_refined/macros.clj b/test/schema_refined/macros.clj new file mode 100644 index 0000000..4158389 --- /dev/null +++ b/test/schema_refined/macros.clj @@ -0,0 +1,7 @@ +(ns schema-refined.macros) + +(defmacro ok! [dt value] + `(cljs.test/is (nil? (schema.core/check ~dt ~value)))) + +(defmacro not-ok! [dt value] + `(cljs.test/is (some? (schema.core/check ~dt ~value)))) diff --git a/test/schema_refined/runner.cljs b/test/schema_refined/runner.cljs new file mode 100644 index 0000000..a311260 --- /dev/null +++ b/test/schema_refined/runner.cljs @@ -0,0 +1,5 @@ +(ns schema-refined.runner + (:require [doo.runner :refer-macros [doo-tests]] + [schema-refined.core-test])) + +(doo-tests 'schema-refined.core-test)