├── core ├── deps.edn ├── README.md ├── test │ └── defacto │ │ └── core_test.cljc └── src │ └── defacto │ ├── impl.cljc │ └── core.cljc ├── forms ├── deps.edn ├── test │ └── defacto │ │ └── forms │ │ └── core_test.cljc ├── README.md └── src │ └── defacto │ └── forms │ └── core.cljc ├── .gitignore ├── forms+ ├── deps.edn ├── src │ └── defacto │ │ └── forms │ │ └── plus.cljc ├── README.md └── test │ └── defacto │ └── forms │ └── plus_test.cljc ├── res ├── deps.edn ├── test │ └── defacto │ │ ├── test │ │ └── utils.cljc │ │ └── resources │ │ ├── core_test.cljc │ │ └── impl_test.cljc ├── src │ └── defacto │ │ └── resources │ │ ├── impl.cljc │ │ └── core.cljc └── README.md ├── deps.edn └── README.md /core/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {}} 3 | -------------------------------------------------------------------------------- /forms/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {skuttleman/defacto {:local/root "../core"}}} 3 | -------------------------------------------------------------------------------- /core/README.md: -------------------------------------------------------------------------------- 1 | # defacto-core 2 | 3 | The core of the `defacto` library ecosystem. See [the root project](../README.md) for usage. 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .cpcache/ 2 | .idea/ 3 | .shadow-cljs/ 4 | node_modules/ 5 | resources/public/js/ 6 | resources/public/css/ 7 | resources/public/img/ 8 | target/ 9 | *.iml 10 | *.log 11 | .nrepl-port 12 | -------------------------------------------------------------------------------- /forms+/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {skuttleman/defacto {:local/root "../core"} 2 | skuttleman/defacto-forms {:local/root "../forms"} 3 | skuttleman/defacto-res {:local/root "../res"}}} 4 | 5 | -------------------------------------------------------------------------------- /res/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {org.clojure/core.async {:mvn/version "1.6.673"} 3 | skuttleman/defacto {:local/root "../core"}} 4 | :aliases {:dev {:extra-paths ["test"] 5 | :extra-deps {org.clojure/clojurescript {:mvn/version "1.10.844"}}}}} 6 | -------------------------------------------------------------------------------- /res/test/defacto/test/utils.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.test.utils 2 | #?(:cljs (:require cljs.test))) 3 | 4 | (defmacro async [cb & body] 5 | (if (:ns &env) 6 | `(cljs.test/async ~cb ~@body) 7 | `(let [prom# (promise) 8 | ~cb (fn [] (deliver prom# true)) 9 | result# (do ~@body)] 10 | @prom# 11 | result#))) 12 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {skuttleman/defacto-core {:local/root "core"}} 2 | :aliases {:dev {:extra-paths ["core/src" "core/test" 3 | "forms+/src" "forms+/test" 4 | "forms/test" "forms/test" 5 | "res/src" "res/test"] 6 | :extra-deps {org.clojure/clojurescript {:mvn/version "1.10.844"} 7 | skuttleman/defacto-forms+ {:local/root "forms+"}}}}} 8 | -------------------------------------------------------------------------------- /forms/test/defacto/forms/core_test.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.forms.core-test 2 | (:require 3 | [clojure.test :refer [deftest is testing]] 4 | [defacto.core :as defacto] 5 | [defacto.forms.core :as forms])) 6 | 7 | (deftest forms-test 8 | (testing "when creating a form" 9 | (let [store (defacto/create nil nil)] 10 | (defacto/dispatch! store [::forms/ensure! 123 {:fruit :apple}]) 11 | (testing "and when querying the db" 12 | (testing "has the form data" 13 | (is (= {:fruit :apple} (forms/data (defacto/query-responder @store [::forms/?:form 123])))))) 14 | 15 | (testing "and when recreating a form" 16 | (defacto/dispatch! store [::forms/ensure! 123 {:random? true}]) 17 | (testing "and when querying the db" 18 | (testing "retains the original form data" 19 | (is (= {:fruit :apple} (forms/data (defacto/query-responder @store [::forms/?:form 123]))))))) 20 | 21 | (testing "and when updating the form" 22 | (defacto/emit! store [::forms/changed 123 [:fruit] :banana]) 23 | (defacto/emit! store [::forms/changed 123 [:nested :prop] -13]) 24 | (testing "has the updated form data" 25 | (is (= {:fruit :banana 26 | :nested {:prop -13}} 27 | (forms/data (defacto/query-responder @store [::forms/?:form 123])))))) 28 | 29 | (testing "and when updating the form with an ^int key" 30 | (defacto/emit! store [::forms/changed 123 [:nested :thing 1 :name] :first]) 31 | (testing "updates the data with a vector" 32 | (is (= {:fruit :banana 33 | :nested {:prop -13 34 | :thing [nil {:name :first}]}} 35 | (forms/data (defacto/query-responder @store [::forms/?:form 123])))))) 36 | 37 | (testing "and when destroying the form" 38 | (defacto/emit! store [::forms/destroyed 123]) 39 | 40 | (testing "no longer has form data" 41 | (is (nil? (forms/data (defacto/query-responder @store [::forms/?:form 123]))))))))) 42 | -------------------------------------------------------------------------------- /core/test/defacto/core_test.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.core-test 2 | (:require 3 | [clojure.test :refer [deftest is testing]] 4 | [defacto.core :as defacto])) 5 | 6 | (defmethod defacto/command-handler ::command! 7 | [_ [_ params] emit-cb] 8 | (emit-cb [::commanded params])) 9 | 10 | (defmethod defacto/event-reducer ::commanded 11 | [db [_ result]] 12 | (assoc db ::result result)) 13 | 14 | (defmethod defacto/query-responder ::result 15 | [db _] 16 | (::result db)) 17 | 18 | (defmethod defacto/command-handler ::change! 19 | [_ [_ params] emit-cb] 20 | (emit-cb [::changed params])) 21 | 22 | (defmethod defacto/event-reducer ::changed 23 | [db [_ result]] 24 | (assoc db ::something-else result)) 25 | 26 | (defmethod defacto/query-responder ::something-else 27 | [db _] 28 | (::something-else db)) 29 | 30 | (deftest DefactoStore-test 31 | (let [store (defacto/create {} {} atom) 32 | result (defacto/subscribe store [::result]) 33 | something-else (defacto/subscribe store [::something-else]) 34 | notifications (atom [])] 35 | (testing "when dispatching a command" 36 | (defacto/dispatch! store [::command! #{:apple :banana}]) 37 | (testing "processes updates" 38 | (is (= #{:apple :banana} @result)))) 39 | 40 | (testing "when emitting an event" 41 | (defacto/emit! store [::commanded #{:orange :pineapple}]) 42 | (testing "processes updates" 43 | (is (= #{:orange :pineapple} @result)))) 44 | 45 | (testing "when watching a subscription" 46 | (add-watch result ::watch (fn [_ _ _ new] 47 | (swap! notifications conj new))) 48 | (testing "and when the query result changes" 49 | (defacto/dispatch! store [::command! #{:pear :kiwi}]) 50 | (testing "processes the command" 51 | (is (= #{:pear :kiwi} @result))) 52 | 53 | (testing "notifies the watcher" 54 | (is (= [#{:pear :kiwi}] @notifications))) 55 | 56 | (testing "and when a state change does not change the query result" 57 | (reset! notifications []) 58 | (defacto/dispatch! store [::change! {:some :value}]) 59 | (testing "processes the command" 60 | (is (= {:some :value} @something-else))) 61 | 62 | (testing "does not notify the watcher" 63 | (is (empty? @notifications)))))) 64 | 65 | (testing "when including an initializer in the context map" 66 | (let [store-prom (promise) 67 | store (defacto/create {:my-component (reify 68 | defacto/IInitialize 69 | (init! [_ store] (deliver store-prom store)))} 70 | nil)] 71 | (testing "initializes the component" 72 | (is (= store @store-prom))))))) 73 | -------------------------------------------------------------------------------- /res/src/defacto/resources/impl.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.resources.impl 2 | (:require 3 | [clojure.core.async :as async] 4 | [clojure.core.async.impl.protocols :as iasync] 5 | [defacto.core :as defacto])) 6 | 7 | (defn ^:private safely! [request-fn & args] 8 | (try 9 | (apply request-fn args) 10 | (catch #?(:cljs :default :default Throwable) ex 11 | [:defacto.resources.core/err {:exception ex 12 | :reason "request-fn threw an exception"}]))) 13 | 14 | (defn ^:private ->ch [ch-or-result] 15 | (async/go 16 | (cond-> ch-or-result 17 | (satisfies? iasync/ReadPort ch-or-result) 18 | async/result [result] 21 | (if (vector? result) 22 | result 23 | [:defacto.resources.core/err {:result result 24 | :reason "request-fn must return a vector"}])) 25 | 26 | (defn ^:private send-all [send-fn messages result ->output] 27 | (run! send-fn (for [msg messages] 28 | (conj msg (->output result))))) 29 | 30 | (defn ^:private ->upload-progress-ch [{:keys [prog-events prog-commands]} emit-cb dispatch-cb] 31 | (when (or (seq prog-events) (seq prog-commands)) 32 | (let [chan (async/chan)] 33 | (async/go-loop [] 34 | (let [report (async/err ->ok] :or {->err identity ->ok identity}} input 50 | dispatch-cb (partial defacto/dispatch! store)] 51 | (run! emit-cb pre-events) 52 | (run! dispatch-cb pre-commands) 53 | (when (some? params) 54 | (let [{:keys [ok-events ok-commands err-events err-commands]} input 55 | progress (->upload-progress-ch input emit-cb dispatch-cb) 56 | ch (->ch (safely! request-fn resource-type (assoc params :progress progress)))] 57 | (async/go 58 | (let [[status payload] (->result (async/output] (if (= :defacto.resources.core/ok status) 60 | [ok-events ok-commands ->ok] 61 | [err-events err-commands ->err])] 62 | (send-all emit-cb events payload ->output) 63 | (send-all dispatch-cb commands payload ->output))))) 64 | nil)) 65 | -------------------------------------------------------------------------------- /forms/README.md: -------------------------------------------------------------------------------- 1 | # defacto-forms 2 | 3 | A simple module for isolating and maintaining arbitrary maps of user input. 4 | 5 | ```clojure 6 | ;; deps.edn 7 | {:deps {skuttleman/defacto-forms {:git/url "https://github.com/skuttleman/defacto" 8 | :git/sha "{SHA_OF_HEAD}" 9 | :deps/root "forms"}}} 10 | ``` 11 | 12 | ```clojure 13 | (ns killer-app.core 14 | (:require 15 | [defacto.core :as defacto] 16 | [defacto.forms.core :as forms])) 17 | 18 | 19 | ;; create a form of any map of data 20 | (defacto/emit! store [::forms/created ::any-unique-id {:input "data"}]) 21 | (def sub (defacto/subscribe store [::forms/?:form ::any-unique-id])) 22 | (defacto/emit! store [::forms/changed ::any-unique-id [:path :into :model] "value"]) 23 | (forms/data @sub) 24 | ;; => {:input "data" :path {:into {:model "value"}}} 25 | 26 | 27 | ;; paths with `integer`s expand into vectors. (do not use integer keys in maps) 28 | (defacto/emit! store [::forms/changed ::any-unique-id [:other 1 :data] "thingy"]) 29 | (forms/data @sub) 30 | ;; => {:input "data" :path {:into {:model "value"}} :other [nil {:data "thingy"}]} 31 | 32 | 33 | ;; forms retain `nil` in leaf values be default, but that can be changed 34 | (defacto/emit! store [::forms/created ::any-unique-id {:input "data"} {:remove-nil? true}]) 35 | (defacto/emit! store [::forms/changed ::any-unique-id [:path :into :model] "value"]) 36 | (forms/data @sub) 37 | ;; => {:input "data" :path {:into {:model "value"}}} 38 | (defacto/emit! store [::forms/changed ::any-unique-id [:path :into :model] nil]) 39 | (forms/data @sub) 40 | ;; => {:input "data"} 41 | ``` 42 | 43 | See [forms+](../forms+/README.md) for more possibilities. 44 | 45 | ## Commands 46 | 47 | This module exposes the following `commands`. 48 | 49 | ### [::forms/ensure! form-id data ?opts] 50 | 51 | Creates a form if there isn't already one with the supplied `form-id`. 52 | 53 | ```clojure 54 | (defacto/dispatch! store [::forms/ensure! ::unique-form-id {:some "data"}]) 55 | ``` 56 | 57 | ## Queries 58 | 59 | This module exposes the following `queries`. 60 | 61 | ### [::forms/?:form form-id] 62 | 63 | Queries the current form. 64 | 65 | ```clojure 66 | @(defacto/subscribe store [::forms/?:form ::unique-form-id]) 67 | ``` 68 | 69 | ## Events 70 | 71 | This module exposes the following `events`. 72 | 73 | ### [::forms/created form-id data >opts] 74 | 75 | Creates a new form, clobbering an existing form with the same id if it exists. 76 | 77 | ```clojure 78 | (defacto/emit! store [::forms/created ::unique-form-id {:some "data"}]) 79 | ``` 80 | 81 | ### [::forms/changed form-id path value] 82 | 83 | Changes the value at a path into your data model. 84 | 85 | ### [::forms/modified form-id path f arg1 arg2 ...] 86 | 87 | Modifies the value at a path in your data model by applying a function and additional args. 88 | 89 | ```clojure 90 | (defacto/emit! store [::forms/changed ::unique-form-id [:some :path] "value"]) 91 | ``` 92 | 93 | ### [::forms/destroyed form-id] 94 | 95 | Removes a form from the db. 96 | 97 | ```clojure 98 | (defacto/emit! store [::forms/destroyed ::unique-form-id]) 99 | ``` 100 | -------------------------------------------------------------------------------- /forms+/src/defacto/forms/plus.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.forms.plus 2 | "An extension module that combines [[defacto.forms.core]] with [[defacto.resources.core]]" 3 | #?(:cljs (:require-macros defacto.forms.plus)) 4 | (:require 5 | [defacto.core :as defacto] 6 | [defacto.forms.core :as forms] 7 | [defacto.resources.core :as res])) 8 | 9 | (defmulti ^{:arglists '([resource-key form resource-payload])} re-init 10 | "Extend this multimethod to define how your form is reinitialized upon 11 | successful submission. Defaults to the initial form value." 12 | (fn [resource-key _ _] 13 | (first resource-key))) 14 | 15 | (defmulti ^{:arglists '([resource-key form-data])} validate 16 | "Extend this multimethod for `::valid` forms. Your validator should 17 | return `nil` when valid, or an appropriate data structure to represent 18 | form errors in your application. Gets wrapped in a map; so, it can 19 | be distinguished from other errors: `{::forms/data validate-return-val}`." 20 | (fn [resource-key _form-data] 21 | (first resource-key))) 22 | 23 | (defmacro validated [dispatch-key validator argv & body] 24 | `(let [validator# ~validator] 25 | (defmethod validate ~dispatch-key [_# data#] (validator# data#)) 26 | (defmethod res/->request-spec ~dispatch-key ~argv ~@body))) 27 | 28 | (defn ->form+ [form res] 29 | (merge form res)) 30 | 31 | 32 | ;; forms 33 | (defmethod res/->request-spec ::std 34 | [[_ resource-key :as form-key] {::forms/keys [form] :as params}] 35 | (let [form-data (forms/data form)] 36 | (-> (res/->request-spec resource-key (assoc params ::forms/data form-data)) 37 | (update :ok-events conj [::recreated form-key])))) 38 | 39 | (defmethod res/->request-spec ::valid 40 | [[_ resource-key :as form-key] {::forms/keys [form] :as params}] 41 | (let [form-data (forms/data form)] 42 | (if-let [errors (validate resource-key form-data)] 43 | {:pre-events [[::res/failed form-key {::forms/errors errors}]]} 44 | (-> (res/->request-spec resource-key (assoc params ::forms/data form-data)) 45 | (update :ok-events conj [::recreated form-key]))))) 46 | 47 | 48 | ;; commands 49 | (defmethod defacto/command-handler ::submit! 50 | [{::defacto/keys [store]} [_ form-key params] _] 51 | (let [form (defacto/query-responder @store [::forms/?:form form-key]) 52 | params (cond-> params form (assoc ::forms/form form))] 53 | (defacto/dispatch! store [::res/submit! form-key params]))) 54 | 55 | 56 | ;; queries 57 | (defmethod defacto/query-responder ::?:form+ 58 | [db [_ form-key]] 59 | (merge (defacto/query-responder db [::forms/?:form form-key]) 60 | (defacto/query-responder db [::res/?:resource form-key]))) 61 | 62 | 63 | ;; events 64 | (defmethod defacto/event-reducer ::recreated 65 | [db [_ [_ resource-key :as form-key] result]] 66 | (let [form (defacto/query-responder db [::?:form+ form-key]) 67 | next-init (re-init resource-key form result)] 68 | (defacto/event-reducer db [::forms/created form-key next-init (forms/opts form)]))) 69 | 70 | (defmethod defacto/event-reducer ::destroyed 71 | [db [_ form-key]] 72 | (-> db 73 | (defacto/event-reducer [::forms/destroyed form-key]) 74 | (defacto/event-reducer [::res/destroyed form-key]))) 75 | 76 | 77 | ;; internal 78 | (defmethod re-init :default 79 | [_ form _] 80 | (forms/initial form)) 81 | -------------------------------------------------------------------------------- /core/src/defacto/impl.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.impl 2 | #?(:clj 3 | (:import 4 | (clojure.lang IDeref IRef)))) 5 | 6 | (defprotocol IStore 7 | "A store for processing `commands` and `events`. A `command` is used to invoke side 8 | effects, which may include emitting `events`." 9 | (-dispatch! [this command] 10 | "Dispatches a `command` through the system causing potential side-effects and/or emmitting `events` 11 | which update the internal db.") 12 | (-subscribe [this query] 13 | "Returns a deref-able and watchable subscription to a `query`. 14 | The subscription should be updated any time the query results change.")) 15 | 16 | (defn ^:private add-watch* [store sub key f] 17 | (add-watch sub key (fn [key _ old new] 18 | (f key store old new))) 19 | store) 20 | 21 | ;; TODO - do we always want to do this? Maybe LRU? 22 | (defn ^:private ->query-cached-sub-fn [->sub] 23 | (let [query->sub (atom {})] 24 | (fn [query result] 25 | (let [sub (-> query->sub 26 | (swap! update query #(or % (->sub result))) 27 | (get query))] 28 | (doto sub (reset! result)))))) 29 | 30 | (deftype ^:private ImmutableSubscription [sub] 31 | IDeref 32 | (#?(:cljs -deref :default deref) [_] @sub) 33 | 34 | #?@(:cljs 35 | [IWatchable 36 | (-add-watch [this key f] (add-watch* this sub key f)) 37 | (-remove-watch [_ key] (remove-watch sub key)) 38 | (-notify-watches [_ old new] (-notify-watches sub old new))] 39 | 40 | :default 41 | [IRef 42 | (addWatch [this key f] (add-watch* this sub key f)) 43 | (removeWatch [_ key] (remove-watch sub key))])) 44 | 45 | (deftype DefactoStore [watchable-store ->atom-sub api] 46 | IDeref 47 | (#?(:cljs -deref :default deref) [_] @watchable-store) 48 | 49 | IStore 50 | (-dispatch! [this command] 51 | (-dispatch! watchable-store command) 52 | this) 53 | (-subscribe [_ query] 54 | (let [responder (:query-responder api) 55 | sub (->atom-sub query (responder @watchable-store query))] 56 | (add-watch watchable-store query (fn [_ _ old new] 57 | (let [prev (responder old query) 58 | next (responder new query)] 59 | (when-not (= prev next) 60 | (reset! sub next))))) 61 | (->ImmutableSubscription sub)))) 62 | 63 | (deftype ^:private StandardSubscription [atom-db query responder watchable?] 64 | IDeref 65 | (#?(:cljs -deref :default deref) [_] (responder @atom-db query)) 66 | 67 | #?@(:cljs 68 | [IWatchable 69 | (-add-watch [this key f] (cond-> this watchable? (add-watch* atom-db key f))) 70 | (-remove-watch [_ key] (remove-watch atom-db key)) 71 | (-notify-watches [_ old new] (-notify-watches atom-db old new))] 72 | 73 | :default 74 | [IRef 75 | (addWatch [this key f] (cond-> this watchable? (add-watch* atom-db key f))) 76 | (removeWatch [_ key] (remove-watch atom-db key))])) 77 | 78 | (deftype WatchableStore [ctx-map atom-db api ->Sub] 79 | IDeref 80 | (#?(:cljs -deref :default deref) [_] @atom-db) 81 | 82 | IStore 83 | (-dispatch! [this command] 84 | (let [{:keys [command-handler event-reducer]} api] 85 | (command-handler (assoc ctx-map :defacto.core/store this) 86 | command 87 | (fn [event] 88 | (swap! atom-db event-reducer event) 89 | nil)))) 90 | (-subscribe [_ query] 91 | (->Sub atom-db query)) 92 | 93 | #?@(:cljs 94 | [IWatchable 95 | (-add-watch [this key f] (add-watch* this atom-db key f)) 96 | (-remove-watch [_ key] (remove-watch atom-db key)) 97 | (-notify-watches [this _ _] this)] 98 | 99 | :default 100 | [IRef 101 | (addWatch [this key f] (add-watch* this atom-db key f)) 102 | (removeWatch [_ key] (remove-watch atom-db key))])) 103 | 104 | (defn create 105 | "Use this to construct a [[DefactoStore]]" 106 | [ctx-map init-db api ->sub] 107 | (let [->Sub #(->StandardSubscription %1 %2 (:query-responder api) false) 108 | base-store (->WatchableStore ctx-map (atom init-db) api ->Sub)] 109 | (->DefactoStore base-store (->query-cached-sub-fn ->sub) api))) 110 | -------------------------------------------------------------------------------- /forms/src/defacto/forms/core.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.forms.core 2 | (:refer-clojure :exclude [flatten]) 3 | (:require 4 | [defacto.core :as defacto])) 5 | 6 | (defn ^:private flatten* [m path] 7 | (mapcat (fn [[k v]] 8 | (let [path' (conj path k)] 9 | (cond 10 | (map? v) (flatten* v path') 11 | (vector? v) (flatten* (into {} (map-indexed vector) v) path') 12 | :else [[path' v]]))) 13 | m)) 14 | 15 | (defn ^:private assoc-in* [m [k :as path] v] 16 | (cond 17 | (empty? path) 18 | v 19 | 20 | (and (int? k) (or (nil? m) (vector? m))) 21 | (loop [vector (or m [])] 22 | (if (> k (count vector)) 23 | (recur (conj vector nil)) 24 | (update vector k assoc-in* (next path) v))) 25 | 26 | :else 27 | (assoc m k (assoc-in* (get m k) (next path) v)))) 28 | 29 | (defn ^:private flatten [m] 30 | (into {} (flatten* m []))) 31 | 32 | (defn ^:private nest [m] 33 | (reduce-kv assoc-in* {} m)) 34 | 35 | (defn id 36 | "The id of the form" 37 | [form] 38 | (::id form)) 39 | 40 | (defn opts 41 | "The opts of the form" 42 | [form] 43 | (::opts form)) 44 | 45 | (defn data 46 | "Extract the canonical model of data of the form." 47 | [form] 48 | (when form 49 | (nest (::current form)))) 50 | 51 | (defn initial 52 | "Extract the canonical model of initial value of the form." 53 | [form] 54 | (when form 55 | (nest (::init form)))) 56 | 57 | (defn modify 58 | "Modifies the value of a form at a path by applying a function 59 | and any additional args. 60 | 61 | (-> form 62 | (modify [:some] (fnil conj []) {:path 1}) 63 | (modify [:some 0 :path] + [7 12]) 64 | data) 65 | ;; => {:some [{:path 20}]}" 66 | ([form path f] 67 | (modify form path f nil)) 68 | ([form path f args] 69 | (when form 70 | (let [{:keys [remove-nil? update-fn] :or {update-fn identity}} (opts form) 71 | model (apply update-in (data form) path f args) 72 | remove? (and (nil? (get-in model path)) remove-nil?) 73 | long-path? (next path) 74 | model (cond-> model 75 | (and remove? long-path?) 76 | (update-in (butlast path) dissoc (last path)) 77 | 78 | (and remove? (not long-path?)) 79 | (dissoc (first path)))] 80 | (assoc form ::current (flatten (update-fn model))))))) 81 | 82 | (defn change 83 | "Changes a value of a form at a path. 84 | 85 | (-> form 86 | (change [:some 0 :path] 42) 87 | data) 88 | ;; => {:some [{:path 42}]}" 89 | [form path value] 90 | (modify form path (constantly value))) 91 | 92 | (defn changed? 93 | "Does the current value of the form differ from the initial value?" 94 | ([{::keys [current init]}] 95 | (not= current init)) 96 | ([{::keys [current init]} path] 97 | (not= (get current path) (get init path)))) 98 | 99 | (defn create 100 | "Creates a form from `init-data` which must be a `map`. Supported opts 101 | 102 | :remove-nil? - when true, calls to [[change]] will remove the path instead of setting it. 103 | defaults to `false`." 104 | [id init-data opts] 105 | {:pre [(or (nil? init-data) (map? init-data))]} 106 | (let [internal-data (flatten init-data)] 107 | {::id id 108 | ::init internal-data 109 | ::current internal-data 110 | ::opts opts})) 111 | 112 | 113 | ;; commands 114 | (defmethod defacto/command-handler ::ensure! 115 | [{::defacto/keys [store]} [_ form-id params opts] emit-cb] 116 | (when-not (defacto/query-responder @store [::?:form form-id]) 117 | (emit-cb [::created form-id params opts]))) 118 | 119 | 120 | ;; queries 121 | (defmethod defacto/query-responder ::?:forms 122 | [db _] 123 | (vals (::-forms db))) 124 | 125 | (defmethod defacto/query-responder ::?:form 126 | [db [_ form-id]] 127 | (get-in db [::-forms form-id])) 128 | 129 | 130 | ;; events 131 | (defmethod defacto/event-reducer ::created 132 | [db [_ form-id data opts]] 133 | (assoc-in db [::-forms form-id] (create form-id data opts))) 134 | 135 | (defmethod defacto/event-reducer ::changed 136 | [db [_ form-id path value]] 137 | (update-in db [::-forms form-id] change path value)) 138 | 139 | (defmethod defacto/event-reducer ::modified 140 | [db [_ form-id path f & args]] 141 | (update-in db [::-forms form-id] modify path f args)) 142 | 143 | (defmethod defacto/event-reducer ::destroyed 144 | [db [_ form-id]] 145 | (update db ::-forms dissoc form-id)) 146 | -------------------------------------------------------------------------------- /forms+/README.md: -------------------------------------------------------------------------------- 1 | # defacto-forms+ 2 | 3 | A module for combing the functionality of [defacto-forms](../forms/README.md) with [defacto-res](../res/README.md). 4 | 5 | ```clojure 6 | ;; deps.edn 7 | {:deps {skuttleman/defacto-forms+ {:git/url "https://github.com/skuttleman/defacto" 8 | :git/sha "{SHA_OF_HEAD}" 9 | :deps/root "forms+"}}} 10 | ``` 11 | 12 | ## An example using reagent 13 | 14 | ```clojure 15 | (ns killer-app.core 16 | (:require 17 | [clojure.core.async :as async] 18 | [defacto.core :as defacto] 19 | [defacto.forms.core :as forms] 20 | [defacto.forms.plus :as forms+] 21 | [defacto.resources.core :as res] 22 | [reagent.core :as r])) 23 | 24 | (defn request-fn [_resource-key params] 25 | (async/go 26 | ;; ... fulfills request 27 | [::res/ok {:some "result"}])) 28 | 29 | (def store (defacto/create (res/with-ctx request-fn) {})) 30 | 31 | (defn input [form+ path] 32 | [:input {:value (get-in (forms/data form+) path) 33 | :on-change (fn [_] 34 | (defacto/emit! store [::forms/changed [::forms+/std [::my-res-spec 123]] 35 | path 36 | (-> e .-target .-value)]))}]) 37 | 38 | (defn app [] 39 | (r/with-let [sub (store/subscribe [::forms+/:form+ [::forms+/std [::my-res-spec 123]]])] 40 | (let [form+ @sub] ;; a `form+` is a `form` AND a `resource` 41 | (if (res/requesting? form+) 42 | [:div "loading..."] 43 | [:div 44 | [input form+ [:input-1]] 45 | [input form+ [:input :two]] 46 | [:button {:on-click (fn [_] 47 | (defacto/dispatch! store [::forms+/submit! [::forms+/std [::my-res-spec 123]] 48 | {:additional :input}]))} 49 | "Submit!"]])) 50 | (finally 51 | (defacto/emit! store [::forms+/destroyed])))) 52 | 53 | 54 | ;; a `form+` is wrapper around a normal defacto resource spec 55 | (defmethod res/->request-spec ::my-res-spec 56 | [[_ id] {::forms/keys [data] :keys [additional] :as params}] 57 | ;; `id` is 123 (from the above usage) 58 | ;; ::forms/data is the current value of the form (i.e. {:input-1 "foo" :input {:two "bar"}}) 59 | ;; `params` contains other params passed to ::forms+/submit! 60 | {:params {:req :params} ;; this is what will be passed to `request-fn` 61 | :ok-events [...]}) 62 | 63 | 64 | ;; when the resource "succeeds", the form+ is reset back it its initial state by default. Override that by extending forms+/re-init 65 | (defmethod forms+/re-init ::my-res-spec 66 | [_resource-key form _res-result-data] 67 | (forms/data form)) ;; retains the form data that was submitted 68 | ``` 69 | 70 | ## Form validation 71 | 72 | The above example uses `::forms+/std`, but there is also `::forms+/valid` which will do local validation before submitting 73 | the form. In order to use this form, you must extend `forms+/validate`. 74 | 75 | 76 | ```clojure 77 | (defmethod forms+/validate ::my-res-spec 78 | [_resource-key form-data] 79 | ;; return `nil` when the form is VALID 80 | ;; any non-`nil` value is treated as INVALID 81 | {:key ["something is wrong"]}) 82 | 83 | 84 | ;; now change the form-key in the above example to use `::forms+/valid` instead of `::forms+/std` 85 | (defacto/subscribe [::forms+/:form+ [::forms+/valid [::my-res-spec 123]]]) 86 | 87 | 88 | ;; if the form is invalid, the resource will not be submitted, and instead will fail with: 89 | ;; {::forms/errors return-val-from-validate} to distinguish 90 | (res/payload @(defacto/subscribe [::forms+/:form+ [::forms+/valid [::my-res-spec 123]]])) 91 | ;; {::forms/errors {:key ["something is wrong"]}} 92 | ``` 93 | 94 | ## Commands 95 | 96 | This module exposes the following `commands`. 97 | 98 | ### [::forms+/submit! form-key ?params] 99 | 100 | Submits the underlying resource with the current form data. 101 | 102 | ```clojure 103 | (defacto/dispatch! store [::forms+/submit! [::forms+/valid [::my-res-spec 123]]]) 104 | ``` 105 | 106 | ## Queries 107 | 108 | This module exposes the following `queries`. 109 | 110 | ### [::forms+/?:form+ form-key] 111 | 112 | ```clojure 113 | @(defacto/subscribe store [::forms+/?form+ [::forms+/valid [::my-res-spec 123]]]) 114 | ``` 115 | 116 | ## Events 117 | 118 | This module exposes the following `events`. 119 | 120 | ### [::forms+/recreated form-key res-result] 121 | 122 | Re-initializes a `form+` after a successful submission. **Not intended to be used directly** 123 | 124 | ### [::forms+/destroyed form-key] 125 | 126 | Destroys the `form+` (i.e. the underlying `form` and `resource`) 127 | 128 | ```clojure 129 | (defacto/emit! store [::forms+/destroyed [::forms+/std [::my-res-spec 123]]]) 130 | ``` 131 | -------------------------------------------------------------------------------- /core/src/defacto/core.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.core 2 | (:require 3 | [clojure.walk :as walk] 4 | [defacto.impl :as impl])) 5 | 6 | (defmulti ^{:arglists '([{::keys [store] :as ctx-map} command emit-cb])} command-handler 7 | "Handles a `command` in whatever fashion you decide. `emit-cb` can be called 8 | with 0 or more `events`. A command should be a vector with a keyword in first 9 | position denoting its `action`. 10 | 11 | ```clojure 12 | (defmethod command-handler :do-something! 13 | [ctx-map command emit-cb] 14 | (emit-cb [:something-happened {:some :data}])) 15 | ```" 16 | (fn [_ [action] _] action)) 17 | 18 | (defmulti ^{:arglists '([db event])} event-reducer 19 | "Reduces an `event` over the current `db` and returns a new db value. 20 | Your [[event-reducer]] implementation should have NO SIDE EFFECTS. Those belong in 21 | [[command-handler]]s. 22 | 23 | ```clojure 24 | (defmethod event-reducer :something-happened 25 | [db event] 26 | (update db ...)) 27 | ```" 28 | (fn [_ [type]] type)) 29 | 30 | (defmulti ^{:arglists '([db query-responder])} query-responder 31 | "Processes a query and returns the data from the db. Your [[query-responder]] 32 | implementation should have NO SIDE EFFECTS. Those belong in [[command-handler]]s. 33 | 34 | ```clojure 35 | (defmethod query-responder :data? 36 | [db query] 37 | (get-in db [...])) 38 | ```" 39 | (fn [_ [resource]] resource)) 40 | 41 | (defprotocol IInitialize 42 | "Extend this protocol to have components in your `ctx-map` get initialized with the store upon creation." 43 | (init! [_ store])) 44 | 45 | (defn create 46 | "Creates a basic, deref-able state store which takes these arguments. 47 | 48 | `ctx-map` - any arbitrary map of clojure data. keys with the namespace 49 | `defacto*` (i.e. `:defacto.whatever/some-key`) are reserved 50 | for use by this library. Any node in the `ctx-map` that satisfies 51 | [[IInitialize]] will be initialized with the store upon creation. 52 | 53 | `init-db` - the initial value of your db. 54 | 55 | `->sub` (optional) - a function that returns something that behaves like an atom. 56 | For example, [[clojure.core/atom]] or [[reagent.core/atom]]. 57 | Specifically, it needs to support these protocol methods: 58 | 59 | clj - `IAtom/reset`, `IDeref/deref` 60 | cljs - `IReset/-reset`, `IDeref/-deref` 61 | 62 | If you want to *watch* your subscriptions, then the return value 63 | of `->sub` must also satisfy: 64 | 65 | clj - `IRef/addWatch`, `IRef/removeWatch` (and notify watchers 66 | in impl of `IAtom/reset`) 67 | cljs - `IWatchable/-add-watch` `IWatchable/-remove-watch, and 68 | `IWatchable/-notify-watches`" 69 | ([ctx-map init-db] 70 | (create ctx-map init-db nil)) 71 | ([ctx-map init-db {:keys [->sub] :or {->sub atom} :as opts}] 72 | (let [handler-mw (:handler-mw opts identity) 73 | reducer-mw (:reducer-mw opts identity) 74 | responder-mw (:responder-mw opts identity) 75 | api {:command-handler (handler-mw command-handler) 76 | :event-reducer (reducer-mw event-reducer) 77 | :query-responder (responder-mw query-responder)} 78 | store (impl/create ctx-map init-db api ->sub)] 79 | (walk/postwalk (fn [x] 80 | (when (satisfies? IInitialize x) 81 | (init! x store)) 82 | x) 83 | ctx-map) 84 | store))) 85 | 86 | (defn dispatch! 87 | "Dispatches a `command` through the store. The `command` should be a vector with a keyword in 88 | first position denoting its type. 89 | 90 | ```clojure 91 | (dispatch! store [:update-thing! {:id 123 :attribute \"value\"}]) 92 | ```" 93 | [store command] 94 | (impl/-dispatch! store command) 95 | store) 96 | 97 | (defn emit! 98 | "Emit an `event` through the store which may update the db. `event` should be a vector 99 | with a keyword in first position denoting its type. 100 | 101 | ```clojure 102 | (emit! store [:thing-updated {:id 123 ...}]) 103 | ```" 104 | [store event] 105 | (dispatch! store [::emit! event])) 106 | 107 | (defn subscribe 108 | "Returns a deref-able window into the database. `query` should be a vector with a keyword 109 | in first position denoting its type. 110 | 111 | ```clojure 112 | (subscribe store [:thing {:id 123}]) 113 | ```" 114 | [store query] 115 | (impl/-subscribe store query)) 116 | 117 | (defmethod command-handler ::emit! 118 | [_ [_ event :as _command] emit-cb] 119 | (emit-cb event)) 120 | 121 | (defmethod event-reducer :default 122 | [db _event] 123 | db) 124 | -------------------------------------------------------------------------------- /res/README.md: -------------------------------------------------------------------------------- 1 | # defacto-resources 2 | 3 | A module for `defacto` that generically handles "asynchronous" resources. 4 | 5 | ```clojure 6 | ;; deps.edn 7 | {:deps {skuttleman/defacto-res {:git/url "https://github.com/skuttleman/defacto" 8 | :git/sha "{SHA_OF_HEAD}" 9 | :deps/root "res"}}} 10 | ``` 11 | 12 | ```clojure 13 | (ns killer-app.core 14 | (:require 15 | [defacto.core :as defacto] 16 | [defacto.resources.core :as res])) 17 | 18 | ;; define your resource spec by returning a map by including any of the following 19 | (defmethod res/->resource-spec ::fetch-thing 20 | [_ input] 21 | {:pre-events [[::fetch-started]] 22 | :params {:request-method :get 23 | :url (str "http://www.example.com/things/" (:id input))} 24 | :err-commands [[::toast!]] 25 | :ok-events ...}) 26 | 27 | ;; define a request-fn 28 | (defn my-request-fn [resource-type params] 29 | ;; returns a vector tuple or a core.async channel 30 | (async/go 31 | ;; does whatever, http prolly 32 | ... 33 | ;; succeeds with a vector tuple 34 | [::res/ok {:some :data}] ;; if it isn't `::res/ok`, it's `::res/err` 35 | ;; or fails with a vector tuple 36 | [::res/err {:some :error}])) 37 | 38 | 39 | ;; resource key 40 | (def resource-key [::fetch-thing ::numero-uno]) 41 | 42 | ;; create your store your request handler 43 | (def store (defacto/create (res/with-ctx {:some :ctx-map} my-request-fn) {})) 44 | (def sub (defacto/subscribe store [::res/?:resource resource-key])) 45 | 46 | ;; submit the resource 47 | (defacto/dispatch! store [::res/submit! resource-key {:id 123}]) 48 | (res/requesting? @sub) ;; => true 49 | ... after the request finishes 50 | (res/success? @sub) ;; true (one would hope) 51 | (res/payload @sub) ;; => {...} 52 | ``` 53 | 54 | ## What's a resource? 55 | 56 | A `resource` is defined by extending [[defacto.resources.core/->resource-spec]] with your `resource-type` which 57 | you can use to create and reference resources in the system. 58 | 59 | ```clojure 60 | (defmethod defacto.resources.core/->request-spec ::resource-type 61 | [resource-key input] ;; resource-key is a vector beginning with the `resource-type` 62 | {:params {...} 63 | ...}) 64 | ``` 65 | 66 | Your spec can return any of the following keys 67 | 68 | - `:params` - a NON-`nil` argument to request the resource. If this key is `nil`, the resource will not be requested. 69 | - `:pre-events`, `:pre-command` - optional sequences of events/commands to be emitted/dispatched before the request 70 | is submitted. These occur even if `:params` is `nil` 71 | - `:ok-events`, `:ok-commands` - optional sequences of events/commands to emitted/dispatched after the request succeeds. 72 | These events/commands should be express "callback" style with the final argument to be the success result `conj`'ed on 73 | to the event/command vector. 74 | - `:err-events`, `:err-commands` - optional sequences of events/commands to emitted/dispatched after the request fails. 75 | These events/commands should be express "callback" style with the final argument to be the error result `conj`'ed on 76 | to the event/command vector. 77 | 78 | ## Commands 79 | 80 | This module exposes the following `commands`. 81 | 82 | ### [::res/submit! resource-key params] 83 | 84 | This submits a resource with the provided params. 85 | 86 | ```clojure 87 | (defacto/dispatch! store [::res/submit! [::resource-type] {:a 1}]) 88 | ``` 89 | 90 | ### [::res/ensure! resource-key params] 91 | 92 | This submits a resource if it is currently in the `:init` state. 93 | 94 | ```clojure 95 | (defacto/dispatch! store [::res/ensure! [::resource-type] {:a 1}]) 96 | ``` 97 | 98 | ### [::res/poll! milliseconds resource-key params] 99 | 100 | Continuously submits a resource in intervals of `milliseconds`. 101 | 102 | ```clojure 103 | ;; sends a request now, and after every 2 seconds forever 104 | (defacto/dispatch! store [::res/poll! 2000 [::resource-type] {:a 1}]) 105 | ;; destroy the resource to stop the polling 106 | (defacto/emit! store [::res/destroyed [::resource-type]]) 107 | ``` 108 | 109 | ### [::res/delay! milliseconds command] 110 | 111 | Executes a command after `milliseconds` have expired. 112 | 113 | ```clojure 114 | (defacto/dispatch! store [::res/delay! 123 [::any-command! {:a 1}]]) 115 | ``` 116 | 117 | ## Queries 118 | 119 | This module exposes the following `queries`. 120 | 121 | ### [::res/?:resources] 122 | 123 | Returns a sequence of all resources. 124 | 125 | ```clojure 126 | @(defacto/subscribe store [::res/?:resources]) 127 | ;; returns `nil` for undefined resources 128 | ``` 129 | 130 | ### [::res/?:resource resource-key] 131 | 132 | Retrieves the current state of a resource. 133 | 134 | ```clojure 135 | @(defacto/subscribe store [::res/?:resource [::some-key 123]]) 136 | ;; returns `nil` for undefined resources 137 | ``` 138 | 139 | ## Events 140 | 141 | This module exposes the following `events`. 142 | 143 | ### [::res/submitted resource-key request-params] 144 | 145 | Transitions the resource from any state to `:requesting`. **Not intended to be used directly** 146 | 147 | ### [::res/succeeded resource-key data] 148 | 149 | Transitions the resource from a `:requesting` state to a `:success` state. **Not intended to be used directly** 150 | 151 | ### [::res/failed resource-key error] 152 | 153 | Transitions the resource from a `:requesting` state to an `:error` state. **Not intended to be used directly** 154 | 155 | ### [::res/destroyed resource-key] 156 | 157 | Destroys a resource. 158 | 159 | ```clojure 160 | (defacto/emit! store [::res/destroyed [::resource-type]]) 161 | ``` 162 | -------------------------------------------------------------------------------- /forms+/test/defacto/forms/plus_test.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.forms.plus-test 2 | (:require 3 | [clojure.core.async :as async] 4 | [clojure.test :refer [deftest is testing]] 5 | [defacto.core :as defacto] 6 | [defacto.forms.core :as forms] 7 | [defacto.forms.plus :as forms+] 8 | [defacto.resources.core :as res])) 9 | 10 | (defmacro async [cb & body] 11 | (if (:ns &env) 12 | `(cljs.test/async ~cb ~@body) 13 | `(let [prom# (promise) 14 | ~cb (fn [] (deliver prom# :done)) 15 | result# (do ~@body)] 16 | @prom# 17 | result#))) 18 | 19 | (defmethod forms+/re-init ::res-spec [_ _ _] 20 | {:init true}) 21 | 22 | (defmethod res/->request-spec ::res-spec 23 | [_ {::forms/keys [data]}] 24 | {:params data}) 25 | 26 | (deftest std-form-test 27 | (async done 28 | (async/go 29 | (testing "when creating a form+" 30 | (let [resp (atom [::res/err {:some "error"}]) 31 | store (defacto/create (res/with-ctx (fn [_ _] @resp)) nil) 32 | sub:form+ (defacto/subscribe store [::forms+/?:form+ [::forms+/std [::res-spec]]])] 33 | (defacto/emit! store [::forms/created [::forms+/std [::res-spec]] {:some {:path "init-value"}}]) 34 | (testing "and when modifying the form+" 35 | (-> store 36 | (defacto/emit! [::forms/changed [::forms+/std [::res-spec]] [:some :path] "new-value"]) 37 | (defacto/emit! [::forms/changed [::forms+/std [::res-spec]] [:another :path] "value"])) 38 | 39 | (testing "has the form data" 40 | (is (= {:some {:path "new-value"} 41 | :another {:path "value"}} 42 | (forms/data @sub:form+)))) 43 | 44 | (testing "and when submitting the form+" 45 | (defacto/dispatch! store [::forms+/submit! [::forms+/std [::res-spec]]]) 46 | (async/request-spec 11 | "Implement this to generate a request spec from a resource-key. 12 | Your implementation should return a map containing any of the following: 13 | 14 | - :params - passed to the request fn 15 | 16 | - :pre-events - xs of events to emitted before the request is made 17 | - :pre-commands - xs of commands to dispatched before the request is made 18 | - :ok-events - xs of events to emitted upon success with the payload conj'ed onto the event 19 | - :ok-commands - xs of commands to dispatched upon success with the payload conj'ed onto the command 20 | - :err-events - xs of events to emitted upon failure with the payload conj'ed onto the event 21 | - :err-commands - xs of commands to dispatched upon failure with the payload conj'ed onto the command 22 | 23 | - :->ok - optionally transform the ok response payload 24 | - :->err - optionally transform the error response payload" 25 | (fn [resource-key _] 26 | (first resource-key))) 27 | 28 | (defn with-ctx 29 | ([request-fn] 30 | (with-ctx {} request-fn)) 31 | ([ctx-map request-fn] 32 | (assoc ctx-map ::impl/request-fn request-fn))) 33 | 34 | (defn init? [resource] 35 | (= :init (::status resource))) 36 | 37 | (defn success? [resource] 38 | (= :success (::status resource))) 39 | 40 | (defn error? [resource] 41 | (= :error (::status resource))) 42 | 43 | (defn requesting? [resource] 44 | (= :requesting (::status resource))) 45 | 46 | (defn payload [resource] 47 | (::payload resource)) 48 | 49 | (defn ^:private with-msgs [m k spec] 50 | (if-let [v (seq (get spec k))] 51 | (update m k (fnil into []) v) 52 | m)) 53 | 54 | (defn ^:private ->input [resource-key {:keys [params] :as spec}] 55 | (-> (->request-spec resource-key params) 56 | (assoc :resource-type (first resource-key) 57 | :spec spec) 58 | (with-msgs :pre-events spec) 59 | (with-msgs :pre-commands spec) 60 | (with-msgs :ok-events spec) 61 | (with-msgs :ok-commands spec) 62 | (with-msgs :err-events spec) 63 | (with-msgs :err-commands spec))) 64 | 65 | (defn ^:private params->spec [resource-key params] 66 | {:params params 67 | :ok-events [[::succeeded resource-key]] 68 | :err-events [[::failed resource-key]]}) 69 | 70 | (defn ^:private now-ms [] 71 | #?(:clj (.getTime (Date.)) :cljs (.getTime (js/Date.)))) 72 | 73 | ;; commands 74 | (defmethod defacto/command-handler ::delay! 75 | [{::defacto/keys [store]} [_ ms command] _] 76 | (async/go 77 | (async/spec resource-key params)] 83 | (emit-cb [::submitted resource-key]) 84 | (impl/request! ctx-map (->input resource-key spec) emit-cb))) 85 | 86 | (defmethod defacto/command-handler ::ensure! 87 | [{::defacto/keys [store]} [_ resource-key {::keys [ttl] :as params}] _] 88 | (let [{::keys [ms] :as res} (defacto/query-responder @store [::?:resource resource-key]) 89 | expired? (when (and ms ttl) 90 | (> (- (now-ms) ms) ttl))] 91 | (when (or expired? (init? res)) 92 | (defacto/dispatch! store [::submit! resource-key (dissoc params ::ttl)])))) 93 | 94 | (defmethod defacto/command-handler ::poll! 95 | [{::defacto/keys [store] :as ctx-map} [_ ms resource-key params when-exists?] emit-cb] 96 | (when (or (not when-exists?) (get-in @store [::-resources resource-key])) 97 | (let [spec (-> (params->spec resource-key params) 98 | (assoc :ok-commands [[::delay! ms [::poll! ms resource-key params true]]] 99 | :err-commands [[::delay! ms [::poll! ms resource-key params true]]]))] 100 | (emit-cb [::submitted resource-key]) 101 | (impl/request! ctx-map (->input resource-key spec) emit-cb)))) 102 | 103 | 104 | ;; queries 105 | (defmethod defacto/query-responder ::?:resources 106 | [db _] 107 | (vals (::-resources db))) 108 | 109 | (defmethod defacto/query-responder ::?:resource 110 | [db [_ resource-key]] 111 | (or (get-in db [::-resources resource-key]) 112 | (when (contains? (methods ->request-spec) (first resource-key)) 113 | {::status :init}))) 114 | 115 | 116 | ;; events 117 | (defmethod defacto/event-reducer ::submitted 118 | [db [_ resource-key]] 119 | (update-in db [::-resources resource-key] assoc 120 | ::status :requesting 121 | ::ms (now-ms))) 122 | 123 | (defmethod defacto/event-reducer ::succeeded 124 | [db [_ resource-key data]] 125 | (cond-> db 126 | (requesting? (get-in db [::-resources resource-key])) 127 | (update-in [::-resources resource-key] assoc 128 | ::status :success 129 | ::payload data))) 130 | 131 | (defmethod defacto/event-reducer ::failed 132 | [db [_ resource-key errors]] 133 | (cond-> db 134 | (requesting? (get-in db [::-resources resource-key])) 135 | (update-in [::-resources resource-key] assoc 136 | ::status :error 137 | ::payload errors))) 138 | 139 | (defmethod defacto/event-reducer ::destroyed 140 | [db [_ resource-key]] 141 | (update db ::-resources dissoc resource-key)) 142 | 143 | (defmethod defacto/event-reducer ::swapped 144 | [db [_ resource-key data]] 145 | (cond-> db 146 | (success? (get-in db [::-resources resource-key])) 147 | (assoc-in [::-resources resource-key ::payload] data))) 148 | -------------------------------------------------------------------------------- /res/test/defacto/resources/core_test.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.resources.core-test 2 | #?(:cljs (:require-macros defacto.resources.core-test)) 3 | (:require 4 | [clojure.core.async :as async] 5 | [clojure.test :refer [deftest is testing]] 6 | [defacto.core :as defacto] 7 | [defacto.resources.core :as res] 8 | [defacto.test.utils :as tu])) 9 | 10 | (defmethod res/->request-spec ::resource 11 | [_ params] 12 | {:params params}) 13 | 14 | (defmethod defacto/command-handler ::command! 15 | [_ _ _]) 16 | 17 | (defmethod defacto/event-reducer ::resourced 18 | [db [_ value]] 19 | (assoc db ::resource value)) 20 | 21 | (deftest resources-test 22 | (tu/async done 23 | (async/go 24 | (let [calls (atom []) 25 | request-fn (fn [_ req] 26 | (swap! calls conj [::request-fn req]) 27 | [::res/ok {:some :data}]) 28 | store (defacto/create {:defacto.resources.impl/request-fn request-fn} nil)] 29 | (testing "when ensuring the resource exists" 30 | (testing "and when the resource does not exist" 31 | (defacto/dispatch! store [::res/ensure! [::resource 123] {:some :params}]) 32 | (testing "submits the resource" 33 | (is (contains? (set @calls) [::request-fn {:some :params}])))) 34 | 35 | (testing "and when the resource exists" 36 | (reset! calls []) 37 | (defacto/dispatch! store [::res/ensure! [::resource 123] {:some :params}]) 38 | (testing "does not submit the resource" 39 | (is (empty? @calls)))) 40 | 41 | (testing "and when ensuring the resource was not requested recently" 42 | (async/sub r/atom})] 85 | ;; using [[r/atom]] gets you 86 | ;; **reactive subscriptions**!! 87 | [component store])) 88 | 89 | (rdom/render [app-root] (.getElementById js/document "root")) 90 | 91 | (defmethod defacto/command-handler ::fetch-data! 92 | [{::defacto/keys [store] :keys [http-fn]} [ id] emit-cb] 93 | (async/go 94 | (let [result (async/>STORE: subscribe! (data?) 190 | ...->>APP: user interaction, HTTP, WS, etc 191 | APP->>STORE: dispatch! command 192 | loop 193 | STORE->>handler: command 194 | handler->>...: do stuff! 195 | handler->>STORE: dispatch! command(s) 196 | end 197 | handler->>STORE: emit! event(s) 198 | STORE->>reducer: DB, event 199 | reducer->>STORE: DB 200 | STORE-->>APP: updated sub (data) 201 | ``` 202 | 203 | ## Why? 204 | 205 | Good question. [re-frame](https://github.com/day8/re-frame) is awesome, but it's usually too heavy-weight for my purposes. 206 | Sometimes I just want to build things out of tiny, composable pieces. 207 | -------------------------------------------------------------------------------- /res/test/defacto/resources/impl_test.cljc: -------------------------------------------------------------------------------- 1 | (ns defacto.resources.impl-test 2 | (:require 3 | [clojure.test :refer [deftest is testing]] 4 | [clojure.core.async :as async] 5 | [defacto.core :as defacto] 6 | [defacto.test.utils :as tu] 7 | [defacto.resources.core :as res] 8 | [defacto.resources.impl :as impl])) 9 | 10 | (def ^:private fixture 11 | {:params {:some :params} 12 | :pre-events [[::pre'ed-1] 13 | [::pre'ed-2]] 14 | :pre-commands [[::pre-1!] 15 | [::pre-2!]] 16 | :ok-events [[::oked-1] 17 | [::oked-2]] 18 | :ok-commands [[::ok-1!] 19 | [::ok-2!]] 20 | :err-events [[::erred-1] 21 | [::erred-2]] 22 | :err-commands [[::err-1!] 23 | [::err-2!]] 24 | :->ok vector 25 | :->err (partial conj #{})}) 26 | 27 | (deftest request!-test 28 | (tu/async done 29 | (async/go 30 | (let [commands (atom []) 31 | events (atom []) 32 | store (reify 33 | defacto.impl/IStore 34 | (-dispatch! [_ command] 35 | (swap! commands conj command))) 36 | ctx-map {::defacto/store store 37 | ::impl/request-fn (fn [_ _] 38 | (async/timeout 1000))} 39 | emit-cb (partial swap! events conj)] 40 | (testing "when requesting a resource" 41 | (impl/request! ctx-map fixture emit-cb) 42 | (testing "emits pre-events" 43 | (is (= [[::pre'ed-1] [::pre'ed-2]] @events))) 44 | 45 | (testing "dispatches pre-commands" 46 | (is (= [[::pre-1!] [::pre-2!]] @commands))) 47 | 48 | (testing "and when the request succeeds" 49 | (let [ctx-map (assoc ctx-map ::impl/request-fn (fn [_ _] 50 | (async/go 51 | (reset! commands []) 52 | (reset! events []) 53 | [::res/ok {:some :data}])))] 54 | (impl/request! ctx-map fixture emit-cb) 55 | (async/