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. diff --git a/src/minimallist/core.cljc b/src/minimallist/core.cljc index dfa37e6..26e4051 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,8 @@ (-valid? context (:count-model model) (count data))) (implies (contains? model :condition-model) (-valid? context (:condition-model 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))) @@ -219,7 +222,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 +242,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 +257,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 +282,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 +308,16 @@ (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 (-valid? context (:outer-model model) data) + (let [description (-describe context (:inner-model model) ((:outer->inner model identity) data))] + (if (:valid? description) + {:valid? true + :desc ((:outer<-inner model identity) (: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..16abb34 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 :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] @@ -169,6 +171,7 @@ (map (comp ::leaf-distance :model)))] (when (every? some? distances) (inc (reduce max 0 distances)))) + :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) @@ -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 (:inner-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 (->> (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) :ref (generator context (get context (:key model)) budget)))) diff --git a/src/minimallist/helper.cljc b/src/minimallist/helper.cljc index c80e4e7..8a2d969 100644 --- a/src/minimallist/helper.cljc +++ b/src/minimallist/helper.cljc @@ -206,6 +206,19 @@ [model] (repeat 1 ##Inf model)) +(defn transform + "Transformation of a data matching the model. + `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." [bindings body] diff --git a/src/minimallist/minimap.cljc b/src/minimallist/minimap.cljc index 4a2b241..3be7fed 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)] + [: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 d86176f..7581166 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/fn string?) + (h/sequence-of (h/enum #{"A" "T" "G" "C"})) + #(mapv str (seq %)) + #(apply str %)) + ["" "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/fn string?) + (h/sequence-of (h/enum #{"A" "T" "G" "C"})) + #(mapv str (seq %)) + #(apply str %)) + ["" "" + "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..b968a61 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/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))))) + (let [model (h/let ['int? fn-int? 'string? fn-string? 'int-string? (h/cat (h/ref 'int?) (h/ref 'string?))]