wip

Author: frenchy64

test/compojure/api/dev/gen.clj

@@ -0,0 +1,169 @@
+(ns compojure.api.dev.gen
+  (:require [clojure.string :as str]
+            [clojure.set :as set]
+            [clojure.walk :as walk]))
+
+(def impl-local-sym '+impl+)
+
+(defn normalize-argv [argv]
+  {:post [(or (empty? %)
+              (apply distinct? %))
+          (not-any? #{impl-local-sym} %)]}
+  (into [] (map-indexed (fn [i arg]
+                          (if (symbol? arg)
+                            (do (assert (not (namespace arg)))
+                                (if (some #(Character/isDigit (char %)) (name arg))
+                                  (symbol (apply str (concat
+                                                       (remove #(Character/isDigit (char %)) (name arg))
+                                                       [i])))
+                                  arg))
+                            (symbol (str "arg" i)))))
+        argv))
+
+(defn normalize-arities [arities]
+  (cond-> arities
+    (= 1 (count arities)) first))
+
+(defn import-fn [sym]
+  {:pre [(namespace sym)]}
+  (let [vr (find-var sym)
+        m (meta vr)
+        n (:name m)
+        arglists (:arglists m)
+        protocol (:protocol m)
+        when-class (-> sym meta :when-class)
+        _ (assert (not when-class))
+        forward-meta (into (sorted-map) (select-keys m [:tag :arglists :doc :deprecated]))
+        _ (assert (not= n impl-local-sym))
+        _ (when (:macro m)
+            (throw (IllegalArgumentException.
+                     (str "Calling import-fn on a macro: " sym))))
+        form (if protocol
+               (list* 'defn (with-meta n (dissoc forward-meta :arglists))
+                      (map (fn [argv]
+                             {:pre [(not-any? #{'&} argv)]}
+                             (list argv (list* sym argv)))
+                           arglists))
+               (list 'def (with-meta n forward-meta) sym))]
+    (cond->> form
+      #_#_when-class (list 'java-time.util/when-class when-class))))
+
+(defn import-macro [sym]
+  (let [vr (find-var sym)
+        m (meta vr)
+        _ (when-not (:macro m)
+            (throw (IllegalArgumentException.
+                     (str "Calling import-macro on a non-macro: " sym))))
+        n (:name m)
+        arglists (:arglists m)]
+    (list* 'defmacro n 
+           (concat
+             (some-> (not-empty (into (sorted-map) (select-keys m [:doc :deprecated])))
+                     list)
+             (normalize-arities
+               (map (fn [argv]
+                      (let [argv (normalize-argv argv)]
+                        (list argv
+                              (if (some #{'&} argv)
+                                (list* 'list* (list 'quote sym) (remove #{'&} argv))
+                                (list* 'list (list 'quote sym) argv)))))
+                    arglists))))))
+
+(defn import-vars
+  "Imports a list of vars from other namespaces."
+  [& syms]
+  (let [unravel (fn unravel [x]
+                  (if (sequential? x)
+                    (->> x
+                         rest
+                         (mapcat unravel)
+                         (map
+                           #(with-meta
+                              (symbol
+                                (str (first x)
+                                     (when-let [n (namespace %)]
+                                       (str "." n)))
+                                (name %))
+                              (meta %))))
+                    [x]))
+        syms (mapcat unravel syms)]
+    (map (fn [sym]
+           (let [vr (if-some [rr (resolve 'clojure.core/requiring-resolve)]
+                      (rr sym)
+                      (do (require (-> sym namespace symbol))
+                          (resolve sym)))
+                 _ (assert vr (str sym " is unresolvable"))
+                 m (meta vr)]
+             (if (:macro m)
+               (import-macro sym)
+               (import-fn sym))))
+         syms)))
+
+(def impl-info
+  {:vars '([compojure.api.core routes defroutes let-routes undocumented middleware
+            context GET ANY HEAD PATCH DELETE OPTIONS POST PUT]
+           [compojure.api.api api defapi]
+           [compojure.api.resource resource]
+           [compojure.api.routes path-for]
+           [compojure.api.swagger swagger-routes]
+           [ring.swagger.json-schema describe])})
+
+(defn gen-compojure-api-sweet-ns-forms [nsym]
+  (let [require-macros (into #{} (map first) (:macros impl-info))]
+    (concat
+      [";; NOTE: This namespace is generated by compojure.api.dev.gen"
+       `(~'ns ~nsym
+          (:require compojure.api.core
+                    compojure.api.api
+                    compojure.api.routes
+                    compojure.api.resource
+                    compojure.api.swagger
+                    ring.swagger.json-schema))]
+      (apply import-vars (:vars impl-info)))))
+
+(defn print-form [form]
+  (with-bindings
+    (cond-> {#'*print-meta* true
+             #'*print-length* nil
+             #'*print-level* nil}
+      (resolve '*print-namespace-maps*)
+      (assoc (resolve '*print-namespace-maps*) false))
+    (cond
+      (string? form) (println form)
+      :else (println (pr-str (walk/postwalk
+                               (fn [v]
+                                 (if (meta v)
+                                   (if (symbol? v)
+                                     (vary-meta v #(not-empty
+                                                     (cond-> (sorted-map)
+                                                       (some? (:tag %)) (assoc :tag (:tag %))
+                                                       (some? (:doc %)) (assoc :doc (:doc %))
+                                                       ((some-fn true? string?) (:deprecated %)) (assoc :deprecated (:deprecated %))
+                                                       (string? (:superseded-by %)) (assoc :superseded-by (:superseded-by %))
+                                                       (string? (:supercedes %)) (assoc :supercedes (:supercedes %))
+                                                       (some? (:arglists %)) (assoc :arglists (list 'quote (doall (map normalize-argv (:arglists %))))))))
+                                     (with-meta v nil))
+                                   v))
+                               form)))))
+  nil)
+
+(defn print-compojure-api-ns [nsym]
+  (run! print-form (gen-compojure-api-sweet-ns-forms nsym)))
+
+(def compojure-api-sweet-nsym
+  (with-meta
+    'compojure.api.sweet
+    ;;TODO ns meta
+    nil))
+
+(def gen-source->nsym
+  {"src/compojure/api/sweet.clj" compojure-api-sweet-nsym})
+
+(defn spit-compojure-api-ns []
+  (doseq [[source nsym] gen-source->nsym]
+    (spit source (with-out-str (print-compojure-api-ns nsym)))))
+
+(comment
+  (print-compojure-api-ns compojure-api-sweet-nsym)
+  (spit-compojure-api-ns)
+  )