Metabase Defendpoint 1 -> Defendpoint 2

defendpoint_2.clj

(ns metabase.api.defendpoint-2
  (:require
   [metabase.util :as u]))

(defn- parse-defendpoint-1-args
  [form]
  (let [[_defendpoint method route & args] form
        [docstring & args]                 (if (string? (first args))
                                             args
                                             (cons nil args))
        [fn-args & args]                   args
        [schema-map & body]                (if (map? (first args))
                                             args
                                             (cons nil args))]
    {:method     (keyword (u/lower-case-en (name method)))
     :route      route
     :docstring  docstring
     :fn-args    fn-args
     :schema-map schema-map
     :body       body}))

(defn- route-query-args-symbols [{:keys [fn-args], :as _parsed}]
  (first (split-with #(not= % :as) fn-args)))

(defn- schema-map->malli [schema-map]
  (when (seq schema-map)
    (into [:map]
          (map (fn [[k schema]]
                 (if (and (vector? schema)
                          (= (first schema) :maybe))
                   [(keyword k) {:optional true} schema]
                   [(keyword k) schema])))
          schema-map)))

(defn- route-args-symbols [{:keys [route], :as _parsed}]
  (if (vector? route)
    (recur (first route))
    (map (comp symbol second) (re-seq #":([^:/]+)" route))))

(defn- route-args-schema [{:keys [schema-map], :as parsed}]
  (schema-map->malli (select-keys schema-map (route-args-symbols parsed))))

(defn- route-args-binding [parsed]
  (if-let [args (not-empty (route-args-symbols parsed))]
    {:keys (vec args)}
    '_route-params))

(defn- query-args-symbols [parsed]
  (remove (set (route-args-symbols parsed))
          (route-query-args-symbols parsed)))

(defn- query-args-binding [parsed]
  (if-let [args (not-empty (query-args-symbols parsed))]
    {:keys (vec args)}
    '_query-params))

(defn- query-args-schema [{:keys [schema-map], :as parsed}]
  (schema-map->malli (select-keys schema-map (query-args-symbols parsed))))

(defn- body-binding [{:keys [fn-args], :as _parsed}]
  (or (let [[_route-query-args [_as request-map]] (split-with #(not= % :as) fn-args)]
        (when (seq request-map)
          (let [m (zipmap (vals request-map) (keys request-map))]
            (:body m))))
      '_body))

(comment
  (body-binding '{:fn-args [id :as {{:keys [name default description icon collection_id archived] :as timeline-updates} :body}]}))

(defn- body-schema [{:keys [schema-map], :as parsed}]
  (let [body-keys (->> schema-map
                       keys
                       (remove (set (route-args-symbols parsed)))
                       (remove (set (query-args-symbols parsed))))]
    (schema-map->malli (select-keys schema-map body-keys))))

(defn defendpoint-1->defendpoint-2
  [form]
  (let [{:keys [method route docstring body], :as parsed} (parse-defendpoint-1-args form)]
    `(metabase.api.macros/defendpoint ~method ~route
       ~@(when docstring [docstring])
       [ ;; route
        ~(route-args-binding parsed)
        ~@(when-let [schema (route-args-schema parsed)]
            [:- schema])
        ;; query params
        ~(query-args-binding parsed)
        ~@(when-let [schema (query-args-schema parsed)]
            [:- schema])
        ;; body
        ~(body-binding parsed)
        ~@(when-let [schema (body-schema parsed)]
            [:- schema])]
       ~@body)))