Add string schema properties

src/malli/core.cljc

@@ -570,6 +570,82 @@
   (when-let [ns-name (some-> properties :namespace name)]
     (fn [x] (= (namespace x) ns-name))))
 
+;;
+;; string schema helpers
+;;
+
+#?(:cljs (defn -numeric-char? [c] (and (< 47 c) (< c 58))))
+#?(:cljs (defn -upper-alpha-char? [c] (and (< 64 c) (< c 91))))
+#?(:cljs (defn -lower-alpha-char? [c] (and (< 96 c) (< c 123))))
+#?(:cljs (defn -letter? [c] (or (-lower-alpha-char? c) (-upper-alpha-char? c))))
+#?(:cljs (defn -alphanumeric? [c] (or (-letter? c) (-numeric-char? c))))
+
+(defn -charset-predicate
+  [o]
+  (case o
+    :digit #?(:clj #(Character/isDigit ^char %) :cljs -numeric-char?)
+    :letter #?(:clj #(Character/isLetter ^char %) :cljs -letter?)
+    :letter-or-digit #?(:clj #(Character/isLetterOrDigit ^char %) :cljs -alphanumeric?)
+    :alphanumeric #?(:clj #(Character/isLetterOrDigit ^char %) :cljs -alphanumeric?)
+    :alphabetic #?(:clj #(Character/isAlphabetic (int %)) :cljs -letter?)
+    (cond
+      (set? o) (miu/-some-pred (mapv -charset-predicate o))
+      (char? o) #?(:clj #(= ^char o %) :cljs (let [i (.charCodeAt o 0)] #(= i %)))
+      (fn? o) o
+      (nil? o) nil
+      :else (throw (ex-info "Invalid string predicate" {:pred o})))))
+
+(defn string-char-predicate
+  [p]
+  (fn charset-pred ^Boolean [^String s]
+    (let [n #?(:clj (.length s) :cljs (.-length s))]
+      (loop [i 0]
+        (if (= i n)
+          true
+          (if (p #?(:clj  (.charAt s (unchecked-int i))
+                    :cljs (.charCodeAt s (unchecked-int i))))
+            (recur (unchecked-inc i))
+            false))))))
+
+#?(:clj
+   (defn find-blank-method
+     []
+     (try
+       (.getMethod String "isBlank" (into-array Class []))
+       #(.isBlank ^String %)
+       (catch Exception _
+         (require 'clojure.string)
+         clojure.string/blank?))))
+
+#?(:clj  (def blank? (find-blank-method))
+   :cljs (defn blank? [^String s] (zero? (.-length (.trim s)))))
+
+(defn -string-predicates
+  ([{:keys [charset pattern non-blank]}]
+   (let [pattern
+         (when pattern
+           (let [pattern (re-pattern pattern)]
+             #?(:clj #(.find (.matcher ^Pattern pattern ^String %))
+                :cljs #(boolean (re-find pattern %)))))
+         charset
+         (when charset
+           (let [p (-charset-predicate charset)]
+             (string-char-predicate p)))
+         non-blank (when non-blank #(not (blank? %)))]
+     (-> non-blank
+         (miu/-maybe-and charset)
+         (miu/-maybe-and pattern)))))
+
+(defn -string-property-pred
+  []
+  (fn [properties]
+    (miu/-maybe-and
+     ((-min-max-pred
+       #?(:clj #(.length ^String %)
+          :cljs #(.-length ^String %)))
+      properties)
+     (-string-predicates properties))))
+
 ;;
 ;; Schemas
 ;;
@@ -625,7 +701,7 @@
 
 (defn -nil-schema [] (-simple-schema {:type :nil, :pred nil?}))
 (defn -any-schema [] (-simple-schema {:type :any, :pred any?}))
-(defn -string-schema [] (-simple-schema {:type :string, :pred string?, :property-pred (-min-max-pred count)}))
+(defn -string-schema [] (-simple-schema {:type :string, :pred string?, :property-pred (-string-property-pred)}))
 (defn -int-schema [] (-simple-schema {:type :int, :pred int?, :property-pred (-min-max-pred nil)}))
 (defn -double-schema [] (-simple-schema {:type :double, :pred double?, :property-pred (-min-max-pred nil)}))
 (defn -boolean-schema [] (-simple-schema {:type :boolean, :pred boolean?}))

src/malli/impl/util.cljc

@@ -65,3 +65,10 @@
 (def ^{:arglists '([[& preds]])} -some-pred
   #?(:clj (-pred-composer or 16)
      :cljs (fn [preds] (fn [x] (boolean (some #(% x) preds))))))
+
+(defn -maybe-and
+  [f g]
+  (cond
+    (and f g) #(and (f %) (g %))
+    f f
+    g g))

test/malli/core_test.cljc

@@ -2622,3 +2622,44 @@
   (is (= ["1"] (m/-vmap str (subvec [1 2] 0 1))))
   (is (= ["1"] (m/-vmap str (lazy-seq [1]))))
   (is (= ["1" "2"] (m/-vmap str [1 2]))))
+
+(deftest string-test
+  (testing "pattern"
+    (let [s (m/schema [:string {:pattern "foo"}])]
+      (is (true? (m/validate s "foo")))
+      (is (true? (m/validate s "afoo")))
+      (is (true? (m/validate s "fooa")))
+      (is (false? (m/validate s "foao"))))
+    (let [s (m/schema [:string {:pattern "^foo"}])]
+      (is (true? (m/validate s "foo")))
+      (is (false? (m/validate s "afoo")))
+      (is (true? (m/validate s "fooa")))
+      (is (false? (m/validate s "foao")))))
+  (testing "charset"
+    (let [s (m/schema [:string {:charset :alphabetic}])]
+      (is (true? (m/validate s "foo")))
+      (is (false? (m/validate s "fo1o"))))
+    (let [s (m/schema [:string {:charset :letter}])]
+      (is (true? (m/validate s "foo")))
+      (is (false? (m/validate s "fo1o"))))
+    (let [s (m/schema [:string {:charset :letter-or-digit}])]
+      (is (true? (m/validate s "foo")))
+      (is (true? (m/validate s "fo0")))
+      (is (false? (m/validate s "f-1o"))))
+    (let [s (m/schema [:string {:charset #{\- :letter-or-digit}}])]
+      (is (true? (m/validate s "foo")))
+      (is (true? (m/validate s "fo0")))
+      (is (true? (m/validate s "f-1x")))
+      (is (false? (m/validate s "f?1o")))))
+  (testing "non blank"
+    (let [s (m/schema [:string {:non-blank true}])]
+      (is (true? (m/validate s "foo")))
+      (is (false? (m/validate s "")))
+      (is (false? (m/validate s "  ")))))
+  (testing "Combined"
+    (let [s (m/schema [:string {:non-blank true :pattern "foo" :charset :letter-or-digit}])]
+      (is (true? (m/validate s "foo")))
+      (is (false? (m/validate s "")))
+      (is (false? (m/validate s "  ")))
+      (is (false? (m/validate s " foo ")))
+      (is (true? (m/validate s "foo0"))))))