From 6385ef24744c83a17bb348bcb35841708929d1b7 Mon Sep 17 00:00:00 2001 From: Vincent Cantin Date: Tue, 11 Aug 2020 10:47:02 +0800 Subject: [PATCH 1/3] Implemented the transformers. Improved the implementation of describe for the :condition-model properties. --- src/minimallist/core.cljc | 22 +++++++++++++++++----- src/minimallist/generator.cljc | 8 ++++++++ src/minimallist/helper.cljc | 11 +++++++++++ src/minimallist/minimap.cljc | 5 +++++ test/minimallist/core_test.cljc | 27 +++++++++++++++++++++++---- test/minimallist/generator_test.cljc | 7 +++++++ 6 files changed, 71 insertions(+), 9 deletions(-) diff --git a/src/minimallist/core.cljc b/src/minimallist/core.cljc index dfa37e6..1b6bc18 100644 --- a/src/minimallist/core.cljc +++ b/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))) diff --git a/src/minimallist/generator.cljc b/src/minimallist/generator.cljc index 720f9f1..bc4162b 100644 --- a/src/minimallist/generator.cljc +++ b/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)))) diff --git a/src/minimallist/helper.cljc b/src/minimallist/helper.cljc index c80e4e7..6349084 100644 --- a/src/minimallist/helper.cljc +++ b/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] diff --git a/src/minimallist/minimap.cljc b/src/minimallist/minimap.cljc index 4a2b241..d539f3a 100644 --- a/src/minimallist/minimap.cljc +++ b/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))] diff --git a/test/minimallist/core_test.cljc b/test/minimallist/core_test.cljc index d86176f..1ed998b 100644 --- a/test/minimallist/core_test.cljc +++ b/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)])))))) diff --git a/test/minimallist/generator_test.cljc b/test/minimallist/generator_test.cljc index 404d35b..6095a07 100644 --- a/test/minimallist/generator_test.cljc +++ b/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?))] From f2322e9120e15cc88086d8dd391171933e9e3efd Mon Sep 17 00:00:00 2001 From: Vincent Cantin Date: Wed, 12 Aug 2020 01:17:35 +0800 Subject: [PATCH 2/3] Renamed properties on the :transform node, and changed its structure. --- src/minimallist/core.cljc | 12 +++++------- src/minimallist/generator.cljc | 12 ++++++------ src/minimallist/helper.cljc | 18 ++++++++++-------- src/minimallist/minimap.cljc | 8 ++++---- test/minimallist/core_test.cljc | 16 ++++++++-------- test/minimallist/generator_test.cljc | 8 ++++---- 6 files changed, 37 insertions(+), 37 deletions(-) diff --git a/src/minimallist/core.cljc b/src/minimallist/core.cljc index 1b6bc18..26e4051 100644 --- a/src/minimallist/core.cljc +++ b/src/minimallist/core.cljc @@ -132,9 +132,8 @@ (-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))) + :transform (and (-valid? context (:outer-model model) data) + (-valid? context (:inner-model model) ((:outer->inner model identity) data))) :let (-valid? (into context (:bindings model)) (:body model) data) :ref (-valid? context (get context (:key model)) data))) @@ -312,12 +311,11 @@ (-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))] + :transform (if (-valid? context (:outer-model model) data) + (let [description (-describe context (:inner-model model) ((:outer->inner model identity) data))] (if (:valid? description) {:valid? true - :desc ((:construct model) (:desc description))} + :desc ((:outer<-inner model identity) (:desc description))} {:valid? false})) {:valid? false}) :let (-describe (into context (:bindings model)) (:body model) data) diff --git a/src/minimallist/generator.cljc b/src/minimallist/generator.cljc index bc4162b..16abb34 100644 --- a/src/minimallist/generator.cljc +++ b/src/minimallist/generator.cljc @@ -100,7 +100,7 @@ [stack walked-bindings] (map-indexed vector entries))))) :transform (-> [[stack walked-bindings] model] - (reduce-update :child-model walk (conj path :child-model))) + (reduce-update :inner-model walk (conj path :inner-model))) :let (let [[[stack' walked-bindings'] walked-body] (walk [(conj stack {:bindings (:bindings model) :path (conj path :bindings)}) walked-bindings] @@ -171,7 +171,7 @@ (map (comp ::leaf-distance :model)))] (when (every? some? distances) (inc (reduce max 0 distances)))) - :transform (some-> (-> model :child-model ::leaf-distance) inc) + :transform (some-> (-> model :inner-model ::leaf-distance) inc) :let (some-> (-> model :body ::leaf-distance) inc) :ref (let [key (:key model) index (find-stack-index stack key) @@ -224,7 +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) + :transform (some-> (::min-cost (:inner-model model)) inc) :let (::min-cost (:body model)) :ref (let [key (:key model) index (find-stack-index stack key)] @@ -495,9 +495,9 @@ 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)))) + :transform (->> (generator context (:inner-model model) budget) + (gen/fmap (:outer<-inner model identity)) + (gen/such-that (partial m/valid? context (:outer-model model)))) :let (generator (merge context (:bindings model)) (:body model) budget) diff --git a/src/minimallist/helper.cljc b/src/minimallist/helper.cljc index 6349084..8a2d969 100644 --- a/src/minimallist/helper.cljc +++ b/src/minimallist/helper.cljc @@ -208,14 +208,16 @@ (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))) + `outer-model` is the model viewed from outside this node. + `inner-model` is the model used for the inside of the node. + `outer->inner` is transforming data during validation and parsing, and + `outer<-inner` is transforming data during parsing and generation." + [outer-model inner-model outer->inner outer<-inner] + {:type :transform + :outer-model outer-model + :inner-model inner-model + :outer->inner outer->inner + :outer<-inner outer<-inner}) (defn let "Model with local model definitions." diff --git a/src/minimallist/minimap.cljc b/src/minimallist/minimap.cljc index d539f3a..3be7fed 100644 --- a/src/minimallist/minimap.cljc +++ b/src/minimallist/minimap.cljc @@ -61,10 +61,10 @@ [: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)]))] + [:outer-model (h/ref 'model)] + [:inner-model (h/ref 'model)]) + (h/with-optional-entries [:outer->inner (h/fn fn?)] + [:outer<-inner (h/fn fn?)]))] [:let (h/map [:type (h/val :let)] [:bindings (h/map-of (h/fn any?) (h/ref 'model))] diff --git a/test/minimallist/core_test.cljc b/test/minimallist/core_test.cljc index 1ed998b..7581166 100644 --- a/test/minimallist/core_test.cljc +++ b/test/minimallist/core_test.cljc @@ -226,10 +226,10 @@ [: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?))) + (h/transform (h/fn string?) + (h/sequence-of (h/enum #{"A" "T" "G" "C"})) + #(mapv str (seq %)) + #(apply str %)) ["" "A" "CGATCAT"] [:foobar "CGAUCAU" "AOEU"] @@ -452,10 +452,10 @@ [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?))) + (h/transform (h/fn string?) + (h/sequence-of (h/enum #{"A" "T" "G" "C"})) + #(mapv str (seq %)) + #(apply str %)) ["" "" "A" "A" "CGATCAT" "CGATCAT" diff --git a/test/minimallist/generator_test.cljc b/test/minimallist/generator_test.cljc index 6095a07..b968a61 100644 --- a/test/minimallist/generator_test.cljc +++ b/test/minimallist/generator_test.cljc @@ -427,10 +427,10 @@ (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?)))] + (let [model (h/transform (h/fn string?) + (h/sequence-of (h/enum #{"A" "T" "G" "C"})) + #(mapv str (seq %)) + #(apply str %))] (is (every? (partial valid? model) (tcg/sample (gen model))))) From 4cd5b3cff396011ee36593c4328e2fa54b98673f Mon Sep 17 00:00:00 2001 From: Vincent Cantin Date: Wed, 12 Aug 2020 01:48:37 +0800 Subject: [PATCH 3/3] Added a few lines in the documentation - sorry, I am out of imagination for now. --- doc/model_builder.md | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/doc/model_builder.md b/doc/model_builder.md index 47ae8d9..4828cd7 100644 --- a/doc/model_builder.md +++ b/doc/model_builder.md @@ -219,6 +219,20 @@ With `h/not-inlined`, it will be contained in its own a collection (list or vect (h/fn string?)) ``` +### Transform + +`h/transform` creates a bridge between an inner model and the outer model. +The data is transformed is each direction when needed, via a separate function. + +```clojure +(m/describe (h/transform (h/fn string?) + (h/sequence-of (h/enum #{"A" "T" "G" "C"})) + #(mapv str (seq %)) + #(apply str %)) + "CGATCAT") +;=> "CGATCAT" +``` + ### Let / Ref `h/let` creates a model where some local models are defined.