Fix malli swagger defs

src/malli/json_schema.cljc

@@ -7,12 +7,21 @@
 (defprotocol JsonSchema
   (-accept [this children options] "transforms schema to JSON Schema"))
 
-(defn -ref [x] {:$ref (str "#/definitions/" x)})
+(defn -ref [x] {:$ref (apply str "#/definitions/"
+                             (cond
+                               (qualified-keyword? x) [(namespace x) "~1"
+                                                       (name x)]
+                               (keyword? x) [(name x)]
+                               :else [x]))})
 
 (defn -schema [schema {::keys [transform definitions] :as options}]
   (let [result (transform (m/deref schema) options)]
     (if-let [ref (m/-ref schema)]
-      (do (swap! definitions assoc ref result) (-ref ref))
+      (do
+        (when-not (and (contains? result :$ref)
+                       (= (:$ref result) ref)) ; don't create circular defs
+          (swap! definitions assoc ref result))
+        (-ref ref))
       result)))
 
 (defn select [m] (select-keys m [:title :description :default]))

src/malli/swagger.cljc

@@ -1,5 +1,6 @@
 (ns malli.swagger
   (:require [clojure.set :as set]
+            [clojure.walk :as walk]
             [malli.core :as m]
             [malli.json-schema :as json-schema]))
 
@@ -67,3 +68,102 @@
                                  ::json-schema/definitions definitions
                                  ::json-schema/transform -transform})]
      (cond-> (-transform ?schema options) (seq @definitions) (assoc :definitions @definitions)))))
+
+(defn remove-empty-keys
+  [m]
+  (into (empty m) (filter (comp not nil? val) m)))
+
+(defmulti extract-parameter (fn [in _] in))
+
+(defmethod extract-parameter :body [_ schema]
+  (let [swagger-schema (transform schema {:in :body, :type :parameter})]
+    [{:in          "body"
+      :name        (:title swagger-schema "body")
+      :description (:description swagger-schema "")
+      :required    (not= :maybe (m/type schema))
+      :schema      swagger-schema}]))
+
+(defmethod extract-parameter :default [in schema]
+  (let [{:keys [properties required definitions]} (transform schema {:in in, :type :parameter})]
+    (println "\nextract-parameter definitions:"
+             (with-out-str (clojure.pprint/pprint definitions)))
+    (mapv
+      (fn [[k {:keys [type] :as schema}]]
+        (merge
+          {:in          (name in)
+           :name        k
+           :description (:description schema "")
+           :type        type
+           :required    (contains? (set required) k)}
+          schema))
+      properties)))
+
+(defmulti expand (fn [k _ _ _] k))
+
+#_(defn lift-response-definitions
+    [response]
+    (if-let [definitions (get-in response [:schema :definitions])]
+      (-> response
+          (update :schema dissoc :definitions)
+          (assoc :definitions definitions))))
+
+(defmethod expand ::responses [_ v acc _]
+  {:responses
+   (into
+     (or (:responses acc) {})
+     (for [[status response] v]
+       [status (-> response
+                   (update :schema transform {:type :schema})
+                   (update :description (fnil identity ""))
+                   remove-empty-keys)]))})
+
+(defmethod expand ::parameters [_ v acc _]
+  (let [old    (or (:parameters acc) [])
+        new    (mapcat (fn [[in spec]] (extract-parameter in spec)) v)
+        merged (->> (into old new)
+                    reverse
+                    (reduce
+                      (fn [[ps cache :as acc] p]
+                        (let [c (select-keys p [:in :name])]
+                          (if (cache c)
+                            acc
+                            [(conj ps p) (conj cache c)])))
+                      [[] #{}])
+                    first
+                    reverse
+                    vec)]
+    {:parameters merged}))
+
+(defn expand-qualified-keywords
+  [x options]
+  (let [accept? (-> expand methods keys set)]
+    (walk/postwalk
+      (fn [x]
+        (if (map? x)
+          (reduce-kv
+            (fn [acc k v]
+              (if (accept? k)
+                (let [expanded    (expand k v acc options)
+                      parameters  (:parameters expanded)
+                      _           (println "\nPARAMETERS:"
+                                           (with-out-str (clojure.pprint/pprint parameters)))
+                      responses   (:responses expanded)
+                      _           (println "\nRESPONSES:"
+                                           (with-out-str (clojure.pprint/pprint responses)))
+                      definitions (if parameters
+                                    (-> parameters first :schema :definitions)
+                                    (->> responses vals (map :schema)
+                                         (map :definitions) (apply merge)))
+                      _           (println "\nDEFINITIONS:"
+                                           (with-out-str (clojure.pprint/pprint definitions)))]
+                  (-> acc (dissoc k) (merge expanded) (update :definitions merge definitions)))
+                acc))
+            x x)
+          x))
+      x)))
+
+(defn swagger-spec
+  ([x]
+   (swagger-spec x nil))
+  ([x options]
+   (expand-qualified-keywords x options)))