Convert JSON schema to malli

src/malli/json_schema/parse.cljc

@@ -0,0 +1,179 @@
+(ns malli.json-schema.parse
+  (:require [malli.core :as m]
+            [malli.util :as mu]
+            [clojure.set :as set]
+            [clojure.string :as str]))
+
+(def annotations #{:title :description :default :examples :example})
+
+(defn annotations->properties [js-schema]
+  (-> js-schema
+      (select-keys annotations)
+      (set/rename-keys {:examples    :json-schema/examples
+                        :example     :json-schema/example
+                        :title       :json-schema/title
+                        :description :json-schema/description
+                        :default     :json-schema/default})))
+
+;; Utility Functions
+(defn- map-values
+  ([-fn] (map (fn [[k v]] [k (-fn v)])))
+  ([-fn coll] (sequence (map-values -fn) coll)))
+
+;; Parsing
+(defmulti type->malli :type)
+
+(defn $ref [v]
+  ;; TODO to be improved
+  (keyword (last (str/split v #"/"))))
+
+(defn schema->malli [js-schema]
+  (let [-keys (set (keys js-schema))]
+    (mu/update-properties
+     (cond
+       (-keys :type) (type->malli js-schema)
+
+       (-keys :enum) (into [:enum]
+                           (:enum js-schema))
+
+       (-keys :const) [:= (:const js-schema)]
+
+       ;; Aggregates
+       (-keys :oneOf) (into
+                       ;; TODO Figure out how to make it exclusively select o schema
+                       ;; how about `m/multi`?
+                       [:or]
+                       (map schema->malli)
+                       (:oneOf js-schema))
+
+       (-keys :anyOf) (into
+                       [:or]
+                       (map schema->malli)
+                       (:anyOf js-schema))
+
+       (-keys :allOf) (into
+                       [:and]
+                       (map schema->malli)
+                       (:allOf js-schema))
+
+       (-keys :not) [:not (schema->malli (:not js-schema))]
+
+       (-keys :$ref) ($ref (:$ref js-schema))
+
+       (empty -keys) :any
+
+       :else (throw (ex-info "Not supported" {:json-schema js-schema
+                                              :reason ::schema-type})))
+     merge
+     (annotations->properties js-schema))))
+
+(defn properties->malli [required [k v]]
+  (cond-> [k]
+    (nil? (required k)) (conj {:optional true})
+    true (conj (schema->malli v))))
+
+(defn- prop-size [pred?] (fn [-map] (pred? (count (keys -map)))))
+(defn- min-properties [-min] (prop-size (partial <= -min)))
+(defn- max-properties [-max] (prop-size (partial >= -max)))
+
+(defn with-min-max-properties-size [malli v]
+  (let [predicates [(some->> v
+                             (:minProperties)
+                             (min-properties)
+                             (conj [:fn]))
+                    (some->> v
+                             (:maxProperties)
+                             (max-properties)
+                             (conj [:fn]))]]
+    (cond->> malli
+      (some some? predicates)
+      (conj (into [:and]
+                  (filter some?)
+                  predicates)))))
+
+(defn object->malli [{:keys [additionalProperties] :as v}]
+  (let [required (into #{}
+                       ;; TODO Should use the same fn as $ref
+                       (map keyword)
+                       (:required v))
+        closed? (false? additionalProperties)]
+    (m/schema (-> (if (:type additionalProperties)
+                    (let [va (schema->malli additionalProperties)] [:map-of va va])
+                    [:map])
+                  (cond-> closed? (conj {:closed :true}))
+                  (into
+                   (map (partial properties->malli required))
+                   (:properties v))
+                  (with-min-max-properties-size v)))))
+
+(defmethod type->malli "string" [{:keys [pattern minLength maxLength enum format]}]
+  ;; `format` metadata is deliberately not considered.
+  ;; String enums are stricter, so they're also implemented here.
+  (cond
+    pattern [:re pattern]
+    enum (into [:enum] enum)
+    (= format "uuid") :uuid
+    :else (let [attrs (cond-> nil
+                        minLength (assoc :min minLength)
+                        maxLength (assoc :max maxLength))]
+            (if attrs
+              [:string attrs]
+              :string))))
+
+(defn- number->malli [{:keys [minimum maximum exclusiveMinimum exclusiveMaximum
+                              multipleOf enum type]
+                       :as schema}]
+  (let [integer (= type "integer")
+        implicit-double (or minimum maximum integer enum
+                            (number? exclusiveMaximum) (number? exclusiveMinimum))
+        maximum (if (number? exclusiveMaximum) exclusiveMaximum maximum)
+        minimum (if (number? exclusiveMinimum) exclusiveMinimum minimum)]
+    (cond-> (if integer [:int] [])
+      (or minimum maximum) identity
+      enum    (into [(into [:enum] enum)])
+      maximum (into [[(if exclusiveMaximum :< :<=) maximum]])
+      minimum (into [[(if exclusiveMinimum :> :>=) minimum]])
+      (not implicit-double) (into [[:double]]))))
+
+(defmethod type->malli "integer" [p]
+  ;; TODO Implement multipleOf support
+  (let [ranges-logic (number->malli p)]
+    (if (> (count ranges-logic) 1)
+      (into [:and] ranges-logic)
+      (first ranges-logic))))
+
+(defmethod type->malli "number" [{:keys [exclusiveMinimum exclusiveMaximum minimum maximum] :as p}]
+  (let [ranges-logic (number->malli p)]
+    (if (> (count ranges-logic) 1)
+      (into [:and] ranges-logic)
+      (first ranges-logic))))
+
+(defmethod type->malli "boolean" [p] boolean?)
+(defmethod type->malli "null" [p] :nil)
+(defmethod type->malli "object" [p] (object->malli p))
+(defmethod type->malli "array" [p] (let [items (:items p)]
+                                     (cond
+                                       (vector? items) (into [:tuple]
+                                                             (map schema->malli)
+                                                             items)
+                                       (:uniqueItems p) [:set (schema->malli items)]
+                                       (map? items) [:vector (schema->malli items)]
+                                       :else (throw (ex-info "Not Supported" {:json-schema p
+                                                                              :reason ::array-items})))))
+
+(defmethod type->malli "file" [p]
+  [:map {:json-schema {:type "file"}} [:file :any]])
+
+(defmethod type->malli :default [{:keys [type] :as p}]
+  (cond
+    (vector? type) (into [:or] (map #(type->malli {:type %}) type))
+    (and type (= 1 (count (keys p)))) {:json-schema/type type}
+    :else
+    (throw (ex-info "Not Supported" {:json-schema p
+                                     :reason ::unparseable-type}))))
+
+(defn json-schema-document->malli [obj]
+  [:schema {:registry (into {}
+                            (map-values schema->malli)
+                            (:definitions obj))}
+   (schema->malli obj)])

test/malli/json_schema/parse_test.cljc

@@ -0,0 +1,117 @@
+(ns malli.json-schema.parse-test
+  (:require [clojure.test :refer [deftest is testing]]
+            [malli.core :as m]
+            [malli.core-test]
+            [malli.json-schema :as json-schema]
+            [malli.json-schema.parse :as sut]
+            [malli.util :as mu]))
+
+(def expectations
+  [ ;; predicates
+   [[:and :int [:>= 1]] {:type "integer", :minimum 1} :one-way true]
+   [[:and :int [:>= 1]] {:allOf [{:type "integer"} {:type "number", :minimum 1}]}]
+   [[:> 0] {:type "number" :exclusiveMinimum 0}]
+   [:double {:type "number"}]
+   ;; comparators
+   [[:> 6] {:type "number", :exclusiveMinimum 6}]
+   [[:>= 6] {:type "number", :minimum 6}]
+   [[:< 6] {:type "number", :exclusiveMaximum 6}]
+   [[:<= 6] {:type "number", :maximum 6}]
+   [[:= "x"] {:const "x"}]
+   ;; base
+   [[:not :string] {:not {:type "string"}}]
+   [[:and :int [:and :int [:>= 1]]] {:allOf [{:type "integer"}
+                                             {:type "integer", :minimum 1}]} :one-way true]
+   [[:or :int :string] {:anyOf [{:type "integer"} {:type "string"}]}]
+   [[:map
+     [:a :string]
+     [:b {:optional true} :string]
+     [:c :string]] {:type "object"
+     :properties {:a {:type "string"}
+                  :b {:type "string"}
+                  :c {:type "string"}}
+     :required [:a :c]}]
+   [[:or [:map [:type :string] [:size :int]] [:map [:type :string] [:name :string] [:address [:map [:country :string]]]] :string]
+    {:oneOf [{:type "object",
+              :properties {:type {:type "string"}
+                           :size {:type "integer"}},
+              :required [:type :size]}
+             {:type "object",
+              :properties {:type {:type "string"},
+                           :name {:type "string"},
+                           :address {:type "object"
+                                     :properties {:country {:type "string"}}
+                                     :required [:country]}},
+              :required [:type :name :address]}
+             {:type "string"}]} :one-way true]
+   [[:map-of :string :string] {:type "object"
+                               :additionalProperties {:type "string"}}]
+   [[:vector :string] {:type "array", :items {:type "string"}}]
+   [[:set :string] {:type "array"
+                    :items {:type "string"}
+                    :uniqueItems true}]
+   [[:enum 1 2 "3"] {:enum [1 2 "3"]}]
+   [[:and :int [:enum 1 2 3]] {:type "integer" :enum [1 2 3]} :one-way true]
+   [[:enum 1.1 2.2 3.3] {:type "number" :enum [1.1 2.2 3.3]}]
+   [[:enum "kikka" "kukka"] {:type "string" :enum ["kikka" "kukka"]}]
+   [[:enum :kikka :kukka] {:type "string" :enum [:kikka :kukka]}]
+   [[:enum 'kikka 'kukka] {:type "string" :enum ['kikka 'kukka]}]
+   [[:or :string :nil] {:oneOf [{:type "string"} {:type "null"}]} :one-way true]
+   [[:or :string :nil] {:anyOf [{:type "string"} {:type "null"}]}]
+   [[:tuple :string :string] {:type "array"
+                              :items [{:type "string"} {:type "string"}]
+                              :additionalItems false}]
+   [[:re "^[a-z]+\\.[a-z]+$"] {:type "string", :pattern "^[a-z]+\\.[a-z]+$"}]
+   [:any {}]
+   [:nil {:type "null"}]
+   [[:string {:min 1, :max 4}] {:type "string", :minLength 1, :maxLength 4}]
+   [[:and :int [:<= 4] [:>= 1]] {:type "integer", :minimum 1, :maximum 4} :one-way true]
+   [[:and [:<= 4] [:>= 1]] {:type "number", :minimum 1, :maximum 4} :one-way true]
+   [:uuid {:type "string", :format "uuid"}]
+
+   [:int {:type "integer"}]
+   ;; type-properties
+   [[:and :int [:>= 6]] {:type "integer", :format "int64", :minimum 6} :one-way true]
+   [[:and {:json-schema/example 42} :int [:>= 6]] {:type "integer", :format "int64", :minimum 6, :example 42} :one-way true]])
+
+(deftest json-schema-test
+  (doseq [[schema json-schema & {:keys [one-way]}] expectations]
+    (testing json-schema
+      (is (= schema
+             (m/form (sut/schema->malli json-schema)))))
+
+    (when-not one-way
+      (testing (str "round trip " json-schema "\n" schema)
+        (is (= json-schema
+               (-> json-schema sut/schema->malli malli.json-schema/transform))))))
+
+  (testing "full override"
+    (is (= [:map {:json-schema {:type "file"}} [:file :any]]
+           (m/form (sut/schema->malli {:type "file"})))))
+
+  (testing "with properties"
+    (is (= [:map
+            [:x1 [:string {:json-schema/title "x"}]]
+            [:x2 [:any #:json-schema{:default "x" :title "x"}]]
+            [:x3 [:string #:json-schema{:title "x" :default "x"}]]
+            [:x4 {:optional true} [:any #:json-schema{:title "x-string" :default "x2"}]]]
+
+           (m/form (sut/schema->malli {:type "object",
+                                       :properties {:x1 {:title "x", :type "string"}
+                                                    :x2 {:title "x", :default "x"}
+                                                    :x3 {:title "x", :type "string", :default "x"}
+                                                    :x4 {:title "x-string", :default "x2"}},
+                                       :required [:x1 :x2 :x3]}))))
+
+    #_(testing "custom type"
+        (is (= [:map
+                [:x5 {:json-schema/type "x-string"} :string]]
+               (m/form (sut/schema->malli {:type "object", :properties {:x5 {:type "x-string"}}, :required [:x5]})))))
+
+    (is (= [:and {:json-schema/title "age"
+                  :json-schema/description "blabla"
+                  :json-schema/default 42} :int]
+           (m/form (sut/schema->malli {:allOf [{:type "integer"}]
+                                       :title "age"
+                                       :description "blabla"
+                                       :default 42}))))))