diff --git a/src/com/verybigthings/funicular/anomalies.cljc b/src/com/verybigthings/funicular/anomalies.cljc index aad0f59..d768a28 100644 --- a/src/com/verybigthings/funicular/anomalies.cljc +++ b/src/com/verybigthings/funicular/anomalies.cljc @@ -23,4 +23,4 @@ (defn ->ex-info ([anomaly] (->ex-info anomaly nil)) ([anomaly cause] - (ex-info (:funicular.anomaly/message anomaly) anomaly cause))) \ No newline at end of file + (ex-info (:funicular.anomaly/message anomaly) anomaly cause))) diff --git a/src/com/verybigthings/funicular/controller.cljs b/src/com/verybigthings/funicular/controller.cljs index 63bdb17..3d1891e 100644 --- a/src/com/verybigthings/funicular/controller.cljs +++ b/src/com/verybigthings/funicular/controller.cljs @@ -4,14 +4,17 @@ [keechma.next.protocols :as keechma-pt] [promesa.core :as p] [cljs.core.async :refer [chan timeout ids id->aliases]}] (->> (fetch/post url (assoc fetch-opts :body {:queries queries})) - (p/map extract-result) - (p/map (fn [{:keys [queries]}] - (doseq [[deferred ids] deferred->ids] - (let [deferred-id->aliases (get id->aliases deferred) - deferred-res (reduce - (fn [acc id] - (let [r (get queries id) - aliases (get deferred-id->aliases id)] - (reduce #(assoc %1 %2 r) acc aliases))) - {} - ids)] - (p/resolve! deferred {:queries deferred-res}))))) - (p/catch (fn [err] - (doseq [deferred (vals deferred->ids)] - (p/reject! deferred err)))))) - -(defn deferred-result-handler [{:keys [command queries] :as res}] + (p/map extract-result) + (p/map (fn [{:keys [queries]}] + (doseq [[deferred ids] deferred->ids] + (let [deferred-id->aliases (get id->aliases deferred) + deferred-res (reduce + (fn [acc id] + (let [r (get queries id) + aliases (get deferred-id->aliases id)] + (reduce #(assoc %1 %2 r) acc aliases))) + {} + ids)] + (p/resolve! deferred {:queries deferred-res}))))) + (p/error (fn [err] + (doseq [deferred (vals deferred->ids)] + (p/reject! deferred err)))))) + +(defn deferred-result-handler [{:keys [queries command] :as res} log-success log-error] (let [[_ command-result] command + + ;; This will be set by the `get-reject-pipeline` function + command-error (::command-error res) + ;; This will be set by the `get-resolve-pipeline` function + command-res (::command-res res) + errored-query-result (reduce-kv - (fn [_ _ [_ query-result]] - (when (contains? query-result :funicular.anomaly/category) - (reduced query-result))) - nil - queries)] + (fn [_ _ [_ query-result]] + (when (contains? query-result :funicular.anomaly/category) + (reduced query-result))) + nil + queries) + errored-command (contains? command-result :funicular.anomaly/category)] + + (when debug-enabled? + (cond + (or errored-query-result errored-command) + (log-error res) + + command-error + (log-error command-error) + + command-res + (log-success command-res) + + :else + (log-success res))) (cond - (contains? command-result :funicular.anomaly/category) + errored-command (p/rejected (ex-info (:funicular.anomaly/message command-result) command-result)) errored-query-result @@ -132,23 +156,24 @@ :else res))) -(defn deferred-with-result-handler [deferred] +(defn deferred-with-result-handler [deferred log-success log-error] (->> deferred - (p/map deferred-result-handler))) + (p/map (fn [res] + (deferred-result-handler res log-success log-error))))) (def set-conj (fnil conj #{})) (defn merge-queries [queued {:keys [payload deferred]}] (reduce-kv - (fn [acc query-alias query] - (let [query-id (or (get-in acc [:query->id query]) (keyword (gensym "req-")))] - (-> acc - (assoc-in [:query->id query] query-id) - (update-in [:id->aliases deferred query-id] set-conj query-alias) - (update-in [:deferred->ids deferred] set-conj query-id) - (assoc-in [:queries query-id] query)))) - queued - (:queries payload))) + (fn [acc query-alias query] + (let [query-id (or (get-in acc [:query->id query]) (keyword (gensym "req-")))] + (-> acc + (assoc-in [:query->id query] query-id) + (update-in [:id->aliases deferred query-id] set-conj query-alias) + (update-in [:deferred->ids deferred] set-conj query-id) + (assoc-in [:queries query-id] query)))) + queued + (:queries payload))) (defn make-query-requester [ctrl] (let [in-chan (chan)] @@ -185,19 +210,23 @@ val (recur (merge-queries queries val)))))) -(defn get-reject-pipeline [command-name err] - (pipeline! [_ ctrl] - (ctrl/broadcast ctrl [:funicular/error command-name] err) - (throw err))) +(defn get-reject-pipeline + ([command-name err] (get-reject-pipeline command-name err {:command [command-name err]})) + ([command-name err payload] + (-> (pipeline! [_ ctrl] + (ctrl/broadcast ctrl [:funicular/error command-name] err) + (throw err)) + (assoc ::command-error payload)))) (defn get-resolve-pipeline [command-name {:keys [command] :as payload}] (let [[_ command-result] command] (if (contains? command-result :funicular.anomaly/category) (let [err (p/rejected (ex-info (:funicular.anomaly/message command-result) command-result))] - (get-reject-pipeline command-name err)) - (pipeline! [_ ctrl] - (ctrl/broadcast ctrl [:funicular/after command-name] {:command (:command payload)}) - payload)))) + (get-reject-pipeline command-name err payload)) + (-> (pipeline! [_ ctrl] + (ctrl/broadcast ctrl [:funicular/after command-name] {:command (:command payload)}) + payload) + (assoc ::command-res payload))))) (defn request-command! [{:funicular/keys [url] :as ctrl} is-called-from-pipeline {:keys [command] :as payload} deferred] (let [[command-name command-payload] command @@ -207,64 +236,64 @@ query-attacher (reify IQueryAttacher (-get-command [_] command-payload) - (attach! [_ payload] + (attach! [_ payload log-success log-error] (when (contains? payload :command) (throw (ex-info "Commands can't be attached to another command" {:payload payload}))) (let [deferred (p/deferred)] (put! query-collector-chan {:payload payload :deferred deferred}) - (deferred-with-result-handler deferred))))] + (deferred-with-result-handler deferred log-success log-error))))] (put! query-collector-chan {:payload payload :deferred deferred}) (ctrl/broadcast ctrl [:funicular/before command-name] query-attacher) (go - (let [{:keys [queries deferred->ids id->aliases] :as collected} (ids id->aliases]} (> (fetch/post url (assoc fetch-opts :body {:queries (or queries {}) :command command})) - (p/map extract-result) - (p/map (fn [{:keys [queries command]}] - (when-not command-has-queries - (if is-called-from-pipeline - (p/resolve! deferred (get-resolve-pipeline command-name {:command command})) - (p/resolve! deferred {:command command}))) - (doseq [[d ids] deferred->ids] - (let [d-id->aliases (get id->aliases d) - d-res (reduce - (fn [acc id] - (let [r (get queries id) - aliases (get d-id->aliases id)] - (reduce #(assoc %1 %2 r) acc aliases))) - {} - ids) - payload {:queries d-res :command command}] - (if (and (= d deferred) is-called-from-pipeline) - (p/resolve! d (get-resolve-pipeline command-name payload)) - (p/resolve! d payload)))))) - (p/catch (fn [err] - (doseq [d (vals deferred->ids)] - (if (and (= d deferred) is-called-from-pipeline) - (p/reject! d (get-reject-pipeline command-name err)) - (p/resolve! d err)))))))))) + (p/map extract-result) + (p/map (fn [{:keys [queries command]}] + (when-not command-has-queries + (if is-called-from-pipeline + (p/resolve! deferred (get-resolve-pipeline command-name {:command command})) + (p/resolve! deferred {:command command}))) + (doseq [[d ids] deferred->ids] + (let [d-id->aliases (get id->aliases d) + d-res (reduce + (fn [acc id] + (let [r (get queries id) + aliases (get d-id->aliases id)] + (reduce #(assoc %1 %2 r) acc aliases))) + {} + ids) + payload {:queries d-res :command command}] + (if (and (= d deferred) is-called-from-pipeline) + (p/resolve! d (get-resolve-pipeline command-name payload)) + (p/resolve! d payload)))))) + (p/error (fn [err] + (doseq [d (vals deferred->ids)] + (if (and (= d deferred) is-called-from-pipeline) + (p/reject! d (get-reject-pipeline command-name err)) + (p/resolve! d err)))))))))) (defmethod ctrl/api ::controller [{:funicular/keys [url] :as ctrl}] (let [query-requester (::query-requester ctrl)] (reify IApi - (-req! [_ payload] + (-req! [_ payload log-success log-error] (if (:command payload) (let [deferred (p/deferred) - is-called-from-pipeline (in-pipeline?) ] + is-called-from-pipeline (in-pipeline?)] (request-command! ctrl is-called-from-pipeline payload deferred) (if is-called-from-pipeline - (deferred-with-result-handler deferred) + (deferred-with-result-handler deferred log-success log-error) (let [deferred-with-hijacked (->> deferred - deferred-with-result-handler - (hijack-command-deferred-then-and-catch ctrl payload))] + (deferred-with-result-handler log-success log-error) + (hijack-command-deferred-then-and-catch ctrl payload))] ;; Force at least one on-fulfilled and on-rejected handlers so we're ;; sure code in `hijack-command-deferred-then-and-catch` is called (->> deferred-with-hijacked - (p/map identity) - (p/catch identity)) + (p/map identity) + (p/error identity)) deferred-with-hijacked))) (let [deferred (p/deferred)] (queue-request query-requester payload deferred) - (deferred-with-result-handler deferred))))))) + (deferred-with-result-handler deferred log-success log-error))))))) (defmethod ctrl/init ::controller [ctrl] (let [query-requester (make-query-requester ctrl)] @@ -278,7 +307,7 @@ (install app {})) ([app config] (assoc-in app [:keechma/controllers ::controller] - (merge default-config config)))) + (merge default-config config)))) (defn command ([command-name payload] @@ -313,36 +342,79 @@ (let [[_ res] (get queries query-alias)] (or res default)))) -(defn req! [{:keechma/keys [app]} payload] +(defn -internal-req! [{:keechma/keys [app]} payload log-success log-error] (let [api* (keechma-pt/-get-api* app ::controller)] (if-let [api @api*] - (-req! api payload) + (-req! api payload log-success log-error) ;; Handle the case where this controller is started after the calling controller ;; because both might be without deps, which means that the order is nondeterministic (let [deferred (p/deferred)] - (js/setTimeout #(p/resolve! deferred (-req! @api* payload)) 1) + (js/setTimeout #(p/resolve! deferred (-req! @api* payload log-success log-error)) 1) deferred)))) +(defn req! [ctrl payload] + (let [log-success (fn [res] + (l/group-collapsed "%c[REQ]" "color: green" payload) + (l/log "[RES]" res) + (l/group-end)) + log-error (fn [err] + (l/group-collapsed "%c[REQ]" "color: red" payload) + (l/log "[REQ]" payload) + (l/log "[ERR]" err) + (l/group-end))] + (-internal-req! ctrl payload log-success log-error))) + (defn query! ([ctrl query-name payload] (query! ctrl query-name payload nil)) ([ctrl query-name payload default] - (->> (req! ctrl (query query-name payload)) - (p/map #(get-query % query-name default))))) + (let [log-success (fn [res] + (l/group-collapsed (str "%c[QUERY] " query-name) "color: green") + (l/log "[REQ]" payload) + (l/log "[RES]" (get-query res query-name default)) + (l/group-end)) + log-error (fn [err] + (l/group-collapsed (str "%c[QUERY] " query-name) "color: red") + (l/log "[REQ]" payload) + (l/log "[ERR]" err) + (l/group-end))] + (->> (-internal-req! ctrl (query query-name payload) log-success log-error) + (p/map #(get-query % query-name default)))))) (defn command! ([ctrl command-name payload] (command! ctrl command-name payload nil)) ([ctrl command-name payload default] - (->> (req! ctrl (command command-name payload)) - (p/map (fn [res] - (if (pipeline? res) - (update-in res [:pipeline :begin] conj (fn [value _] (get-command value default))) - (get-command res default))))))) + (let [log-success (fn [res] + (l/group-collapsed (str "%c[COMMAND] " command-name) "color: green") + (l/log "[REQ]" payload) + (l/log "[RES]" (get-command res default)) + (l/group-end)) + log-error (fn [err] + (l/group-collapsed (str "%c[COMMAND] " command-name) "color: red") + (l/log "[REQ]" payload) + (l/log "[ERR]" err) + (l/group-end)) + req (-internal-req! ctrl (command command-name payload) log-success log-error)] + (->> req + (p/map (fn [res] + (if (pipeline? res) + (update-in res [:pipeline :begin] conj (fn [value _] (get-command value default))) + (get-command res default)))))))) (defn attach-query! ([value query-name payload] (attach-query! value query-name payload nil)) ([value query-name payload default] - (->> (attach! value (query query-name payload)) - (p/map #(get-query % query-name default))))) + (let [log-success (fn [res] + (l/group-collapsed (str "%c[ATTACHED QUERY] " query-name) "color: green") + (l/log "[REQ]" payload) + (l/log "[RES]" (get-query res query-name default)) + (l/group-end)) + log-error (fn [err] + (l/group-collapsed (str "%c[ATTACHED QUERY] " query-name) "color: red") + (l/log "[REQ]" payload) + (l/log "[ERR]" err) + (l/group-end))] + (->> (attach! value (query query-name payload) log-success log-error) + (p/map #(get-query % query-name default)))))) diff --git a/src/com/verybigthings/funicular/core.clj b/src/com/verybigthings/funicular/core.clj index 306e39f..1f5824e 100644 --- a/src/com/verybigthings/funicular/core.clj +++ b/src/com/verybigthings/funicular/core.clj @@ -15,25 +15,25 @@ (cond (map? y) (deep-merge-malli-errors x y) (vector? y) (concat x y) :else y)) - a b)) + a b)) (defn interceptor-map? [val] (and map? - (seq (set/intersection - (-> val keys set) - #{:enter - :leave - :error})))) + (seq (set/intersection + (-> val keys set) + #{:enter + :leave + :error})))) (s/def :com.verybigthings.funicular.core.interceptor/enter fn?) (s/def :com.verybigthings.funicular.core.interceptor/leave fn?) (s/def :com.verybigthings.funicular.core.interceptor/error fn?) (s/def :com.verybigthings.funicular.core/interceptor (s/and - interceptor-map? - (s/keys :opt-un [:com.verybigthings.funicular.core.interceptor/enter - :com.verybigthings.funicular.core.interceptor/leave - :com.verybigthings.funicular.core.interceptor/error]))) + interceptor-map? + (s/keys :opt-un [:com.verybigthings.funicular.core.interceptor/enter + :com.verybigthings.funicular.core.interceptor/leave + :com.verybigthings.funicular.core.interceptor/error]))) (s/def ::input-schema any?) (s/def ::output-schema any?) @@ -42,26 +42,26 @@ (s/def ::resolver (s/and - map? - (s/keys - :opt-un [::rules - ::interceptors] - :req-un [::handler - ::input-schema - ::output-schema]))) + map? + (s/keys + :opt-un [::rules + ::interceptors] + :req-un [::handler + ::input-schema + ::output-schema]))) (s/def ::rule (s/or - :fn fn? - :and (s/cat - :op #(= % :and) - :rules (s/+ ::rule)) - :or (s/cat - :op #(= % :or) - :rules (s/+ ::rule)) - :not (s/cat - :op #(= % :not) - :rule ::rule))) + :fn fn? + :and (s/cat + :op #(= % :and) + :rules (s/+ ::rule)) + :or (s/cat + :op #(= % :or) + :rules (s/+ ::rule)) + :not (s/cat + :op #(= % :not) + :rule ::rule))) (s/def ::rules ::rule) @@ -76,28 +76,28 @@ (s/def ::context-props (s/and - map? - (s/keys - :opt-un [::interceptors - ::input-schema - ::rules - ::queries - ::commands]))) + map? + (s/keys + :opt-un [::interceptors + ::input-schema + ::rules + ::queries + ::commands]))) (s/def ::api-context-name (s/and - simple-keyword? - (s/or - :anon #{:<>} - :named any?))) + simple-keyword? + (s/or + :anon #{:<>} + :named any?))) (s/def ::api (s/and - vector? - (s/cat - :name ::api-context-name - :props (s/? ::context-props) - :api-subcontexts (s/* ::api)))) + vector? + (s/cat + :name ::api-context-name + :props (s/? ::context-props) + :api-subcontexts (s/* ::api)))) (s/def ::context map?) @@ -110,27 +110,27 @@ (s/def ::funicular (s/and - map? - (s/keys - :req-un [::api] - :opt-un [::pipes]))) + map? + (s/keys + :req-un [::api] + :opt-un [::pipes]))) (s/def :com.verybigthings.funicular.request/query (s/tuple keyword? any?)) (s/def :com.verybigthings.funicular.request/queries (s/map-of - keyword? :com.verybigthings.funicular.request/query)) + keyword? :com.verybigthings.funicular.request/query)) (s/def :com.verybigthings.funicular.request/command (s/tuple keyword? any?)) (s/def :com.verybigthings.funicular/request (s/and - map? - (s/keys - :opt-un [:com.verybigthings.funicular.request/command - :com.verybigthings.funicular.request/queries]))) + map? + (s/keys + :opt-un [:com.verybigthings.funicular.request/command + :com.verybigthings.funicular.request/queries]))) (def FunicularAnomaly [:map @@ -139,24 +139,28 @@ ;; TODO: Make this toggleable (defn sanitize-error-keys [error] (reduce-kv - (fn [acc k v] - (let [k-ns (namespace k)] - (if (or (= "funicular" k-ns) (str/starts-with? k-ns "funicular.")) - (assoc acc k v) - acc))) - {} - error) + (fn [acc k v] + (let [k-ns (namespace k)] + (if (or (= "funicular" k-ns) (str/starts-with? k-ns "funicular.")) + (assoc acc k v) + acc))) + {} + error) error) -(def root-error-interceptor - {:error (fn [{:keys [error] :as ctx}] - (let [data (ex-data error) +(defn make-root-error-interceptor [_] + {:error (fn [{:keys [_request error] :as ctx}] + (let [data (ex-data error) response (if (contains? data :funicular.anomaly/category) data (anom/internal-error (ex-message error)))] (-> ctx - (dissoc :error) - (assoc :response (sanitize-error-keys response)))))}) + (dissoc :error) + (assoc :response (sanitize-error-keys response)))))}) + +(defn make-root-nil-interceptor [namespaced-resolver-name] + {:leave (fn [ctx] + (update ctx :response #(or % (anom/unavailable (str namespaced-resolver-name " returned no data")))))}) (defmulti enforce-rule (fn [_ [op & _]] op)) @@ -186,11 +190,6 @@ (recur (rest rules)))) false))) - -(defn log [arg] - (clojure.pprint/pprint arg) - arg) - (defn with-context-name [acc {[context-type context-name] :name}] (if (= :named context-type) (update acc :path conj context-name) @@ -209,38 +208,38 @@ (humanize acc explanation nil)) ([acc {:keys [value errors]} {f :wrap :or {f :message} :as options}] (if errors - (if (coll? value) + (when (coll? value) (reduce - (fn [acc error] - (let [error-path (me/error-path error options) - error-path' (if (seq error-path) error-path :funicular/errors)] - (update acc error-path' set-conj (f (me/with-error-message error options))))) - acc - errors)) + (fn [acc error] + (let [error-path (me/error-path error options) + error-path' (if (seq error-path) error-path :funicular/errors)] + (update acc error-path' set-conj (f (me/with-error-message error options))))) + acc + errors)) (reduce - (fn [acc error] - (update acc :funicular/errors set-conj (f (me/with-error-message error options)))) - acc - errors)))) + (fn [acc error] + (update acc :funicular/errors set-conj (f (me/with-error-message error options)))) + acc + errors)))) (defn schemas->validator-explainer [schemas opts] (let [ves (mapv - (fn [s] {:explainer (m/explainer s opts) - :validator (m/validator s opts)}) - schemas)] + (fn [s] {:explainer (m/explainer s opts) + :validator (m/validator s opts)}) + schemas)] (fn [data] (let [errors (reduce - (fn [acc {:keys [explainer validator]}] - (if (validator data) - acc - (->> data - explainer - (humanize acc)))) - {} - ves)] + (fn [acc {:keys [explainer validator]}] + (if (validator data) + acc + (->> data + explainer + (humanize acc)))) + {} + ves)] (->> errors - (mapv (fn [[k v]] [k (-> v sort vec)])) - (into {})))))) + (mapv (fn [[k v]] [k (-> v sort vec)])) + (into {})))))) (defn with-input-schema-interceptor "Given that an input schema is present on the current node, @@ -253,7 +252,7 @@ interceptor {:enter (fn [ctx] - (let [data (get-in ctx [:request :data]) + (let [data (get-in ctx [:request :data]) errors (validator-explainer data)] (if (empty? errors) ctx @@ -276,7 +275,7 @@ {:leave (fn [{:keys [response] :as ctx}] (if (funiculary-anomaly-validator response) ctx - (let [data (get-in ctx [:response]) + (let [data (get-in ctx [:response]) errors (validator-explainer data)] (if (empty? errors) ctx @@ -289,7 +288,7 @@ (defn with-schema "Appends the schemas present on the current node onto a list of either input or output schemas." - [acc {:keys [input-schema output-schema]} opts] + [acc {:keys [input-schema output-schema]} _] (cond-> acc input-schema (update :input-schemas conj input-schema) @@ -308,7 +307,7 @@ At runtime, the interceptor checks if the rule is satisfied. If the rule fails, an early exit happens and no further interceptors are executed." - [acc {:keys [rules]} opts] + [acc {:keys [rules]} _] (let [interceptor (fn [{:keys [request] :as ctx}] (if rules (if (enforce-rule request rules) @@ -321,31 +320,33 @@ "Compiles command and query resolvers" [acc resolver-type props opts] (reduce-kv - (fn [acc' resolver-name {:keys [handler] :as resolver}] - (let [{:keys [interceptors input-schemas output-schemas]} - (-> acc - (with-rules resolver opts) - (with-interceptors resolver) - (with-schema resolver opts) - (with-input-schema-interceptor opts) - (update :interceptors conj handler) - (with-output-schema-interceptor opts)) - - namespaced-resolver-name (make-namespaced-resolver-name (:path acc) resolver-name)] - (when (get-in acc' [:resolvers namespaced-resolver-name]) - (throw (ex-info "Duplicate resolver" {:error ::duplicate-resolver - :resolver namespaced-resolver-name}))) - (assoc-in acc' [:resolvers namespaced-resolver-name] {:chain (into [root-error-interceptor] interceptors) - :input-schemas input-schemas - :output-schemas output-schemas - :input-schema (last input-schemas) - :output-schema (last output-schemas) - :path (:path acc) - :name resolver-name - :ns-name namespaced-resolver-name - :type ({:commands :command :queries :query} resolver-type)}))) - acc - (get props resolver-type))) + (fn [acc' resolver-name {:keys [handler] :as resolver}] + (let [{:keys [interceptors input-schemas output-schemas]} + (-> acc + (with-rules resolver opts) + (with-interceptors resolver) + (with-schema resolver opts) + (with-input-schema-interceptor opts) + (update :interceptors conj handler) + (with-output-schema-interceptor opts)) + + namespaced-resolver-name (make-namespaced-resolver-name (:path acc) resolver-name)] + (when (get-in acc' [:resolvers namespaced-resolver-name]) + (throw (ex-info "Duplicate resolver" {:error ::duplicate-resolver + :resolver namespaced-resolver-name}))) + (assoc-in acc' [:resolvers namespaced-resolver-name] {:chain (into [(make-root-nil-interceptor namespaced-resolver-name) + (make-root-error-interceptor opts)] + interceptors) + :input-schemas input-schemas + :output-schemas output-schemas + :input-schema (last input-schemas) + :output-schema (last output-schemas) + :path (:path acc) + :name resolver-name + :ns-name namespaced-resolver-name + :type ({:commands :command :queries :query} resolver-type)}))) + acc + (get props resolver-type))) (declare compile-api) @@ -353,42 +354,42 @@ "Compiles the child subcontexts (all document nodes below the current node)." [acc {:keys [api-subcontexts]} opts] (reduce - (fn [acc' api-subcontext] - (let [resolvers (:resolvers (compile-api acc' api-subcontext opts))] - (update acc' :resolvers merge resolvers))) - acc - api-subcontexts)) + (fn [acc' api-subcontext] + (let [resolvers (:resolvers (compile-api acc' api-subcontext opts))] + (update acc' :resolvers merge resolvers))) + acc + api-subcontexts)) (defn compile-api "Compiles the `:api` section of the Funicular document" ([context opts] (compile-api {:path [] :interceptors [] :input-schemas [] :output-schemas []} context opts)) ([acc {:keys [props] :as context} opts] (-> acc - (with-context-name context) - (with-rules props opts) - (with-schema props opts) - (with-interceptors props) - (with-resolvers :commands props opts) - (with-resolvers :queries props opts) - (with-api-subcontexts context opts)))) + (with-context-name context) + (with-rules props opts) + (with-schema props opts) + (with-interceptors props) + (with-resolvers :commands props opts) + (with-resolvers :queries props opts) + (with-api-subcontexts context opts)))) (defn compile-pipes "Compiles the `:pipes` section of the Funicular document" - [pipes resolvers opts] + [pipes resolvers _] (reduce-kv - (fn [acc source->target pipe] - (let [[source target] source->target] - (when (not= :command (get-in resolvers [source :type])) - (throw (ex-info "Non existent command" {:command source - :error :non-existent-command}))) - (when (not= :query (get-in resolvers [target :type])) - (throw (ex-info "Non existent query" {:query target - :error :non-existent-query}))) - (assoc acc source->target {:enter (fn [ctx] - (let [request (:request ctx)] - (assoc ctx :request (pipe request))))}))) - {} - pipes)) + (fn [acc source->target pipe] + (let [[source target] source->target] + (when (not= :command (get-in resolvers [source :type])) + (throw (ex-info "Non existent command" {:command source + :error :non-existent-command}))) + (when (not= :query (get-in resolvers [target :type])) + (throw (ex-info "Non existent query" {:query target + :error :non-existent-query}))) + (assoc acc source->target {:enter (fn [ctx] + (let [request (:request ctx)] + (assoc ctx :request (pipe request))))}))) + {} + pipes)) (defn compile "Compiles the Funicular definition file into a data struture that can be executed by `execute`" @@ -408,7 +409,8 @@ (defn execute-command [acc compiled context {:keys [command]}] (if command (let [[command-name command-data] command - chain (get-in compiled [:resolvers command-name :chain]) + resolver (get-in compiled [:resolvers command-name]) + chain (when (= :command (:type resolver)) (:chain resolver)) res (if chain (si/execute chain (assoc context :data command-data :command command-name)) (anom/not-found "Command not found" (make-missing-command-error command-name command-data)))] @@ -420,35 +422,37 @@ :data query-data :funicular.anomaly/subcategory :funicular.anomaly.category.not-found/query}) -;; TODO queries should return errors when command returns error (defn execute-queries [{:keys [command] :as acc} compiled context {:keys [queries]}] (let [[command-name command-res] command] (reduce-kv - (fn [acc' query-alias [query-name query-data]] - (let [chain (get-in compiled [:resolvers query-name :chain])] - (if chain - (let [pipe (get-in compiled [:pipes [command-name query-name]]) - context' (-> (if command - (assoc context :command {:name command-name :response command-res}) - context) - (assoc :query query-name) - (assoc :data query-data)) - chain' (if pipe (into [pipe] chain) chain) - res (si/execute chain' context')] - (assoc-in acc' [:queries query-alias] [query-name res])) - (assoc-in acc' [:queries query-alias] [query-name (anom/not-found "Query not found" (make-missing-query-error query-name query-data))])))) - acc - queries))) + (fn [acc' query-alias [query-name query-data]] + (let [resolver (get-in compiled [:resolvers query-name]) + chain (when (= :query (:type resolver)) (:chain resolver))] + (if chain + (if (contains? command-res :funicular.anomaly/category) + (assoc-in acc' [:queries query-alias] [query-name (anom/internal-error (str "Command " command-name " failed"))]) + (let [pipe (get-in compiled [:pipes [command-name query-name]]) + context' (-> (if command + (assoc context :command {:name command-name :response command-res}) + context) + (assoc :query query-name) + (assoc :data query-data)) + chain' (if pipe (into [pipe] chain) chain) + res (si/execute chain' context')] + (assoc-in acc' [:queries query-alias] [query-name res]))) + (assoc-in acc' [:queries query-alias] [query-name (anom/not-found "Query not found" (make-missing-query-error query-name query-data))])))) + acc + queries))) (defn execute [compiled context request] (s/assert :com.verybigthings.funicular/request request) (-> {} - (execute-command compiled context request) - (execute-queries compiled context request))) + (execute-command compiled context request) + (execute-queries compiled context request))) (defn inspect [compiled] (->> compiled - :resolvers - (map (fn [[k v]] [k (select-keys v [:input-schemas :input-schema :output-schemas :output-schema :type])])) - (sort-by (fn [[k _]] (str k))) - vec)) \ No newline at end of file + :resolvers + (map (fn [[k v]] [k (select-keys v [:input-schemas :input-schema :output-schemas :output-schema :type])])) + (sort-by (fn [[k _]] (str k))) + vec)) diff --git a/src/com/verybigthings/funicular/transit.cljc b/src/com/verybigthings/funicular/transit.cljc index 2fc4bfe..e1352b1 100644 --- a/src/com/verybigthings/funicular/transit.cljc +++ b/src/com/verybigthings/funicular/transit.cljc @@ -2,6 +2,7 @@ "Connect time-literals to transit." (:require [time-literals.read-write] [cognitect.transit :as transit] + #?(:cljs [com.cognitect.transit.types :as ty]) #?(:cljs [java.time :refer [Period LocalDate LocalDateTime @@ -31,6 +32,9 @@ Duration Year YearMonth)))) +#?(:cljs + (extend-type ty/UUID + IUUID)) (def time-classes {'period Period @@ -51,8 +55,8 @@ (def write-handlers {:handlers (into {} - (for [[tick-class host-class] time-classes] - [host-class (transit/write-handler (constantly (name tick-class)) str)]))}) + (for [[tick-class host-class] time-classes] + [host-class (transit/write-handler (constantly (name tick-class)) str)]))}) (def read-handlers {:handlers @@ -72,4 +76,4 @@ #?(:clj (let [in (ByteArrayInputStream. (.getBytes json)) reader (transit/reader in :json read-handlers)] (transit/read reader)) - :cljs (transit/read (transit/reader :json read-handlers) json))) \ No newline at end of file + :cljs (transit/read (transit/reader :json read-handlers) json)))