Skip to content

Commit

Permalink
Implemented the transformers. Improved the implementation of describe…
Browse files Browse the repository at this point in the history 
… for the :condition-model properties.
  • Loading branch information
@green-coder
green-coder committed Aug 11, 2020
1 parent e81abf5 commit 6385ef2
Show file tree
Hide file tree
Showing 6 changed files with 71 additions and 9 deletions.
22 changes: 17 additions & 5 deletions src/minimallist/core.cljc
View file
Expand Up @@ -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:
Expand Down Expand Up @@ -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)))

Expand Down Expand Up @@ -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)
Expand All @@ -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})
Expand All @@ -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})
Expand All @@ -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})
Expand All @@ -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)))

Expand Down
8 changes: 8 additions & 0 deletions src/minimallist/generator.cljc
View file
Expand Up @@ -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]
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)]
Expand Down Expand Up @@ -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))))
Expand Down
11 changes: 11 additions & 0 deletions src/minimallist/helper.cljc
View file
Expand Up @@ -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]
Expand Down
5 changes: 5 additions & 0 deletions src/minimallist/minimap.cljc
View file
Expand Up @@ -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))]
Expand Down
27 changes: 23 additions & 4 deletions test/minimallist/core_test.cljc
View file
@@ -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 {}
Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -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?))]
Expand All @@ -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)]))))))
7 changes: 7 additions & 0 deletions test/minimallist/generator_test.cljc
View file
Expand Up @@ -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?))]
Expand Down

0 comments on commit 6385ef2

Please sign in to comment.