new preds, specs, and gens

Author: pkpkpk

src/main/cljs/cljs/core.cljs

@@ -1263,6 +1263,23 @@
       (garray/defaultCompare (.valueOf this) (.valueOf other))
       (throw (js/Error. (str "Cannot compare " this " to " other))))))
 
+(defprotocol Inst
+  (inst-ms* [inst]))
+
+(extend-protocol Inst
+  js/Date
+  (inst-ms* [inst] (.getTime inst)))
+
+(defn inst-ms
+  "Return the number of milliseconds since January 1, 1970, 00:00:00 GMT"
+  [inst]
+  (inst-ms* inst))
+
+(defn ^boolean inst?
+  "Return true if x satisfies Inst"
+  [x]
+  (satisfies? Inst x))
+
 (extend-type number
   IEquiv
   (-equiv [x o] (identical? x o)))
@@ -2064,6 +2081,10 @@ reduces them without incurring seq initialization"
   "Returns true if x is the value true, false otherwise."
   [x] (cljs.core/true? x))
 
+(defn ^boolean boolean?
+  "Return true if x is a Boolean"
+  [x] (or (cljs.core/true? x) (cljs.core/false? x)))
+
 (defn ^boolean undefined?
   "Returns true if x identical to the JavaScript undefined value."
   [x]
@@ -2102,6 +2123,26 @@ reduces them without incurring seq initialization"
        (not (identical? n js/Infinity))
        (== (js/parseFloat n) (js/parseInt n 10))))
 
+(defn ^boolean long?
+  "Return true if x is an instance of goog.math.Long"
+  [x] (instance? goog.math.Long x))
+
+(defn ^boolean pos-long?
+  "Return true if x is a positive Long"
+  [x] (and (instance? goog.math.Long x)
+           (not (.isNegative x))
+           (not (.isZero x))))
+
+(defn ^boolean neg-long?
+  "Return true if x is a negative Long"
+  [x] (and (instance? goog.math.Long x)
+           (.isNegative x)))
+
+(defn ^boolean nat-long?
+  "Return true if x is a non-negative Long"
+  [x] (and (instance? goog.math.Long x)
+           (or (not (.isNegative x)) (.isZero x))))
+
 (defn ^boolean contains?
   "Returns true if key is present in the given collection, otherwise
   returns false.  Note that for numerically indexed collections like
@@ -3086,6 +3127,34 @@ reduces them without incurring seq initialization"
     (-namespace ^not-native x)
     (throw (js/Error. (str "Doesn't support namespace: " x)))))
 
+(defn ^boolean ident?
+  "Return true if x is a symbol or keyword"
+  [x] (or (keyword? x) (symbol? x)))
+
+(defn ^boolean simple-ident?
+  "Return true if x is a symbol or keyword without a namespace"
+  [x] (and (ident? x) (nil? (namespace x))))
+
+(defn ^boolean qualified-ident?
+  "Return true if x is a symbol or keyword with a namespace"
+  [x] (and (ident? x) (namespace x) true))
+
+(defn ^boolean simple-symbol?
+  "Return true if x is a symbol without a namespace"
+  [x] (and (symbol? x) (nil? (namespace x))))
+
+(defn ^boolean qualified-symbol?
+  "Return true if x is a symbol with a namespace"
+  [x] (and (symbol? x) (namespace x) true))
+
+(defn ^boolean simple-keyword?
+  "Return true if x is a keyword without a namespace"
+  [x] (and (keyword? x) (nil? (namespace x))))
+
+(defn ^boolean qualified-keyword?
+  "Return true if x is a keyword with a namespace"
+  [x] (and (keyword? x) (namespace x) true))
+
 (defn keyword
   "Returns a Keyword with the given namespace and name.  Do not use :
   in the keyword strings, it will be added automatically."
@@ -10090,8 +10159,11 @@ reduces them without incurring seq initialization"
   [multifn] (-dispatch-fn multifn))
 
 ;; UUID
+(defprotocol IUUID "A marker protocol for UUIDs")
 
 (deftype UUID [uuid ^:mutable __hash]
+  IUUID
+
   Object
   (toString [_] uuid)
   (equiv [this other]
@@ -10131,6 +10203,9 @@ reduces them without incurring seq initialization"
              (hex) (hex) (hex) (hex)
              (hex) (hex) (hex) (hex))))))
 
+(defn ^boolean uuid?
+  [x] (implements? IUUID x))
+
 ;;; ExceptionInfo
 
 (defn- pr-writer-ex-info [obj writer opts]

src/main/cljs/cljs/spec.cljc

@@ -377,6 +377,25 @@ specified, return speced vars from all namespaces."
   [kpred vpred]
   `(and (coll-of (tuple ~kpred ~vpred) {}) map?))
 
+(defmacro inst-in
+  "Returns a spec that validates insts in the range from start
+  (inclusive) to end (exclusive)."
+  [start end]
+  `(let [st# (inst-ms ~start)
+         et# (inst-ms ~end)
+         mkdate# (fn [d#] (js/Date. d#))]
+     (spec (and inst? #(inst-in-range? ~start ~end %))
+       :gen (fn []
+              (gen/fmap mkdate#
+                (gen/large-integer* {:min st# :max et#}))))))
+
+(defmacro long-in
+  "Returns a spec that validates longs in the range from start
+  (inclusive) to end (exclusive)."
+  [start end]
+  `(spec (and c/long? #(long-in-range? ~start ~end %))
+     :gen #(gen/large-integer* {:min ~start :max (dec ~end)})))
+
 (defmacro instrument
   "Instruments the var at v, a var or symbol, to check specs
   registered with fdef. Wraps the fn at v to check :args/:ret/:fn

src/main/cljs/cljs/spec.cljs

@@ -1115,3 +1115,17 @@
       (gen/fmap
         #(if (vector? init) % (into init %))
         (gen/vector (gen pred))))))
+
+(defn inst-in-range?
+  "Return true if inst at or after start and before end"
+  [start end inst]
+  (c/and (inst? inst)
+         (let [t (inst-ms inst)]
+           (c/and (<= (inst-ms start) t) (< t (inst-ms end))))))
+
+(defn long-in-range?
+  "Return true if start <= val and val < end"
+  [start end val]
+  (c/and (long? val)
+         (.lessThanOrEqual (goog.math.Long.fromNumber start) val)
+         (.lessThan val  (goog.math.Long.fromNumber end))))

src/main/cljs/cljs/spec/impl/gen.cljs

@@ -67,7 +67,8 @@
 ;      (throw (js/Error. (str "Var " s " is not a generator"))))))
 
 (lazy-combinators hash-map list map not-empty set vector fmap elements
-  bind choose one-of such-that tuple sample return)
+  bind choose one-of such-that tuple sample return
+  large-integer*)
 
 (lazy-prims any any-printable boolean char char-alpha char-alphanumeric char-ascii double
   int keyword keyword-ns large-integer ratio simple-type simple-type-printable
@@ -80,16 +81,39 @@ gens, each of which should generate something sequential."
   (fmap #(apply concat %)
     (apply tuple gens)))
 
+(defn- ^boolean qualified? [ident] (not (nil? (namespace ident))))
+
 (def ^:private
 gen-builtins
   (c/delay
     (let [simple (simple-type-printable)]
       {number? (one-of [(large-integer) (double)])
        integer? (large-integer)
+       long? (large-integer)
+       pos-long? (large-integer* {:min 1})
+       neg-long? (large-integer* {:max -1})
+       nat-long? (large-integer* {:min 0})
        ;float? (double)
        string? (string-alphanumeric)
+       ident? (one-of [(keyword-ns) (symbol-ns)])
+       simple-ident? (one-of [(keyword) (symbol)])
+       qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)]))
        keyword? (keyword-ns)
+       simple-keyword? (keyword)
+       qualified-keyword? (such-that qualified? (keyword-ns))
        symbol? (symbol-ns)
+       simple-symbol? (symbol)
+       qualified-symbol? (such-that qualified? (symbol-ns))
+       uuid? (uuid)
+       inst? (fmap #(js/Date. %)
+                    (large-integer))
+       seqable? (one-of [(return nil)
+                         (list simple)
+                         (vector simple)
+                         (map simple simple)
+                         (set simple)
+                         (string-alphanumeric)])
+       indexed? (vector simple)
        map? (map simple simple)
        vector? (vector simple)
        list? (list simple)

src/test/cljs/cljs/core_test.cljs

@@ -702,13 +702,17 @@
 
 (deftest test-booleans
   (testing "Testing boolean predicates"
-    (is (= [true false true false false false]
+    (is (= [true false true false false false true true false false]
           [(true? true)
            (true? false)
            (false? false)
            (false? true)
            (true? js/undefined)
-           (false? js/undefined)]))))
+           (false? js/undefined)
+           (boolean? true)
+           (boolean? false)
+           (boolean? nil)
+           (boolean? js/undefined)]))))
 
 (deftest test-fn-with-metadata
   (let [f (fn [x] (* x 2))

src/test/cljs/cljs/predicates_test.cljs

@@ -0,0 +1,57 @@
+(ns cljs.predicates-test
+  (:require [cljs.test :refer-macros [deftest is]])
+  (:import [goog.math Long]))
+
+
+(def pred-val-table
+  (let [now (js/Date.)
+        uuid (uuid nil)]
+    [[identity    boolean? indexed? seqable?  ident?  uuid?    inst?  simple-ident? qualified-ident? simple-symbol? qualified-symbol? simple-keyword? qualified-keyword?]
+     [0             false    false    false    false  false    false  false         false            false          false             false           false]
+     [1             false    false    false    false  false    false  false         false            false          false             false           false]
+     [-1            false    false    false    false  false    false  false         false            false          false             false           false]
+     [1.0           false    false    false    false  false    false  false         false            false          false             false           false]
+     [true          true     false    false    false  false    false  false         false            false          false             false           false]
+     [[]            false    true     true     false  false    false  false         false            false          false             false           false]
+     [nil           false    false    false    false  false    false  false         false            false          false             false           false]
+     [{}            false    false    true     false  false    false  false         false            false          false             false           false]
+     [:foo          false    false    false    true   false    false  true          nil              false          false             true            nil]
+     [::foo         false    false    false    true   false    false  false         true             false          false             false           true]
+     ['foo          false    false    false    true   false    false  true          nil              true           nil               false           false]
+     ['foo/bar      false    false    false    true   false    false  false         true             false          true              false           false]
+     [uuid          false    false    false    false  true     false  false         false            false          false             false           false]
+     [now           false    false    false    false  false    true   false         false            false          false             false           false]]))
+
+(deftest test-preds
+  (let [[preds & rows] pred-val-table]
+    (doseq [row rows]
+      (let [v (first row)]
+        (dotimes [i (count row)]
+          (is (= ((nth preds i) v) (nth row i))
+              (pr-str (list (nth preds i) v))))))))
+
+(def int-val-table
+  (let [posint 10e10
+        negint -10e10
+        natl (goog.math.Long.getZero)
+        posl (goog.math.Long.fromNumber posint)
+        negl (goog.math.Long.fromNumber negint)]
+    [[identity  neg?  pos?   integer? long?  neg-long? pos-long? nat-long?]
+     [0         false false  true     false  false     false     false    ]
+     [1         false true   true     false  false     false     false    ]
+     [-1        true  false  true     false  false     false     false    ]
+     [1.0       false true   true     false  false     false     false    ]
+     [-1.0      true  false  true     false  false     false     false    ]
+     [posint    false true   true     false  false     false     false    ]
+     [negint    true  false  true     false  false     false     false    ]
+     [natl      false false  false    true   false     false     true     ]
+     [posl      false true   false    true   false     true      true     ]
+     [negl      true  false  false    true   true      false     false    ]]))
+
+(deftest test-int-preds
+  (let [[preds & rows] int-val-table]
+    (doseq [row rows]
+      (let [v (first row)]
+        (dotimes [i (count row)]
+          (is (= ((nth preds i) v) (nth row i))
+              (pr-str (list (nth preds i) v))))))))