>.
14 |
15 | image::https://img.shields.io/clojars/v/navis/untangled-client.svg[link=https://clojars.org/navis/untangled-client]
16 |
17 | Release: image:https://api.travis-ci.org/untangled-web/untangled-client.svg?branch=master[link=https://github.com/untangled-web/untangled-client/tree/master]
18 | Snapshot: image:https://api.travis-ci.org/untangled-web/untangled-client.svg?branch=develop[link=https://github.com/untangled-web/untangled-client/tree/develop]
19 |
20 | == Learn more
21 | * about link:docs/index.adoc#untangled-client-docs[Untangled Client]
22 | * about link:http://untangled-web.github.io/untangled/index.html[Untangled] & checkout the link:http://untangled-web.github.io/untangled/index.html[Documentation Reference]
23 | * interactively with the link:http://untangled-web.github.io/untangled/guide.html[Untangled Tutorial]
24 | ** http://untangled-web.github.io/untangled/guide.html#!/untangled_devguide.B_UI[B_UI]
25 | ** http://untangled-web.github.io/untangled/guide.html#!/untangled_devguide.C_App_Database[C_App_Database]
26 | ** http://untangled-web.github.io/untangled/guide.html#!/untangled_devguide.D_Queries[D_Queries]
27 | ** http://untangled-web.github.io/untangled/guide.html#!/untangled_devguide.E_UI_Queries_and_State[E_UI_Queries_and_State]
28 | ** http://untangled-web.github.io/untangled/guide.html#!/untangled_devguide.F_Untangled_Client[F_Untangled_Client]
29 | ** http://untangled-web.github.io/untangled/guide.html#!/untangled_devguide.F_Untangled_Initial_App_State[F_Untangled_Initial_App_State]
30 | ** http://untangled-web.github.io/untangled/guide.html#!/untangled_devguide.G_Mutation[G_Mutation]
31 | ** http://untangled-web.github.io/untangled/guide.html#!/untangled_devguide.H_Server_Interactions[H_Server_Interactions]
32 |
33 | ## Usage
34 |
35 | The following instructions assume:
36 |
37 | - You're using leiningen
38 | - You'd like to be able to use Cursive REPL integration with IntelliJ
39 | - You'll use Chrome and would like to have nice support for looking at cljs data structures in the browser and
40 | console log messages.
41 |
42 | ### Base Project file
43 |
44 | In addition to the base untangled client library, the following are the minimum requirements for a project file:
45 |
46 | - Choose a version of clj/cljs
47 | - Choose a version of Om (Untangled requires Om, but treats it as a provided dependency)
48 |
49 | If you copy/paste the following file into a `project.clj` it will serve as a good start:
50 |
51 | [source]
52 | ----
53 | (defproject client-demo "1.0.0"
54 | :description "Untangled Client Quickstart"
55 | :dependencies [[org.clojure/clojure "1.8.0"]
56 | [org.clojure/clojurescript "1.8.51"]
57 | [org.omcljs/om "1.0.0-alpha46"]
58 | [navis/untangled-client "0.5.6"]]
59 |
60 | ; needed or compiled js files won't get cleaned
61 | :clean-targets ^{:protect false} ["resources/public/js/compiled" "target" "i18n/out"]
62 |
63 | ; needed for macros and our recommended figwheel setup
64 | :source-paths ["dev/server" "src/client"]
65 |
66 | :cljsbuild {:builds [{:id "dev"
67 | :source-paths ["dev/client" "src/client"]
68 | :figwheel true
69 | :compiler {:main "cljs.user"
70 | :asset-path "js/compiled/dev"
71 | :output-to "resources/public/js/compiled/app.js"
72 | :output-dir "resources/public/js/compiled/dev"
73 | :recompile-dependents true
74 | :optimizations :none}}]}
75 |
76 | ; figwheel dependency and chrome data structure formatting tools (formatting cljs in source debugging and logging)
77 | :profiles {:dev {:dependencies [[figwheel-sidecar "0.5.7"]
78 | [binaryage/devtools "0.6.1"]]}})
79 | ----
80 |
81 | ### Setting up Folders and Supporting files
82 |
83 | Create the directories as follows (OSX/Linux):
84 |
85 | [source]
86 | ----
87 | mkdir -p src/client/app dev/client/cljs dev/server resources/public/css resources/public/js script
88 | ----
89 |
90 | then create a base HTML file in `resources/public/index.html`:
91 |
92 | [source]
93 | ----
94 |
95 |
96 |
97 |
98 | Application
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 | ----
107 |
108 | and an empty CSS file:
109 |
110 | [source]
111 | ----
112 | touch resources/public/css/app.css
113 | ----
114 |
115 | ### Add base application source
116 |
117 | Make the application itself, with an initial state, in `src/client/app/core.cljs`:
118 |
119 | [source]
120 | ----
121 | (ns app.core
122 | (:require [untangled.client.core :as uc]))
123 |
124 | ; The application itself, create, and store in an atom for a later DOM mount and dev mode debug analysis
125 | ; of the application.
126 | ; The initial state is the starting data for the entire UI
127 | ; see dev/client/user.cljs for the actual DOM mount
128 | (defonce app (atom (uc/new-untangled-client)))
129 | ----
130 |
131 | Notice that making the application is a single line of code.
132 |
133 | then create the base UI in `src/client/app/ui.cljs`:
134 |
135 | [source]
136 | ----
137 | (ns app.ui
138 | (:require [om.next :as om :refer-macros [defui]]
139 | [untangled.client.mutations :as mut]
140 | [untangled.client.core :as uc]
141 | [om.dom :as dom]))
142 |
143 | ;; A UI node, with a co-located query of app state and a definition of the application's initial state.
144 | ;; The `:once` metadata ensures that figwheel does not redefine the static component with each re-render
145 | (defui ^:once Root
146 | static uc/InitialAppState
147 | (initial-state [this params] {:ui/react-key "ROOT"
148 | :some-data 42})
149 | static om/IQuery
150 | (query [this] [:ui/react-key :some-data])
151 | Object
152 | (render [this]
153 | (let [{:keys [ui/react-key some-data]} (om/props this)]
154 | (dom/div #js {:key react-key}
155 | (str "Hello world: " some-data)))))
156 | ----
157 |
158 |
159 | Create an application entry point for development mode in `dev/client/cljs/user.cljs`:
160 |
161 | [source]
162 | ----
163 | (ns cljs.user
164 | (:require
165 | [cljs.pprint :refer [pprint]]
166 | [devtools.core :as devtools]
167 | [untangled.client.logging :as log]
168 | [untangled.client.core :as uc]
169 | [app.ui :as ui]
170 | [app.core :as core]))
171 |
172 | ;; Enable browser console
173 | (enable-console-print!)
174 |
175 | ;; Set overall browser loggin level
176 | (log/set-level :debug)
177 |
178 | ;; Enable devtools in chrome for data structure formatting
179 | (defonce cljs-build-tools (devtools/install!))
180 |
181 | ;; Mount the Root UI component in the DOM div named "app"
182 | (swap! core/app uc/mount ui/Root "app")
183 | ----
184 |
185 | technically, only the `ns` declaration and last line are necessary.
186 |
187 | ### Setting up Figwheel
188 |
189 | We don't use the lein plugin for figwheel, as we'd rather have IntelliJ
190 | REPL integration, which we find works better with a figwheel sidecar
191 | setup.
192 |
193 | The setup can read the cljs builds from the project file, and can also
194 | support specifying which builds you'd like to initially start via JVM
195 | options (e.g. -Dtest -Ddev will cause it to build the test and dev builds).
196 |
197 | To get this, place the following in `dev/server/user.clj`:
198 |
199 | [source]
200 | ----
201 | (ns user
202 | (:require [figwheel-sidecar.system :as fig]
203 | [com.stuartsierra.component :as component]))
204 |
205 | (def figwheel-config (fig/fetch-config))
206 | (def figwheel (atom nil))
207 |
208 | (defn start-figwheel
209 | "Start Figwheel on the given builds, or defaults to build-ids in `figwheel-config`."
210 | ([]
211 | (let [props (System/getProperties)
212 | all-builds (->> figwheel-config :data :all-builds (mapv :id))]
213 | (start-figwheel (keys (select-keys props all-builds)))))
214 | ([build-ids]
215 | (let [default-build-ids (-> figwheel-config :data :build-ids)
216 | build-ids (if (empty? build-ids) default-build-ids build-ids)
217 | preferred-config (assoc-in figwheel-config [:data :build-ids] build-ids)]
218 | (reset! figwheel (component/system-map
219 | :figwheel-system (fig/figwheel-system preferred-config)
220 | :css-watcher (fig/css-watcher {:watch-paths ["resources/public/css"]})))
221 | (println "STARTING FIGWHEEL ON BUILDS: " build-ids)
222 | (swap! figwheel component/start)
223 | (fig/cljs-repl (:figwheel-system @figwheel)))))
224 | ----
225 |
226 | and you'll also want the following startup script in `script/figwheel.clj`:
227 |
228 | [source]
229 | ----
230 | (require '[user :refer [start-figwheel]])
231 |
232 | (start-figwheel)
233 | ----
234 |
235 | and now you can either start figwheel from the command prompt with:
236 |
237 | [source]
238 | ----
239 | lein run -m clojure.main script/figwheel.clj
240 | ----
241 |
242 | or from Cursive in IntelliJ with a run profile:
243 |
244 | - Local REPL
245 | - Use clojure main in a normal JVM, not an NREPL
246 | - Under Parameters, add: script/figwheel.clj
247 |
248 | Once you've started figwheel you should be able to browse to:
249 |
250 | http://localhost:3449
251 |
252 | and see the UI. Any changes you make to the UI or to the CSS will automatically reload.
253 |
254 | ## Next Steps
255 |
256 | We recommend going through the https://github.com/untangled-web/untangled-devguide[Untangled Developers Guide],
257 | which you should clone and work through on your local machine.
258 |
259 | ## A More Complete Project
260 |
261 | An Untanged template is in progress. A pretty complete version is available at
262 | https://github.com/untangled-web/untangled-template[https://github.com/untangled-web/untangled-template]
263 | and has:
264 |
265 | - Full stack with sample UI for login/sign up.
266 | - Newer version of figwheel (better errors, etc.)
267 | - Bootstrap CSS
268 | - Examples of adding REST routes to the server
269 | - Examples of hooking into the Ring handlers
270 | - Sample tests for the server and client
271 | - Uberjar building
272 | - Deployment to Heroku (or similar environments)
273 | - CI (command-line runnable) testing for UI (via karma) and server
274 | - Devcards
275 |
--------------------------------------------------------------------------------
/dev/clj/user.clj:
--------------------------------------------------------------------------------
1 | (ns clj.user
2 | (:require
3 | [clojure.pprint :refer [pprint]]
4 | [clojure.repl :refer [doc source]]
5 | [clojure.set :as set]
6 | [clojure.spec :as s]
7 | [clojure.spec.gen :as sg]
8 | [clojure.tools.namespace.repl :refer [refresh]]
9 | [figwheel-sidecar.system :as fig]
10 | [com.stuartsierra.component :as component]))
11 |
12 | (def figwheel (atom nil))
13 |
14 | (defn start-figwheel
15 | "Start Figwheel on the given builds, or defaults to build-ids in `figwheel-config`."
16 | ([]
17 | (let [figwheel-config (fig/fetch-config)
18 | props (System/getProperties)
19 | all-builds (->> figwheel-config :data :all-builds (mapv :id))]
20 | (start-figwheel (keys (select-keys props all-builds)))))
21 | ([build-ids]
22 | (let [figwheel-config (fig/fetch-config)
23 | default-build-ids (-> figwheel-config :data :build-ids)
24 | build-ids (if (empty? build-ids) default-build-ids build-ids)
25 | preferred-config (assoc-in figwheel-config [:data :build-ids] build-ids)]
26 | (reset! figwheel (component/system-map
27 | :figwheel-system (fig/figwheel-system preferred-config)
28 | :css-watcher (fig/css-watcher {:watch-paths ["resources/public/css"]})))
29 | (println "STARTING FIGWHEEL ON BUILDS: " build-ids)
30 | (swap! figwheel component/start)
31 | (fig/cljs-repl (:figwheel-system @figwheel)))))
32 |
--------------------------------------------------------------------------------
/dev/cljs/user.clj:
--------------------------------------------------------------------------------
1 | (ns cljs.user
2 | (:require [cljs.tagged-literals :refer [*cljs-data-readers*]]))
3 |
4 | (defn pp [form] `(doto ~form (cljs.pprint/pprint)))
5 | (defn cl [form] `(doto ~form (js/console.log)))
6 |
7 | (alter-var-root #'*cljs-data-readers* assoc 'spy pp 'log cl)
8 |
9 |
--------------------------------------------------------------------------------
/dev/cljs/user.cljs:
--------------------------------------------------------------------------------
1 | (ns ^:figwheel-always cljs.user
2 | (:require
3 | untangled.tests-to-run
4 | [untangled-spec.selectors :as sel]
5 | [untangled-spec.suite :refer [def-test-suite]]))
6 |
7 | (def-test-suite spec-report {:ns-regex #"untangled\..*-spec"}
8 | {:default #{::sel/none :focused}
9 | :available #{:focused}})
10 |
--------------------------------------------------------------------------------
/docs/Overview.md:
--------------------------------------------------------------------------------
1 | # Untangled
2 |
3 | Plans for a slide-based video tour...
4 |
5 | ## Quick Tour (Demo)
6 |
7 | ## The Client
8 |
9 | ### The Database (2 slides)
10 |
11 | - Om standard format (graph database)
12 | - Plain cljs data (maps and vectors)
13 | - Tables are maps keyed by user-defined "object" ID
14 | - Idents used to create links
15 | - Leaves of the tree can be anything (functions should be avoided)
16 | - See online Om Tutorial for more info/exercises
17 |
18 | ### The UI (4 slides)
19 |
20 | - Om standard UI components
21 | - Generates plain React components
22 | - Co-located Queries for data
23 | - Queries compose to root
24 | - Components can have idents, which defines table/ID of data
25 |
26 | ### Mutations (3 slides)
27 |
28 | - Om standard mutations
29 | - All changes to database happen through top-level, abstract, transactions
30 | - Predefined mutate multimethod: simply use `defmethod`
31 | - Optimistic updates and remote interactions under a single abstraction
32 | - Extension for `post-mutate` hook (to trigger common behaviors). Multimethod.
33 |
34 | ### Internationalization (3 slides)
35 |
36 | - GNU gettext-style internationalization support
37 | - `tr` : English string is key
38 | - `trf` : Formatted (plural support, date, time, numerics)
39 | - Formatting based on Yahoo's formatjs
40 | - POT file generated from source code (cljs to js, then standard xgettext)
41 | - Translations edited with standard tools, like PoEdit
42 | - Module support for dynamically loading translations at runtime
43 |
44 | ## The Server (2 slides)
45 |
46 | - Based on Stuart Sierra's component library
47 | - Includes components for: logging, config, static resource handling,
48 | and a web server (currently httpkit)
49 | - Can easily extend/inject your own components
50 |
51 | ### Configuration (1 slide)
52 |
53 | - Configuration via EDN
54 | - Defaults file in project
55 | - Custom-named external file overrides
56 | - Command-line augmentation (e.g. name alt file)
57 |
58 | ### Injectable Server Components (1 slide)
59 |
60 | - Define a component
61 | - Add it to server
62 | - Can automatically inject it in server-side read/mutations
63 | - Can augment Ring handler
64 |
65 | ### Datomic Integration (2 slides)
66 |
67 | - Separate add-on library to create/support Datomic databases
68 | - Migration support
69 | - Seeding support (for testing/development)
70 | - Optional extra schema validation
71 |
72 | ## The Full Stack
73 |
74 | ### Remoting (6 slides)
75 |
76 | - All network plumbing pre-built
77 | - One-at-a-time processing semantics
78 | - Full optimistic update (UI instantly responsive)
79 | - Pluggable network components
80 | - Support for unhappy path (network down, server errors)
81 | - Query attributes namespaced to `ui` are automatically elided
82 | - Complete tempid handling
83 | - Rewritten in state *and* network request queue
84 | - Smart merging:
85 | - Deep merge is the default
86 | - Automatic handling of multi-source merges: A/B ask for different
87 | attributes of the same object...when to stomp vs merge?
88 |
89 | ### Initial Load (1 slide)
90 |
91 | - All loads are explicit
92 | - Initial loads triggered via startup callback
93 | - Queries based on UI or just custom queries
94 | - Post-processing Support
95 | - UI query filtering (e.g. `:without`)
96 |
97 | ### Lazy Loading (4 slides)
98 |
99 | - Lazy loads can be triggered at any time
100 | - Can be field-based if the component has an Ident. Generates the query for you.
101 | - Supports callback post-processing, `:without`, etc.
102 | - Places marker in state at proper location for "spinner" rendering (UI helper)
103 | - Seeing marker requires that you query for `:ui/fetch-state`
104 |
105 | ### Testing (4 slides)
106 |
107 | - Helpers and rendering stacked on clj/cljs test
108 | - Outline-based rendering
109 | - Human readable data diffs and output
110 | - Advanced mocking
111 | - Timeline simulation for testing async behaviors
112 |
113 | #### Protocol Testing (2 slides)
114 |
115 | - Gives end-to-end testing without the integration pain
116 | - Proof of correctness through shared data
117 |
118 | ### Support VCR Viewer (1 slide)
119 |
120 | - Allows an end user to submit a problem report that includes a recording of
121 | their session
122 | - Play forward/backward
123 | - Timestamps of interactions
124 | - Server error recording (with server timestamps)
125 |
126 | ## Dev Tools (2 slides)
127 |
128 | - Click-to-edit components
129 | - Database browser/query tools
130 |
131 |
--------------------------------------------------------------------------------
/docs/internationalization.md:
--------------------------------------------------------------------------------
1 | # Untangled Internationalization
2 |
3 | The internationalization support in Untangled is based on a number of tools to give a fully-functional, bi-directional
4 | localization and internationalization solution that includes:
5 |
6 | - GNU Gettext message support
7 | - Use plain strings in your UI
8 | - The plain strings are extracted
9 | - Standard GNU utilities are used to build translation files
10 | - Translations are complied to cljs dependencies
11 | - Extensions to Gettext support:
12 | - Formatted messages
13 | - Output of localized numbers, dates, currency symbols
14 | - Support for output *and* input of dates, numbers, and currency strings
15 | - E.g. User can type 4.211,44 in one field and 03.11.2011 in another with German as the locale and you can easily
16 | convert that to the javascript number 4211.44 and a Date object with November 3, 2011 in it.
17 | - Yahoo's FormatJS for output.
18 | - Augmented parsing to get the same for input
19 |
20 |
21 | TODO: More docs
22 |
--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "untangled-spec",
3 | "version": "1.0.0",
4 | "description": "Testing",
5 | "main": "index.js",
6 | "directories": { },
7 | "dependencies": {},
8 | "devDependencies": {
9 | "karma": "~1",
10 | "karma-firefox-launcher": "~1",
11 | "karma-chrome-launcher": "~2",
12 | "karma-cljs-test": ">=0.1"
13 | },
14 | "repository": {
15 | "type": "git",
16 | "url": "git@gitlab.buehner-fry.com:navis/untangled.git"
17 | },
18 | "author": "",
19 | "license": "MIT"
20 | }
21 |
--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
1 | (defproject navis/untangled-client "0.8.2-SNAPSHOT"
2 | :description "Client-side code for Untangled Webapps"
3 | :url ""
4 | :license {:name "MIT"
5 | :url "https://opensource.org/licenses/MIT"}
6 |
7 | :dependencies [[com.lucasbradstreet/cljs-uuid-utils "1.0.2"]
8 | [devcards "0.2.2" :exclusions [org.omcljs/om org.omcljs/om org.clojure/core.async] :scope "provided"]
9 | [lein-doo "0.1.7" :scope "test"]
10 | [navis/untangled-spec "1.0.0-alpha3" :scope "test"]
11 | [org.clojure/clojure "1.9.0-alpha14" :scope "provided"]
12 | [org.clojure/clojurescript "1.9.494" :scope "provided"]
13 | [org.clojure/core.async "0.3.442" :exclusions [org.clojure/tools.reader]]
14 | [com.ibm.icu/icu4j "58.2"] ; needed for i18n on server-side rendering
15 | [org.omcljs/om "1.0.0-alpha48" :scope "provided"]
16 | [org.clojure/test.check "0.9.0" :scope "test"]]
17 |
18 | :source-paths ["src" "src-cards"]
19 | :resource-paths ["src" "resources"] ; maven deploy to internal artifactory needs src here
20 |
21 | :jvm-opts ["-XX:-OmitStackTraceInFastThrow" "-Xmx512m" "-Xms256m"]
22 | :clean-targets ^{:protect false} ["resources/private/js" "resources/public/js/cards" "resources/public/js/test" "resources/public/js/compiled" "target"]
23 |
24 | :plugins [[lein-cljsbuild "1.1.5"]
25 | [lein-doo "0.1.7"]
26 | [com.jakemccrary/lein-test-refresh "0.19.0"]]
27 |
28 | :test-paths ["spec"]
29 | :test-refresh {:report untangled-spec.reporters.terminal/untangled-report
30 | :changes-only true
31 | :with-repl true}
32 | :test-selectors {:test/in-progress :test/in-progress
33 | :focused :focused}
34 |
35 | :doo {:build "automated-tests"
36 | :paths {:karma "node_modules/karma/bin/karma"}}
37 |
38 | :figwheel {:open-file-command "fw-open-file"
39 | :server-port 8080}
40 |
41 | :cljsbuild {:builds
42 | [{:id "test"
43 | :source-paths ["src" "dev" "spec"]
44 | :figwheel {:on-jsload "cljs.user/spec-report"}
45 | :compiler {:main cljs.user
46 | :output-to "resources/public/js/test/test.js"
47 | :output-dir "resources/public/js/test/out"
48 | :recompile-dependents true
49 | :preloads [devtools.preload]
50 | :asset-path "js/test/out"
51 | :optimizations :none}}
52 | {:id "cards"
53 | :source-paths ["src" "src-cards"]
54 | :figwheel {:devcards true}
55 | :compiler {:main untangled.client.card-ui
56 | :output-to "resources/public/js/cards/cards.js"
57 | :output-dir "resources/public/js/cards/out"
58 | :asset-path "js/cards/out"
59 | :source-map-timestamp true
60 | :optimizations :none}}
61 | {:id "automated-tests"
62 | :source-paths ["spec" "src"]
63 | :compiler {:output-to "resources/private/js/unit-tests.js"
64 | :main untangled.all-tests
65 | :output-dir "resources/private/js/out"
66 | :asset-path "js/out"
67 | :optimizations :none}}]}
68 |
69 | :profiles {:dev {:source-paths ["dev" "src" "spec"]
70 | :repl-options {:init-ns clj.user
71 | :nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]}
72 | :dependencies [[binaryage/devtools "0.9.2"]
73 | [com.cemerick/piggieback "0.2.1"]
74 | [figwheel-sidecar "0.5.9"]
75 | [org.clojure/test.check "0.9.0"]
76 | [org.clojure/tools.namespace "0.3.0-alpha3"]
77 | [org.clojure/tools.nrepl "0.2.12"]]}})
78 |
--------------------------------------------------------------------------------
/resources/public/cards.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 | Untangled Client Devcards
7 |
8 |
9 |
10 |
11 |
12 |
--------------------------------------------------------------------------------
/resources/public/css/cards.css:
--------------------------------------------------------------------------------
1 | .highlight-element {
2 | background-color: rgba(130, 180, 230, 0.4);
3 | outline: solid 1px #0F4D9A;
4 | box-sizing: border-box;
5 | }
6 |
7 | div.dev-panel-bottom {
8 | position: fixed;
9 | bottom: 0;
10 | left: 0;
11 | right: 0;
12 | }
13 |
14 | body {
15 | padding : 1.5em;
16 | background : #f8f8f8;
17 | font-family : sans-serif;
18 | line-height : 1.5;
19 | }
20 |
21 | .tabbed {
22 | float : left;
23 | width : 100%;
24 | }
25 |
26 | .tabbed > input {
27 | display : none;
28 | }
29 |
30 | .tabbed > section > h1 {
31 | float : left;
32 | box-sizing : border-box;
33 | margin : 0;
34 | padding : 0.5em 0.5em 0;
35 | overflow : hidden;
36 | font-size : 1em;
37 | font-weight : normal;
38 | }
39 |
40 | .tabbed > input:first-child + section > h1 {
41 | padding-left : 1em;
42 | }
43 |
44 | .tabbed > section > h1 > label {
45 | display : block;
46 | padding : 0.25em 0.75em;
47 | border : 1px solid #ddd;
48 | border-bottom : none;
49 | border-top-left-radius : 4px;
50 | border-top-right-radius : 4px;
51 | box-shadow : 0 0 0.5em rgba(0,0,0,0.0625);
52 | background : #fff;
53 | cursor : pointer;
54 | -moz-user-select : none;
55 | -ms-user-select : none;
56 | -webkit-user-select : none;
57 | }
58 |
59 | .tabbed > section > div {
60 | position : relative;
61 | z-index : 1;
62 | float : right;
63 | box-sizing : border-box;
64 | width : 100%;
65 | margin : 2.5em 0 0 -100%;
66 | padding : 0.5em 0.75em;
67 | border : 1px solid #ddd;
68 | border-radius : 4px;
69 | box-shadow : 0 0 0.5em rgba(0,0,0,0.0625);
70 | background : #fff;
71 | }
72 |
73 | .tabbed > input:checked + section > h1 {
74 | position : relative;
75 | z-index : 2;
76 | }
77 |
78 | .tabbed > input:not(:checked) + section > div {
79 | display : none;
80 | }
81 |
--------------------------------------------------------------------------------
/resources/public/css/edn.css:
--------------------------------------------------------------------------------
1 | .rendered-edn .collection {
2 | display: flex;
3 | display: -webkit-flex;
4 | }
5 |
6 | .rendered-edn .keyval {
7 | display: flex;
8 | display: -webkit-flex;
9 | flex-wrap: wrap;
10 | -webkit-flex-wrap: wrap;
11 | }
12 |
13 | .rendered-edn .keyval > .keyword {
14 | color: #a94442;
15 | }
16 |
17 | .rendered-edn .keyval > *:first-child {
18 | margin: 0px 3px;
19 | flex-shrink: 0;
20 | -webkit-flex-shrink: 0;
21 | }
22 |
23 | .rendered-edn .keyval > *:last-child {
24 | margin: 0px 3px;
25 | }
26 |
27 | .rendered-edn .opener {
28 | color: #999;
29 | margin: 0px 4px;
30 | flex-shrink: 0;
31 | -webkit-flex-shrink: 0;
32 | }
33 |
34 | .rendered-edn .closer {
35 | display: flex;
36 | display: -webkit-flex;
37 | flex-direction: column-reverse;
38 | -webkit-flex-direction: column-reverse;
39 | margin: 0px 3px;
40 | color: #999;
41 | }
42 |
43 | .rendered-edn .string {
44 | color: #428bca;
45 | }
46 |
47 | .rendered-edn .string .opener,
48 | .rendered-edn .string .closer {
49 | display: inline;
50 | margin: 0px;
51 | color: #428bca;
52 | }
53 |
--------------------------------------------------------------------------------
/resources/public/css/style.css:
--------------------------------------------------------------------------------
1 | @import url(https://fonts.googleapis.com/css?family=Lato);
2 | @import url(https://fonts.googleapis.com/css?family=Cutive+Mono);
3 | @import url(edn.css);
4 |
5 | .overlay {
6 | background-color: rgb(230, 230, 240);
7 | width: 194px;
8 | }
9 |
10 | .hidden {
11 | display: none;
12 | }
13 |
14 | .test-report {
15 | font-family: 'Lato' sans-serif;
16 | display: block;
17 | font-size: 20pt;
18 | }
19 |
20 | .test-item {
21 | display: block;
22 | font-size: 13pt;
23 | }
24 |
25 | .test-namespace {
26 | margin-top: 20px;
27 | font-weight: 400;
28 | display: block;
29 | font-size: 18pt;
30 | }
31 |
32 | .test-header {
33 | font-weight: 700;
34 | display: block;
35 | font-size: 18pt;
36 | }
37 |
38 | .test-manually {
39 | color: orange;
40 | }
41 |
42 | .filter-controls {
43 | position: fixed;
44 | top: 0px;
45 | right: 0px;
46 | }
47 |
48 | .filter-controls label {
49 | font-size: 10pt;
50 | }
51 |
52 | .filter-controls a {
53 | font-size: 10pt;
54 | padding-left: 5pt;
55 | }
56 |
57 | .selected {
58 | color: green;
59 | text-decoration: underline;
60 | }
61 |
62 | .test-pending {
63 | color: gray;
64 | }
65 |
66 | .test-passed {
67 | color: limegreen;
68 | }
69 |
70 | .test-error {
71 | color: red;
72 | }
73 |
74 | .test-failed {
75 | color: red;
76 | }
77 |
78 | .test-list {
79 | list-style-type: none;
80 | }
81 |
82 | .test-result {
83 | margin: 12px;
84 | font-size: 16px;
85 | }
86 |
87 | .test-result-title {
88 | width: 100px;
89 | font-size: 16px;
90 | }
91 |
92 | .test-count {
93 | margin: 20px 0 20px 20px;
94 | }
95 |
96 | .test-report ul {
97 | padding-left: 10px;
98 | margin-bottom: 10px;
99 | }
100 |
101 | .test-report ul:empty {
102 | display: none;
103 | }
104 |
105 | .test-report h2 {
106 | font-size: 24px;
107 | margin-bottom: 15px;
108 | }
109 |
110 | #test-app {
111 | display: none;
112 | }
113 |
--------------------------------------------------------------------------------
/resources/public/css/viewer.css:
--------------------------------------------------------------------------------
1 | .bottom {
2 | position: fixed;
3 | bottom: 0px;
4 | }
5 |
6 | .top {
7 | position: fixed;
8 | top: 0px;
9 | }
10 |
11 | .reposition {
12 | float: right;
13 | }
14 |
15 | div.vcr-controls {
16 | left: 0px;
17 | height: 50pt;
18 | width: 100%;
19 | opacity: 0.95;
20 | background-color: #f7f7f7;
21 | color: black;
22 | text-align: center;
23 | }
24 |
25 | .vcr-controls .container {
26 | padding-top: 1em;
27 | max-width: 30em;
28 | text-align: center;
29 | }
30 |
31 | .current-position {
32 | padding: 14pt;
33 | }
34 |
35 | .status-area {
36 | width: 22em;
37 | }
38 | div.status {
39 | width: 400px;
40 | position: relative;
41 | display: inline;
42 | text-align: center;
43 | }
44 |
--------------------------------------------------------------------------------
/resources/public/test.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 | Loading "js/test/test.js", if you need to name that something else (conflicts?) make your own test html file
15 |
16 |
17 |
18 |
--------------------------------------------------------------------------------
/script/figwheel.clj:
--------------------------------------------------------------------------------
1 | (require '[clj.user :refer [start-figwheel]])
2 |
3 | (start-figwheel)
4 |
--------------------------------------------------------------------------------
/spec/untangled/all_tests.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.all-tests
2 | (:require untangled.tests-to-run [doo.runner :refer-macros [doo-all-tests]]))
3 |
4 | (doo-all-tests #".*-spec")
5 |
--------------------------------------------------------------------------------
/spec/untangled/client/core_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.core-spec
2 | (:require
3 | [om.next :as om :refer [defui]]
4 | [untangled.client.core :as uc]
5 | [untangled-spec.core :refer-macros
6 | [specification behavior assertions provided component when-mocking]]
7 | [om.next.protocols :as omp]
8 | [cljs.core.async :as async]
9 | [untangled.client.logging :as log]
10 | [untangled.dom :as udom]
11 | [untangled.client.impl.om-plumbing :as plumbing]
12 | [untangled.client.impl.util :as util]))
13 |
14 | (defui Child
15 | static om/Ident
16 | (ident [this props] [:child/by-id (:id props)])
17 | static om/IQuery
18 | (query [this] [:id :label]))
19 |
20 | (defui Parent
21 | static uc/InitialAppState
22 | (uc/initial-state [this params] {:ui/checked true})
23 | static om/Ident
24 | (ident [this props] [:parent/by-id (:id props)])
25 | static om/IQuery
26 | (query [this] [:ui/checked :id :title {:child (om/get-query Child)}]))
27 |
28 | (specification "merge-state!"
29 | (assertions
30 | "merge-query is the component query joined on it's ident"
31 | (#'uc/component-merge-query Parent {:id 42}) => [{[:parent/by-id 42] [:ui/checked :id :title {:child (om/get-query Child)}]}])
32 | (component "preprocessing the object to merge"
33 | (let [no-state (atom {:parent/by-id {}})
34 | no-state-merge-data (:merge-data (#'uc/preprocess-merge no-state Parent {:id 42}))
35 | state-with-old (atom {:parent/by-id {42 {:ui/checked true :id 42 :title "Hello"}}})
36 | id [:parent/by-id 42]
37 | old-state-merge-data (-> (#'uc/preprocess-merge state-with-old Parent {:id 42}) :merge-data :untangled/merge)]
38 | (assertions
39 | "Uses the existing object in app state as base for merge when present"
40 | (get-in old-state-merge-data [id :ui/checked]) => true
41 | "Marks fields that were queried but are not present as plumbing/not-found"
42 | old-state-merge-data => {[:parent/by-id 42] {:id 42
43 | :ui/checked true
44 | :title :untangled.client.impl.om-plumbing/not-found
45 | :child :untangled.client.impl.om-plumbing/not-found}}))
46 | (let [union-query {:union-a [:b] :union-b [:c]}
47 | state (atom {})]
48 | (when-mocking
49 | (uc/get-class-ident c d) => :ident
50 | (om/get-query comp) => union-query
51 | (uc/component-merge-query comp data) => :merge-query
52 | (om/db->tree q d r) => {:ident :data}
53 | (plumbing/mark-missing d q) => (do
54 | (assertions
55 | "wraps union queries in a vector"
56 | q => [union-query])
57 |
58 | {:ident :data})
59 | (util/deep-merge d1 d2) => :merge-result
60 |
61 | (#'uc/preprocess-merge state :comp :data))))
62 | (let [state (atom {})
63 | data {}]
64 | (when-mocking
65 | (uc/preprocess-merge s c d) => {:merge-data :the-data :merge-query :the-query}
66 | (uc/integrate-ident! s i op args op args) => :ignore
67 | (uc/get-class-ident c p) => [:table :id]
68 | (om/merge! r d q) => :ignore
69 | (om/app-state r) => state
70 | (omp/queue! r kw) => (assertions
71 | "schedules re-rendering of all affected paths"
72 | kw => [:children :items])
73 |
74 | (uc/merge-state! :reconciler :component data :append [:children] :replace [:items 0]))))
75 |
76 | (specification "integrate-ident!"
77 | (let [state (atom {:a {:path [[:table 2]]}
78 | :b {:path [[:table 2]]}
79 | :d [:table 6]
80 | :many {:path [[:table 99] [:table 88] [:table 77]]}})]
81 | (behavior "Can append to an existing vector"
82 | (uc/integrate-ident! state [:table 3] :append [:a :path])
83 | (assertions
84 | (get-in @state [:a :path]) => [[:table 2] [:table 3]])
85 | (uc/integrate-ident! state [:table 3] :append [:a :path])
86 | (assertions
87 | "(is a no-op if the ident is already there)"
88 | (get-in @state [:a :path]) => [[:table 2] [:table 3]]))
89 | (behavior "Can prepend to an existing vector"
90 | (uc/integrate-ident! state [:table 3] :prepend [:b :path])
91 | (assertions
92 | (get-in @state [:b :path]) => [[:table 3] [:table 2]])
93 | (uc/integrate-ident! state [:table 3] :prepend [:b :path])
94 | (assertions
95 | "(is a no-op if already there)"
96 | (get-in @state [:b :path]) => [[:table 3] [:table 2]]))
97 | (behavior "Can create/replace a to-one ident"
98 | (uc/integrate-ident! state [:table 3] :replace [:c :path])
99 | (uc/integrate-ident! state [:table 3] :replace [:d])
100 | (assertions
101 | (get-in @state [:d]) => [:table 3]
102 | (get-in @state [:c :path]) => [:table 3]
103 | ))
104 | (behavior "Can replace an existing to-many element in a vector"
105 | (uc/integrate-ident! state [:table 3] :replace [:many :path 1])
106 | (assertions
107 | (get-in @state [:many :path]) => [[:table 99] [:table 3] [:table 77]]))))
108 |
109 | (specification "integrate-ident"
110 | (let [state {:a {:path [[:table 2]]}
111 | :b {:path [[:table 2]]}
112 | :d [:table 6]
113 | :many {:path [[:table 99] [:table 88] [:table 77]]}}]
114 | (assertions
115 | "Can append to an existing vector"
116 | (-> state
117 | (uc/integrate-ident [:table 3] :append [:a :path])
118 | (get-in [:a :path]))
119 | => [[:table 2] [:table 3]]
120 |
121 | "(is a no-op if the ident is already there)"
122 | (-> state
123 | (uc/integrate-ident [:table 3] :append [:a :path])
124 | (get-in [:a :path]))
125 | => [[:table 2] [:table 3]]
126 |
127 | "Can prepend to an existing vector"
128 | (-> state
129 | (uc/integrate-ident [:table 3] :prepend [:b :path])
130 | (get-in [:b :path]))
131 | => [[:table 3] [:table 2]]
132 |
133 | "(is a no-op if already there)"
134 | (-> state
135 | (uc/integrate-ident [:table 3] :prepend [:b :path])
136 | (get-in [:b :path]))
137 | => [[:table 3] [:table 2]]
138 |
139 | "Can create/replace a to-one ident"
140 | (-> state
141 | (uc/integrate-ident [:table 3] :replace [:d])
142 | (get-in [:d]))
143 | => [:table 3]
144 | (-> state
145 | (uc/integrate-ident [:table 3] :replace [:c :path])
146 | (get-in [:c :path]))
147 | => [:table 3]
148 |
149 | "Can replace an existing to-many element in a vector"
150 | (-> state
151 | (uc/integrate-ident [:table 3] :replace [:many :path 1])
152 | (get-in [:many :path]))
153 | => [[:table 99] [:table 3] [:table 77]])))
154 |
155 | (specification "Untangled Application -- clear-pending-remote-requests!"
156 | (let [channel (async/chan 1000)
157 | mock-app (uc/map->Application {:send-queues {:remote channel}})]
158 | (async/put! channel 1 #(async/put! channel 2 (fn [] (async/put! channel 3 (fn [] (async/put! channel 4))))))
159 |
160 | (uc/clear-pending-remote-requests! mock-app nil)
161 |
162 | (assertions
163 | "Removes any pending items in the network queue channel"
164 | (async/poll! channel) => nil)))
165 |
166 | (defui BadResetAppRoot
167 | Object
168 | (render [this] nil))
169 |
170 | (defui ResetAppRoot
171 | static uc/InitialAppState
172 | (initial-state [this params] {:x 1}))
173 |
174 | (specification "Untangled Application -- reset-app!"
175 | (let [scb-calls (atom 0)
176 | custom-calls (atom 0)
177 | mock-app (uc/map->Application {:send-queues {:remote :fake-queue}
178 | :started-callback (fn [] (swap! scb-calls inc))})
179 | cleared-network? (atom false)
180 | merged-unions? (atom false)
181 | history-reset? (atom false)
182 | re-rendered? (atom false)
183 | state (atom {})]
184 | (behavior "Logs an error if the supplied component does not implement InitialAppState"
185 | (when-mocking
186 | (log/error e) => (assertions
187 | e => "The specified root component does not implement InitialAppState!")
188 | (uc/reset-app! mock-app BadResetAppRoot nil)))
189 |
190 | (behavior "On a proper app root"
191 | (when-mocking
192 | (uc/clear-queue t) => (reset! cleared-network? true)
193 | (om/app-state r) => state
194 | (uc/merge-alternate-union-elements! app r) => (reset! merged-unions? true)
195 | (uc/reset-history-impl a) => (reset! history-reset? true)
196 | (udom/force-render a) => (reset! re-rendered? true)
197 |
198 | (uc/reset-app! mock-app ResetAppRoot nil)
199 | (uc/reset-app! mock-app ResetAppRoot :original)
200 | (uc/reset-app! mock-app ResetAppRoot (fn [a] (swap! custom-calls inc))))
201 |
202 | (assertions
203 | "Clears the network queue"
204 | @cleared-network? => true
205 | "Resets Om's app history"
206 | @history-reset? => true
207 | "Sets the base state from component"
208 | @state => {:x 1 :om.next/tables #{}}
209 | "Attempts to merge alternate union branches into state"
210 | @merged-unions? => true
211 | "Re-renders the app"
212 | @re-rendered? => true
213 | "Calls the original started-callback when callback is :original"
214 | @scb-calls => 1
215 | "Calls the supplied started-callback when callback is a function"
216 | @custom-calls => 1))))
217 |
218 | (specification "Mounting an Untangled Application"
219 | (let [mounted-mock-app {:mounted? true :initial-state {}}]
220 | (provided "When it is already mounted"
221 | (uc/refresh* a) =1x=> (do
222 | (assertions
223 | "Refreshes the UI"
224 | 1 => 1)
225 | a)
226 |
227 | (uc/mount* mounted-mock-app :fake-root :dom-id)))
228 | (behavior "When is is not already mounted"
229 | (behavior "and root does NOT implement InitialAppState"
230 | (let [mock-app {:mounted? false :initial-state {:a 1} :reconciler-options :OPTIONS}]
231 | (when-mocking
232 | (uc/initialize app state root dom opts) => (do
233 | (assertions
234 | "Initializes the app with a plain map"
235 | state => {:a 1}
236 | ))
237 |
238 | (uc/mount* mock-app :fake-root :dom-id)))
239 | (let [supplied-atom (atom {:a 1})
240 | mock-app {:mounted? false :initial-state supplied-atom :reconciler-options :OPTIONS}]
241 | (when-mocking
242 | (uc/initialize app state root dom opts) => (do
243 | (assertions
244 | "Initializes the app with a supplied atom"
245 | {:a 1} => @state))
246 |
247 | (uc/mount* mock-app :fake-root :dom-id))))
248 | (behavior "and root IMPLEMENTS InitialAppState"
249 | (let [mock-app {:mounted? false :initial-state {:a 1} :reconciler-options :OPTIONS}]
250 | (when-mocking
251 | (log/warn msg) =1x=> (do (assertions "warns about duplicate initialization"
252 | msg =fn=> (partial re-matches #"^You supplied.*")))
253 | (uc/initialize app state root dom opts) => (do
254 | (assertions
255 | "Initializes the app with the InitialAppState"
256 | state => (uc/get-initial-state Parent nil)))
257 |
258 | (uc/mount* mock-app Parent :dom-id)))
259 | (let [mock-app {:mounted? false :initial-state (atom {:a 1}) :reconciler-options :OPTIONS}]
260 | (behavior "When both atom and InitialAppState are present:"
261 | (when-mocking
262 | (log/warn msg) =1x=> true
263 | (om/tree->db c d merge-idents) => (do
264 | (behavior "Normalizes InitialAppState:"
265 | (assertions
266 | "includes Om tables"
267 | merge-idents => true
268 | "uses the Root UI component query"
269 | c => Parent
270 | "uses InitialAppState as the data"
271 | d => (uc/initial-state Parent nil)))
272 | :NORMALIZED-STATE)
273 | (uc/initialize app state root dom opts) => (do
274 | (assertions
275 | "Overwrites the supplied atom with the normalized InitialAppState"
276 | @state => :NORMALIZED-STATE))
277 |
278 | (uc/mount* mock-app Parent :dom-id))))
279 | (let [mock-app {:mounted? false :reconciler-options :OPTIONS}]
280 | (behavior "When only InitialAppState is present:"
281 | (when-mocking
282 | (untangled.client.core/initial-state root-component nil) => :INITIAL-UI-STATE
283 | (uc/initialize app state root dom opts) => (do
284 | (assertions
285 | "Supplies the raw InitialAppState to internal initialize"
286 | state => :INITIAL-UI-STATE))
287 |
288 | (uc/mount* mock-app Parent :dom-id)))))))
289 |
290 |
291 | (defui MergeX
292 | static uc/InitialAppState
293 | (initial-state [this params] {:n :x})
294 | static om/IQuery
295 | (query [this] [:n]))
296 |
297 | (defui MergeY
298 | static uc/InitialAppState
299 | (initial-state [this params] {:n :y})
300 | static om/IQuery
301 | (query [this] [:n]))
302 |
303 |
304 | (defui MergeA
305 | static uc/InitialAppState
306 | (initial-state [this params] {:n :a})
307 | static om/IQuery
308 | (query [this] [:n]))
309 |
310 | (defui MergeB
311 | static uc/InitialAppState
312 | (initial-state [this params] {:n :b})
313 | static om/IQuery
314 | (query [this] [:n]))
315 |
316 | (defui MergeUnion
317 | static uc/InitialAppState
318 | (initial-state [this params] (uc/initial-state MergeA {}))
319 | static om/IQuery
320 | (query [this] {:a (om/get-query MergeA) :b (om/get-query MergeB)}))
321 |
322 | (defui MergeRoot
323 | static uc/InitialAppState
324 | (initial-state [this params] {:a 1 :b (uc/initial-state MergeUnion {})})
325 | static om/IQuery
326 | (query [this] [:a {:b (om/get-query MergeUnion)}]))
327 |
328 | ;; Nested routing tree
329 | ;; NestedRoot
330 | ;; |
331 | ;; U1
332 | ;; / B A = MergeRoot B = MergeB
333 | ;; R2
334 | ;; U2 A2
335 | ;; X Y
336 |
337 | (defui U2
338 | static uc/InitialAppState
339 | (initial-state [this params] (uc/initial-state MergeX {}))
340 | static om/IQuery
341 | (query [this] {:x (om/get-query MergeX) :y (om/get-query MergeY)}))
342 |
343 | (defui R2
344 | static uc/InitialAppState
345 | (initial-state [this params] {:id 1 :u2 (uc/initial-state U2 {})})
346 | static om/IQuery
347 | (query [this] [:id {:u2 (om/get-query U2)}]))
348 |
349 | (defui U1
350 | static uc/InitialAppState
351 | (initial-state [this params] (uc/initial-state MergeB {}))
352 | static om/IQuery
353 | (query [this] {:r2 (om/get-query R2) :b (om/get-query MergeB)}))
354 |
355 | (defui NestedRoot
356 | static uc/InitialAppState
357 | (initial-state [this params] {:u1 (uc/initial-state U1 {})})
358 | static om/IQuery
359 | (query [this] [{:u1 (om/get-query U1)}]))
360 |
361 | ;; Sibling routing tree
362 | ;; SiblingRoot
363 | ;; | \
364 | ;; SU1 SU2
365 | ;; A B X Y
366 |
367 | (defui SU1
368 | static uc/InitialAppState
369 | (initial-state [this params] (uc/initial-state MergeB {}))
370 | static om/IQuery
371 | (query [this] {:a (om/get-query MergeA) :b (om/get-query MergeB)}))
372 |
373 | (defui SU2
374 | static uc/InitialAppState
375 | (initial-state [this params] (uc/initial-state MergeX {}))
376 | static om/IQuery
377 | (query [this] {:x (om/get-query MergeX) :y (om/get-query MergeY)}))
378 |
379 |
380 | (defui SiblingRoot
381 | static uc/InitialAppState
382 | (initial-state [this params] {:su1 (uc/initial-state SU1 {}) :su2 (uc/initial-state SU2 {})})
383 | static om/IQuery
384 | (query [this] [{:su1 (om/get-query SU1)} {:su2 (om/get-query SU2)}]))
385 |
386 |
387 | (specification "merge-alternate-union-elements!"
388 | (behavior "For applications with sibling unions"
389 | (when-mocking
390 | (uc/merge-state! app comp state) =1x=> (do
391 | (assertions
392 | "Merges level one elements"
393 | state => (uc/initial-state MergeA {})))
394 | (uc/merge-state! app comp state) =1x=> (do
395 | (assertions
396 | "Merges only the state of branches that are not already initialized"
397 | state => (uc/initial-state MergeY {})))
398 |
399 | (uc/merge-alternate-union-elements! :app SiblingRoot)))
400 |
401 | (behavior "For applications with nested unions"
402 | (when-mocking
403 | (uc/merge-state! app comp state) =1x=> (do
404 | (assertions
405 | "Merges level one elements"
406 | state => (uc/initial-state R2 {})))
407 | (uc/merge-state! app comp state) =1x=> (do
408 | (assertions
409 | "Merges only the state of branches that are not already initialized"
410 | state => (uc/initial-state MergeY {})))
411 |
412 | (uc/merge-alternate-union-elements! :app NestedRoot)))
413 | (behavior "For applications with non-nested unions"
414 | (when-mocking
415 | (uc/merge-state! app comp state) => (do
416 | (assertions
417 | "Merges only the state of branches that are not already initialized"
418 | state => (uc/initial-state MergeB {})))
419 |
420 | (uc/merge-alternate-union-elements! :app MergeRoot))))
421 |
422 |
--------------------------------------------------------------------------------
/spec/untangled/client/impl/built_in_mutations_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.built-in-mutations-spec
2 | (:require [om.next :as om]
3 | [untangled.client.mutations :as m]
4 | [untangled.client.impl.built-in-mutations]
5 | [untangled.client.impl.om-plumbing :as plumb]
6 | [untangled.i18n.core :as i18n]
7 | [untangled.client.logging :as log]
8 | [untangled.client.impl.data-fetch :as df])
9 | (:require-macros
10 | [cljs.test :refer [is]]
11 | [untangled-spec.core :refer [specification assertions behavior provided component when-mocking]]))
12 |
13 |
14 | (specification "Mutation Helpers"
15 | (let [state (atom {:foo "bar"
16 | :baz {:a {:b "c"}
17 | :1 {:2 3
18 | :4 false}}})]
19 |
20 | (component "set-value!"
21 | (behavior "can set a raw value"
22 | (when-mocking
23 | (om/transact! _ tx) => (let [tx-key (ffirst tx)
24 | params (second (first tx))]
25 | ((:action (m/mutate {:state state :ref [:baz :1]} tx-key params))))
26 |
27 | (let [get-data #(-> @state :baz :1 :2)]
28 | (is (= 3 (get-data)))
29 | (m/set-value! '[:baz :1] :2 4)
30 | (is (= 4 (get-data)))))))
31 |
32 | (component "set-string!"
33 | (when-mocking
34 | (m/set-value! _ field value) => (assertions
35 | field => :b
36 | value => "d")
37 | (behavior "can set a raw string"
38 | (m/set-string! '[:baz :a] :b :value "d"))
39 | (behavior "can set a string derived from an event"
40 | (m/set-string! '[:baz :a] :b :event #js {:target #js {:value "d"}}))))
41 |
42 | (component "set-integer!"
43 | (when-mocking
44 | (m/set-value! _ field value) => (assertions
45 | field => :2
46 | value => 6)
47 |
48 | (behavior "can set a raw integer"
49 | (m/set-integer! '[:baz 1] :2 :value 6))
50 | (behavior "coerces strings to integers"
51 | (m/set-integer! '[:baz 1] :2 :value "6"))
52 | (behavior "can set an integer derived from an event target value"
53 | (m/set-integer! '[:baz 1] :2 :event #js {:target #js {:value "6"}})))
54 |
55 | (when-mocking
56 | (m/set-value! _ field value) => (assertions
57 | field => :2
58 | value => 0)
59 |
60 | (behavior "coerces invalid strings to 0"
61 | (m/set-integer! '[:baz 1] :2 :value "as"))))
62 |
63 | (component "toggle!"
64 | (when-mocking
65 | (om/transact! _ tx) => (let [tx-key (ffirst tx)
66 | params (second (first tx))]
67 | ((:action (m/mutate {:state state :ref [:baz :1]} tx-key params))))
68 |
69 | (behavior "can toggle a boolean value"
70 | (m/toggle! '[:baz :1] :4)
71 | (is (get-in @state [:baz :1 :4]))
72 | (m/toggle! '[:baz :1] :4)
73 | (is (not (get-in @state [:baz :1 :4]))))))))
74 |
75 | (specification "Mutations via transact"
76 | (let [state {}
77 | parser (partial (om/parser {:read plumb/read-local :mutate m/mutate}))
78 | reconciler (om/reconciler {:state state
79 | :parser parser})]
80 |
81 | (behavior "can change the current localization."
82 | (reset! i18n/*current-locale* "en-US")
83 | (om/transact! reconciler `[(ui/change-locale {:lang "es-MX"}) :ui/locale])
84 | (is (= "es-MX" @i18n/*current-locale*)))
85 |
86 | (behavior "reports an error if an undefined multi-method is called."
87 | (when-mocking
88 | (log/error msg) => (is (re-find #"Unknown app state mutation." msg))
89 | (om/transact! reconciler `[(not-a-real-transaction!)])))))
90 |
91 | (specification "Fallback mutations"
92 | (try
93 | (let [called (atom false)
94 | parser (om/parser {:read (fn [e k p] nil) :mutate m/mutate})]
95 | (defmethod m/mutate 'my-undo [e k p]
96 | (do
97 | (assertions
98 | "do not pass :action or :execute key to mutation parameters"
99 | (contains? p :action) => false
100 | (contains? p :execute) => false)
101 | {:action #(reset! called true)}))
102 |
103 | (behavior "are included in remote query if execute parameter is missing/false"
104 | (is (= '[(tx/fallback {:action my-undo})] (parser {} '[(tx/fallback {:action my-undo})] :remote)))
105 | (is (not @called)))
106 | (behavior "delegate to their action if the execute parameter is true"
107 | (parser {} '[(tx/fallback {:action my-undo :execute true})])
108 | (is @called)))
109 |
110 | (finally
111 | (-remove-method m/mutate 'my-undo))))
112 |
113 | (specification "Load triggering mutation"
114 | (provided "triggers a mark-ready on the application state"
115 | (df/mark-ready args) => :marked
116 |
117 | (let [result (m/mutate {} 'untangled/load {})]
118 | ((:action result))
119 |
120 | (assertions
121 | "is remote"
122 | (:remote result) => true))))
123 |
--------------------------------------------------------------------------------
/spec/untangled/client/impl/network_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.network-spec
2 | (:require
3 | [untangled.client.impl.network :as net]
4 | [goog.events :as events]
5 | [untangled-spec.core :refer-macros [specification behavior assertions provided component when-mocking]]))
6 |
7 | (specification "Networking"
8 | (component "Construction of networking"
9 | (let [url "/some-api"
10 | atom? (fn [a] (= (type a) Atom))
11 | n (net/make-untangled-network url :request-transform :transform :global-error-callback (fn [status body] status))]
12 | (assertions
13 | "sets the URL"
14 | (:url n) => url
15 | "records the request transform"
16 | (:request-transform n) => :transform
17 | "records the global error callback"
18 | (@(:global-error-callback n) 200 "Body") => 200)))
19 |
20 | (behavior "Send"
21 | (let [body-sent (atom nil)
22 | headers-sent (atom nil)
23 | network (net/make-untangled-network "/api")
24 | fake-xhrio (js-obj "send" (fn [url typ body headers]
25 | (reset! body-sent body)
26 | (reset! headers-sent headers)))]
27 |
28 | (when-mocking
29 | (net/make-xhrio) => fake-xhrio
30 | (events/listen _ _ _) => nil
31 |
32 | (net/send network {:original 1} nil nil))
33 |
34 | (assertions
35 | "Sends the original body if no transform is present"
36 | (js->clj @body-sent) => "[\"^ \",\"~:original\",1]"
37 | "Uses content-type for transit by default"
38 | (js->clj @headers-sent) => {"Content-Type" "application/transit+json"}))
39 |
40 | (let [body-sent (atom nil)
41 | headers-sent (atom nil)
42 | network (net/make-untangled-network "/api" :request-transform (fn [{:keys [request headers]}]
43 | {:body {:new 2}
44 | :headers {:other 3}}))
45 | fake-xhrio (js-obj "send" (fn [url typ body headers]
46 | (reset! body-sent body)
47 | (reset! headers-sent headers)))]
48 |
49 | (when-mocking
50 | (net/make-xhrio) => fake-xhrio
51 | (events/listen _ _ _) => nil
52 |
53 | (net/send network {:original 1} nil nil))
54 |
55 | (assertions
56 | "Request transform can replace body"
57 | (js->clj @body-sent) => "[\"^ \",\"~:new\",2]"
58 | "Request transform can replace headers"
59 | (js->clj @headers-sent) => {"other" 3}))))
60 |
--------------------------------------------------------------------------------
/spec/untangled/client/impl/om_plumbing_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.om-plumbing-spec
2 | (:require
3 | [om.next :as om]
4 | [untangled.client.impl.om-plumbing :as impl]
5 | [untangled.i18n.core :as i18n]
6 | [cljs.core.async :as async]
7 | [untangled-spec.core :refer-macros [specification behavior assertions provided component when-mocking]]
8 | [cljs.test :refer-macros [is are]]))
9 |
10 | (specification "Local read can"
11 | (let [state (atom {:top-level :top-level-value
12 | :union-join [:panel :a]
13 | :union-join-2 [:dashboard :b]
14 | :join {:sub-key-1 [:item/by-id 1]
15 | :sub-key-2 :sub-value-2}
16 | :item/by-id {1 {:survey/title "Howdy!" :survey/description "More stuff"}}
17 | :settings {:tags nil}
18 | :dashboard {:b {:x 2 :y 1 :z [:dashboard :c]}
19 | :c {:x 3 :y 7 :z [[:dashboard :d]]}
20 | :d {:x 5 :y 10}}
21 | :panel {:a {:x 1 :n 4}}})
22 | parser (partial (om/parser {:read impl/read-local}) {:state state})]
23 |
24 | (reset! i18n/*current-locale* "en-US")
25 |
26 | (assertions
27 | "read top-level properties"
28 | (parser [:top-level]) => {:top-level :top-level-value}
29 |
30 | "read nested queries"
31 | (parser [{:join [:sub-key-2]}]) => {:join {:sub-key-2 :sub-value-2}}
32 |
33 | "read union queries"
34 | (parser [{:union-join {:panel [:x :n] :dashboard [:x :y]}}]) => {:union-join {:x 1 :n 4}}
35 | (parser [{:union-join-2 {:panel [:x :n] :dashboard [:x :y]}}]) => {:union-join-2 {:x 2 :y 1}}
36 | (parser [{[:panel :a] {:panel [:x :n] :dashboard [:x :y]}}]) => {[:panel :a] {:x 1 :n 4}}
37 |
38 | "read queries with references"
39 | (parser [{:join [{:sub-key-1 [:survey/title :survey/description]}]}]) =>
40 | {:join {:sub-key-1 {:survey/title "Howdy!" :survey/description "More stuff"}}}
41 |
42 | "read with pathopt turned on"
43 | (parser [{[:item/by-id 1] [:survey/title]}])
44 | => {[:item/by-id 1] {:survey/title "Howdy!"}}
45 |
46 | "read with recursion"
47 | (parser [{:dashboard [{:b [:x :y {:z '...}]}]}]) => {:dashboard {:b {:x 2 :y 1 :z {:x 3 :y 7 :z [{:x 5 :y 10}]}}}}
48 |
49 | "read recursion nested in a union query"
50 | (parser [{:union-join-2 {:panel [:x :n] :dashboard [:x :y {:z '...}]}}]) =>
51 | {:union-join-2 {:x 2 :y 1 :z {:x 3 :y 7 :z [{:x 5 :y 10}]}}})
52 |
53 | (let [state {:curr-view [:main :view]
54 | :main {:view {:curr-item [[:sub-item/by-id 2]]}}
55 | :sub-item/by-id {2 {:foo :baz :sub-items [[:sub-item/by-id 4]]}
56 | 4 {:foo :bar}}}
57 | parser (partial (om/parser {:read impl/read-local}) {:state (atom state)})]
58 |
59 | (assertions
60 | "read recursion nested in a join underneath a union"
61 | (parser '[{:curr-view {:settings [*] :main [{:curr-item [:foo {:sub-items ...}]}]}}]) =>
62 | {:curr-view {:curr-item [{:foo :baz :sub-items [{:foo :bar}]}]}}))))
63 |
64 | (specification "remove-loads-and-fallbacks"
65 | (behavior "Removes top-level mutations that use the untangled/load or tx/fallback symbols"
66 | (are [q q2] (= (impl/remove-loads-and-fallbacks q) q2)
67 | '[:a {:j [:a]} (f) (untangled/load {:x 1}) (app/l) (tx/fallback {:a 3})] '[:a {:j [:a]} (f) (app/l)]
68 | '[(untangled/load {:x 1}) (app/l) (tx/fallback {:a 3})] '[(app/l)]
69 | '[(untangled/load {:x 1}) (tx/fallback {:a 3})] '[]
70 | '[:a {:j [:a]}] '[:a {:j [:a]}])))
71 |
72 | (specification "fallback-query"
73 | (behavior "extracts the fallback expressions of a query, adds execute flags, and includes errors in params"
74 | (are [q q2] (= (impl/fallback-query q {:error 42}) q2)
75 | '[:a :b] nil
76 |
77 | '[:a {:j [:a]} (f) (untangled/load {:x 1}) (app/l) (tx/fallback {:a 3})]
78 | '[(tx/fallback {:a 3 :execute true :error {:error 42}})]
79 |
80 | '[:a {:j [:a]} (tx/fallback {:b 4}) (f) (untangled/load {:x 1}) (app/l) (tx/fallback {:a 3})]
81 | '[(tx/fallback {:b 4 :execute true :error {:error 42}}) (tx/fallback {:a 3 :execute true :error {:error 42}})])))
82 |
83 | (specification "tempid handling"
84 | (behavior "rewrites all tempids used in pending requests in the request queue"
85 | (let [queue (async/chan 10000)
86 | tid1 (om/tempid)
87 | tid2 (om/tempid)
88 | tid3 (om/tempid)
89 | rid1 4
90 | rid2 2
91 | rid3 42
92 | tid->rid {tid1 rid1
93 | tid2 rid2
94 | tid3 rid3}
95 | q (fn [id] {:query `[(app/thing {:id ~id})]})
96 | expected-result [(q rid1) (q rid2) (q rid3)]
97 | results (atom [])]
98 |
99 | (async/offer! queue (q tid1))
100 | (async/offer! queue (q tid2))
101 | (async/offer! queue (q tid3))
102 |
103 | (impl/rewrite-tempids-in-request-queue queue tid->rid)
104 |
105 | (swap! results conj (async/poll! queue))
106 | (swap! results conj (async/poll! queue))
107 | (swap! results conj (async/poll! queue))
108 |
109 | (is (nil? (async/poll! queue)))
110 | (is (= expected-result @results))))
111 |
112 | (let [tid (om/tempid)
113 | tid2 (om/tempid)
114 | rid 1
115 | state {:thing {tid {:id tid}
116 | tid2 {:id tid2}} ; this one isn't in the remap, and should not be touched
117 | :things [[:thing tid]]}
118 | expected-state {:thing {rid {:id rid}
119 | tid2 {:id tid2}}
120 | :things [[:thing rid]]}
121 | reconciler (om/reconciler {:state state :parser {:read (constantly nil)} :migrate impl/resolve-tempids})]
122 |
123 | (assertions
124 | "rewrites all tempids in the app state (leaving unmapped ones alone)"
125 | ((-> reconciler :config :migrate) @reconciler {tid rid}) => expected-state)))
126 |
127 | (specification "strip-ui"
128 | (let [q1 [:username :password :ui/login-dropdown-showing {:forgot-password [:email :ui/forgot-button-showing]}]
129 | q2 [:username :password :ui.login/dropdown-showing {:forgot-password [:email :ui.forgot/button-showing]}]
130 | result [:username :password {:forgot-password [:email]}]]
131 |
132 | (assertions
133 | "removes keywords with a ui namespace"
134 | (impl/strip-ui q1) => result
135 | "removes keywords with a ui.{something} namespace"
136 | (impl/strip-ui q2) => result))
137 |
138 | (let [query '[(app/x {:ui/boo 23})]]
139 | (assertions
140 | "does not remove ui prefixed data from parameters"
141 | (impl/strip-ui query) => query)))
142 |
143 | (specification "mark-missing"
144 | (behavior "correctly marks missing properties"
145 | (are [query ?missing-result exp]
146 | (= exp (impl/mark-missing ?missing-result query))
147 | [:a :b]
148 | {:a 1}
149 | {:a 1 :b impl/nf}))
150 |
151 | (behavior "joins -> one"
152 | (are [query ?missing-result exp]
153 | (= exp (impl/mark-missing ?missing-result query))
154 | [:a {:b [:c]}]
155 | {:a 1}
156 | {:a 1 :b impl/nf}
157 |
158 | [{:b [:c]}]
159 | {:b {}}
160 | {:b {:c impl/nf}}
161 |
162 | [{:b [:c]}]
163 | {:b {:c 0}}
164 | {:b {:c 0}}
165 |
166 | [{:b [:c :d]}]
167 | {:b {:c 1}}
168 | {:b {:c 1 :d impl/nf}}))
169 |
170 | (behavior "join -> many"
171 | (are [query ?missing-result exp]
172 | (= exp (impl/mark-missing ?missing-result query))
173 |
174 | [{:a [:b :c]}]
175 | {:a [{:b 1 :c 2} {:b 1}]}
176 | {:a [{:b 1 :c 2} {:b 1 :c impl/nf}]}))
177 |
178 | (behavior "idents and ident joins"
179 | (are [query ?missing-result exp]
180 | (= exp (impl/mark-missing ?missing-result query))
181 | [{[:a 1] [:x]}]
182 | {[:a 1] {}}
183 | {[:a 1] {:x impl/nf}}
184 |
185 | [{[:b 1] [:x]}]
186 | {[:b 1] {:x 2}}
187 | {[:b 1] {:x 2}}
188 |
189 | [{[:c 1] [:x]}]
190 | {}
191 | {[:c 1] {:ui/fetch-state {:untangled.client.impl.data-fetch/type :not-found}
192 | :x impl/nf}}
193 |
194 | [{[:e 1] [:x :y :z]}]
195 | {}
196 | {[:e 1] {:ui/fetch-state {:untangled.client.impl.data-fetch/type :not-found}
197 | :x impl/nf
198 | :y impl/nf
199 | :z impl/nf}}
200 |
201 | [[:d 1]]
202 | {}
203 | {[:d 1] {:ui/fetch-state {:untangled.client.impl.data-fetch/type :not-found}}}))
204 |
205 | (behavior "paramterized"
206 | (are [query ?missing-result exp]
207 | (= exp (impl/mark-missing ?missing-result query))
208 | '[:z (:y {})]
209 | {:z 1}
210 | {:z 1 :y impl/nf}
211 |
212 | '[:z (:y {})]
213 | {:z 1 :y 0}
214 | {:z 1 :y 0}
215 |
216 | '[:z ({:y [:x]} {})]
217 | {:z 1 :y {}}
218 | {:z 1 :y {:x impl/nf}}))
219 |
220 | (behavior "nested"
221 | (are [query ?missing-result exp]
222 | (= exp (impl/mark-missing ?missing-result query))
223 | [{:b [:c {:d [:e]}]}]
224 | {:b {:c 1}}
225 | {:b {:c 1 :d impl/nf}}
226 |
227 | [{:b [:c {:d [:e]}]}]
228 | {:b {:c 1 :d {}}}
229 | {:b {:c 1 :d {:e impl/nf}}}))
230 |
231 | (behavior "upgrades value to maps if necessary"
232 | (are [query ?missing-result exp]
233 | (= exp (impl/mark-missing ?missing-result query))
234 | [{:l [:m]}]
235 | {:l 0}
236 | {:l {:m impl/nf}}
237 |
238 | [{:b [:c]}]
239 | {:b nil}
240 | {:b {:c impl/nf}}))
241 |
242 | (behavior "unions"
243 | (are [query ?missing-result exp]
244 | (= exp (impl/mark-missing ?missing-result query))
245 |
246 | ;singleton
247 | [{:j {:a [:c]
248 | :b [:d]}}]
249 | {:j {:c {}}}
250 | {:j {:c {}
251 | :d impl/nf}}
252 |
253 | ;singleton with no result
254 | [{:j {:a [:c]
255 | :b [:d]}}]
256 | {}
257 | {:j impl/nf}
258 |
259 | ;list
260 | [{:j {:a [:c]
261 | :b [:d]}}]
262 | {:j [{:c "c"}]}
263 | {:j [{:c "c" :d impl/nf}]}
264 |
265 | [{:items
266 | {:photo [:id :image]
267 | :text [:id :text]}}]
268 | {:items
269 | [{:id 0 :image "img1"}
270 | {:id 1 :text "text1"}]}
271 | {:items [{:id 0 :image "img1" :text impl/nf}
272 | {:id 1 :image impl/nf :text "text1"}]}
273 |
274 | ;list with no results
275 | [{:j {:a [:c]
276 | :b [:d]}}]
277 | {:j []}
278 | {:j []}
279 |
280 | ))
281 |
282 | (behavior "if the query has a ui.*/ attribute, it should not be marked as missing"
283 | (are [query ?missing-result exp]
284 | (= exp (impl/mark-missing ?missing-result query))
285 |
286 | [:a :ui/b :c]
287 | {:a {}
288 | :c {}}
289 | {:a {}
290 | :c {}}
291 |
292 | [{:j [:ui/b :c]}]
293 | {:j {:c 5}}
294 | {:j {:c 5}}))
295 |
296 | (behavior "mutations!"
297 | (are [query ?missing-result exp]
298 | (= exp (impl/mark-missing ?missing-result query))
299 |
300 | '[(f) {:j [:a]}]
301 | {'f {}
302 | :j {}}
303 | {'f {}
304 | :j {:a impl/nf}}
305 |
306 | '[(app/add-q {:p 1}) {:j1 [:p1]} {:j2 [:p2]}]
307 | {'app/add-q {:tempids {}}
308 | :j1 {}
309 | :j2 [{:p2 2} {}]}
310 | {'app/add-q {:tempids {}}
311 | :j1 {:p1 impl/nf}
312 | :j2 [{:p2 2} {:p2 impl/nf}]}))
313 |
314 | (behavior "correctly walks recursive queries to mark missing data"
315 | (behavior "when the recursive target is a singleton"
316 | (are [query ?missing-result exp]
317 | (= exp (impl/mark-missing ?missing-result query))
318 | [:a {:b '...}]
319 | {:a 1 :b {:a 2}}
320 | {:a 1 :b {:a 2 :b impl/nf}}
321 |
322 | [:a {:b '...}]
323 | {:a 1 :b {:a 2 :b {:a 3}}}
324 | {:a 1 :b {:a 2 :b {:a 3 :b impl/nf}}}
325 |
326 | [:a {:b 9}]
327 | {:a 1 :b {:a 2 :b {:a 3 :b {:a 4}}}}
328 | {:a 1 :b {:a 2 :b {:a 3 :b {:a 4 :b impl/nf}}}}))
329 | (behavior "when the recursive target is to-many"
330 | (are [query ?missing-result exp]
331 | (= exp (impl/mark-missing ?missing-result query))
332 | [:a {:b '...}]
333 | {:a 1 :b [{:a 2 :b [{:a 3}]}
334 | {:a 4}]}
335 | {:a 1 :b [{:a 2 :b [{:a 3 :b impl/nf}]}
336 | {:a 4 :b impl/nf}]})))
337 | (behavior "marks leaf data based on the query where"
338 | (letfn [(has-leaves [leaf-paths] (fn [result] (every? #(impl/leaf? (get-in result %)) leaf-paths)))]
339 | (assertions
340 | "plain data is always a leaf"
341 | (impl/mark-missing {:a 1 :b {:x 5}} [:a {:b [:x]}]) =fn=> (has-leaves [[:b :x] [:a] [:missing]])
342 | "data structures are properly marked in singleton results"
343 | (impl/mark-missing {:b {:x {:data 1}}} [{:b [:x :y]}]) =fn=> (has-leaves [[:b :x]])
344 | "data structures are properly marked in to-many results"
345 | (impl/mark-missing {:b [{:x {:data 1}} {:x {:data 2}}]} [{:b [:x]}]) =fn=> (has-leaves [[:b 0 :x] [:b 1 :x]])
346 | (impl/mark-missing {:b []} [:a {:b [:x]}]) =fn=> (has-leaves [[:b]])
347 | "unions are followed"
348 | (impl/mark-missing {:a [{:x {:data 1}} {:y {:data 2}}]} [{:a {:b [:x] :c [:y]}}]) =fn=> (has-leaves [[:a 0 :x] [:a 1 :y]])
349 | "unions leaves data in place when the result is empty"
350 | (impl/mark-missing {:a 1} [:a {:z {:b [:x] :c [:y]}}]) =fn=> (has-leaves [[:a]])))))
351 |
--------------------------------------------------------------------------------
/spec/untangled/client/impl/util_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.util-spec
2 | (:require
3 | [untangled-spec.core :refer-macros [specification when-mocking assertions]]
4 | [untangled.client.impl.util :as util]
5 | [om.next :as om]))
6 |
7 | (specification "Log app state"
8 | (let [state (atom {:foo {:a :b
9 | 12 {:c ["hello" "world"]
10 | [:wee :ha] {:e [{:e :g}
11 | {:a [1 2 3 4]}
12 | {:t :k}]
13 | :g :h
14 | :i :j}}}
15 | {:map :key} {:other :data}
16 | [1 2 3] :data})]
17 |
18 | (when-mocking
19 | (om/app-state _) => state
20 | (cljs.pprint/pprint data) => data
21 |
22 | (assertions
23 | "Handle non-sequential keys"
24 | (util/log-app-state state {:map :key}) => {:other :data}
25 |
26 | "Handles sequential keys"
27 | (util/log-app-state state [[1 2 3]]) => :data
28 |
29 | "Handles non-sequential and sequential keys together"
30 | (util/log-app-state state [:foo :a] {:map :key}) => {:foo {:a :b}
31 | {:map :key} {:other :data}}
32 |
33 | "Handles distinct paths"
34 | (util/log-app-state state [:foo 12 [:wee :ha] :g] [{:map :key}]) => {:foo {12 {[:wee :ha] {:g :h}}}
35 | {:map :key} {:other :data}}
36 |
37 | "Handles shared paths"
38 | (util/log-app-state state [:foo 12 [:wee :ha] :g] [:foo :a]) => {:foo {12 {[:wee :ha] {:g :h}}
39 | :a :b}}
40 |
41 | "Handles keys and paths together"
42 | (util/log-app-state state {:map :key} [:foo 12 :c 1]) => {:foo {12 {:c {1 "world"}}}
43 | {:map :key} {:other :data}}))))
44 |
--------------------------------------------------------------------------------
/spec/untangled/client/logging_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.logging-spec
2 | (:require
3 | [untangled-spec.core :refer-macros [specification behavior assertions when-mocking]]
4 | [goog.debug.Logger.Level :as level]
5 | [goog.log :as glog]
6 | [om.next :refer [*logger*]]
7 | [untangled.client.logging :as log]))
8 |
9 | (specification "Logging Level"
10 | (behavior "can be set to"
11 | (when-mocking
12 | (level/getPredefinedLevel name) =1x=> (assertions "all" name => "ALL")
13 | (level/getPredefinedLevel name) =1x=> (assertions "debug" name => "FINE")
14 | (level/getPredefinedLevel name) =1x=> (assertions "info" name => "INFO")
15 | (level/getPredefinedLevel name) =1x=> (assertions "warn" name => "WARNING")
16 | (level/getPredefinedLevel name) =1x=> (assertions "error" name => "SEVERE")
17 | (level/getPredefinedLevel name) =1x=> (assertions "none" name => "OFF")
18 |
19 | (doall (map log/set-level [:all :debug :info :warn :error :none])))))
20 |
21 | (specification "Debug logging"
22 | (when-mocking
23 | (glog/fine *logger* _) => nil
24 |
25 | (assertions
26 | "Returns provided value after logging"
27 | (log/debug [:foo :bar]) => [:foo :bar]
28 | "Returns provided value after logging with a message"
29 | (log/debug "A message" [:foo :bar]) => [:foo :bar])))
30 |
--------------------------------------------------------------------------------
/spec/untangled/client/mutations_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.mutations-spec
2 | (:require
3 | [untangled-spec.core :refer-macros [specification behavior assertions component]]
4 | [untangled.client.mutations :as m :refer [defmutation]]
5 | [goog.debug.Logger.Level :as level]
6 | [goog.log :as glog]
7 | [om.next :refer [*logger*]]
8 | [untangled.client.logging :as log]))
9 |
10 | (defmutation sample
11 | "Doc string"
12 | [{:keys [id]}]
13 | (action [{:keys [state]}]
14 | (swap! state assoc :sample id))
15 | (remote [{:keys [ast]}]
16 | (assoc ast :params {:x 1})))
17 |
18 | (specification "defmutation"
19 | (component "action"
20 | (let [state (atom {})
21 | ast {}
22 | env {:ast ast :state state}
23 | {:keys [action remote]} (m/mutate env `sample {:id 42})]
24 |
25 | (action)
26 |
27 | (assertions
28 | "Emits an action that has proper access to env and params"
29 | (:sample @state) => 42
30 | "Emits a remote that has the proper value"
31 | remote => {:params {:x 1}}))))
32 |
--------------------------------------------------------------------------------
/spec/untangled/client/protocol_support_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.protocol-support-spec
2 | (:require
3 | [untangled-spec.core :refer-macros [specification behavior provided component assertions]]
4 | [untangled.client.protocol-support :as ps :refer-macros [with-methods]]
5 | [untangled.client.mutations :as mut]))
6 |
7 | (specification "Client Protocol Testing"
8 | (behavior "with-methods macro runs body with extra multi methods"
9 | (do (defmulti my-multi (fn [x] x))
10 | (defmethod my-multi 'minus [x] (dec x))
11 | (defmethod my-multi 'plus [x] (inc x))
12 | (with-methods my-multi {'plus (fn [x] :new-plus)}
13 | (assertions
14 | ((get-method my-multi 'plus) 0) => :new-plus))
15 | (assertions
16 | "resetting the multimethod when its done"
17 | ((get-method my-multi 'plus) 0) => 1)))
18 |
19 | (let [silly-protocol {:initial-ui-state {:thing [0]
20 | :foo 5}
21 | :ui-tx '[(inc-thing)]
22 | :optimistic-delta {[:thing] (ps/with-behavior "it appends the last thing +1" [0 1])
23 | [:foo] 5}}
24 | inc-thing-fn (fn [{:keys [state]} _ _]
25 | (swap! state update :thing #(conj % (inc (last %)))))]
26 | (behavior "check-optimistic-update"
27 | (with-methods mut/mutate {'inc-thing inc-thing-fn}
28 | (ps/check-optimistic-update silly-protocol))))
29 |
30 | (let [silly-protocol {:initial-ui-state {:fake "fake"}
31 | :ui-tx '[(do/thing {}) :not-sent]
32 | :server-tx '[(do/thing)]}
33 | do-thing-fn (fn [_ _ _] {:remote true})]
34 | (behavior "check-server-tx"
35 | (with-methods mut/mutate {'do/thing do-thing-fn}
36 | (ps/check-server-tx silly-protocol))))
37 |
38 | (let [silly-protocol {:response {:thing/by-id {0 {:thing 1}}}
39 | :pre-response-state {:thing/by-id {}}
40 | :merge-delta {[:thing/by-id 0] {:thing 1}}}]
41 | (behavior "check-response"
42 | (ps/check-response-from-server silly-protocol)))
43 |
44 | (let [silly-protocol {:initial-ui-state {:thing [0]
45 | :foo 5}
46 | :ui-tx '[(dummy-string)]
47 | :optimistic-delta {[:thing] #"^[A-Za-z]+$"
48 | [:foo] 5}
49 | :response {:thing/by-id {0 {:thing "foobarbaz"}}}
50 | :pre-response-state {:thing/by-id {}}
51 | :merge-delta {[:thing/by-id 0 :thing] #".*bar.*"}}
52 | dummy-string-fn (fn [{:keys [state]} _ _]
53 | (swap! state assoc :thing "FooBarbaz"))]
54 |
55 | (behavior "handles regular expressions as value in deltas"
56 | (with-methods mut/mutate {'dummy-string dummy-string-fn}
57 | (ps/check-optimistic-update silly-protocol)
58 | (ps/check-response-from-server silly-protocol))))
59 |
60 | (let [silly-protocol {:initial-ui-state {:x/by-id {13 {:val 0}}}
61 | :ui-tx '[(inc-it)]
62 | :optimistic-delta {[:x/by-id 13 :val] 1}}
63 | inc-it-fn (fn [{:keys [state ref]} _ _]
64 | (swap! state update-in (conj ref :val) inc))]
65 | (behavior "can pass an optional env to the parser, eg: to mock :ref"
66 | (with-methods mut/mutate {'inc-it inc-it-fn}
67 | (ps/check-optimistic-update silly-protocol :env {:ref [:x/by-id 13]}))
68 | (assertions ":state in the env is not allowed, as it should come from the protocol"
69 | (ps/check-optimistic-update nil :env {:state :should-not-allowed})
70 | =throws=> (js/Error #"state not allowed in the env")))))
71 |
--------------------------------------------------------------------------------
/spec/untangled/client/routing_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.routing-spec
2 | (:require [untangled.client.routing :as r :refer [defrouter]]
3 | [om.dom :as dom]
4 | [untangled-spec.core :refer-macros [specification behavior assertions when-mocking component]]
5 | [om.next :as om :refer [defui]]
6 | [untangled.client.mutations :as m]
7 | [untangled.client.core :as uc]))
8 |
9 | (defui Screen1
10 | uc/InitialAppState
11 | (initial-state [cls params] {:type :screen1})
12 | Object
13 | (render [this] (dom/div nil "TODO")))
14 |
15 | (defrouter SampleRouter :router-1
16 | (ident [this props] [(:type props) :top])
17 | :screen1 Screen1)
18 |
19 | (declare SampleRouter-Union)
20 |
21 | (specification "Routers"
22 | (assertions
23 | "Have a top-level table namespaced to the untangled routing library"
24 | (om/ident SampleRouter {}) => [r/routers-table :router-1]
25 | "Use the user-supplied ident function for the union"
26 | (om/ident SampleRouter-Union {:type :screen1}) => [:screen1 :top]))
27 |
28 | (specification "current-route"
29 | (let [state-map {r/routers-table {:router-1 {:id :router-1 :current-route [:A :top]}
30 | :router-2 {:id :router-2 :current-route [:B :top]}}}]
31 | (assertions
32 | "Can read the current route from a router"
33 | (r/current-route state-map :router-1) => [:A :top]
34 | (r/current-route state-map :router-2) => [:B :top])))
35 |
36 | (specification "update-routing-links"
37 | (component "on non-parameterized routes"
38 | (let [r (r/make-route :boo [(r/router-instruction :router-1 [:screen1 :top])])
39 | r2 (r/make-route :foo [(r/router-instruction :router-2 [:screen2 :top])
40 | (r/router-instruction :router-1 [:screen1 :other])])
41 | tree (r/routing-tree r r2)
42 | state-map (merge
43 | tree
44 | {r/routers-table {:router-1 {:id :router-1 :current-route [:unset :unset]}
45 | :router-2 {:id :router-2 :current-route [:unset :unset]}}})
46 | new-state-map (r/update-routing-links state-map {:handler :foo})]
47 | (assertions
48 | "Switches the current routes according to the route instructions"
49 | (r/current-route new-state-map :router-1) => [:screen1 :other]
50 | (r/current-route new-state-map :router-2) => [:screen2 :top])))
51 | (component "on parameterized routes"
52 | (let [r (r/make-route :boo [(r/router-instruction :router-1 [:screen1 :param/some-id])])
53 | tree (r/routing-tree r)
54 | state-map (merge
55 | tree
56 | {r/routers-table {:router-1 {:id :router-1 :current-route [:unset :unset]}}})
57 | new-state-map (r/update-routing-links state-map {:handler :boo :route-params {:some-id :target-id}})]
58 | (assertions
59 | "Switches the current routes with parameter substitutions"
60 | (r/current-route new-state-map :router-1) => [:screen1 :target-id]))))
61 |
62 | (specification "route-to mutation"
63 | (let [r (r/make-route :boo [(r/router-instruction :router-1 [:screen1 :top])])
64 | r2 (r/make-route :foo [(r/router-instruction :router-2 [:screen2 :top])
65 | (r/router-instruction :router-1 [:screen1 :other])])
66 | tree (r/routing-tree r r2)
67 | state-map (merge tree
68 | {r/routers-table {:router-1 {:id :router-1 :current-route [:initial :top]}
69 | :router-2 {:id :router-2 :current-route [:initial :top]}}})
70 | state (atom state-map)
71 | action (:action (m/mutate {:state state} `r/route-to {:handler :boo}))]
72 |
73 | (action)
74 |
75 | (assertions
76 | "Switches the current routes according to the route instructions"
77 | (r/current-route @state :router-1) => [:screen1 :top])))
78 |
79 |
80 |
--------------------------------------------------------------------------------
/spec/untangled/client/server_rendering_spec.clj:
--------------------------------------------------------------------------------
1 | (ns untangled.client.server-rendering-spec
2 | (:require [om.next :as om :refer [defui]]
3 | [om.dom :as dom]
4 | [untangled-spec.core :refer [specification behavior assertions]]
5 | [untangled.client.core :as uc]))
6 |
7 | (defui Item
8 | static uc/InitialAppState
9 | (initial-state [cls {:keys [id label]}] {:id id :label label})
10 | static om/IQuery
11 | (query [this] [:id :label])
12 | static om/Ident
13 | (ident [this props] [:items/by-id (:id props)])
14 | Object
15 | (render [this]
16 | (let [{:keys [label]} (om/props this)]
17 | (dom/div #js {:className "item"}
18 | (dom/span #js {:className "label"} label)))))
19 |
20 | (def ui-item (om/factory Item {:keyfn :id}))
21 |
22 | (defui Root
23 | static uc/InitialAppState
24 | (initial-state [cls params] {:items [(uc/get-initial-state Item {:id 1 :label "A"})
25 | (uc/get-initial-state Item {:id 2 :label "B"})]})
26 | static om/IQuery
27 | (query [this] [{:items (om/get-query Item)}])
28 | Object
29 | (render [this]
30 | (let [{:keys [items]} (om/props this)]
31 | (dom/div #js {:className "root"}
32 | (mapv ui-item items)))))
33 |
34 | (def ui-root (om/factory Root))
35 |
36 | (specification "Server-side rendering"
37 | (assertions
38 | "Can generate a string from UI with initial state"
39 | (dom/render-to-str (ui-root (uc/get-initial-state Root {}))) => ""))
40 |
--------------------------------------------------------------------------------
/spec/untangled/client/ui_spec.clj:
--------------------------------------------------------------------------------
1 | (ns untangled.client.ui-spec
2 | (:require
3 | [clojure.spec :as s]
4 | [clojure.test :as t]
5 | [om.next :as om]
6 | [untangled-spec.core :refer
7 | [specification behavior assertions when-mocking]]
8 | [untangled.client.ui :as ui]))
9 |
10 | (specification "defui, TODO")
11 |
--------------------------------------------------------------------------------
/spec/untangled/i18n_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.i18n-spec
2 | (:require-macros [cljs.test :refer (is deftest testing are)]
3 | [untangled-spec.core :refer (specification behavior provided assertions)])
4 | (:require [untangled.i18n :refer [current-locale tr trf trc trlambda]]
5 | [cljs.test :refer [do-report]]
6 | [untangled.i18n.core :as i18n]))
7 |
8 | (def translations
9 | {"|Hi" "Ola"
10 | "Abbreviation for Monday|M" "L"
11 | "|{n,plural,=0 {none} =1 {one} other {#}}" "{n,plural,=0 {nada} =1 {uno} other {#}}"})
12 |
13 | (swap! i18n/*loaded-translations* (fn [x] (assoc x "es-MX" translations)))
14 |
15 | (specification "Base translation -- tr"
16 | (reset! i18n/*current-locale* "en-US")
17 | (assertions "returns the string it is passed if there is no translation"
18 | (tr "Hello") => "Hello"
19 | "returns message key if current-locale is en-US"
20 | (tr "Hi") => "Hi")
21 | (reset! i18n/*current-locale* "es-MX")
22 | (assertions
23 | "returns message key if no translation map is found for the locale"
24 | (tr "Hello") => "Hello"
25 | "returns message key if translation is not found in the translation map"
26 | (tr "Hi") => "Ola"))
27 |
28 | (specification "Base translation lambda -- trlambda"
29 | (reset! i18n/*current-locale* "en-US")
30 | (behavior "returns a function, which when called, does the translation."
31 | (is (= "Hello" ((trlambda "Hello"))))))
32 |
33 | (specification "Message translations with context"
34 | (reset! i18n/*current-locale* "en-US")
35 | (assertions
36 | "Formats in en-US locale"
37 | (trc "Abbreviation for Monday" "M") => "M")
38 | (reset! i18n/*current-locale* "es-MX")
39 | (assertions
40 | "Formats in es-MX locale"
41 | (trc "Abbreviation for Monday" "M") => "L"))
42 |
43 | (specification "Message format translation -- trf"
44 | (reset! i18n/*current-locale* "en-US")
45 | (behavior "returns the string it is passed if there is no translation"
46 | (is (= "Hello" (trf "Hello"))))
47 | (behavior "accepts a sequence of k/v pairs as arguments to the format"
48 | (is (= "A 1 B Sam" (trf "A {a} B {name}" :a 1 :name "Sam"))))
49 | (behavior "formats numbers - US"
50 | (is (= "18,349" (trf "{a, number}" :a 18349))))
51 | (assertions
52 | "formats dates - US"
53 | (trf "{a, date, long}" :a (js/Date. 1990 3 1 13 45 22 0)) => "April 1, 1990"
54 | (trf "{a, date, medium}" :a (js/Date. 1990 3 1 13 45 22 0)) => "Apr 1, 1990"
55 | (trf "{a, date, short}" :a (js/Date. 1990 3 1 13 45 22 0)) => "4/1/90")
56 | (behavior "formats plurals - US"
57 | (are [n msg] (= msg (trf "{n, plural, =0 {no apples} =1 {1 apple} other {# apples}}" :n n))
58 | 0 "no apples"
59 | 1 "1 apple"
60 | 2 "2 apples"
61 | 146 "146 apples"))
62 | (reset! i18n/*current-locale* "de-DE")
63 | (behavior "formats numbers - Germany"
64 | (is (= "18.349" (trf "{a, number}" :a 18349))))
65 | (reset! i18n/*current-locale* "es-MX")
66 | (assertions
67 | "formats dates - Mexico"
68 | (trf "{a, date, long}" :a (js/Date. 1990 3 1 13 45 22 0)) => "1 de abril de 1990"
69 | "Medium dates (browsers do different things here, so test is more generic)"
70 | (trf "{a, date, medium}" :a (js/Date. 1990 3 1 13 45 22 0)) =fn=> (fn [s] (re-matches #"^1 .*abr.*" s))
71 | (trf "{a, date, short}" :a (js/Date. 1990 3 1 13 45 22 0)) => "1/4/90")
72 | (behavior "formats plurals - Spanish"
73 | (are [n msg] (= msg (trf "{n,plural,=0 {none} =1 {one} other {#}}" :n n))
74 | 0 "nada"
75 | 1 "uno"
76 | 2 "2"
77 | 146 "146")))
78 |
--------------------------------------------------------------------------------
/spec/untangled/services/local_storage_io_spec.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.services.local-storage-io-spec
2 | (:require-macros [cljs.test :refer (is deftest run-tests testing)]
3 | [untangled-spec.core :refer (specification behavior provided assertions with-timeline async tick)])
4 | (:require [cljs.test :refer [do-report]]
5 | untangled-spec.stub
6 | [untangled-spec.async]
7 | [untangled.services.asyncio :as aio]
8 | [untangled.services.local-storage :as ls]
9 | [untangled.services.async-report :as ar]
10 | )
11 | )
12 |
13 | (specification
14 | "Local Storage Io"
15 | (behavior
16 | "with no simulated delay or simulated timeout"
17 | (behavior "save of a new item adds the item to local storage and returns the saved item with a generated id"
18 | (let [async-report (ar/new-async-report #() #() #())
19 | localio (ls/new-local-storage async-report 0)
20 | state (atom [])
21 | goodfn (fn [data] (reset! state data))
22 | badfn (fn [error] (reset! state error))
23 | ]
24 | (aio/save localio "testuri" goodfn badfn {:a 1})
25 | (assertions
26 | (contains? @state :a) => true
27 | (:a @state) => 1
28 | (string? (:id @state)) => true
29 | )
30 | )
31 | )
32 |
33 | (behavior "save updates an existing item and returns the saved item"
34 | (let [async-report (ar/new-async-report #() #() #())
35 | localio (ls/new-local-storage async-report 0)
36 | state (atom [])
37 | goodfn (fn [data] (reset! state data))
38 | badfn (fn [error] (reset! state error))
39 | ]
40 | (aio/save localio "testuri" #() #() {:id "item1" :a 1})
41 | (aio/save localio "testuri" goodfn badfn {:id "item1" :b 2})
42 | (assertions
43 | (contains? @state :b) => true
44 | (:b @state) => 2
45 | (string? (:id @state)) => true
46 | (:id @state) => "item1"
47 | )
48 | )
49 | )
50 | (behavior "fetch returns a single saved item"
51 | (let [async-report (ar/new-async-report #() #() #())
52 | localio (ls/new-local-storage async-report 0)
53 | state (atom [])
54 | goodfn (fn [data] (reset! state data))
55 | badfn (fn [error] (reset! state error))
56 | ]
57 | (aio/save localio "testuri" #() #() {:id "item2" :a 1})
58 | (aio/fetch localio "testuri" goodfn badfn "item2")
59 | (assertions
60 | (:a @state) => 1
61 | (:id @state) => "item2"
62 | )
63 | )
64 | )
65 | (behavior "query returns a list of saved items"
66 | (let [async-report (ar/new-async-report #() #() #())
67 | localio (ls/new-local-storage async-report 0)
68 | state (atom [])
69 | goodfn (fn [data] (reset! state data))
70 | badfn (fn [error] (reset! state error))
71 | ]
72 | (aio/save localio "testuri" #() #() {:id "item1" :a 1})
73 | (aio/save localio "testuri" #() #() {:id "item2" :a 2})
74 | (aio/save localio "testuri" #() #() {:id "item3" :a 3})
75 | (aio/save localio "testuri" #() #() {:id "item4" :a 4})
76 | (aio/query localio "testuri" goodfn badfn)
77 | (assertions
78 | (count @state) => 4
79 | (count (filter #(= "item2" (:id %)) @state)) => 1
80 | (:a (first (filter #(= "item2" (:id %)) @state))) => 2
81 | )
82 | )
83 | )
84 | (behavior "delete deletes a single saved item"
85 | (let [async-report (ar/new-async-report #() #() #())
86 | localio (ls/new-local-storage async-report 0)
87 | state (atom [])
88 | goodfn (fn [data] (reset! state data))
89 | badfn (fn [error] (reset! state error))
90 | ]
91 | (aio/save localio "testuri" #() #() {:id "item1" :a 1})
92 | (aio/save localio "testuri" #() #() {:id "item2" :a 2})
93 | (aio/save localio "testuri" #() #() {:id "item3" :a 3})
94 | (aio/save localio "testuri" #() #() {:id "item4" :a 4})
95 | (aio/delete localio "testuri" goodfn badfn "item3")
96 | (assertions
97 | @state => "item3"
98 | )
99 | (aio/query localio "testuri" goodfn badfn)
100 | (assertions
101 | (count @state) => 3
102 | )
103 | )
104 | )
105 | (behavior "fetch returns an error if the item is not found"
106 | (let [async-report (ar/new-async-report #() #() #())
107 | localio (ls/new-local-storage async-report 0)
108 | state (atom [])
109 | goodfn (fn [data] (reset! state data))
110 | badfn (fn [error] (reset! state error))
111 | ]
112 | (aio/save localio "testuri" #() #() {:id "item1" :a 1})
113 | (aio/save localio "testuri" #() #() {:id "item2" :a 2})
114 | (aio/fetch localio "testuri" goodfn badfn "item5")
115 | (assertions
116 | (:error @state) => :not-found
117 | (:id @state) => "item5"
118 | )
119 | )
120 | )
121 | (behavior "delete returns an error if the item is not found"
122 | (let [async-report (ar/new-async-report #() #() #())
123 | localio (ls/new-local-storage async-report 0)
124 | state (atom [])
125 | goodfn (fn [data] (reset! state data))
126 | badfn (fn [error] (reset! state error))
127 | ]
128 | (aio/save localio "testuri" #() #() {:id "item1" :a 1})
129 | (aio/save localio "testuri" #() #() {:id "item2" :a 2})
130 | (aio/delete localio "testuri" goodfn badfn "item5")
131 | (assertions
132 | (:error @state) => :not-found
133 | (:id @state) => "item5"
134 | )
135 | )
136 | )
137 | (behavior "query returns an empty list if no data is found"
138 | (let [async-report (ar/new-async-report #() #() #())
139 | localio (ls/new-local-storage async-report 0)
140 | state (atom [])
141 | goodfn (fn [data] (reset! state data))
142 | badfn (fn [error] (reset! state error))
143 | ]
144 | (aio/query localio "testuri" goodfn badfn)
145 | (assertions
146 | @state => []
147 | )
148 | )
149 | ))
150 | (behavior
151 | "with simulated delay"
152 | (behavior "save calls the good callback after the timeout period has passed"
153 | (with-timeline
154 | (let [async-report (ar/new-async-report #() #() #())
155 | localio (ls/new-local-storage async-report 100)
156 | state (atom [])
157 | goodfn (fn [data] (reset! state data))
158 | badfn (fn [error] (reset! state error))
159 | ]
160 | (provided "when mocking setTimeout"
161 | (js/setTimeout f n) => (async n (f))
162 | (aio/save localio "testuri" goodfn badfn {:a 1})
163 | (behavior "nothing is called until after the simualed delay is passed"
164 | (is (= @state []))
165 | )
166 | (behavior "item is saved when simualed delay is passed"
167 | (tick 100)
168 | (is (= (:a @state) 1))
169 | )
170 | )
171 | )
172 | )
173 | )
174 | (behavior "query calls the good callback after the timeout period has passed"
175 | (with-timeline
176 | (let [async-report (ar/new-async-report #() #() #())
177 | localio (ls/new-local-storage async-report 100)
178 | state (atom [])
179 | goodfn (fn [data] (reset! state data))
180 | badfn (fn [error] (reset! state error))
181 | ]
182 | (provided "when mocking setTimeout"
183 | (js/setTimeout f n) =5=> (async n (f))
184 | (aio/save localio "testuri" #() #() {:id "item1" :a 1})
185 | (tick 100)
186 | (aio/save localio "testuri" #() #() {:id "item2" :a 2})
187 | (tick 100)
188 | (aio/save localio "testuri" #() #() {:id "item3" :a 3})
189 | (tick 100)
190 | (aio/save localio "testuri" #() #() {:id "item4" :a 4})
191 | (tick 100)
192 | (aio/query localio "testuri" goodfn badfn)
193 | (behavior "nothing is called until after the simualed delay is passed"
194 | (is (= @state []))
195 | )
196 | (behavior "query has returend when simualed delay is passed"
197 | (tick 100)
198 | (is (= (count @state) 4))
199 | )
200 | )
201 | )
202 | )
203 | )
204 | (behavior "fetch calls the good callback after the timeout period has passed"
205 | (with-timeline
206 | (let [async-report (ar/new-async-report #() #() #())
207 | localio (ls/new-local-storage async-report 100)
208 | state (atom [])
209 | goodfn (fn [data] (reset! state data))
210 | badfn (fn [error] (reset! state error))
211 | ]
212 | (provided "when mocking setTimeout"
213 | (js/setTimeout f n) =2=> (async n (f))
214 | (aio/save localio "testuri" #() #() {:id "item1" :a 1})
215 | (tick 100)
216 | (aio/fetch localio "testuri" goodfn badfn "item1")
217 | (behavior "nothing is called until after the simualed delay is passed"
218 | (is (= @state []))
219 | )
220 | (behavior "fetch has happened when simualed delay is passed"
221 | (tick 100)
222 | (is (= (:a @state) 1))
223 | )
224 | )
225 | )
226 | )
227 | )
228 | (behavior "delete calls the good callback after the timeout period has passed"
229 | (with-timeline
230 | (let [async-report (ar/new-async-report #() #() #())
231 | localio (ls/new-local-storage async-report 100)
232 | state (atom [])
233 | goodfn (fn [data] (reset! state data))
234 | badfn (fn [error] (reset! state error))
235 | ]
236 | (provided "when mocking setTimeout"
237 | (js/setTimeout f n) =2=> (async n (f))
238 | (aio/save localio "testuri" #() #() {:id "item1" :a 1})
239 | (tick 100)
240 | (aio/delete localio "testuri" goodfn badfn "item1")
241 | (behavior "nothing is called until after the simualed delay is passed"
242 | (is (= @state []))
243 | )
244 | (behavior "item is deleted when simualed delay is passed"
245 | (tick 100)
246 | (is (= @state "item1"))
247 | )
248 | )
249 | )
250 | )
251 | )
252 | )
253 | )
254 |
255 |
--------------------------------------------------------------------------------
/spec/untangled/tests_to_run.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.tests-to-run
2 | (:require
3 | untangled.services.local-storage-io-spec
4 | untangled.client.protocol-support-spec
5 | untangled.client.impl.util-spec
6 | untangled.client.impl.application-spec
7 | untangled.client.impl.built-in-mutations-spec
8 | untangled.client.mutations-spec
9 | untangled.client.data-fetch-spec
10 | untangled.client.impl.om-plumbing-spec
11 | untangled.client.logging-spec
12 | untangled.client.core-spec
13 | untangled.client.routing-spec
14 | untangled.i18n-spec
15 | untangled.client.impl.network-spec))
16 |
17 |
18 | ;********************************************************************************
19 | ; IMPORTANT:
20 | ; For cljs tests to work in CI, we want to ensure the namespaces for all tests are included/required. By placing them
21 | ; here (and depending on them in user.cljs for dev), we ensure that the all-tests namespace (used by CI) loads
22 | ; everything as well.
23 | ;********************************************************************************
24 |
25 |
26 |
--------------------------------------------------------------------------------
/src-cards/untangled/client/card_ui.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.card-ui
2 | (:require
3 | [devtools.core :as devtools]
4 | untangled.client.fancy-defui
5 | untangled.client.load-cards
6 | untangled.client.initial-app-state-card))
7 |
8 | (devtools/enable-feature! :sanity-hints)
9 | (devtools/install!)
10 |
--------------------------------------------------------------------------------
/src-cards/untangled/client/fancy_defui.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.fancy-defui
2 | (:require-macros
3 | [untangled.client.ui :as ui])
4 | (:require
5 | [devcards.core :as dc :include-macros true]
6 | [untangled.client.core :as uc]
7 | [om.next :as om]
8 | [om.dom :as dom]))
9 |
10 | (ui/defui ListItem [(::ui/DerefFactory {:keyfn :value})]
11 | Object
12 | (render [this]
13 | (dom/li nil
14 | (:value (om/props this)))))
15 |
16 | (ui/defui ThingB [(::ui/BuiltIns {::ui/WithExclamation {:excl "THING B OVERRIDE!"}})]
17 | Object
18 | (render [this]
19 | (dom/div nil
20 | (dom/ul nil
21 | (map @ListItem (map hash-map (repeat :value) (range 6)))))))
22 |
23 | (ui/defui ThingA
24 | {:prod [(::ui/WithExclamation {:excl "IN PROD MODE"})]
25 | :dev [(::ui/WithExclamation {:excl "IN DEV MODE"})]}
26 | Object
27 | (render [this]
28 | (let [{:keys [ui/react-key]} (om/props this)]
29 | (dom/div #js {:key react-key}
30 | "Hello World!"
31 | (@ThingB)))))
32 |
33 | (defonce client (atom (uc/new-untangled-test-client)))
34 |
35 | (dc/defcard fancy-defui
36 | "##untangled.client.ui/defui"
37 | (dc/dom-node
38 | (fn [_ node]
39 | (reset! client (uc/mount @client ThingA node)))))
40 |
--------------------------------------------------------------------------------
/src-cards/untangled/client/initial_app_state_card.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.initial-app-state-card
2 | (:require [devcards.core :as dc :refer-macros [defcard]]
3 | [om.dom :as dom]
4 | [untangled.client.core :as uc :refer [InitialAppState initial-state]]
5 | [untangled.client.cards :refer [untangled-app]]
6 | [om.next :as om :refer [defui]]))
7 |
8 | (defui ^:once ActiveUsersTab
9 | static InitialAppState
10 | (initial-state [clz params] {:which-tab :active-users})
11 |
12 | static om/IQuery
13 | (query [this] [:which-tab])
14 |
15 | static om/Ident
16 | (ident [this props]
17 | [(:which-tab props) :tab])
18 |
19 | Object
20 | (render [this]))
21 |
22 | (def ui-active-users-tab (om/factory ActiveUsersTab))
23 |
24 | (defui ^:once HighScoreTab
25 | static InitialAppState
26 | (initial-state [clz params] {:which-tab :high-score})
27 | static om/IQuery
28 | (query [this] [:which-tab])
29 |
30 | static om/Ident
31 | (ident [this props]
32 | [(:which-tab props) :tab])
33 | Object
34 | (render [this]))
35 |
36 | (def ui-high-score-tab (om/factory HighScoreTab))
37 |
38 | (defui ^:once Union
39 | static InitialAppState
40 | (initial-state
41 | [clz params]
42 | (initial-state HighScoreTab nil))
43 | static om/IQuery
44 | (query [this]
45 | {:active-users (om/get-query ActiveUsersTab)
46 | :high-score (om/get-query HighScoreTab)})
47 |
48 | static om/Ident
49 | (ident [this props] [(:which-tab props) :tab]))
50 |
51 | (def ui-settings-viewer (om/factory Union))
52 |
53 | (defui ^:once Root
54 | static InitialAppState
55 | (initial-state [clz params] {:ui/react-key "A"
56 | :current-tab (initial-state Union nil)})
57 | static om/IQuery
58 | (query [this] [{:current-tab (om/get-query Union)}
59 | :ui/react-key])
60 | Object
61 | (render [this]
62 | (let [{:keys [ui/react-key] :as props} (om/props this)]
63 | (dom/div #js {:key (or react-key)} (str react-key)))))
64 |
65 | (dc/defcard union-initial-app-state
66 | ""
67 | (untangled-app Root)
68 | {}
69 | {:inspect-data true})
70 |
71 |
--------------------------------------------------------------------------------
/src-cards/untangled/client/load_cards.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.load-cards
2 | (:require
3 | [devcards.core :as dc :refer-macros [defcard]]
4 | [untangled.client.core :as uc]
5 | [untangled.client.cards :refer [untangled-app]]
6 | [om.next :as om :refer [defui]]
7 | [om.dom :as dom]
8 | [untangled.client.impl.network :as net]
9 | [untangled.client.mutations :as m]
10 | [untangled.client.data-fetch :as df]
11 | [untangled.client.logging :as log]))
12 |
13 | (defrecord MockNetwork []
14 | net/UntangledNetwork
15 | (send [this edn done-callback error-callback]
16 | (js/setTimeout (fn []
17 | (if (= 'untangled.client.load-cards/add-thing (ffirst edn))
18 | (let [tempid (-> edn first second :id)]
19 | (done-callback {'untangled.client.load-cards/add-thing {:tempids {tempid 1010}}}))
20 | (done-callback {[:thing/by-id 1010] {:id 1010 :label "B"}}))) 2000))
21 | (start [this complete-app] this))
22 |
23 | (defui Thing
24 | static om/IQuery
25 | (query [this] [:id :label])
26 | static om/Ident
27 | (ident [this props] [:thing/by-id (:id props)])
28 | Object
29 | (render [this] (dom/div nil "THING")))
30 |
31 | (defui Root
32 | Object
33 | (render [this]
34 | (dom/div nil "TODO")))
35 |
36 | (m/defmutation add-thing
37 | "Read a thing"
38 | [{:keys [id label]}]
39 | (action [{:keys [state]}]
40 | (swap! state assoc-in [:thing/by-id id] {:id id :label label}))
41 | (remote [env] true))
42 |
43 | (defcard load-with-follow-on-read
44 | "# Sequential Processing
45 |
46 | This card does a write (with a tempid) and a re-read of that as a follow-on read. This
47 | exercises:
48 |
49 | - tempid rewrites in the network queue
50 | - The initial entity has a tempid (generated)
51 | - The tempid is rewritten (to 1010)
52 | - The follow-on read reads the correct thing (label should update to B)
53 | - follow-on reads from a remote
54 | - load marker placement and removal
55 | - Should see a load marker appear IN the entity
56 | - Should see no load markers at the end
57 | "
58 | (untangled-app Root
59 | :networking (MockNetwork.)
60 | :started-callback (fn [{:keys [reconciler]}]
61 | (let [id (om/tempid)]
62 | (om/transact! reconciler `[(add-thing {:id ~id :label "A"})])
63 | (df/load reconciler [:thing/by-id id] Thing))))
64 | {}
65 | {:inspect-data true})
66 |
67 | (defrecord MockNetForMerge []
68 | net/UntangledNetwork
69 | (send [this edn done-callback error-callback]
70 | (js/setTimeout (fn []
71 | (cond
72 | (= [{:thing (om/get-query Thing)}] edn) (done-callback {:thing {:id 2 :label "UPDATED B"}})
73 | :else (done-callback {[:thing/by-id 1] {:id 1 :label "UPDATED A"}}))) 500))
74 | (start [this complete-app] this))
75 |
76 | (defcard ui-attribute-merge
77 | "# Merging
78 |
79 | This card loads over both a non-normalized item, and entry that is normalized from a tree response,
80 | and an entry that is refreshed by ident. In all cases, the (non-queried) UI attributes should remain.
81 |
82 | - Thing 1 and 2 should still have a :ui/value
83 | - Thing 1 and 2 should end up with UPDATED labels
84 |
85 | Basic final state should be:
86 |
87 | ```
88 | {:thing/by-id {1 {:id 1 :label \"UPDATED A\" :ui/value 1}
89 | 2 {:id 2 :label \"UPDATED B\" :ui/value 2}
90 | 3 {:id 3 :label \"C\" :ui/value 3}}
91 | :thing [:thing/by-id 2]}
92 | ```
93 | "
94 | (untangled-app Root
95 | :started-callback (fn [{:keys [reconciler]}]
96 | (js/setTimeout #(df/load reconciler [:thing/by-id 1] Thing {:refresh [[:fake 1] :no-prop] :without #{:ui/value}}) 100)
97 | (js/setTimeout #(df/load reconciler :thing Thing {:without #{:ui/value}}) 200))
98 | :networking (MockNetForMerge.))
99 | {:thing/by-id {1 {:id 1 :label "A" :ui/value 1}
100 | 2 {:id 2 :label "B" :ui/value 2}
101 | 3 {:id 3 :label "C" :ui/value 3}}}
102 | {:inspect-data true})
103 |
104 |
--------------------------------------------------------------------------------
/src/deps.cljs:
--------------------------------------------------------------------------------
1 | {:foreign-libs
2 | [{:file "yahoo/intl-messageformat-with-locales.js"
3 | :file-min "yahoo/intl-messageformat-with-locales.min.js"
4 | :provides ["yahoo.intl-messageformat-with-locales"]}]}
5 |
--------------------------------------------------------------------------------
/src/js.clj:
--------------------------------------------------------------------------------
1 | (ns js
2 | (:require [untangled.i18n.core :as ic])
3 | (:import (com.ibm.icu.text MessageFormat)
4 | (java.util Locale)))
5 |
6 | (defn- current-locale [] @ic/*current-locale*)
7 |
8 | (defn- translations-for-locale [] (get @ic/*loaded-translations* (current-locale)))
9 |
10 | (defn tr
11 | [msg]
12 | (let [msg-key (str "|" msg)
13 | translations (translations-for-locale)
14 | translation (get translations msg-key msg)]
15 | translation))
16 |
17 | (defn trc
18 | [ctxt msg]
19 | (let [msg-key (str ctxt "|" msg)
20 | translations (translations-for-locale)
21 | translation (get translations msg-key msg)]
22 | translation))
23 |
24 | (defn trf
25 | [fmt & {:keys [] :as args}]
26 | (try
27 | (let [argmap (into {} (map (fn [[k v]] [(name k) v]) args))
28 | _ (println argmap)
29 | msg-key (str "|" fmt)
30 | translations (translations-for-locale)
31 | translation (get translations msg-key fmt)
32 | formatter (new MessageFormat translation (Locale/forLanguageTag (current-locale)))]
33 | (.format formatter argmap))
34 | (catch Exception e "???")))
35 |
--------------------------------------------------------------------------------
/src/untangled/client/augmentation.clj:
--------------------------------------------------------------------------------
1 | (ns untangled.client.augmentation
2 | (:require
3 | [untangled.client.impl.util :as utl]
4 | [clojure.string :as str]
5 | [clojure.spec :as s]))
6 |
7 | (defmulti defui-augmentation
8 | "Multimethod for defining augments for use in `untangled.client.ui/defui`.
9 | * `ctx` contains various (& in flux) information about the context in which
10 | the augment is being run (eg: :defui/ui-name, :env/cljs?, :defui/loc).
11 | * `ast` contains the conformed methods of the defui, and is the subject and focus of your transformations.
12 | * `params` contains the parameters the user of your augment has passed to you
13 | when using the augment to make their defui.
14 | eg: `(defui MyComp [(:your/augment {:fake :params})] ...)`"
15 | {:arglists '([ctx ast params])}
16 | (fn [ctx _ _] (:augment/dispatch ctx)))
17 |
18 | (defmulti defui-augmentation-group (fn [{:keys [aug]}] aug))
19 | (defmethod defui-augmentation-group :default [& _] nil)
20 |
21 | (defn- my-group-by [f coll]
22 | (into {} (map (fn [[k v]]
23 | (assert (= 1 (count v))
24 | (str "Cannot implement " k " more than once!"))
25 | [(name k) (first v)]) (group-by f coll))))
26 | (defn group-impls [x]
27 | (-> x
28 | (update :impls (partial mapv (fn [x] (update x :methods (partial my-group-by :name)))))
29 | (update :impls (partial my-group-by :protocol))))
30 | (defn ungroup-impls [x]
31 | (-> x
32 | (update :impls vals)
33 | (update :impls (partial mapv (fn [x] (update x :methods vals))))))
34 |
35 | (s/def ::method
36 | (s/cat :name symbol?
37 | :param-list (s/coll-of symbol? :into [] :kind vector?)
38 | :body (s/+ utl/TRUE)))
39 | (s/def ::impls
40 | (s/cat :static (s/? '#{static})
41 | :protocol symbol?
42 | :methods (s/+ (s/spec ::method))))
43 | (s/def ::augments.vector
44 | (s/coll-of (s/or :kw keyword? :sym symbol?
45 | :call (s/cat :aug (s/or :kw keyword? :sym symbol?)
46 | :params map?))
47 | :into [] :kind vector?))
48 | (s/def ::dev ::augments.vector)
49 | (s/def ::prod ::augments.vector)
50 | (s/def ::always ::augments.vector)
51 | (s/def ::augments
52 | (s/or
53 | :map (s/and map? (s/keys :opt-un [::dev ::prod ::always]))
54 | :vector ::augments.vector))
55 | (s/def ::defui-name symbol?)
56 | (s/def ::defui
57 | (s/and (s/cat
58 | :defui-name ::defui-name
59 | :augments (s/? ::augments)
60 | :impls (s/+ ::impls))
61 | (s/conformer
62 | group-impls
63 | ungroup-impls)))
64 |
65 | (def ^:private defui-augment-mode
66 | (let [allowed-modes {"prod" :prod, "dev" :dev}
67 | ?mode (str/lower-case
68 | (or (System/getenv "DEFUI_AUGMENT_MODE")
69 | (System/getProperty "DEFUI_AUGMENT_MODE")
70 | "prod"))]
71 | (or (get allowed-modes ?mode)
72 | (throw (ex-info "Invalid DEFUI_AUGMENT_MODE, should be 'prod' or 'dev'"
73 | {:invalid-mode ?mode, :allowed-modes (set (keys allowed-modes))})))))
74 | (.println System/out (str "INITIALIZED DEFUI_AUGMENT_MODE TO: " defui-augment-mode))
75 |
76 | (defn- parse [[aug-type aug]]
77 | (case aug-type
78 | (:kw :sym) {:aug aug}
79 | :call (update aug :aug (comp :aug parse))))
80 |
81 | (declare parse-augments)
82 |
83 | (defn- expand-augment [augment]
84 | (if-let [[aug-group cb] (defui-augmentation-group augment)]
85 | (cb (parse-augments (utl/conform! ::augments aug-group)))
86 | [augment]))
87 |
88 | (defn parse-augments "WARNING: FOR INTERNAL USE" [[augs-type augs]]
89 | (case augs-type
90 | :vector (into [] (comp (map parse) (mapcat expand-augment)) augs)
91 | :map (parse-augments [:vector (apply concat (vals (select-keys augs [:always defui-augment-mode])))])))
92 |
93 | ;;==================== AUGMENT BUILDER HELPERS ====================
94 |
95 | (defn add-defui-augmentation-group
96 | "Used for defining a one to many alias for augments,
97 | so that you can bundle up various augments under a single augment.
98 | Has the same augment syntax as `untangled.client.ui/defui`,
99 | but see ::augments for exact and up to date syntax.
100 |
101 | Example: `:untangled.client.ui/BuiltIns` in `untangled.client.impl.built-in-augments`"
102 | [group-dispatch build-augs]
103 | (defmethod defui-augmentation-group group-dispatch [augment]
104 | [(build-augs augment)
105 | (partial mapv
106 | (fn [{:as <> :keys [params aug]}]
107 | (cond-> <> params
108 | (update :params merge (get (:params augment) aug)))))]))
109 |
110 | (s/def ::inject-augment
111 | (s/cat
112 | :ast utl/TRUE
113 | :static (s/? '#{static})
114 | :protocol symbol?
115 | :method symbol?
116 | :body utl/TRUE))
117 |
118 | (defn inject-augment
119 | "EXPERIMENTAL, may change to some sort of def-augment-injection macro
120 |
121 | For use in a defui-augmentation for injecting a method under a protocol.
122 |
123 | WARNING: Does not currently check that the method does not exist,
124 | so this may override the targeted method if it existed before.
125 |
126 | EXAMPLE: `:untangled.client.ui/DerefFactory` in `untangled.client.impl.built-in-augments`"
127 | [& args]
128 | (let [{:keys [ast static protocol method body]}
129 | (utl/conform! ::inject-augment args)]
130 | ;;TODO: Check protocol & method dont already exist
131 | (update-in ast [:impls (str protocol)]
132 | #(-> %
133 | (assoc
134 | :protocol protocol)
135 | (cond-> static
136 | (assoc :static 'static))
137 | (assoc-in [:methods (str method)]
138 | {:name method
139 | :param-list (second body)
140 | :body [(last body)]})))))
141 |
142 | (s/def ::wrap-augment
143 | (s/cat
144 | :ast utl/TRUE
145 | :protocol symbol?
146 | :method symbol?
147 | :wrapper fn?))
148 |
149 | (defn wrap-augment
150 | "EXPERIMENTAL: May change to some sort of def-augment-behavior macro.
151 |
152 | For use in `defui-augmentation` for wrapping an existing method with a behavior.
153 | Is run at compile time, and can be used to transform the method body, or simply add a run time function call.
154 |
155 | WARNING: Does not check that the method (& protocol) existed,
156 | so it may crash unexpectedly if the method is not found until fixed
157 | (if so do tell us on the clojurians slack channel #untangled, and/or make a github issue).
158 |
159 | EXAMPLE: `:untangled.client.ui/WithExclamation` in `untangled.client.impl.built-in-augments`"
160 | [& args]
161 | (let [{:keys [ast protocol method wrapper]}
162 | (utl/conform! ::wrap-augment args)]
163 | ;;TODO: Check protocol & method already exist
164 | (update-in ast [:impls (str protocol) :methods (str method)]
165 | (fn [{:as method :keys [body param-list]}]
166 | (assoc method :body
167 | (conj (vec (butlast body))
168 | (wrapper param-list (last body))))))))
169 |
--------------------------------------------------------------------------------
/src/untangled/client/cards.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.client.cards
2 | #?(:cljs (:require-macros untangled.client.cards)) ; this enables implicit macro loading
3 | #?(:cljs (:require ; ensure the following things are loaded in the CLJS env
4 | untangled.client.core
5 | untangled.dom)))
6 |
7 | ; At the time of this writing, devcards is not server-rendering compatible, and dom-node is a cljs-only thing.
8 | (defmacro untangled-app
9 | "Embed an untangled client application in a devcard. The `args` can be any args you'd
10 | normally pass to `new-untangled-client` except for `:initial-state` (which is taken from
11 | InitialAppState or the card's data in that preferred order)"
12 | [root-ui & args]
13 | `(devcards.core/dom-node
14 | (fn [state-atom# node#]
15 | (untangled.client.core/mount (untangled.client.core/new-untangled-client :initial-state state-atom# ~@args) ~root-ui node#)
16 | ; ensures shows app state immediately if you're using inspect data and InitialAppState:
17 | (js/setTimeout (fn [] (swap! state-atom# assoc :ui/react-key (untangled.dom/unique-key))) 1000))))
18 |
--------------------------------------------------------------------------------
/src/untangled/client/impl/application.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.application
2 | (:require [untangled.client.logging :as log]
3 | [om.next :as om]
4 | [untangled.client.impl.data-fetch :as f]
5 | [untangled.client.impl.util :as util]
6 | #?(:cljs [cljs.core.async :as async]
7 | :clj
8 | [clojure.core.async :as async :refer [go]])
9 | [untangled.client.impl.network :as net]
10 | [untangled.client.impl.om-plumbing :as plumbing]
11 | [untangled.i18n.core :as i18n])
12 | #?(:cljs (:require-macros
13 | [cljs.core.async.macros :refer [go]])))
14 |
15 | (defn fallback-handler
16 | "This internal function is responsible for generating and returning a function that can accomplish calling the fallbacks that
17 | appear in an incoming Om transaction, which is in turn used by the error-handling logic of the plumbing."
18 | [{:keys [reconciler]} query]
19 | (fn [error]
20 | (swap! (om/app-state reconciler) assoc :untangled/server-error error)
21 | (if-let [q (plumbing/fallback-query query error)]
22 | (do (log/warn (log/value-message "Transaction failed. Running fallback." q))
23 | (om/transact! reconciler q))
24 | (log/warn "Fallback triggered, but no fallbacks were defined."))))
25 |
26 | ;; this is here so we can do testing (can mock core async stuff out of the way)
27 | (defn- enqueue
28 | "Enqueue a send to the network queue. This is a standalone function because we cannot mock core async functions."
29 | [q v]
30 | (go (async/>! q v)))
31 |
32 | (defn real-send
33 | "Do a properly-plumbed network send. This function recursively strips ui attributes from the tx and pushes the tx over
34 | the network. It installs the given on-load and on-error handlers to deal with the network response."
35 | [net tx on-done on-error on-load]
36 | ; server-side rendering doesn't do networking. Don't care.
37 | (if #?(:clj false
38 | :cljs (implements? net/ProgressiveTransfer net))
39 | (net/updating-send net (plumbing/strip-ui tx) on-done on-error on-load)
40 | (net/send net (plumbing/strip-ui tx) on-done on-error)))
41 |
42 | (defn split-mutations
43 | "Split a tx that contains mutations. Returns a vector that contains at least one tx (the original).
44 |
45 | Examples:
46 | [(f) (g)] => [[(f) (g)]]
47 | [(f) (g) (f) (k)] => [[(f) (g)] [(f) (k)]]
48 | [(f) (g) (f) (k) (g)] => [[(f) (g)] [(f) (k) (g)]]
49 | "
50 | [tx]
51 | (if-not (and (vector? tx) (every? (fn [t] (and (list? t) (symbol? (first t)))) tx))
52 | (do
53 | (log/error "INTERNAL ERROR: split-mutations was asked to split a tx that contained things other than mutations." tx)
54 | [tx])
55 | (if (empty? tx)
56 | []
57 | (let [mutation-name (fn [m] (first m))
58 | {:keys [accumulator current-tx]}
59 | (reduce (fn [{:keys [seen accumulator current-tx]} mutation]
60 | (if (contains? seen (mutation-name mutation))
61 | {:seen #{} :accumulator (conj accumulator current-tx) :current-tx [mutation]}
62 | {:seen (conj seen (mutation-name mutation))
63 | :accumulator accumulator
64 | :current-tx (conj current-tx mutation)})) {:seen #{} :accumulator [] :current-tx []} tx)]
65 | (conj accumulator current-tx)))))
66 |
67 | (defn enqueue-mutations
68 | "Splits out the (remote) mutations and fallbacks in a transaction, creates an error handler that can
69 | trigger fallbacks, and enqueues the remote mutations on the network queue. If duplicate mutation names
70 | appear, then they will be separated into separate network requests.
71 |
72 | NOTE: If the mutation in the tx has duplicates, then the same fallback will be used for the
73 | resulting split tx. See `split-mutations` (which is used by this function to split dupes out of txes)."
74 | [{:keys [send-queues] :as app} remote-tx-map cb]
75 | (doseq [remote (keys remote-tx-map)]
76 | (let [queue (get send-queues remote)
77 | full-remote-transaction (get remote-tx-map remote)
78 | fallback (fallback-handler app full-remote-transaction)
79 | desired-remote-mutations (plumbing/remove-loads-and-fallbacks full-remote-transaction)
80 | tx-list (split-mutations desired-remote-mutations)
81 | ; todo: split remote mutations
82 | has-mutations? (fn [tx] (> (count tx) 0))
83 | payload (fn [tx]
84 | {:query tx
85 | :on-load cb
86 | :on-error #(fallback %)})]
87 | (doseq [tx tx-list]
88 | (when (has-mutations? tx)
89 | (enqueue queue (payload tx)))))))
90 |
91 | (defn enqueue-reads
92 | "Finds any loads marked `parallel` and triggers real network requests immediately. Remaining loads
93 | are pulled into a single fetch payload (combined into one query) and enqueued behind any prior mutations/reads that
94 | were already requested in a prior UI/event cycle. Thus non-parallel reads are processed in clusters grouped due to UI
95 | events (a single event might trigger many reads which will all go to the server as a single combined request).
96 | Further UI events that trigger remote interaction will end up waiting until prior network request(s) are complete.
97 |
98 | This ensures that default reasoning is simple and sequential in the face of optimistic UI updates (real network
99 | traffic characteristics could cause out of order processing, and you would not want
100 | a 'create list' to be processed on the server *after* an 'add an item to the list'). "
101 | [{:keys [send-queues reconciler networking]}]
102 | (doseq [remote (keys send-queues)]
103 | (let [queue (get send-queues remote)
104 | network (get networking remote)
105 | parallel-payload (f/mark-parallel-loading remote reconciler)]
106 | (doseq [{:keys [query on-load on-error load-descriptors]} parallel-payload]
107 | (let [on-load' #(on-load % load-descriptors)
108 | on-error' #(on-error % load-descriptors)]
109 | ; TODO: queries cannot report progress, yet. Could update the payload marker in app state.
110 | (real-send network query on-load' on-error' nil)))
111 | (loop [fetch-payload (f/mark-loading remote reconciler)]
112 | (when fetch-payload
113 | (enqueue queue (assoc fetch-payload :networking network))
114 | (recur (f/mark-loading remote reconciler)))))))
115 |
116 | (defn detect-errant-remotes [{:keys [reconciler send-queues] :as app}]
117 | (let [state (om/app-state reconciler)
118 | all-items (get @state :untangled/ready-to-load)
119 | item-remotes (into #{} (map f/data-remote all-items))
120 | all-remotes (set (keys send-queues))
121 | invalid-remotes (clojure.set/difference item-remotes all-remotes)]
122 | (when (not-empty invalid-remotes) (log/error (str "Use of invalid remote(s) detected! " invalid-remotes)))))
123 |
124 | (defn server-send
125 | "Puts queries/mutations (and their corresponding callbacks) onto the send queue. The networking code will pull these
126 | off one at a time and send them through the real networking layer. Reads are guaranteed to *follow* writes."
127 | [app remote-tx-map cb]
128 | (detect-errant-remotes app)
129 | (enqueue-mutations app remote-tx-map cb)
130 | (enqueue-reads app))
131 |
132 | (defn- send-payload
133 | "Sends a network payload. There are two kinds of payloads in Untanged. The first is
134 | for reads, which are tracked by load descriptors in the app state. These load descriptors
135 | tell the plumbing how to handle the response, and expect to only be merged in once. Mutations
136 | do not have a payload, and can technically received progress updates from the network. The built-in
137 | networking does not (currently) give progress events, but plugin networking can. It is currently not
138 | supported to give an update on a load, so this function is careful to detect that a payload is a send
139 | and turns all but the last update into a no-op. The send-complete function comes from the
140 | network sequential processing loop, and when called unblocks the network processing to allow the
141 | next request to go. Be very careful with this code, as bugs will cause applications to stop responding
142 | to remote requests."
143 | [network payload send-complete]
144 | ; Note, only data-fetch reads will have load-descriptors,
145 | ; in which case the payload on-load is data-fetch/loaded-callback, and cannot handle updates.
146 | (let [{:keys [query on-load on-error load-descriptors]} payload
147 | merge-data (if load-descriptors #(on-load % load-descriptors) on-load)
148 | on-update (if load-descriptors identity merge-data) ; TODO: queries cannot handle progress
149 | on-error (if load-descriptors #(on-error % load-descriptors) on-error)
150 | on-error (comp send-complete on-error)
151 | on-done (comp send-complete merge-data)]
152 | (real-send network query on-done on-error on-update)))
153 |
154 | (defn is-sequential? [network]
155 | (if (and #?(:clj false :cljs (implements? net/NetworkBehavior network)))
156 | (net/serialize-requests? network)
157 | true))
158 |
159 | (defn start-network-sequential-processing
160 | "Starts a async go loop that sends network requests on a networking object's request queue. Must be called once and only
161 | once for each active networking object on the UI. Each iteration of the loop pulls off a
162 | single request, sends it, waits for the response, and then repeats. Gives the appearance of a separate networking
163 | 'thread' using core async."
164 | [{:keys [networking send-queues response-channels]}]
165 | (doseq [remote (keys send-queues)]
166 | (let [queue (get send-queues remote)
167 | network (get networking remote)
168 | sequential? (is-sequential? network)
169 | response-channel (get response-channels remote)
170 | send-complete (if sequential?
171 | (fn [] (go (async/>! response-channel :complete)))
172 | identity)]
173 | (go
174 | (loop [payload (async/> source
222 | (filter (fn [[k _]] (not (symbol? k))))
223 | (into {}))
224 | merged-state (sweep-merge target source-to-merge)]
225 | (reduce (fn [acc [k v]]
226 | (if (and mutation-merge (symbol? k))
227 | (if-let [updated-state (mutation-merge acc k (dissoc v :tempids))]
228 | updated-state
229 | (do
230 | (log/info "Return value handler for" k "returned nil. Ignored.")
231 | acc))
232 | acc)) merged-state source)))
233 |
234 | (defn generate-reconciler
235 | "The reconciler's send method calls UntangledApplication/server-send, which itself requires a reconciler with a
236 | send method already defined. This creates a catch-22 / circular dependency on the reconciler and :send field within
237 | the reconciler.
238 |
239 | To resolve the issue, we def an atom pointing to the reconciler that the send method will deref each time it is
240 | called. This allows us to define the reconciler with a send method that, at the time of initialization, has an app
241 | that points to a nil reconciler. By the end of this function, the app's reconciler reference has been properly set."
242 | [{:keys [send-queues mutation-merge] :as app} initial-state parser {:keys [migrate] :as reconciler-options}]
243 | (let [rec-atom (atom nil)
244 | remotes (keys send-queues)
245 | tempid-migrate (fn [pure _ tempids _]
246 | (doseq [queue (vals send-queues)]
247 | (plumbing/rewrite-tempids-in-request-queue queue tempids))
248 | (let [state-migrate (or migrate plumbing/resolve-tempids)]
249 | (state-migrate pure tempids)))
250 | initial-state-with-locale (if (util/atom? initial-state)
251 | (do
252 | (swap! initial-state assoc :ui/locale "en-US")
253 | initial-state)
254 | (assoc initial-state :ui/locale "en-US"))
255 | config (merge {:pathopt true}
256 | reconciler-options
257 | {:migrate tempid-migrate
258 | :state initial-state-with-locale
259 | :send (fn [tx cb]
260 | (server-send (assoc app :reconciler @rec-atom) tx cb))
261 | :normalize true
262 | :remotes remotes
263 | :merge-ident (fn [reconciler app-state ident props]
264 | (update-in app-state ident (comp sweep-one merge) props))
265 | :merge-tree (fn [target source]
266 | (merge-handler mutation-merge target source))
267 | :parser parser})
268 | rec (om/reconciler config)]
269 | (reset! rec-atom rec)
270 | rec))
271 |
272 | (defn initialize-global-error-callbacks
273 | [app]
274 | (doseq [remote (keys (:networking app))]
275 | (let [cb-atom (get-in app [:networking remote :global-error-callback])]
276 | (when (util/atom? cb-atom)
277 | (swap! cb-atom #(if (fn? %)
278 | (partial % (om/app-state (:reconciler app)))
279 | (throw (ex-info "Networking error callback must be a function." {}))))))))
280 |
--------------------------------------------------------------------------------
/src/untangled/client/impl/built_in_augments.clj:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.built-in-augments
2 | (:require
3 | [untangled.client.impl.util :as utl]
4 | [untangled.client.augmentation :as aug]))
5 |
6 | (defmethod aug/defui-augmentation :untangled.client.ui/DerefFactory
7 | [{:keys [defui/ui-name env/cljs?]} ast args]
8 | (aug/inject-augment ast 'static
9 | (if cljs? 'IDeref 'clojure.lang.IDeref)
10 | (if cljs? '-deref 'deref)
11 | `(fn [_#] (om.next/factory ~ui-name ~(or args {})))))
12 |
13 | (defmethod aug/defui-augmentation :untangled.client.ui/WithExclamation
14 | [_ ast {:keys [excl]}]
15 | (aug/wrap-augment ast 'Object 'render
16 | (fn [_ body]
17 | `(om.dom/div nil
18 | (om.dom/p nil ~(str excl))
19 | ~body))))
20 |
21 | (aug/add-defui-augmentation-group :untangled.client.ui/BuiltIns
22 | (fn [_augment]
23 | '[:untangled.client.ui/DerefFactory
24 | (:untangled.client.ui/WithExclamation {:excl "BuiltIns Engaged!"})]))
25 |
--------------------------------------------------------------------------------
/src/untangled/client/impl/built_in_mutations.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.built-in-mutations
2 | (:require [untangled.client.mutations :refer [mutate post-mutate]]
3 | [untangled.client.logging :as log]
4 | [untangled.client.impl.data-fetch :as df]
5 | [untangled.dom :refer [unique-key]]
6 | [untangled.i18n.core :as i18n]))
7 |
8 | ; Built-in mutation for adding a remote query to the network requests.
9 | (defmethod mutate 'untangled/load
10 | [{:keys [state]} _ {:keys [post-mutation remote]
11 | :as config}]
12 | (when (and post-mutation (not (symbol? post-mutation))) (log/error "post-mutation must be a symbol or nil"))
13 | {(if remote remote :remote) true
14 | :action (fn [] (df/mark-ready (assoc config :state state)))})
15 |
16 | ; Built-in i18n mutation for changing the locale of the application. Causes a re-render.
17 | (defmethod mutate 'ui/change-locale [{:keys [state]} _ {:keys [lang]}]
18 | {:action (fn []
19 | (reset! i18n/*current-locale* lang)
20 | (swap! state #(-> %
21 | (assoc :ui/locale lang)
22 | (assoc :ui/react-key (unique-key)))))})
23 |
24 | ; A mutation that requests the installation of a fallback mutation on a transaction that should run if that transaction
25 | ; fails in a 'hard' way (e.g. network/server error). Data-related error handling should either be implemented as causing
26 | ; such a hard error, or as a post-mutation step.
27 | (defmethod mutate 'tx/fallback [env _ {:keys [action execute] :as params}]
28 | (if execute
29 | {:action #(some-> (mutate env action (dissoc params :action :execute)) :action (apply []))}
30 | {:remote true}))
31 |
32 | ; A convenience helper, generally used 'bit twiddle' the data on a particular database table (using the component's ident).
33 | ; Specifically, merge the given `params` into the state of the database object at the component's ident.
34 | ; In general, it is recommended this be used for ui-only properties that have no real use outside of the component.
35 | (defmethod mutate 'ui/set-props [{:keys [state ref]} _ params]
36 | (when (nil? ref) (log/error "ui/set-props requires component to have an ident."))
37 | {:action #(swap! state update-in ref (fn [st] (merge st params)))})
38 |
39 | ; A helper method that toggles the true/false nature of a component's state by ident.
40 | ; Use for local UI data only. Use your own mutations for things that have a good abstract meaning.
41 | (defmethod mutate 'ui/toggle [{:keys [state ref]} _ {:keys [field]}]
42 | (when (nil? ref) (log/error "ui/toggle requires component to have an ident."))
43 | {:action #(swap! state update-in (conj ref field) not)})
44 |
45 | (defmethod mutate :default [{:keys [target]} k _]
46 | (when (nil? target)
47 | (log/error (log/value-message "Unknown app state mutation. Have you required the file with your mutations?" k))))
48 |
49 | ;
50 | (defmethod post-mutate :default [env k p] nil)
51 |
--------------------------------------------------------------------------------
/src/untangled/client/impl/network.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.network
2 | (:refer-clojure :exclude [send])
3 | (:require [untangled.client.logging :as log]
4 | [cognitect.transit :as ct]
5 | #?(:cljs [goog.events :as events])
6 | [om.transit :as t]
7 | [clojure.string :as str])
8 | #?(:cljs (:import [goog.net XhrIo EventType])))
9 |
10 | (declare make-untangled-network)
11 |
12 | #?(:cljs
13 | (defn make-xhrio "This is here (not inlined) to make mocking easier." [] (XhrIo.)))
14 |
15 | (defprotocol NetworkBehavior
16 | (serialize-requests? [this] "Returns true if the network is configured to desire one request at a time."))
17 |
18 | (defprotocol ProgressiveTransfer
19 | (updating-send [this edn done-callback error-callback update-callback] "Send EDN. The update-callback will merge the state
20 | given to it. The done-callback will merge the state given to it, and indicates completion."))
21 |
22 | (defprotocol UntangledNetwork
23 | (send [this edn done-callback error-callback]
24 | "Send EDN. Calls either the done or error callback when the send is done, and optionally calls the update-callback
25 | one or more times during the transfer (if not nil and supported)")
26 | (start [this complete-app]
27 | "Starts the network, passing in the app for any components that may need it."))
28 |
29 | (defprotocol IXhrIOCallbacks
30 | (response-ok [this xhrio ok-cb] "Called by XhrIo on OK")
31 | (response-error [this xhrio err-cb] "Called by XhrIo on ERROR"))
32 |
33 | #?(:cljs
34 | (defn parse-response
35 | "An XhrIo-specific implementation method for interpreting the server response."
36 | ([xhr-io] (parse-response xhr-io nil))
37 | ([xhr-io read-handlers]
38 | (try (let [text (.getResponseText xhr-io)
39 | base-handlers {"f" (fn [v] (js/parseFloat v)) "u" cljs.core/uuid}
40 | handlers (if (map? read-handlers) (merge base-handlers read-handlers) base-handlers)]
41 | (if (str/blank? text)
42 | (.getStatus xhr-io)
43 | (ct/read (t/reader {:handlers handlers})
44 | (.getResponseText xhr-io))))
45 | (catch js/Object e {:error 404 :message "Server down"})))))
46 |
47 | (defrecord Network [url request-transform global-error-callback complete-app transit-handlers]
48 | NetworkBehavior
49 | (serialize-requests? [this] true)
50 | IXhrIOCallbacks
51 | (response-ok [this xhr-io valid-data-callback]
52 | ;; Implies: everything went well and we have a good response
53 | ;; (i.e., got a 200).
54 | #?(:cljs
55 | (try
56 | (let [read-handlers (:read transit-handlers)
57 | query-response (parse-response xhr-io read-handlers)]
58 | (when (and query-response valid-data-callback) (valid-data-callback query-response)))
59 | (finally (.dispose xhr-io)))))
60 | (response-error [this xhr-io error-callback]
61 | ;; Implies: request was sent.
62 | ;; *Always* called if completed (even in the face of network errors).
63 | ;; Used to detect errors.
64 | #?(:cljs
65 | (try
66 | (let [status (.getStatus xhr-io)
67 | log-and-dispatch-error (fn [str error]
68 | ;; note that impl.application/initialize will partially apply the
69 | ;; app-state as the first arg to global-error-callback
70 | (log/error str)
71 | (error-callback error)
72 | (when @global-error-callback
73 | (@global-error-callback status error)))]
74 | (if (zero? status)
75 | (log-and-dispatch-error
76 | (str "UNTANGLED NETWORK ERROR: No connection established.")
77 | {:type :network})
78 | (log-and-dispatch-error
79 | (str "SERVER ERROR CODE: " status)
80 | (parse-response xhr-io transit-handlers))))
81 | (finally (.dispose xhr-io)))))
82 | UntangledNetwork
83 | (send [this edn ok error]
84 | #?(:cljs
85 | (let [xhrio (make-xhrio)
86 | handlers (or (:write transit-handlers) {})
87 | headers {"Content-Type" "application/transit+json"}
88 | {:keys [body headers]} (cond-> {:body edn :headers headers}
89 | request-transform request-transform)
90 | post-data (ct/write (t/writer {:handlers handlers}) body)
91 | headers (clj->js headers)]
92 | (.send xhrio url "POST" post-data headers)
93 | (events/listen xhrio (.-SUCCESS EventType) #(response-ok this xhrio ok))
94 | (events/listen xhrio (.-ERROR EventType) #(response-error this xhrio error)))))
95 | (start [this app]
96 | (assoc this :complete-app app)))
97 |
98 |
99 | (defn make-untangled-network
100 | "TODO: This is PUBLIC API! Should not be in impl ns.
101 |
102 | Build an Untangled Network object using the default implementation.
103 |
104 | Features:
105 |
106 | - Can configure the target URL on the server for Om network requests
107 | - Can supply a (fn [{:keys [body headers] :as req}] req') to transform arbitrary requests (e.g. to add things like auth headers)
108 | - Supports a global error callback (fn [status-code error] ) that is notified when a 400+ status code or hard network error occurs
109 | - `transit-handlers`: A map of transit handlers to install on the reader, such as
110 |
111 | `{ :read { \"thing\" (fn [wire-value] (convert wire-value))) }
112 | :write { Thing (ThingHandler.) } }`
113 |
114 | where:
115 |
116 | (defrecord Thing [foo])
117 |
118 | (deftype ThingHandler []
119 | Object
120 | (tag [_ _] \"thing\")
121 | (rep [_ thing] (make-raw thing))
122 | (stringRep [_ _] nil)))
123 | "
124 | [url & {:keys [request-transform global-error-callback transit-handlers]}]
125 | (map->Network {:url url
126 | :transit-handlers transit-handlers
127 | :request-transform request-transform
128 | :global-error-callback (atom global-error-callback)}))
129 |
130 | (defrecord MockNetwork
131 | [complete-app]
132 | UntangledNetwork
133 | (send [this edn ok err] (log/info "Ignored (mock) Network request " edn))
134 | (start [this app]
135 | (assoc this :complete-app app)))
136 |
137 | (defn mock-network [] (map->MockNetwork {}))
138 |
--------------------------------------------------------------------------------
/src/untangled/client/impl/om_plumbing.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.om-plumbing
2 | (:require [om.next :as om]
3 | [om.util :as util]
4 | [untangled.client.mutations :as m]
5 | [untangled.client.logging :as log]
6 | #?(:cljs
7 | [cljs.core.async :as async]
8 | :clj
9 | [clojure.core.async :as async])
10 | [clojure.walk :as walk]))
11 |
12 | (defn read-local
13 | "Read function for the Om parser.
14 |
15 | *** NOTE: This function only runs when it is called without a target -- it is not triggered for remote reads. To
16 | trigger a remote read, use the `untangled/data-fetch` namespace. ***
17 |
18 | Returns the current locale when reading the :ui/locale keyword. Otherwise pulls data out of the app-state.
19 | "
20 | [{:keys [query target state ast]} dkey _]
21 | (when (not target)
22 | (case dkey
23 | (let [top-level-prop (nil? query)
24 | key (or (:key ast) dkey)
25 | by-ident? (util/ident? key)
26 | union? (map? query)
27 | data (if by-ident? (get-in @state key) (get @state key))]
28 | {:value
29 | (cond
30 | union? (get (om/db->tree [{key query}] @state @state) key)
31 | top-level-prop data
32 | :else (om/db->tree query data @state))}))))
33 |
34 | (defn write-entry-point
35 | "This is the Om entry point for writes. In general this is simply a call to the multi-method
36 | defined by Untangled (mutate); however, Untangled supports the concept of a global `post-mutate`
37 | function that will be called anytime the general mutate has an action that is desired. This
38 | can be useful, for example, in cases where you have some post-processing that needs
39 | to happen for a given (sub)set of mutations (that perhaps you did not define)."
40 | [env k params]
41 | (let [rv (try
42 | (m/mutate env k params)
43 | (catch #?(:cljs :default :clj Exception) e
44 | (log/error (str "Mutation " k " failed with exception") e)
45 | nil))
46 | action (:action rv)]
47 | (if action
48 | (assoc rv :action (fn []
49 | (try
50 | (let [action-result (action env k params)]
51 | (try
52 | (m/post-mutate env k params)
53 | (catch #?(:cljs :default :clj Exception) e (log/error (str "Post mutate failed on dispatch to " k))))
54 | action-result)
55 | (catch #?(:cljs :default :clj Exception) e
56 | (log/error (str "Mutation " k " failed with exception") e)
57 | (throw e)))))
58 | rv)))
59 |
60 | (defn resolve-tempids
61 | "Replaces all om-tempids in app-state with the ids returned by the server."
62 | [state tid->rid]
63 | (if (empty? tid->rid)
64 | state
65 | (walk/prewalk #(if (om/tempid? %) (get tid->rid % %) %) state)))
66 |
67 | (defn rewrite-tempids-in-request-queue
68 | "Rewrite any pending requests in the request queue to account for the fact that a response might have
69 | changed ids that are expressed in the mutations of that queue. tempid-map MUST be a map from om
70 | tempid to real ids, not idents."
71 | [queue tempid-map]
72 | (loop [entry (async/poll! queue) entries []]
73 | (cond
74 | entry (recur (async/poll! queue) (conj entries (resolve-tempids entry tempid-map)))
75 | (seq entries) (doseq [e entries] (assert (async/offer! queue e) "Queue should not block.")))))
76 |
77 | (defn remove-loads-and-fallbacks
78 | "Removes all untangled/load and tx/fallback mutations from the query"
79 | [query]
80 | (let [symbols-to-filter #{'untangled/load 'tx/fallback}
81 | ast (om/query->ast query)
82 | children (:children ast)
83 | new-children (filter (fn [child] (not (contains? symbols-to-filter (:dispatch-key child)))) children)
84 | new-ast (assoc ast :children new-children)]
85 | (om/ast->query new-ast)))
86 |
87 | (defn fallback-query [query resp]
88 | "Filters out everything from the query that is not a fallback mutation.
89 | Returns nil if the resulting expression is empty."
90 | (let [symbols-to-find #{'tx/fallback}
91 | ast (om/query->ast query)
92 | children (:children ast)
93 | new-children (->> children
94 | (filter (fn [child] (contains? symbols-to-find (:dispatch-key child))))
95 | (map (fn [ast] (update ast :params assoc :execute true :error resp))))
96 | new-ast (assoc ast :children new-children)
97 | fallback-query (om/ast->query new-ast)]
98 | (when (not-empty fallback-query)
99 | fallback-query)))
100 |
101 | (defn- is-ui-query-fragment?
102 | "Check the given keyword to see if it is in the :ui namespace."
103 | [kw]
104 | (when (keyword? kw) (some->> kw namespace (re-find #"^ui(?:\.|$)"))))
105 |
106 | (defn strip-ui
107 | "Returns a new query with fragments that are in the `ui` namespace removed."
108 | [query]
109 | (let [ast (om/query->ast query)
110 | drop-ui-children (fn drop-ui-children [ast-node]
111 | (assoc ast-node :children
112 | (reduce (fn [acc n]
113 | (if (is-ui-query-fragment? (:dispatch-key n))
114 | acc
115 | (conj acc (drop-ui-children n))
116 | )
117 | ) [] (:children ast-node))))]
118 | (om/ast->query (drop-ui-children ast))))
119 |
120 | (def nf ::not-found)
121 |
122 | (defn walk [inner outer form]
123 | (cond
124 | (map? form) (outer (into (empty form) (map #(inner (with-meta % {:map-entry? true})) form)))
125 | (list? form) (outer (apply list (map inner form)))
126 | (seq? form) (outer (doall (map inner form)))
127 | (record? form) (outer (reduce (fn [r x] (conj r (inner x))) form form))
128 | (coll? form) (outer (into (empty form) (map inner form)))
129 | :else (outer form)))
130 |
131 | (defn prewalk [f form]
132 | (walk (partial prewalk f) identity (f form)))
133 |
134 | (defn postwalk [f form]
135 | (walk (partial postwalk f) f form))
136 |
137 | (defn recursive? [qf]
138 | (or ;(number? qf)
139 | (= '... qf)))
140 | (defn add-meta-to-recursive-queries [q]
141 | (let [a (atom q)]
142 | (->> q
143 | (prewalk
144 | #(cond
145 | (and (vector? %)
146 | (-> % meta :map-entry? false?))
147 | (do (reset! a %) %)
148 |
149 | (number? %) (with-meta '... {:... @a :depth %})
150 |
151 | (recursive? %) (with-meta % {:... @a})
152 | :else %))
153 | (postwalk
154 | #(cond
155 | (and (vector? %)
156 | (not (some-> % meta :map-entry?))
157 | (= (count %) 2)
158 | (some-> % second meta :depth number?))
159 | [(first %) (-> % second meta :depth)]
160 |
161 | :else %)))))
162 |
163 | (defn as-leaf
164 | "Returns data with meta-data marking it as a leaf in the result."
165 | [data]
166 | (if (coll? data)
167 | (with-meta data {:untangled/leaf true})
168 | data))
169 |
170 | (defn leaf?
171 | "Returns true iff the given data is marked as a leaf in the result (according to the query). Requires pre-marking."
172 | [data]
173 | (or
174 | (not (coll? data))
175 | (empty? data)
176 | (and (coll? data)
177 | (-> data meta :untangled/leaf boolean))))
178 |
179 | (defn mark-missing
180 | "Recursively walk the query and response marking anything that was *asked for* in the query but is *not* in the response as missing.
181 | The merge process (which happens later in the plumbing) looks for these markers as indicators to remove any existing
182 | data in the database (which has provably disappeared).
183 |
184 | The naive approach to data merging (even recursive) would fail to remove such data.
185 |
186 | Returns the result with missing markers in place (which are then used/removed in a later stage)."
187 | [result query]
188 | (letfn [(paramterized? [q]
189 | (and (list? q)
190 | (or (symbol? (first q))
191 | (= 2 (count q)))))
192 | (ok*not-found [res k]
193 | (cond
194 | (contains? res k) res
195 | (recursive? k) res
196 | (util/ident? k) (assoc (if (map? res) res {}) k {:ui/fetch-state {:untangled.client.impl.data-fetch/type :not-found}})
197 | :else (assoc (if (map? res) res {}) k nf)))
198 | (union->query [u] (->> u vals flatten set))
199 | (union? [q]
200 | (let [expr (cond-> q (seq? q) first)]
201 | (and (map? expr)
202 | (< 1 (count (seq expr))))))
203 | (step [res q]
204 | (let [q (if (paramterized? q) (first q) q)
205 | [query-key ?sub-query] (cond
206 | (util/join? q)
207 | [(util/join-key q) (util/join-value q)]
208 | :else [q nil])
209 | result-or-not-found (ok*not-found res query-key)
210 | result-or-not-found (if (and (keyword? q) (map? result-or-not-found)) (update result-or-not-found q as-leaf) result-or-not-found)
211 | sub-result (get result-or-not-found query-key)]
212 | (cond
213 | ;; singleton union result
214 | (and (union? ?sub-query) (map? sub-result))
215 | (assoc result-or-not-found query-key
216 | (mark-missing sub-result
217 | (union->query (get q query-key))))
218 |
219 | ;; list union result
220 | (and (union? ?sub-query) (coll? sub-result))
221 | (as-> sub-result <>
222 | (mapv #(mark-missing % (union->query (get q query-key))) <>)
223 | (assoc result-or-not-found query-key <>))
224 |
225 | ;; ui.*/ fragment's are ignored
226 | (is-ui-query-fragment? q) (as-leaf res)
227 |
228 | ;; recur
229 | (and ?sub-query
230 | (not= nf sub-result)
231 | (not (recursive? ?sub-query)))
232 | (as-> sub-result <>
233 | (if (vector? <>)
234 | (mapv #(mark-missing % ?sub-query) <>)
235 | (mark-missing <> ?sub-query))
236 | (assoc result-or-not-found query-key <>))
237 |
238 | ;; recursive?
239 | (recursive? ?sub-query)
240 | (if-let [res- (get res query-key)]
241 | (as-> res- <>
242 | (if (vector? <>)
243 | (mapv #(mark-missing % ?sub-query) <>)
244 | (mark-missing <> ?sub-query))
245 | (assoc res query-key <>))
246 | result-or-not-found)
247 |
248 | ;; nf so next step
249 | :else result-or-not-found)))]
250 | (reduce step result
251 | (if (recursive? query)
252 | (-> query meta :... add-meta-to-recursive-queries)
253 | (add-meta-to-recursive-queries query)))))
254 |
255 |
--------------------------------------------------------------------------------
/src/untangled/client/impl/protocol_support.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.protocol-support
2 | (:require
3 | [untangled-spec.core :refer-macros [assertions behavior]]
4 | [cljs.test :refer-macros [is]]
5 | [clojure.walk :as walk]
6 | [om.next :as om :refer [defui]]
7 | [om.dom :as dom]
8 | [untangled.client.core :as core]))
9 |
10 | (defn tempid?
11 | "Is the given keyword a seed data tempid keyword (namespaced to `tempid`)?"
12 | [kw] (and (keyword? kw) (= "om.tempid" (namespace kw))))
13 |
14 | (defn rewrite-tempids
15 | "Rewrite tempid keywords in the given state using the tid->rid map. Leaves the keyword alone if the map
16 | does not contain an entry for it."
17 | [state tid->rid & [pred]]
18 | (walk/prewalk #(if ((or pred tempid?) %)
19 | (get tid->rid % %) %)
20 | state))
21 |
22 | (defn check-delta
23 | "Checks that `new-state` includes the `delta`, where `delta` is a map keyed by data path (as in get-in). The
24 | values of `delta` are literal values to verify at that path (nil means the path should be missing)."
25 | [new-state delta]
26 | (if (empty? delta)
27 | (throw (ex-info "Cannot have empty :merge-delta"
28 | {:new-state new-state}))
29 | (doseq [[key-path value] delta]
30 | (let [behavior-string (:cps/behavior value)
31 | value (or (:cps/value value) value)]
32 | (behavior behavior-string
33 | (if (instance? js/RegExp value)
34 | (is (re-matches value (get-in new-state key-path)))
35 | (is (= value (get-in new-state key-path)))))))))
36 |
37 | (defn with-behavior [behavior-string value]
38 | {:cps/value value
39 | :cps/behavior behavior-string})
40 |
41 | (defn allocate-tempids [tx]
42 | (let [allocated-ids (atom #{})]
43 | (walk/prewalk
44 | (fn [v] (when (tempid? v) (swap! allocated-ids conj v)) v)
45 | tx)
46 | (into {} (map #(vector % (om/tempid)) @allocated-ids))))
47 |
48 | (defui Root
49 | static om/IQuery (query [this] [:fake])
50 | Object (render [this] (dom/div nil "if you see this something is wrong")))
51 |
52 | (defn init-testing []
53 | (-> (core/new-untangled-test-client)
54 | (core/mount Root "invisible-specs")))
55 |
--------------------------------------------------------------------------------
/src/untangled/client/impl/util.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.client.impl.util
2 | (:require
3 | [clojure.pprint :refer [pprint]]
4 | [clojure.spec :as s]
5 | [om.next :as om]
6 | #?(:clj
7 | [clojure.spec.gen :as sg]))
8 | #?(:clj
9 | (:import (clojure.lang Atom))))
10 |
11 | (defn atom? [a] (instance? Atom a))
12 |
13 | (defn deep-merge [& xs]
14 | "Merges nested maps without overwriting existing keys."
15 | (if (every? map? xs)
16 | (apply merge-with deep-merge xs)
17 | (last xs)))
18 |
19 | (defn log-app-state
20 | "Helper for logging the app-state. Pass in an untangled application atom and either top-level keys, data-paths
21 | (like get-in), or both."
22 | [app-atom & keys-and-paths]
23 | (try
24 | (let [app-state (om/app-state (:reconciler @app-atom))]
25 | (pprint
26 | (letfn [(make-path [location]
27 | (if (sequential? location) location [location]))
28 | (process-location [acc location]
29 | (let [path (make-path location)]
30 | (assoc-in acc path (get-in @app-state path))))]
31 |
32 | (condp = (count keys-and-paths)
33 | 0 @app-state
34 | 1 (get-in @app-state (make-path (first keys-and-paths)))
35 | (reduce process-location {} keys-and-paths)))))
36 | (catch #?(:cljs js/Error :clj Exception) e
37 | (throw (ex-info "untangled.client.impl.util/log-app-state expects an atom with an untangled client" {})))))
38 |
39 | #?(:clj
40 | (defn dbg [& args]
41 | (.println System/out (apply str (interpose " " args)))))
42 |
43 | #?(:clj
44 | (defn conform! [spec x]
45 | (let [rt (s/conform spec x)]
46 | (when (s/invalid? rt)
47 | (throw (ex-info (s/explain-str spec x)
48 | (s/explain-data spec x))))
49 | rt)))
50 |
51 | #?(:clj
52 | (def TRUE (s/with-gen (constantly true) sg/int)))
53 |
--------------------------------------------------------------------------------
/src/untangled/client/logging.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.client.logging
2 | #?(:cljs (:require cljs.pprint
3 | [om.next :refer [*logger*]]
4 | [goog.log :as glog]
5 | [goog.debug.Logger.Level :as level])))
6 |
7 | #?(:cljs
8 | (defn set-level [log-level]
9 | "Takes a keyword (:all, :debug, :info, :warn, :error, :none) and changes the log level accordingly.
10 | Note that the log levels are listed from least restrictive level to most restrictive."
11 | (.setLevel *logger*
12 | (level/getPredefinedLevel
13 | (case log-level :all "ALL" :debug "FINE" :info "INFO" :warn "WARNING" :error "SEVERE" :none "OFF"))))
14 | :clj (defn set-level [l] l))
15 |
16 | #?(:cljs
17 | (defn value-message
18 | "Include a pretty-printed cljs value as a string with the given text message."
19 | [msg val]
20 | (str msg ":\n" (with-out-str (cljs.pprint/pprint val))))
21 | :clj
22 | (defn value-message [msg val] (str msg val)))
23 |
24 |
25 | #?(:cljs
26 | (defn debug
27 | "Print a debug message to the Om logger which includes a value.
28 | Returns the value (like identity) so it can be harmlessly nested in expressions."
29 | ([value] (glog/fine *logger* (value-message "DEBUG" value)) value)
30 | ([msg value] (glog/fine *logger* (value-message msg value)) value))
31 | :clj (defn debug
32 | ([v] (println v))
33 | ([m v] (println m v))))
34 |
35 | #?(:cljs
36 | (defn info
37 | "output an INFO level message to the Om logger"
38 | [& data]
39 | (glog/info *logger* (apply str (interpose " " data))))
40 | :clj
41 | (def info debug))
42 |
43 | #?(:cljs
44 | (defn warn
45 | "output a WARNING level message to the Om logger"
46 | [& data]
47 | (glog/warning *logger* (apply str (interpose " " data))))
48 | :clj (def warn debug))
49 |
50 | #?(:cljs
51 | (defn error
52 | "output an ERROR level message to the Om logger"
53 | [& data]
54 | (glog/error *logger* (apply str (interpose " " data))))
55 | :clj (def error debug))
56 |
--------------------------------------------------------------------------------
/src/untangled/client/mutations.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.client.mutations
2 | #?(:cljs (:require-macros untangled.client.mutations))
3 | (:require
4 | #?(:clj [clojure.spec :as s])
5 | [om.next :as om]))
6 |
7 | ;; Add methods to this to implement your local mutations
8 | (defmulti mutate om/dispatch)
9 |
10 | ;; Add methods to this to implement post mutation behavior (called after each mutation): WARNING: EXPERIMENTAL.
11 | (defmulti post-mutate om/dispatch)
12 |
13 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14 | ;; Public Mutation Helpers
15 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16 |
17 | (defn toggle!
18 | "Toggle the given boolean `field` on the specified component. It is recommended you use this function only on
19 | UI-related data (e.g. form checkbox checked status) and write clear top-level transactions for anything more complicated."
20 | [comp field]
21 | (om/transact! comp `[(ui/toggle {:field ~field})]))
22 |
23 | (defn set-value!
24 | "Set a raw value on the given `field` of a `component`. It is recommended you use this function only on
25 | UI-related data (e.g. form inputs that are used by the UI, and not persisted data)."
26 | [component field value]
27 | (om/transact! component `[(ui/set-props ~{field value})]))
28 |
29 | #?(:cljs
30 | (defn- ensure-integer
31 | "Helper for set-integer!, use that instead. It is recommended you use this function only on UI-related
32 | data (e.g. data that is used for display purposes) and write clear top-level transactions for anything else."
33 | [v]
34 | (let [rv (js/parseInt v)]
35 | (if (js/isNaN v) 0 rv)))
36 | :clj
37 | (defn- ensure-integer [v] (Integer/parseInt v)))
38 |
39 | (defn target-value [evt] (.. evt -target -value))
40 |
41 | (defn set-integer!
42 | "Set the given integer on the given `field` of a `component`. Allows same parameters as `set-string!`.
43 |
44 | It is recommended you use this function only on UI-related data (e.g. data that is used for display purposes)
45 | and write clear top-level transactions for anything else."
46 | [component field & {:keys [event value]}]
47 | (assert (and (or event value) (not (and event value))) "Supply either :event or :value")
48 | (let [value (ensure-integer (if event (target-value event) value))]
49 | (set-value! component field value)))
50 |
51 | (defn set-string!
52 | "Set a string on the given `field` of a `component`. The string can be literal via named parameter `:value` or
53 | can be auto-extracted from a UI event using the named parameter `:event`
54 |
55 | Examples
56 |
57 | ```
58 | (set-string! this :ui/name :value \"Hello\") ; set from literal (or var)
59 | (set-string! this :ui/name :event evt) ; extract from UI event target value
60 | ```
61 |
62 | It is recommended you use this function only on UI-related
63 | data (e.g. data that is used for display purposes) and write clear top-level transactions for anything else."
64 | [component field & {:keys [event value]}]
65 | (assert (and (or event value) (not (and event value))) "Supply either :event or :value")
66 | (let [value (if event (target-value event) value)]
67 | (set-value! component field value)))
68 |
69 |
70 | #?(:clj (s/def ::action (s/cat
71 | :action-name (fn [sym] (= sym 'action))
72 | :action-args (fn [a] (and (vector? a) (= 1 (count a))))
73 | :action-body (s/+ (constantly true)))))
74 |
75 | #?(:clj (s/def ::remote (s/cat
76 | :remote-name symbol?
77 | :remote-args (fn [a] (and (vector? a) (= 1 (count a))))
78 | :remote-body (s/+ (constantly true)))))
79 |
80 | #?(:clj (s/def ::mutation-args (s/cat
81 | :sym symbol?
82 | :doc (s/? string?)
83 | :arglist vector?
84 | :action (s/? #(and (list? %) (= 'action (first %))))
85 | :remote (s/* #(and (list? %) (not= 'action (first %)))))))
86 |
87 | #?(:clj (defn- conform! [spec x]
88 | (let [rt (s/conform spec x)]
89 | (when (s/invalid? rt)
90 | (throw (ex-info (s/explain-str spec x)
91 | (s/explain-data spec x))))
92 | rt)))
93 |
94 | #?(:clj
95 | (defmacro ^{:doc "Define an Untangled mutation.
96 |
97 | The given symbol will be prefixed with the namespace of the current namespace, as if
98 | it were def'd into the namespace.
99 |
100 | The arglist should be the *parameter* arglist of the mutation, NOT the complete argument list
101 | for the equivalent defmethod. For example:
102 |
103 | (defmutation boo [{:keys [id]} ...) => (defmethod m/mutate *ns*/boo [{:keys [state ref]} _ {:keys [id]}] ...)
104 |
105 | The mutation may include any combination of action and any number of remotes (by the remote name).
106 |
107 | If `action` is supplied, it must be first.
108 |
109 | (defmutation boo \"docstring\" [params-map]
110 | (action [env] ...)
111 | (my-remote [env] ...)
112 | (other-remote [env] ...)
113 | (remote [env] ...))"
114 | :arglists '([sym docstring? arglist action]
115 | [sym docstring? arglist action remote]
116 | [sym docstring? arglist remote])} defmutation
117 | [& args]
118 | (let [{:keys [sym doc arglist action remote]} (conform! ::mutation-args args)
119 | fqsym (symbol (name (ns-name *ns*)) (name sym))
120 | {:keys [action-args action-body]} (if action
121 | (conform! ::action action)
122 | {:action-args ['env] :action-body []})
123 | remotes (if (seq remote)
124 | (map #(conform! ::remote %) remote)
125 | [{:remote-name :remote :remote-args ['env] :remote-body [false]}])
126 | env-symbol (gensym "env")
127 | remote-blocks (map (fn [{:keys [remote-name remote-args remote-body]}]
128 | `(let [~(first remote-args) ~env-symbol]
129 | {~(keyword (name remote-name)) (do ~@remote-body)})
130 | ) remotes)]
131 | `(defmethod untangled.client.mutations/mutate '~fqsym [~env-symbol ~'_ ~(first arglist)]
132 | (merge
133 | (let [~(first action-args) ~env-symbol]
134 | {:action (fn [] ~@action-body)})
135 | ~@remote-blocks)))))
136 |
137 |
--------------------------------------------------------------------------------
/src/untangled/client/protocol_support.clj:
--------------------------------------------------------------------------------
1 | (ns untangled.client.protocol-support)
2 |
3 | (defmacro with-methods [multifn methods-map & body]
4 | `(do (let [old-methods-map# (atom {})]
5 | ;;add the new methods while keeping track of the old values
6 | (doseq [[dispatch# function#] ~methods-map]
7 | (when-let [old-function# (get-method ~multifn dispatch#)]
8 | (swap! old-methods-map# assoc dispatch# old-function#))
9 | (~'-add-method ~multifn dispatch# function#))
10 | ;;exec body
11 | ~@body
12 | ;;cleanup methods we added
13 | (doseq [[dispatch# ~'_] ~methods-map]
14 | (remove-method ~multifn dispatch#))
15 | ;;put back the old methods
16 | (doseq [[dispatch# function#] @old-methods-map#]
17 | (~'-add-method ~multifn dispatch# function#)))))
18 |
--------------------------------------------------------------------------------
/src/untangled/client/protocol_support.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.protocol-support
2 | (:require
3 | [clojure.set :as set]
4 | [untangled-spec.core :refer-macros [specification behavior provided when-mocking component assertions]]
5 | [om.next :as om :refer-macros [defui]]
6 | [untangled.client.impl.om-plumbing :as plumbing]
7 | [om.tempid :as omt]
8 | [untangled.client.impl.protocol-support :as impl]))
9 |
10 | (defn check-optimistic-update
11 | "Takes a map containing:
12 | `initial-ui-state`: denormalized app state prior to the optimistic update for transactions going to the server
13 | `ui-tx`: the om transaction that modifies the app state prior to receiving a server response
14 | `optimistic-delta`: the expected changes to the app state after executing ui-tx. See Protocol Testing README for how
15 | to build this properly."
16 | [{:keys [initial-ui-state ui-tx optimistic-delta] :as data} & {:keys [env]}]
17 | (assert (not (:state env)) "state not allowed in the env argument")
18 | (component "Optimistic Updates"
19 | (let [{:keys [parser]} (impl/init-testing)
20 | state (atom initial-ui-state)
21 | parse (partial parser (merge {:state state} env))
22 | tempid-map (impl/allocate-tempids ui-tx)
23 | ui-tx (impl/rewrite-tempids ui-tx tempid-map)]
24 | (behavior "trigger correct state transitions"
25 | (parse ui-tx)
26 | (impl/check-delta (impl/rewrite-tempids @state (set/map-invert tempid-map)
27 | omt/tempid?)
28 | optimistic-delta)))))
29 |
30 | (defn check-server-tx
31 | "Takes a map containing:
32 | `initial-ui-state`: denormalized app state prior to sending the server transaction
33 | `ui-tx`: the om transaction that modifies the app state locally
34 | `server-tx`: the server transaction corresponding to ui-tx"
35 | [{:keys [initial-ui-state ui-tx server-tx]} & {:keys [env]}]
36 | (component "Client Remoting"
37 | (let [{:keys [parser]} (impl/init-testing)
38 | state (atom initial-ui-state)
39 | parse (partial parser (merge {:state state} env))
40 | tempid-map (impl/allocate-tempids ui-tx)
41 | ui-tx (impl/rewrite-tempids ui-tx tempid-map)]
42 |
43 | ;; remote parsing expects that local parsing has executed
44 | (parse ui-tx)
45 | (assertions "Generates the expected server query"
46 | (-> (parse ui-tx :remote)
47 | plumbing/remove-loads-and-fallbacks
48 | plumbing/strip-ui
49 | (impl/rewrite-tempids (set/map-invert tempid-map)
50 | omt/tempid?))
51 | => server-tx))))
52 |
53 | (defn check-response-from-server
54 | "Takes a map containing:
55 | `response`: the exact data the server sends back to the client
56 | `pre-response-state`: normalized state prior to receiving `response`
57 | `server-tx`: the transaction originally sent to the server, yielding `response`
58 | `merge-delta`: the delta between `pre-response-state` and its integration with `response`"
59 | [{:keys [response pre-response-state ui-tx merge-delta]}]
60 | (component "Server response merged with app state"
61 | (let [{:keys [reconciler]} (impl/init-testing)
62 | state (om/app-state reconciler)]
63 | (reset! state pre-response-state)
64 | (om/merge! reconciler response ui-tx)
65 | (if merge-delta
66 | (impl/check-delta @state merge-delta)
67 | (assertions
68 | @state => pre-response-state)))))
69 |
70 | (def with-behavior impl/with-behavior)
71 |
--------------------------------------------------------------------------------
/src/untangled/client/routing.clj:
--------------------------------------------------------------------------------
1 | (ns untangled.client.routing
2 | (:require [untangled.client.mutations :as m]
3 | [untangled.client.core]
4 | [clojure.spec :as s]
5 | [untangled.client.logging :as log]))
6 |
7 | (s/def ::mutation-args (s/cat
8 | :sym symbol?
9 | :doc (s/? string?)
10 | :arglist vector?
11 | :body (s/+ (constantly true))))
12 |
13 | (defn- conform! [spec x]
14 | (let [rt (s/conform spec x)]
15 | (when (s/invalid? rt)
16 | (throw (ex-info (s/explain-str spec x)
17 | (s/explain-data spec x))))
18 | rt))
19 |
20 | (defn- emit-union-element [sym ident-fn kws-and-screens]
21 | (try
22 | (let [query (reduce (fn [q {:keys [kw sym]}] (assoc q kw `(om.next/get-query ~sym))) {} kws-and-screens)
23 | first-screen (-> kws-and-screens first :sym)
24 | screen-render (fn [cls] `((om.next/factory ~cls {:keyfn (fn [props#] ~(name cls))}) (om.next/props ~'this)))
25 | render-stmt (reduce (fn [cases {:keys [kw sym]}]
26 | (-> cases
27 | (conj kw (screen-render sym)))) [] kws-and-screens)]
28 | `(om.next/defui ~(vary-meta sym assoc :once true)
29 | ~'static untangled.client.core/InitialAppState
30 | (~'initial-state [~'clz ~'params] (untangled.client.core/get-initial-state ~first-screen ~'params))
31 | ~'static om.next/Ident
32 | ~ident-fn
33 | ~'static om.next/IQuery
34 | (~'query [~'this] ~query)
35 | ~'Object
36 | (~'render [~'this]
37 | (let [page# (first (om.next/get-ident ~'this))]
38 | (case page#
39 | ~@render-stmt
40 | (om.dom/div nil (str "Cannot route: Unknown Screen " page#)))))))
41 | (catch Exception e `(def ~sym (log/error "BROKEN ROUTER!")))))
42 |
43 | (defn- emit-router [router-id sym union-sym]
44 | `(om.next/defui ~(vary-meta sym assoc :once true)
45 | ~'static untangled.client.core/InitialAppState
46 | (~'initial-state [~'clz ~'params] {:id ~router-id :current-route (untangled.client.core/get-initial-state ~union-sym {})})
47 | ~'static om.next/Ident
48 | (~'ident [~'this ~'props] [:untangled.client.routing.routers/by-id ~router-id])
49 | ~'static om.next/IQuery
50 | (~'query [~'this] [:id {:current-route (om.next/get-query ~union-sym)}])
51 | ~'Object
52 | (~'render [~'this]
53 | ((om.next/factory ~union-sym) (:current-route (om.next/props ~'this))))))
54 |
55 | (s/def ::router-args (s/cat
56 | :sym symbol?
57 | :router-id keyword?
58 | :ident-fn (constantly true)
59 | :kws-and-screens (s/+ (s/cat :kw keyword? :sym symbol?))))
60 |
61 | (defmacro ^{:doc "Generates a component with a union query that can route among the given screen, which MUST be
62 | in cljc files. The first screen listed will be the 'default' screen that the router will be initialized to show.
63 |
64 | - All screens *must* implement InitialAppState
65 | - All screens *must* have a UI query
66 | - Add screens *must* have state that the ident-fn can use to determine which query to run. E.g. the left member
67 | of running (ident-fn Screen initial-screen-state) => [:kw-for-screen some-id]
68 | "
69 | :arglists '([sym router-id ident-fn & kws-and-screens])} defrouter
70 | [& args]
71 | (let [{:keys [sym router-id ident-fn kws-and-screens]} (conform! ::router-args args)
72 | union-sym (symbol (str (name sym) "-Union"))]
73 | `(do
74 | ~(emit-union-element union-sym ident-fn kws-and-screens)
75 | ~(emit-router router-id sym union-sym))))
76 |
77 |
--------------------------------------------------------------------------------
/src/untangled/client/routing.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.client.routing
2 | (:require-macros untangled.client.routing)
3 | (:require [untangled.client.mutations :as m]
4 | untangled.client.core
5 | om.next
6 | om.dom
7 | [untangled.client.logging :as log]))
8 |
9 | (def routing-tree-key ::routing-tree)
10 | (def routers-table :untangled.client.routing.routers/by-id) ; NOTE: needed in macro, but hand-coded
11 |
12 | (defn make-route
13 | "Make a route name that executes the provided routing instructions to change which screen in on the UI. routing-instructions
14 | must be a vector. Returns an item that can be passed to `routing-tree` to generate your overall application's routing
15 | plan.
16 |
17 | `(make-route :route/a [(router-instruction ...) ...])`
18 |
19 | "
20 | [name routing-instructions]
21 | {:pre [(vector? routing-instructions)]}
22 | {:name name :instructions routing-instructions})
23 |
24 | (defn routing-tree
25 | "Generate initial state for your application's routing tree. The return value of this should be merged into your overall
26 | app state in your Root UI component
27 |
28 | ```
29 | (defui Root
30 | static uc/InitialAppState
31 | (initial-state [cls params] (merge {:child-key (uc/get-initial-state Child)}
32 | (routing-tree
33 | (make-route :route/a [(router-instruction ...)])
34 | ...)))
35 | ...
36 | ```
37 | "
38 | [& routes]
39 | {routing-tree-key (reduce (fn [tree {:keys [name instructions]}] (assoc tree name instructions)) {} routes)})
40 |
41 | (defn router-instruction
42 | "Return the definition of a change-route instruction."
43 | [router-id target-screen-ident]
44 | {:target-router router-id
45 | :target-screen target-screen-ident})
46 |
47 | (defn current-route
48 | "Get the current route from the router with the given id"
49 | [state-map router-id] (get-in state-map [routers-table router-id :current-route]))
50 |
51 | (defn- set-ident-route-params
52 | "Replace any keywords of the form :params/X with the value of (get route-params X)"
53 | [ident route-params]
54 | (mapv (fn [element]
55 | (if (and (keyword? element) (= "param" (namespace element)))
56 | (keyword (get route-params (keyword (name element)) element))
57 | element))
58 | ident))
59 |
60 | (defn set-route
61 | "Set the given screen-ident as the current route on the router with the given ID. Returns a new application
62 | state map."
63 | [state-map router-id screen-ident]
64 | (assoc-in state-map [routers-table router-id :current-route] screen-ident))
65 |
66 | (defn update-routing-links
67 | "Given the app state map, returns a new map that has the routing graph links updated for the given route/params
68 | as a bidi match."
69 | [state-map {:keys [handler route-params]}]
70 | (let [routing-instructions (get-in state-map [routing-tree-key handler])]
71 | (if-not (or (nil? routing-instructions) (vector? routing-instructions))
72 | (log/error "Routing tree does not contain a vector of routing-instructions for handler " handler)
73 | (reduce (fn [m {:keys [target-router target-screen]}]
74 | (let [parameterized-screen-ident (set-ident-route-params target-screen route-params)]
75 | (set-route m target-router parameterized-screen-ident))) state-map routing-instructions))))
76 |
77 | (defn route-to
78 | "Om Mutation (use in transact! only):
79 | Change the application's overall UI route to the given route by handler. Handler must be a single keyword that indicates an entry in
80 | your routing tree (which must be in the initial app state of your UI root). route-params is a map of key-value pairs
81 | that will be substituted in the target screen idents of the routing tree."
82 | [{:keys [handler route-params]}] (comment "placeholder for IDE assistance"))
83 |
84 | (defmethod m/mutate `route-to [{:keys [state]} k p]
85 | {:action (fn [] (swap! state update-routing-links p))})
86 |
--------------------------------------------------------------------------------
/src/untangled/client/ui.clj:
--------------------------------------------------------------------------------
1 | (ns untangled.client.ui
2 | (:require
3 | [cljs.analyzer :as ana]
4 | [clojure.pprint :refer [pprint]]
5 | [clojure.spec :as s]
6 | [om.next :as om]
7 | [untangled.client.augmentation :as aug]
8 | [untangled.client.impl.built-in-augments]
9 | [untangled.client.impl.util :as utl]))
10 |
11 | (defn- install-augments [ctx ast]
12 | (reduce
13 | (fn [ast {:keys [aug params]}]
14 | (aug/defui-augmentation (assoc ctx :augment/dispatch aug) ast params))
15 | (dissoc ast :augments :defui-name) (aug/parse-augments (:augments ast))))
16 |
17 | (defn- make-ctx [ast form env]
18 | {:defui/loc (merge (meta form) {:file ana/*cljs-file*})
19 | :defui/ui-name (:defui-name ast)
20 | :env/cljs? (boolean (:ns env))})
21 |
22 | (s/fdef defui*
23 | :args ::aug/defui
24 | :ret ::aug/defui)
25 | (defn defui* [body form env]
26 | (try
27 | (let [ast (utl/conform! ::aug/defui body)
28 | {:keys [defui/ui-name env/cljs?] :as ctx} (make-ctx ast form env)]
29 | ((if cljs? om/defui* om/defui*-clj)
30 | (vary-meta ui-name assoc :once true)
31 | (->> ast
32 | (install-augments ctx)
33 | (s/unform ::aug/defui))))
34 | (catch Exception e
35 | (.println System/out e)
36 | (.println System/out (with-out-str (pprint (into [] (.getStackTrace e))))))))
37 |
38 | (s/fdef defui
39 | :args ::aug/defui
40 | :ret ::aug/defui)
41 | (defmacro defui
42 | "Untangled's defui provides a way to compose transformations and behavior to your om next components.
43 | We're calling them *augments*, and they let you consume and provide behaviors
44 | in a declarative and transparent way.
45 |
46 | The untangled defui only provides an addition to the standard om.next/defui, a vector of augments,
47 | which are defined in `:untangled.client.augmentation/augments`, but roughly take the shape:
48 | [:some/augment ...] or a more granular approach {:always [...] :dev [...] :prod [...]}.
49 |
50 | Augments under `:always` are always used, and those under :dev and :prod are controlled by
51 | `untangled.client.augmentation/defui-augment-mode` (env var or jvm system prop `\"DEFUI_AUGMENT_MODE\"`).
52 |
53 | WARNING: Should be considered alpha tech, and the interface may be subject to changes
54 | depending on feedback and hammock time.
55 |
56 | NOTE: If anything isn't working right, or you just have some questions/comments/feedback,
57 | let @adambros know on the clojurians slack channel #untangled"
58 | [& body] (defui* body &form &env))
59 |
--------------------------------------------------------------------------------
/src/untangled/dom.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.dom
2 | (:require [clojure.string :as str]
3 | [om.next :as om]
4 | [untangled.client.logging :as log]
5 | [om.next.protocols :as omp]))
6 |
7 | (defn unique-key
8 | "Get a unique string-based key. Never returns the same value."
9 | []
10 | (let [s #?(:clj (System/currentTimeMillis)
11 | :cljs (system-time))]
12 | (str s)))
13 |
14 | (defn force-render
15 | "Re-render components. If only a reconciler is supplied then it forces a full DOM re-render by updating the :ui/react-key
16 | in app state and forcing Om to re-render the entire DOM, which only works properly if you query
17 | for :ui/react-key in your Root render component and add that as the react :key to your top-level element.
18 |
19 | If you supply an additional vector of keywords and idents then it will ask Om to rerender only those components that mention
20 | those things in their queries."
21 | ([reconciler keywords]
22 | (omp/queue! reconciler keywords)
23 | (omp/schedule-render! reconciler))
24 | ([reconciler]
25 | (let [app-state (om/app-state reconciler)]
26 | (do
27 | (swap! app-state assoc :ui/react-key (unique-key))
28 | (om/force-root-render! reconciler)))))
29 |
30 | (defn append-class
31 | "Append a CSS class. Given a component and a local state key or keys, to be passed to `om/get-state`,
32 | returns a function that takes the `state-value` to test, a `default-class-string`,
33 | and optionaol `:when-true` and `:when-false`. The values `:when-false` and `when-true`
34 | are appended to `default-class-string` after the test against `state-value`.
35 |
36 | Parameters:
37 | `component`: The component to pass to `om/get-state`.
38 | `local-state-key`: The key or keys to pass to `om/get-state`."
39 | [component local-state-key]
40 | (fn [state-key default-class-string & {:keys [when-true when-false]
41 | :or {when-true "active" when-false ""}}]
42 | (let [append-string (if (= state-key (om/get-state component local-state-key))
43 | when-true
44 | when-false)]
45 | (str default-class-string " " append-string))))
46 |
47 | (defn toggle-class
48 | "Adds the 'visible' CSS class and removes the 'hidden' class to the pre-supplied class string based on the truthiness
49 | of the value in data at key.
50 |
51 | Parameters:
52 | `data`: A map containing the component's state.
53 | `key`: A key within `data`.
54 | `always-classes`: A string that has the CSS classes to always return in the returned string.
55 |
56 | Optional named parameters:
57 |
58 | `:when-true v` : This string to add when the key's value is true. Defaults to \"active\".
59 | `:when-false v` : The string to add when the key's value is false. Defaults to \"\".
60 | "
61 | [data key always-classes & {:keys [when-true when-false]
62 | :or {when-true "active" when-false ""}}]
63 | (if (get data key)
64 | (str/join " " [always-classes when-true])
65 | (str/join " " [always-classes when-false])))
66 |
67 | (defn text-value
68 | "Returns the text value from an input change event."
69 | [evt]
70 | (try
71 | (.-value (.-target evt))
72 | (catch #?(:clj Exception :cljs js/Object) e (log/warn "Event had no target when trying to pull text"))))
73 |
--------------------------------------------------------------------------------
/src/untangled/events.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.events)
2 |
3 | (defn enter-key?
4 | "Return true if a DOM event was the enter key."
5 | [evt]
6 | (= 13 (.-keyCode evt)))
7 |
8 | (defn escape-key?
9 | "Return true if a DOM event was the escape key."
10 | [evt]
11 | (= 27 (.-keyCode evt)))
12 |
13 |
14 |
--------------------------------------------------------------------------------
/src/untangled/i18n.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.i18n
2 | #?(:cljs (:require-macros untangled.i18n))
3 | (:require
4 | #?(:clj js)
5 | [untangled.i18n.core :as ic]
6 | [untangled.client.logging :as log]
7 | #?(:cljs yahoo.intl-messageformat-with-locales)))
8 |
9 | (defn current-locale [] @ic/*current-locale*)
10 |
11 | (defn translations-for-locale [] (get @ic/*loaded-translations* (current-locale)))
12 |
13 | ;; This set of constructions probably looks pretty screwy. In order for xgettext to work right, it
14 | ;; must see `tr("hello")` in the output JS, but by default the compiler outputs a call(tr, args)
15 | ;; construction. By explicitly setting (and using) a Javascript function we don't have to
16 | ;; worry about compiler options for static calls.
17 |
18 | ;; The other thing we're doing is wrapping that in a macro. The macro serves two purposes: One
19 | ;; it makes better syntatic sugar than having to type `(js/tr ...)`, but the real consideration
20 | ;; is that we want `tr` to fail to compile if you use it with a variable. This is another important
21 | ;; consideration for ensuring that translations can be extracted. The `tr-unsafe` macro exists
22 | ;; for cases where you must have logic invoved, but lets you know that you must have some other
23 | ;; way of ensuring those translations make it into your final product.
24 |
25 | #?(:cljs
26 | (set! js/tr
27 | (fn [msg]
28 | (let [msg-key (str "|" msg)
29 | translations (translations-for-locale)
30 | translation (get translations msg-key msg)]
31 | translation))))
32 |
33 | #?(:cljs
34 | (set! js/trc
35 | (fn [ctxt msg]
36 | (let [msg-key (str ctxt "|" msg)
37 | translations (translations-for-locale)
38 | translation (get translations msg-key msg)]
39 | translation))))
40 |
41 | #?(:cljs
42 | (set! js/trf
43 | (fn [fmt & {:keys [] :as argmap}]
44 | (try
45 | (let [msg-key (str "|" fmt)
46 | translations (translations-for-locale)
47 | translation (get translations msg-key fmt)
48 | formatter (js/IntlMessageFormat. translation (current-locale))]
49 | (.format formatter (clj->js argmap)))
50 | (catch :default e (log/error "Failed to format " fmt " args: " argmap " exception: " e)
51 | "???")))))
52 |
53 | #?(:clj
54 | (defmacro tr
55 | "Translate the given literal string. The argument MUST be a literal string so that it can be properly extracted
56 | for use in gettext message files as the message key. This macro throws a detailed assertion error if you
57 | violate this restriction. See trf for generating translations that require formatting (e.g. construction from
58 | variables)."
59 | [msg]
60 | (assert (string? msg) (str "In call to tr(" msg "). Argument MUST be a literal string, not a symbol or expression. Use trf for formatting."))
61 | `(js/tr ~msg)))
62 |
63 | #?(:clj
64 | (defmacro tr-unsafe
65 | "Look up the given message. UNSAFE: you can use a variable with this, and thus string extraction will NOT
66 | happen for you. This means you have to use some other mechanism to make sure the string ends up in translation
67 | files (such as manually calling tr on the various raw string values elsewhere in your program)"
68 | [msg]
69 | `(js/tr ~msg)))
70 |
71 | #?(:clj
72 | (defmacro trlambda
73 | "Translate the given literal string. The argument MUST be a literal string so that it can be properly extracted
74 | for use in gettext message files as the message key. This macro throws a detailed assertion error if you
75 | violate this restriction. See trf for generating translations that require formatting (e.g. construction from
76 | variables)."
77 | [msg]
78 | (assert (string? msg) (str "In call to tr(" msg "). Argument MUST be a literal string, not a symbol or expression. Use trf for formatting."))
79 | `#(js/tr ~msg)))
80 |
81 | #?(:clj
82 | (defmacro trc
83 | "Same as tr, but include a context message to the translator. This is recommended when asking for a
84 | translation to something vague.
85 |
86 | For example:
87 |
88 | (tr \"M\")
89 |
90 | is the same as asking a translator to translate the letter 'M'.
91 |
92 | Using:
93 |
94 | (trc \"abbreviation for male gender\" \"M\")
95 |
96 | lets the translator know what you want. Of course, the msg key is the default language value (US English)
97 | "
98 | [context msg]
99 | (assert (and (string? msg) (string? context)) (str "In call to trc(" context msg "). Arguments MUST be literal strings."))
100 | `(js/trc ~context ~msg)))
101 |
102 | #?(:clj
103 | (defmacro trf
104 | "Translate a format string, then use it to format a message with the given arguments. The format MUST be a literal
105 | string for extraction by gettext. The arguments should be keyword/value pairs that will match the embedded
106 | items to format.
107 |
108 | (trf \"{name} owes {amount, currency)\" :name who :amount amt)
109 |
110 | The format string is an ICU message format. See FormatJS for details.
111 | "
112 | [format & args]
113 | (assert (string? format) (str "Message format in call to trf(" format args ") MUST be literal string (arguments can be variables)."))
114 | `(js/trf ~format ~@args)))
115 |
--------------------------------------------------------------------------------
/src/untangled/i18n/core.cljc:
--------------------------------------------------------------------------------
1 | (ns untangled.i18n.core)
2 |
3 | (def ^:dynamic *current-locale* (atom "en-US"))
4 |
5 | (def ^:dynamic *loaded-translations* (atom {}))
6 |
--------------------------------------------------------------------------------
/src/untangled/openid_client.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.openid-client
2 | (:require [clojure.string :as s]
3 | [clojure.walk :as w]
4 | [om.next :as om])
5 | (:import goog.net.Cookies))
6 |
7 | (defn params []
8 | (apply str (rest (-> js/window .-location .-hash))))
9 |
10 | (defn get-tokens-from-cookies []
11 | (let [cookies (Cookies. js/document)
12 | cookie-keys (.getKeys cookies)]
13 | (reduce
14 | #(assoc %1 %2 (.get cookies %2))
15 | {}
16 | cookie-keys)))
17 |
18 | (defn tokens-from-params [params]
19 | (apply merge
20 | (map (fn [v]
21 | (let [pairs (s/split v #"=")]
22 | {(first pairs) (second pairs)}))
23 | (s/split params #"&"))))
24 |
25 | (defn parse-claims [token]
26 | (some-> token (s/split #"\.") second js/atob js/JSON.parse))
27 |
28 | (defn add-auth-header
29 | "Adds an Authorization header for each request based on the claims in the cookies or the url's hash fragments"
30 | [req]
31 | (let [access-token (-> (or (get-tokens-from-cookies)
32 | (tokens-from-params (params)))
33 | (get "access_token"))]
34 | (assoc-in req [:headers "Authorization"] (str "Bearer " access-token))))
35 |
36 | (defn install-state!
37 | "Installs openid information into the passed in untangled-client app's initial state,
38 | based on the token claims in the cookies or the url's hash fragments."
39 | [reconciler & {:keys [custom-state-fn] :or {custom-state-fn (constantly {})}}]
40 | (let [hash-tokens (tokens-from-params (params))
41 | tokens (or (get-tokens-from-cookies)
42 | hash-tokens)
43 | id-claims (some-> tokens (get "id_token") parse-claims js->clj w/keywordize-keys)]
44 | (when (= tokens hash-tokens)
45 | ;ie: dont always clear the hash, as it might be used by routing
46 | (aset js/window.location "hash" ""))
47 | (swap! (om/app-state reconciler) merge
48 | (merge
49 | (custom-state-fn id-claims)
50 | {:openid/claims id-claims
51 | :openid/access-token (get tokens "access_token")}))))
52 |
--------------------------------------------------------------------------------
/src/untangled/services/async_report.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.services.async-report)
2 |
3 |
4 | (defprotocol IAsyncReport
5 | (started [this m] "started a new request")
6 | (error [this m] "a request reported an error")
7 | (completed [this m] "a request has completed")
8 | (current-async-request-count [this] "returns the current number of outstanding requests")
9 | )
10 |
11 |
12 | (defrecord AsyncReport
13 | [started-fn error-fn completed-fn current-request-count]
14 | IAsyncReport
15 | (started [this m] "started a new request")
16 | (error [this m] "a request reported an error")
17 | (completed [this m] "a request has completed")
18 | (current-async-request-count [this] current-request-count)
19 | )
20 |
21 |
22 | (defn new-async-report
23 | "Create a new async reporting component:
24 | - started-fn a single argument function that is called when an async method has started
25 | - error-fn
26 | "
27 | [started-fn error-fn completed-fn]
28 | (map->AsyncReport {:started-fn started-fn
29 | :completed-fn completed-fn
30 | :error-fn error-fn
31 | :current-request-count 0
32 | }))
33 |
--------------------------------------------------------------------------------
/src/untangled/services/asyncio.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.services.asyncio)
2 |
3 | (defprotocol AsyncIo
4 | (save [this uri goodfn errorfn data] "Save data, save is treated as an upsert")
5 | (delete [this uri goodfn errorfn id] "Delete data with a specific id")
6 | (fetch [this uri goodfn errorfn id] "Get a specific data item")
7 | (query [this uri goodfn errorfn] "Get a list of data items")
8 | )
9 |
10 |
--------------------------------------------------------------------------------
/src/untangled/services/local_storage.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.services.local-storage
2 | (:require
3 | [cljs-uuid-utils.core :as uuid]
4 | [cljs.reader :as r]
5 | )
6 | )
7 |
8 | (defn similate-delay [simulated-delay async-fn]
9 | (cond (= simulated-delay 0) (async-fn)
10 | :otherwise (js/setTimeout async-fn simulated-delay)))
11 |
12 | (defrecord LocalStorageIO
13 | [async-report simulated-delay]
14 | untangled.services.asyncio/AsyncIo
15 | (save [this uri goodfn errorfn data]
16 | (let [id (if (:id data) (:id data) (str (uuid/uuid-string (uuid/make-random-uuid))))
17 | data-with-id (assoc data :id id)
18 | str-current (.getItem js/localStorage uri)
19 | current-data (if str-current (r/read-string str-current) [])
20 | item-removed-data (remove #(= id {:id %}) current-data)
21 | updated-data (conj item-removed-data data-with-id)]
22 | (similate-delay simulated-delay
23 | (fn [] (do (.setItem js/localStorage uri (pr-str updated-data))
24 | (goodfn data-with-id))))))
25 | (delete [this uri goodfn errorfn id]
26 | (let [current-data (r/read-string (.getItem js/localStorage uri))
27 | data (first (filter #(= id (:id %)) current-data))
28 | ]
29 | (if (nil? data)
30 | (errorfn {:error :not-found :id id})
31 | (let [updated-data (remove #(= id (:id %)) current-data)]
32 | (similate-delay simulated-delay
33 | (fn [] (do (.setItem js/localStorage uri (pr-str updated-data))
34 | (goodfn id))))))))
35 |
36 | (fetch [this uri goodfn errorfn id]
37 | (let [current-str (.getItem js/localStorage uri)
38 | current-data (if (nil? current-str) [] (r/read-string current-str))
39 | data (first (filter #(= id (:id %)) current-data))
40 | ]
41 | (if (nil? data)
42 | (errorfn {:error :not-found :id id})
43 | (similate-delay simulated-delay
44 | (fn [] (goodfn data))))))
45 |
46 | (query [this uri goodfn errorfn]
47 | (let [current-str (.getItem js/localStorage uri)
48 | current-data (if (nil? current-str) [] (r/read-string current-str))
49 | ]
50 | (similate-delay simulated-delay
51 | (fn [] (goodfn current-data))))))
52 |
53 | (defn new-local-storage
54 | "Create a new local storage async io component:
55 | - async-report component to report async request processing information
56 | - simulated-delay time in milliseconds
57 | "
58 | [async-report simulated-delay]
59 | (let [localio (map->LocalStorageIO {:async-report async-report
60 | :simulated-delay simulated-delay
61 | })]
62 |
63 | (.clear js/localStorage)
64 | localio))
65 |
--------------------------------------------------------------------------------
/src/untangled/support_viewer.cljs:
--------------------------------------------------------------------------------
1 | (ns untangled.support-viewer
2 | (:require
3 | [om.next :as om :refer-macros [defui]]
4 | [om.dom :as dom]
5 | [untangled.client.data-fetch :refer [load-data]]
6 | [untangled.client.core :as core]
7 | [untangled.client.mutations :as m]
8 | [yahoo.intl-messageformat-with-locales]
9 | [untangled.i18n :refer [tr trf]]
10 | [untangled.client.impl.network :as net]))
11 |
12 | (defui ^:once SupportViewerRoot
13 | static om/IQuery
14 | (query [this] [:ui/react-key :playback-speed :current-position :client-time :frames :position :comments])
15 | Object
16 | (render [this]
17 | (let [{:keys [ui/react-key playback-speed current-position client-time frames position comments] :or {ui/react-key "ROOT"}} (om/props this)]
18 | (dom/div #js {:key react-key :className (str "history-controls " (name position))}
19 | (dom/button #js {:className "toggle-position" :onClick #(om/transact! this '[(support-viewer/toggle-position)])} (tr "<= Reposition =>"))
20 | (dom/button #js {:className "history-back" :onClick #(om/transact! this '[(support-viewer/step-back)])} (tr "Back"))
21 | (dom/button #js {:className "history-forward" :onClick #(om/transact! this '[(support-viewer/step-forward)])} (tr "Forward"))
22 | (dom/hr nil)
23 | (dom/span #js {:className "frame"} (trf "Frame {f,number} of {end,number} " :f (inc current-position) :end frames))
24 | (dom/span #js {:className "timestamp"} (trf "{ts,date,short} {ts,time,long}" :ts client-time))
25 | (dom/div #js {:className "user-comments"} comments)
26 | (dom/hr nil)
27 | (dom/span #js {:className "playback-speed"} (trf "Playback speed {s,number}" :s playback-speed))
28 | (dom/div #js {}
29 | (dom/button #js {:className "speed-1" :onClick #(om/transact! this `[(support-viewer/update-playback-speed ~{:playback-speed 1})])} (tr "1x"))
30 | (dom/button #js {:className "speed-10" :onClick #(om/transact! this `[(support-viewer/update-playback-speed ~{:playback-speed 10})])} (tr "10x"))
31 | (dom/button #js {:className "speed-25" :onClick #(om/transact! this `[(support-viewer/update-playback-speed ~{:playback-speed 25})])} (tr "25x")))
32 | (dom/hr nil)
33 | (dom/span #js {:className "history-jump-to"} "Jump to:")
34 | (dom/div #js {}
35 | (dom/button #js {:className "history-beg" :onClick #(om/transact! this '[(support-viewer/go-to-beg)])} (tr "Beginning"))
36 | (dom/button #js {:className "history-end" :onClick #(om/transact! this '[(support-viewer/go-to-end)])} (tr "End")))))))
37 |
38 | (defn history-entry [history n]
39 | (let [steps (:steps history)
40 | states (:history history)
41 | state-id (nth steps n (last steps))]
42 | (get states state-id)))
43 |
44 | (defrecord SupportViewer [support dom-id app-root application history]
45 | core/UntangledApplication
46 | (mount [this root-component dom-id-or-node]
47 | (if (:mounted? @support)
48 | (do (core/refresh this) this)
49 | (do
50 | (reset! application (core/mount @application app-root dom-id))
51 | (reset! support (core/mount @support SupportViewerRoot dom-id-or-node))
52 | @support)))
53 |
54 | (reset-state! [this new-state] (core/reset-state! @application new-state))
55 |
56 | (refresh [this]
57 | (core/refresh @application)))
58 |
59 | (defn start-untangled-support-viewer
60 | "Create and display a new untangled support viewer on the given app root, with VCR controls to browse through the given history. The support HTML file must include
61 | a div with app-dom-id (to mount the app) and a div with support-dom-id to mount the viewer controls."
62 | [support-dom-id AppRoot app-dom-id]
63 | (let [app (atom (core/new-untangled-client :networking (net/mock-network)))
64 | viewer (map->SupportViewer {:app-root AppRoot
65 | :dom-id app-dom-id
66 | :application app
67 | :support (atom (core/new-untangled-client
68 | :initial-state {:history {}
69 | :application app
70 | :position :controls-left
71 | :client-time (js/Date.)
72 | :playback-speed 1
73 | :frames 0
74 | :current-position 0}
75 | :started-callback
76 | (fn [{:keys [reconciler]}]
77 | (load-data reconciler `[(:support-request {:id ~(core/get-url-param "id")})]
78 | :post-mutation 'support-viewer/initialize-history))))})]
79 | (core/mount viewer SupportViewerRoot support-dom-id)))
80 |
81 | (defn history-step [state delta-fn]
82 | (let [{:keys [application history playback-speed]} @state
83 |
84 | max-idx (dec (count (:steps history)))
85 | p (:current-position @state)
86 | playback-speed (max 1 playback-speed) ;; Playback speed min is 1.
87 | new-pos (-> p
88 | delta-fn
89 | (- p) ; Get the delta i.e. (p' - p).
90 | (* playback-speed) ; Multiply delta by the playback speed.
91 | (+ p) ; Apply this new delta to p.
92 | (max 0)
93 | (min max-idx))
94 | entry (history-entry history new-pos)
95 | tm (-> entry :untangled/meta :client-time)]
96 | (swap! state (fn [s] (-> s
97 | (assoc :current-position new-pos)
98 | (assoc :client-time tm))))
99 | (core/reset-state! @application entry)))
100 |
101 | (defmethod m/mutate 'support-viewer/initialize-history [{:keys [state]} k params]
102 | {:action
103 | (fn []
104 | (swap! state
105 | (fn [s]
106 | (let [req (:support-request @state)
107 | app (:application @state)
108 | comments (:comment req)
109 | history (:history req)
110 | frames (-> history :steps count)
111 | last-idx (dec frames)]
112 | (core/reset-state! @app (history-entry history last-idx))
113 | (-> s
114 | (dissoc :support-request)
115 | (assoc :comments comments)
116 | (assoc :frames frames)
117 | (assoc :history history)
118 | (assoc :current-position last-idx))))))})
119 |
120 | (defmethod m/mutate 'support-viewer/step-forward [{:keys [state]} k params] {:action #(history-step state inc)})
121 |
122 | (defmethod m/mutate 'support-viewer/step-back [{:keys [state]} k params] {:action #(history-step state dec)})
123 |
124 | (defmethod m/mutate 'support-viewer/toggle-position [{:keys [state]} k params]
125 | {:action (fn []
126 | (let [{:keys [position]} @state
127 | new-position (cond
128 | (= :controls-left position) :controls-right
129 | :else :controls-left)]
130 | (swap! state assoc :position new-position)))})
131 |
132 | (defmethod m/mutate 'support-viewer/go-to-beg
133 | [{:keys [state]} k params]
134 | {:action #(history-step state (fn [pos] 0))})
135 |
136 | (defmethod m/mutate 'support-viewer/go-to-end
137 | [{:keys [state]} k params]
138 | {:action #(let [steps (-> @state :history :steps count dec)]
139 | (history-step state (fn [pos] steps)))})
140 |
141 | (defmethod m/mutate 'support-viewer/update-playback-speed
142 | [{:keys [state]} k {:keys [playback-speed]}]
143 | {:action #(swap! state assoc :playback-speed playback-speed)})
144 |
--------------------------------------------------------------------------------