ref(module): total rewrite and decoupling

- rename main router function key to `duct.reitit/router` instead of
  `duct.router/reitit`.
- rename main handler function key to `duct.reitit/handler` instead of
  `duct.handler/root`.
- create separate initializer for `duct.reitit/routes`. It seems to go
  along the lines of decoupling processing steps.
- refactor `duct.module/reitit` and make more readable and easy to
  reason with.
- move default config along with development and production profile
  mutations to `duct/reitit/defaults.clj`.
- refactor reitit module initializer logic to somewhat general purpose
  module initializer.

  ~~~clojure
  (module/init
         {:root  :duct.reitit
          :config config
          :extra [(registry-tree registry)]
          :store  {:namespaces namespaces :routes routes}
          :schema {::registry (registry-references registry)
                   ::routes   [:routes :namespaces ::registry]
                   ::router   [::routes ::options ::log]
                   ::log      ::options
                   ::handler  [::router ::options ::log]}})
  ~~~
  This make create modules similar duct.reitit easier.
  TODO: move to external library.
- change tests to reflect new changes
- remove many redundant files.

src/duct/lib/module.clj

@@ -0,0 +1,50 @@
+(ns duct.lib.module
+  (:require [duct.core :refer [merge-configs]]
+            [integrant.core :as ig]))
+
+(defn- not-member? [coll v]
+  (nil? (some (fn [x] (= x v)) coll)))
+
+(defn- unqualify [key]
+  (keyword (name key)))
+
+(defn- into-options?
+  "Returns true, when the given key's namespace == root
+  and key doesn't exist in 'blacklist"
+  [root key blacklist]
+  (and (= root (namespace key))
+       (not-member? blacklist key)))
+
+(defn- into-options
+  "Returns a map with keys with root are taken into root/options."
+  [root schema-keys config]
+  (let [root (if (keyword? root) (name root) root)]
+    (reduce-kv
+     (fn [m k v]
+       (if (into-options? root k schema-keys)
+         (assoc-in m [(keyword root "options") (unqualify k)] v)
+         (assoc m k v)))
+     {} config)))
+
+(defn- vector-map-transformer
+  [store]
+  (let [ref-or-store #(if (qualified-keyword? %) (ig/ref %) (get store %))
+        process-key (fn [k] [(unqualify k) (ref-or-store k)])]
+    #(into {} (mapv process-key %))))
+
+(defn- transform-schema
+  [schema store]
+  (let [vector-transform (vector-map-transformer store)
+        vec-of-refs? #(and (vector? %) (every? keyword? %))]
+    (reduce-kv
+     (fn [m k v]
+       (assoc m k (cond
+                    (keyword? v) (ig/ref v)
+                    (vec-of-refs? v) (vector-transform v)
+                    :else v))) {} schema)))
+
+(defn init [{:keys [root config extra store schema]}]
+  (let [root-namesspace (if (keyword? root) (name root) root)
+        stripped-config (into-options root-namesspace (keys schema) config)
+        final-config (apply merge-configs (cons stripped-config extra))]
+    (merge final-config (transform-schema schema store))))

src/duct/reitit.clj

@@ -1,64 +1,54 @@
 (ns duct.reitit
   (:require [duct.core :as core :refer [merge-configs]]
+            [duct.lib.module :as module]
+            [duct.logger :as logger]
+            [duct.reitit.defaults :refer [reitit-module-defaults]]
             [duct.reitit.handler]
-            [duct.reitit.util :as util :refer [get-namespaces resolve-registry with-registry spy]]
-            [integrant.core :refer [init-key] :as ig]
-            [duct.logger :as logger]))
+            [duct.reitit.log]
+            [duct.reitit.util :as util :refer [get-namespaces resolve-key]]
+            [integrant.core :refer [init-key] :as ig]))
 
-(def ^:private base-config
-  {:duct.core/handler-ns 'handler
-   :duct.core/middleware-ns 'middleware
-   ::environment {}
-   ::middleware []
-   ::muuntaja true
-   ::coercion nil
-   ::logging {:exceptions? true
-              :pretty? false :logger nil}})
-   ; ::logger (m/displace (ig/ref :duct/logger))})
+(defn registry-resolve
+  "Resolve registry keys into a map of {k [resolve config]}"
+  [namespaces registry]
+  (letfn [(process [f] (reduce f {} registry))
+          (resolve [k] (resolve-key namespaces k))]
+    (process
+     (fn [acc [k v]]
+       (when-let [res (resolve k)]
+         (assoc acc k [res (or v {})]))))))
 
-(def ^:private configs
-  {:development
-   {::logging {:pretty? true
-               :coercions? true
-               :requests? true}
-    ::muuntaja true
-    ::cross-origin {:origin [#".*"] :methods [:get :post :delete :options]}}
-   :production
-   {::logging {:exceptions? false
-               :coercions? false
-               :requests? true
-               :pretty? false}}})
+(defn registry-tree
+  "Returns a config tree that should be merged in duct configuration map"
+  [registry]
+  (reduce-kv (fn [m _ v]
+               (assoc m (first v) (second v))) {} registry))
 
-(defn- merge-to-options [config]
-  (reduce-kv
-   (fn [acc k v]
-     (if (= "duct.reitit" (namespace k))
-       (assoc-in acc [::options (keyword (name k))] v)
-       (assoc acc k v)))
-   {} config))
+(defn- registry-references
+  "Returns a map of keys and their integrant reference."
+  [registry]
+  (reduce-kv (fn [m k v]
+               (assoc m k (ig/ref (first v)))) {} registry))
 
-(defmethod init-key ::log [_ {{:keys [enable logger pretty? exceptions? coercions?]} :logging}]
-  (when (and enable (or exceptions? coercions?))
-    (if (and logger (not pretty?))
-      (fn [level message]
-        (logger/log logger level message))
-      println)))
+(defn get-config
+  "Merge user configuration with default-configuration and
+  environment-default-configuration"
+  [user-config]
+  (let [profile-config (some-> user-config :duct.core/environment reitit-module-defaults)]
+    (merge-configs (reitit-module-defaults :base) profile-config user-config)))
 
 (defmethod init-key :duct.module/reitit [_ _]
-  (fn [{:duct.reitit/keys [registry routes]
-        :duct.core/keys [environment] :as user-config}]
-    (let [env-config (or (configs environment) {})
-          config     (merge-to-options (merge-configs base-config env-config user-config))
+  (fn [{:duct.reitit/keys [registry routes] :as user-config}]
+    (let [config     (get-config user-config)
           namespaces (get-namespaces config)
-          registry   (resolve-registry namespaces registry)
-          merge      (partial with-registry config registry)]
-      (merge
-       {::registry          (reduce-kv (fn [m k v] (assoc m k (ig/ref (first v)))) {} registry)
-        ::log               (ig/ref ::options)
-        :duct.handler/root  {:options (ig/ref ::options)
-                             :router (ig/ref :duct.router/reitit)}
-        :duct.router/reitit {:routes routes
-                             :log (ig/ref ::log)
-                             :registry (ig/ref ::registry)
-                             :options (ig/ref ::options)
-                             :namespaces namespaces}}))))
+          registry   (registry-resolve namespaces registry)]
+      (module/init
+       {:root  :duct.reitit
+        :config config
+        :extra [(registry-tree registry)]
+        :store  {:namespaces namespaces :routes routes}
+        :schema {::registry (registry-references registry)
+                 ::routes   [:routes :namespaces ::registry]
+                 ::router   [::routes ::options ::log]
+                 ::log      ::options
+                 ::handler  [::router ::options ::log]}}))))

src/duct/reitit/defaults.clj

@@ -0,0 +1,24 @@
+(ns duct.reitit.defaults)
+
+(def reitit-module-defaults
+  {:base    {:duct.core/handler-ns 'handler
+             :duct.core/middleware-ns 'middleware
+             :duct.reitit/environment {}
+             :duct.reitit/middleware []
+             :duct.reitit/muuntaja true
+             :duct.reitit/coercion nil
+             :duct.reitit/logging {:enable true
+                                   :exceptions? true
+                                   :pretty? false}}
+
+   :development {:duct.reitit/logging
+                 {:pretty? true :coercions? true :requests? true}
+                 :duct.reitit/muuntaja true
+                 :duct.reitit/cross-origin
+                 {:origin [#".*"] :methods [:get :post :delete :options]}}
+
+   :production  {:duct.reitit/logging
+                 {:exceptions? false
+                  :coercions? false
+                  :requests? true
+                  :pretty? false}}})

src/duct/reitit/format.clj

@@ -0,0 +1,47 @@
+(ns duct.reitit.format
+  (:require [clojure.string :as str]
+            [duct.reitit.request :as request]
+            [expound.alpha :as expound]))
+
+(defn spec-print [{:keys [pre problems print-spec?]}]
+  (let [cfg {:theme :figwheel-theme :print-specs? print-spec?}
+        -print (expound/custom-printer (if pre (assoc cfg :value-str-fn pre) cfg))]
+    (-print problems)))
+
+(defn coercion-pretty [problems print-spec? request-info]
+  (with-out-str
+    (spec-print
+     {:problems problems
+      :print-spec? print-spec?
+      :pre (fn [_name form path _value]
+             (let [message (str (pr-str form) "\n\n" "Path: " (pr-str path))]
+               (if request-info
+                 (str request-info "\n\n" message)
+                 message)))})))
+
+(defn exception-pretty [req-info ex-trace ex-cause ex-message]
+  (let [header "-- Exception Thrown ----------------"
+        footer (str "\n" (apply str (repeat (count header) "-")) "\n")
+        ifline #(when %1 (str "Exception " (str/upper-case %2) ": " (pr-str %1) "\n"))
+        header (str "\n" header "\n\n")]
+    (str header
+         (when req-info (str req-info "\n"))
+         (ifline ex-cause "cause")
+         (ifline ex-message "message")
+         (ifline ex-trace "trace")
+         footer)))
+
+(defn exception-compact [request ex-trace ex-message]
+  (format "Exception: :uri %s, :method %s, :params %s, :message %s, :trace %s"
+          (request :uri)
+          (request :request-method)
+          (request/params request)
+          ex-message ex-trace))
+
+(defn trace-compact [exception]
+  (->> (.getStackTrace exception)
+       (map #(str (.getFileName %) ":" (.getLineNumber %)))
+       (take 5)
+       (str/join " => ")))
+
+

src/duct/reitit/handler.clj

@@ -2,6 +2,6 @@
   (:require [integrant.core :as ig :refer [init-key]]
             [reitit.ring :as ring]))
 
-(defmethod init-key :duct.handler/root
+(defmethod init-key :duct.reitit/handler
   [_ {:keys [router options]}]
   (ring/ring-handler router))

src/duct/reitit/log.clj

@@ -0,0 +1,13 @@
+(ns duct.reitit.log
+  (:require [integrant.core :refer [init-key]]
+            [duct.logger :as logger]))
+
+(defmethod init-key :duct.reitit/log
+  [_ {{:keys [enable logger pretty? exceptions? coercions?]} :logging}]
+  (when (and enable (or exceptions? coercions?))
+    (if (and logger (not pretty?))
+      (fn [level message]
+        (logger/log logger level message))
+      #(println %2))))
+
+

src/duct/reitit/middleware/custom.clj

@@ -0,0 +1,8 @@
+(ns duct.reitit.middleware.custom
+  (:require [duct.reitit.util :refer [defm new-date new-uuid]]))
+
+(defm environment-middleware [data _ h r]
+  (h (into r (data :environment))))
+
+(defm initialize-middleware  [_ _ h r]
+  (h (assoc r :id  (new-uuid) :start-date (new-date))))

src/duct/reitit/middleware/exception.clj

@@ -1,8 +1,38 @@
 (ns duct.reitit.middleware.exception
-  (:require [reitit.ring.middleware.exception :as exception :refer [create-exception-middleware default-handlers]]
+  (:require [duct.reitit.format :as format]
             [duct.reitit.middleware.coercion :as coercion]
-            [duct.reitit.middleware.format :refer [ex-format]]
-            [duct.reitit.util :refer [spy]]))
+            [duct.reitit.request :as request]
+            [reitit.coercion :refer [-get-name] :rename {-get-name spec-type}]
+            [reitit.ring.middleware.exception :as exception :refer [create-exception-middleware default-handlers]]))
+
+(defn coercion-ex? [type]
+  (or (= :reitit.coercion/request-coercion  type)
+      (= :reitit.coercion/response-coercion type)))
+
+(defmulti ex-format
+  (fn [exception _request {:keys [coercions?]}]
+    (let [data (ex-data exception)
+          kind (if (and coercions? (coercion-ex? (:type data))) :coercion :exception)
+          type (when (= :coercion kind) (-> data :coercion spec-type))]
+      [kind type])))
+
+(defmethod ex-format [:coercion :spec]
+  [exception request {:keys [_pretty? with-req-info? print-spec? coercions?]}]
+  (when coercions?
+    (let [problems (:problems (ex-data exception))
+          request-info (when with-req-info? (request/info request))]
+      (duct.reitit.format/coercion-pretty problems print-spec? request-info))))
+
+(defmethod ex-format [:exception nil]
+  [exception request {:keys [pretty? with-req-info? exceptions?]}]
+  (when exceptions?
+    (let [req-info   (when with-req-info? (request/info request))
+          ex-trace   (format/trace-compact exception)
+          ex-cause   (ex-cause exception)
+          ex-message (ex-message exception)]
+      (if pretty?
+        (format/exception-pretty req-info ex-trace ex-cause ex-message)
+        (format/exception-compact request ex-trace ex-message)))))
 
 (defn ^:private get-exception-wrapper [log config]
   (let [config (merge config {:with-req-info? true})]
@@ -13,12 +43,10 @@
 (defn get-middleware
   "Create custom exception middleware."
   [{:keys [coercion exception log logging]}]
-  (let [{:keys [enable coercions? exceptions?]}  logging
+  (let [{:keys [enable coercions? exceptions?]} logging
         should-wrap (or (and enable coercions?) (and enable exceptions?))
-        coercion-handlers (when coercions? (coercion/get-exception-handler coercion))
-        exception-wrapper (when should-wrap {::exception/wrap (get-exception-wrapper log logging)})
         create-middleware #(create-exception-middleware (apply merge default-handlers %))]
     (create-middleware
-     [exception-wrapper
-      coercion-handlers
+     [(when should-wrap {::exception/wrap (get-exception-wrapper log logging)})
+      (when coercions? (coercion/get-exception-handler coercion))
       exception])))