1.2.3

.github/workflows/commit_validation.yml

@@ -12,4 +12,4 @@ jobs:
           # this is to fix GIT not liking owner of the checkout dir, See https://github.com/actions/runner/issues/2033
           chown -R $(id -u):$(id -g) $PWD
       - name: Base image
-        uses: docker://hephaistox/gha-automaton-core:1.2.2
+        uses: docker://hephaistox/gha-automaton-core:1.2.3

bb.edn

@@ -1,5 +1,5 @@
 ;; The file is updated automatically
-{:deps {org.clojars.hephaistox/automaton-build #:mvn{:version "1.4.3"}}
+{:deps {org.clojars.hephaistox/automaton-build #:mvn{:version "1.4.4"}}
  :paths []
  :tasks
  {:requires

deps.edn

@@ -1,8 +1,8 @@
 {:aliases
- {:bb-deps {:extra-deps {org.clojars.hephaistox/automaton-build #:mvn{:version
-                                                                      "1.4.3"}}}
-  :build {:extra-deps {org.clojars.hephaistox/automaton-build #:mvn{:version
-                                                                    "1.4.3"}}}
+ {:bb-deps {:extra-deps {org.clojars.hephaistox/automaton-build
+                         #:mvn{:version "1.4.4"}}}
+  :build {:extra-deps {org.clojars.hephaistox/automaton-build
+                       #:mvn{:version "1.4.4"}}}
   :cljs-deps {:extra-deps {binaryage/devtools #:mvn{:version "1.0.7"}
                            com.yetanalytics/colossal-squuid {:mvn/version
                                                              "0.1.5"}

pom.xml

@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>org.clojars.hephaistox</groupId>
   <artifactId>automaton-core</artifactId>
-  <version>1.2.2</version>
+  <version>1.2.3</version>
   <name>automaton-core</name>
   <dependencies>
     <dependency>

src/cljc/automaton_core/adapters/schema.cljc

@@ -3,16 +3,32 @@
 
   Is a proxy for malli"
   (:require
-   [malli.core  :as malli]
-   [malli.error :as malli-error]))
+   [malli.core      :as malli]
+   [malli.error     :as malli-error]
+   [malli.transform :as malli-transform]
+   [malli.util      :as malli-util]))
+
+(def registry (merge (malli/default-schemas) (malli-util/schemas)))
+
+(defn close-map-schema
+  "Turn a map schema into a closed one."
+  [map-schema]
+  (update map-schema
+          1
+          (fn [schema-params]
+            (if (map? schema-params)
+              (assoc schema-params :closed true)
+              schema-params))))
 
 (defn validate-data
   "Return true if the data is matching the schema
   Params:
   * `schema` schema to match
   * `data` data to check appliance to schema"
   [schema data]
-  (malli/validate schema data))
+  (-> schema
+      (malli/schema {:registry registry})
+      (malli/validate data)))
 
 (defn validate-data-humanize
   "Returns nil if valid, the error message otherwise.
@@ -21,18 +37,22 @@
   * `schema` schema to match
   * `data` data to check appliance to schema"
   [schema data]
-  (when-not (validate-data schema data)
-    (-> (malli/explain schema data)
-        malli-error/with-spell-checking
-        malli-error/humanize)))
+  (when-not (-> schema
+                (malli/schema {:registry registry})
+                (validate-data data))
+    {:error (-> (malli/explain schema data)
+                malli-error/with-spell-checking
+                malli-error/humanize)
+     :schema schema
+     :data data}))
 
 (defn validate
   "Test the schema parameter is valid
 
   Params:
   * `schema` schema to test"
   [schema]
-  (try (malli/schema schema)
+  (try (malli/schema schema {:registry registry})
        true
        (catch #?(:clj Exception
                  :cljs :default)
@@ -47,9 +67,17 @@
   Params:
   * `schema` schema to test"
   [schema]
-  (try (malli/schema schema)
+  (try (malli/schema schema {:registry registry})
        nil
        (catch #?(:clj Exception
                  :cljs :default)
          _
-         (str "Schema not valid" (str schema)))))
+         (str "Schema not valid: " (str schema)))))
+
+(defn add-default
+  "Adds to `data` default values defined in the `schema`."
+  [schema data]
+  (malli/decode schema
+                data
+                (malli-transform/default-value-transformer
+                 {::malli-transform/add-optional-keys true})))

src/cljc/automaton_core/utils/map.cljc

@@ -93,6 +93,13 @@
                   [lang-id language]))
               m)))
 
+(defn maps-to-key
+  "`maps` is a list of map which value matching key `k` is used as a key to store the map as a value."
+  [maps k]
+  (->> (for [m maps] [(get m k) m])
+       (filter (comp some? first))
+       (into {})))
+
 (defn update-kw
   "Update the keywords `kws` in map `m` with function `f`"
   [m kws f]
@@ -175,6 +182,13 @@
        (map (fn [[k v]] [k (get translation v k)]))
        (into {})))
 
+(defn submap?
+  "Is `sub` existing in `m`?"
+  [sub m]
+  (if (and (map? sub) (map? m))
+    (every? (fn [[k v]] (and (contains? m k) (submap? v (get m k)))) sub)
+    (= sub m)))
+
 (defn get-key-or-before
   "Returns the key if it exists in the sorted-map
 

src/cljc/automaton_core/utils/sequences.cljc

@@ -24,6 +24,28 @@
   [coll pred]
   (let [idx? (fn [i a] (when (pred a) i))] (first (keep-indexed idx? coll))))
 
+(defn indexed
+  "Returns a lazy sequence of [index, item] pairs, where items come
+  from 's' and indexes count up from zero.
+
+  (indexed '(a b c d))  =>  ([0 a] [1 b] [2 c] [3 d])"
+  [s]
+  (map vector (iterate inc 0) s))
+
+(defn positions
+  "Returns a lazy sequence containing the positions at which pred
+   is true for items in coll."
+  [pred coll]
+  (for [[idx elt] (indexed coll) :when (pred elt)] idx))
+
+(defn concat-at
+  "Concatenate sequences `x` and `y`, `y` is inserted at position `kw`.
+  If `kw` not found, `y` is concatenated at the end of `x`."
+  [x kw y]
+  (if-let [i (first (positions #{kw} x))]
+    (concat (take i x) y (drop (inc i) x))
+    (concat x y)))
+
 (defn position-by-values
   "Returns a map which associates each value of the vector to the positions where it happens.
 

test/clj/automaton_core/adapters/schema_test.clj

@@ -15,3 +15,10 @@
   (testing "Invalid schema returns false"
     (is (some? (sut/validate-humanize nil)))
     (is (some? (sut/validate-humanize 12)))))
+
+(deftest add-default-test
+  (testing "Adds default values."
+    (is (sut/add-default [:map
+                          [:foo {:default "bar"}
+                           :string]]
+                         {}))))

test/cljc/automaton_core/utils/map_test.cljc

@@ -125,6 +125,24 @@
                          :bar "foo"}))))
   (testing "Empty maps are ok" (is (= {} (sut/add-ids {})))))
 
+(deftest maps-to-k-test
+  (is (= {:b {:a :b}
+          :a {:c :d
+              :a :a}}
+         (sut/maps-to-key [{:a :b}
+                           {:c :d
+                            :a :a}]
+                          :a)))
+  (testing "Maps with no value for the key are removed."
+    (is (= {:b {:a :b}
+            :a {:c :d
+                :a :a}}
+           (sut/maps-to-key [{:a :b}
+                             {:c :d
+                              :a :a}
+                             {}]
+                            :a)))))
+
 (deftest update-kw-test
   (testing "Update is ok, non selected keys are excluded"
     (is (= {:foo "arg"
@@ -234,6 +252,21 @@
     (is (= {} (sut/translate-keys {} nil)))
     (is (= {} (sut/translate-keys nil nil)))))
 
+(deftest submap?
+  (testing "submap is found correctly"
+    (is (sut/submap? {:a {:b :B1}}
+                     {:a {:b :B1
+                          :c :C1}}))
+    (is (sut/submap? {:c 5}
+                     {:a {:b :B1}
+                      :c 5}))
+    (is (sut/submap? {:a 1} {:a 1}))
+    (is (sut/submap? {} {})))
+  (testing "submap is not found cases"
+    (is (false? (sut/submap? {:a {:b :B1}} {:c 5})))
+    (is (false? (sut/submap? nil {})))
+    (is (false? (sut/submap? {:c 5} nil)))))
+
 (deftest get-key-or-before-test
   (testing "Test if latest key is returned, even if doesn't exist"
     (is (nil? (sut/get-key-or-before (into (sorted-map)

test/cljc/automaton_core/utils/sequences_test.cljc

@@ -30,6 +30,12 @@
   (testing "Element not found in the sequence"
     (is (nil? (sut/index-of [1 2 3] :foo)))))
 
+(deftest concat-at-test
+  (is (= [:a :b :c :d :e :f] (sut/concat-at [:a :b :x :e :f] :x [:c :d])))
+  (testing "If replacing `kw` is not found, do nothing."
+    (is (= [:a :b :x :e :f :c :d]
+           (sut/concat-at [:a :b :x :e :f] :y [:c :d])))))
+
 (deftest position-by-values-test
   (testing "Non vector are ok"
     (is (= {1 [0]

version.edn

@@ -1,2 +1,2 @@
 ;; Last generated version, note a failed push consume a number
-{:version "1.2.2"}
+{:version "1.2.3"}