Implemented the transformers. Improved the implementation of describe for the :condition-model properties.

Author: green-coder

src/minimallist/core.cljc

@@ -16,6 +16,7 @@
    :and :or
    :set-of :map-of :map :sequence-of :sequence
    :alt :cat :repeat
+   :transform
    :let :ref])
 
 ;; There are 2 kinds of predicates:
@@ -131,6 +132,9 @@
                                  (-valid? context (:count-model model) (count data)))
                         (implies (contains? model :condition-model)
                                  (-valid? context (:condition-model model) data)))
+    :transform (and (implies (contains? model :condition-model)
+                             (-valid? context (:condition-model model) data))
+                    (-valid? context (:child-model model) ((:destruct model) data)))
     :let (-valid? (into context (:bindings model)) (:body model) data)
     :ref (-valid? context (get context (:key model)) data)))
 
@@ -219,7 +223,7 @@
                                 (implies (contains? model :count-model)
                                          (:valid? (-describe context (:count-model model) (count data))))
                                 (implies (contains? model :condition-model)
-                                         (:valid? (-describe context (:condition-model model) data))))]
+                                         (-valid? context (:condition-model model) data)))]
                 {:valid? valid?
                  :desc (into #{} (map :desc) entries)}))
     :map-of (if (map? data)
@@ -239,7 +243,7 @@
                                 (implies (contains? model :values)
                                          (every? :valid? (vals entries)))
                                 (implies (contains? model :condition-model)
-                                         (:valid? (-describe context (:condition-model model) data))))]
+                                         (-valid? context (:condition-model model) data)))]
                 {:valid? valid?
                  :desc (into {} (map (fn [[k v]] [(:desc k) (:desc v)])) entries)})
               {:valid? false})
@@ -254,7 +258,7 @@
                  valid? (and (implies (contains? model :entries)
                                       (every? :valid? (vals entries)))
                              (implies (contains? model :condition-model)
-                                      (:valid? (-describe context (:condition-model model) data))))]
+                                      (-valid? context (:condition-model model) data)))]
              {:valid? valid?
               :desc (into {} (map (fn [[k v]] [k (:desc v)])) entries)})
            {:valid? false})
@@ -279,7 +283,7 @@
                                                  (implies (contains? model :elements-model)
                                                           (every? :valid? entries))
                                                  (implies (contains? model :condition-model)
-                                                          (:valid? (-describe context (:condition-model model) data))))]
+                                                          (-valid? context (:condition-model model) data)))]
                                  {:valid? valid?
                                   :desc (mapv :desc entries)})
                                {:valid? false})
@@ -305,9 +309,17 @@
                        (if (seq seq-descriptions)
                          {:desc (:desc (first seq-descriptions))
                           :valid? (implies (contains? model :condition-model)
-                                           (:valid? (-describe context (:condition-model model) data)))}
+                                           (-valid? context (:condition-model model) data))}
                          {:valid? false}))
                      {:valid? false})
+    :transform (if (implies (contains? model :condition-model)
+                            (-valid? context (:condition-model model) data))
+                 (let [description (-describe context (:child-model model) ((:destruct model) data))]
+                   (if (:valid? description)
+                     {:valid? true
+                      :desc ((:construct model) (:desc description))}
+                     {:valid? false}))
+                 {:valid? false})
     :let (-describe (into context (:bindings model)) (:body model) data)
     :ref (-describe context (get context (:key model)) data)))
 

src/minimallist/generator.cljc

@@ -99,6 +99,8 @@
                                                                                              walk (conj path :entries index :model)))
                                                                             [stack walked-bindings]
                                                                             (map-indexed vector entries)))))
+                       :transform (-> [[stack walked-bindings] model]
+                                      (reduce-update :child-model walk (conj path :child-model)))
                        :let (let [[[stack' walked-bindings'] walked-body] (walk [(conj stack {:bindings (:bindings model)
                                                                                               :path (conj path :bindings)})
                                                                                  walked-bindings]
@@ -169,6 +171,7 @@
                                                (map (comp ::leaf-distance :model)))]
                             (when (every? some? distances)
                               (inc (reduce max 0 distances))))
+                   :transform (some-> (-> model :child-model ::leaf-distance) inc)
                    :let (some-> (-> model :body ::leaf-distance) inc)
                    :ref (let [key (:key model)
                               index (find-stack-index stack key)
@@ -221,6 +224,7 @@
                                           (map (comp ::min-cost :model)))
                                 content-cost (when (every? some? vals) (reduce + vals))]
                             (some-> content-cost (+ container-cost)))
+                   :transform (some-> (::min-cost (:child-model model)) inc)
                    :let (::min-cost (:body model))
                    :ref (let [key (:key model)
                               index (find-stack-index stack key)]
@@ -491,6 +495,10 @@
                                                 inside-list? (gen/fmap (partial apply list))))))
                                 (contains? model :condition-model) (gen/such-that (partial m/valid? context (:condition-model model))))
 
+        :transform (cond->> (generator context (:child-model model) budget)
+                     (contains? model :construct) (gen/fmap (:construct model))
+                     (contains? model :condition-model) (gen/such-that (partial m/valid? context (:condition-model model))))
+
         :let (generator (merge context (:bindings model)) (:body model) budget)
 
         :ref (generator context (get context (:key model)) budget))))

src/minimallist/helper.cljc

@@ -206,6 +206,17 @@
   [model]
   (repeat 1 ##Inf model))
 
+(defn transform
+  "Transformation of a data matching the model.
+   `destruct` is used during validation and parsing, and
+   `construct` is used during parsing and generation."
+  ([model destruct]
+   {:type :transform
+    :child-model model
+    :destruct destruct})
+  ([model destruct construct]
+   (assoc (transform model destruct) :construct construct)))
+
 (defn let
   "Model with local model definitions."
   [bindings body]

src/minimallist/minimap.cljc

@@ -60,6 +60,11 @@
                                                               [:inlined (h/fn boolean?)]
                                                               [:condition-model (h/ref 'model)])
                                      (h/with-condition (h/fn #(<= (:min %) (:max %)))))]
+                        [:transform (-> (h/map [:type (h/val :transform)]
+                                               [:child-model (h/ref 'model)]
+                                               [:destruct (h/fn fn?)])
+                                        (h/with-optional-entries [:construct (h/fn fn?)]
+                                                                 [:condition-model (h/ref 'model)]))]
                         [:let (h/map [:type (h/val :let)]
                                      [:bindings (h/map-of (h/fn any?)
                                                           (h/ref 'model))]

test/minimallist/core_test.cljc

@@ -1,8 +1,7 @@
 (ns minimallist.core-test
   (:require [clojure.test :refer [deftest testing is are]]
             [minimallist.core :refer [valid? explain describe undescribe] :as m]
-            [minimallist.helper :as h]
-            [minimallist.util :as util]))
+            [minimallist.helper :as h]))
 
 (comment
   (#'m/sequence-descriptions {}
@@ -226,6 +225,14 @@
                     ['div]
                     [:div {:a 1} "hei" [:p {} {} "bonjour"]]]
 
+                   ;; transform
+                   (-> (h/transform (h/sequence-of (h/enum #{"A" "T" "G" "C"}))
+                                    #(mapv str (seq %))
+                                    #(apply str %))
+                       (h/with-condition (h/fn string?)))
+                   ["" "A" "CGATCAT"]
+                   [:foobar "CGAUCAU" "AOEU"]
+
                    ;; let / ref - with recursion within a sequence
                    (h/let ['foo (h/cat (h/fn int?)
                                        (h/? (h/ref 'foo))
@@ -444,6 +451,18 @@
                     [1 "a" 2 "b"] :invalid
                     [1 "a" 2 "b" 3 "c"] :invalid]
 
+                   ;; transform
+                   (-> (h/transform (h/sequence-of (h/enum #{"A" "T" "G" "C"}))
+                                    #(mapv str (seq %))
+                                    #(apply str %))
+                       (h/with-condition (h/fn string?)))
+                   ["" ""
+                    "A" "A"
+                    "CGATCAT" "CGATCAT"
+                    :foobar :invalid
+                    "CGAUCAU" :invalid
+                    "AOEU" :invalid]
+
                    ;; let / ref
                    (h/let ['pos-even? (h/and (h/fn pos-int?)
                                              (h/fn even?))]
@@ -456,5 +475,5 @@
 
     (doseq [[model data-description-pairs] (partition 2 test-data)]
       (doseq [[data description] (partition 2 data-description-pairs)]
-        (is (= [data (describe model data)]
-               [data description]))))))
+        (is (= [data description]
+               [data (describe model data)]))))))

test/minimallist/generator_test.cljc

@@ -427,6 +427,13 @@
     (is (every? (partial valid? model)
                 (tcg/sample (gen model)))))
 
+  (let [model (-> (h/transform (h/sequence-of (h/enum #{"A" "T" "G" "C"}))
+                               #(mapv str (seq %))
+                               #(apply str %))
+                  (h/with-condition (h/fn string?)))]
+    (is (every? (partial valid? model)
+                (tcg/sample (gen model)))))
+
   (let [model (h/let ['int? fn-int?
                       'string? fn-string?
                       'int-string? (h/cat (h/ref 'int?) (h/ref 'string?))]