├── .gitignore ├── .idea └── runConfigurations │ └── Figwheel.xml ├── .travis.yml ├── CHANGELOG.md ├── CONTRIBUTING.md ├── LICENSE ├── Makefile ├── README.adoc ├── dev ├── clj │ └── user.clj └── cljs │ ├── user.clj │ └── user.cljs ├── docs ├── Overview.md ├── index.adoc └── internationalization.md ├── package.json ├── project.clj ├── resources └── public │ ├── cards.html │ ├── css │ ├── cards.css │ ├── edn.css │ ├── style.css │ └── viewer.css │ ├── js │ ├── intl-messageformat-with-locales.min.js │ └── intl-messageformat-with-locales.min.js.map │ └── test.html ├── script └── figwheel.clj ├── spec └── untangled │ ├── all_tests.cljs │ ├── client │ ├── core_spec.cljs │ ├── data_fetch_spec.cljs │ ├── impl │ │ ├── application_spec.cljs │ │ ├── built_in_mutations_spec.cljs │ │ ├── network_spec.cljs │ │ ├── om_plumbing_spec.cljs │ │ └── util_spec.cljs │ ├── logging_spec.cljs │ ├── mutations_spec.cljs │ ├── protocol_support_spec.cljs │ ├── routing_spec.cljs │ ├── server_rendering_spec.clj │ └── ui_spec.clj │ ├── i18n_spec.cljs │ ├── services │ └── local_storage_io_spec.cljs │ └── tests_to_run.cljs ├── src-cards └── untangled │ └── client │ ├── card_ui.cljs │ ├── fancy_defui.cljs │ ├── initial_app_state_card.cljs │ └── load_cards.cljs └── src ├── deps.cljs ├── js.clj ├── untangled ├── client │ ├── augmentation.clj │ ├── cards.cljc │ ├── core.cljc │ ├── data_fetch.cljc │ ├── impl │ │ ├── application.cljc │ │ ├── built_in_augments.clj │ │ ├── built_in_mutations.cljs │ │ ├── data_fetch.cljc │ │ ├── network.cljc │ │ ├── om_plumbing.cljc │ │ ├── protocol_support.cljs │ │ └── util.cljc │ ├── logging.cljc │ ├── mutations.cljc │ ├── protocol_support.clj │ ├── protocol_support.cljs │ ├── routing.clj │ ├── routing.cljs │ └── ui.clj ├── dom.cljc ├── events.cljc ├── i18n.cljc ├── i18n │ └── core.cljc ├── openid_client.cljs ├── services │ ├── async_report.cljs │ ├── asyncio.cljs │ └── local_storage.cljs └── support_viewer.cljs └── yahoo ├── intl-messageformat-with-locales.js └── intl-messageformat-with-locales.min.js /.gitignore: -------------------------------------------------------------------------------- 1 | checkouts 2 | examples/calendar/src/quiescent_model 3 | .DS_Store 4 | compiled 5 | figwheel_server.log 6 | pom.xml 7 | *jar 8 | lib 9 | classes 10 | out 11 | target 12 | bin/publish-local 13 | .lein-deps-sum 14 | .lein-failures 15 | .lein-repl-history 16 | .lein-plugins/ 17 | .repl 18 | .nrepl-port 19 | *.swp 20 | .idea 21 | *.iml 22 | .lein-env 23 | .cljs_rhino_repl 24 | examples/calendar/resources/public/js/specs 25 | examples/todo/src/quiescent_model 26 | node_modules 27 | resources/private/js 28 | resources/public/js/test 29 | resources/public/js/cards 30 | pom.xml.asc 31 | !.idea/runConfigurations/Figwheel.xml 32 | docs/.asciidoctor/ 33 | docs/basic-db.png 34 | docs/mutations.png 35 | -------------------------------------------------------------------------------- /.idea/runConfigurations/Figwheel.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: 2.7.0 3 | jdk: 4 | - oraclejdk8 5 | addons: 6 | firefox: "49.0" 7 | before_script: 8 | - npm install 9 | - export DISPLAY=:99.0 10 | - sh -e /etc/init.d/xvfb start 11 | - while [ ! -e /tmp/.X11-unix/X99 ]; do sleep 0.1; done 12 | script: 13 | - lein test-refresh :run-once 14 | - lein doo firefox automated-tests once 15 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | 0.8.2 2 | ----- 3 | - Changed network result handling so that it does not change :ui/react-key (flicker) 4 | - Added support for splitting mutation txes when there are duplicate calls, so that they go over separate network requests to work around Om returning a map. 5 | 6 | 0.8.1 7 | ----- 8 | - Fixed load markers for ident-based loading: They will appear iff the entity is already present (refresh) 9 | - Cleaned up logic around data markers related to markers and data targeting 10 | - Added sequential processing as a configurable option on networking 11 | - Added devcards for integration testing loading cases 12 | - Removed explicit require of devcards.core in devcard untangled-app macro so that devcards is not a hard dependency. 13 | - Updated load to auto-add target or kw of load to the refresh list. 14 | 15 | 0.8.0 16 | ----- 17 | - Added defmutation 18 | - Fixed up namespaces that defined macros to allow for implicit macro usage by adding self-references 19 | - Added support for multiple remotes (networking option now accepts a map) 20 | - NOTE: `clear-pending-remote-requests!` now requires a remote parameter. 21 | - Added support for progressive load updates (nice for file 22 | upload support) 23 | 24 | 0.7.0 25 | ----- 26 | - Removed cache 27 | - Added UI routing helpers 28 | 29 | 0.6.1 30 | ----- 31 | - Added support for nil as subquery class in load 32 | - Fixed preprocess-merge to eliminate litter in app state 33 | - Added support for server-side rendering. 34 | - Removed forced root re-render on post mutations. POTENTIALLY BREAKING CHANGE! 35 | - The intended use is to include :refresh with your loads that indicate what to re-render 36 | - Fixed bug in InitialAppState that was missing the merge of nested unions on startup 37 | 38 | 0.6.0 39 | ----- 40 | - Changed InitialAppState to overwrite any supplied initial app state atom. 41 | This allows you to inspect data (the app state) when embedding an Untangled application in a devcard. 42 | - Added new `load` and `load-action` functions with cleaner interface. Deprecated `load-data` and `load-data-action`. 43 | - Now have the ability to target a top-level query to a spot in app state. Reduces need for post mutations 44 | - Reduced arguments for better clarity 45 | - Added ability to pass untangled app, so that use in started-callback is easier. 46 | - Fixed bug in failed loading markers 47 | - Fixed bug with removal/addition of markers when markers are off 48 | - Added jump to and playback speed features to the support viewer. 49 | - Added support for post-mutation parameters in load API. 50 | - Added support for custom handling of merge of return values from server mutations (see `:mutation-merge` 51 | in `new-untangled-client`). 52 | - Added support for custom transit handlers on the client side. Server side is coming in a release soon. 53 | - Added support for turning on/off Om path optimization 54 | - Fix for latest cljs support (PR 47) 55 | - DEPRECATED: load-data will soon no longer supports the :ident parameter. Use load instead. 56 | 57 | 0.5.7 58 | ----- 59 | - The `:marker` keyword actually works now! 60 | - Fix: data fetch with parameters places the load marker in the correct location in app state 61 | - Fix: error callback doesn't attempt to modify data state in app state db when the data state's marker is false 62 | 63 | 0.5.6 64 | ----- 65 | - Fixed bug with global-error-callback not being called with a server error returns no body 66 | - Fixed bug that prevents error processing if the server is completely down 67 | - Added reset-history! function to reset UntangledApplication Om cache history. 68 | - Added to UntangledApplication protocol: 69 | * (reset-app! [this root-component callback] "Replace the entire app state with the initial app state defined on the root component (includes auto-merging of unions). callback can be nil, a function, or :original (to call original started-callback).") 70 | * (clear-pending-remote-requests! [this] "Remove all pending network requests. Useful on failures to eliminate cascading failures.") 71 | 72 | 0.5.5 73 | ----- 74 | - Fixed bug where keywords in a union query were not elided when specified in the `:without` set of data fetches 75 | - Fixed bug with query combining that was causing parallel reads to collide 76 | - Corrected initialization order so that alternates on unions are done before startup callback 77 | - Fixed a rendering refresh bug on post mutations 78 | - Fixed compiler warnings about clojure walk 79 | 80 | 0.5.4 81 | ----- 82 | - Added marker option to loads, so that load markers are optional 83 | - OpenID client will now extract tokens from cookies as well as the header. 84 | 85 | 0.5.3 86 | ----- 87 | - Added utility function integrate-ident! 88 | - Refined merge-state! 89 | - Renamed Constructor to InitialAppState 90 | - Automated initialization of to-one unions (to-many was already doable by Om) 91 | 92 | 0.5.2 93 | ----- 94 | - Fixed bug with initial state and new constructors 95 | 96 | 0.5.1 97 | ----- 98 | - Added untangled/Constructor for adding initial state to UI components 99 | - Added merge-state! for easily merging component-centric data (e.g. from server push) 100 | 101 | 0.5.0 102 | ------ 103 | - Significant optimizations to post-query processing. 104 | - BREAKING CHANGE: to load-data. You should now include :refresh to trigger re-rendering of components. This removes the 105 | internal need for a forced root re-render. Proper refresh after load-data now requires this parameter. 106 | - Removed deprecated load-collection and load-singleton. Use load-data instead (name change only) 107 | 108 | 0.4.9 109 | ----- 110 | - Removed old logging code (use untangled.client.logging instead) 111 | - Added support for parallel lazy loading 112 | - Added `(start [this app])` to the `UntangledNetwork` protocol. 113 | - Log-app-state now requires the atom containing a mounted untangled client, define it in the user namespace like so: 114 | ``` 115 | (defonce app (atom (uc/new-untangled-client ... ))) 116 | (swap! app uc/mount RootComponent "app-div") 117 | (def log-app-state (partial util/log-app-state app)) 118 | ``` 119 | - `global-error-callback` now expectes an arity 2 function. First param is the status and the second is the response. 120 | - Fixed bug that closed over tempids in network callbacks 121 | - Fixed bug in path-optimized union query parsing 122 | 123 | 0.4.8 124 | ----- 125 | - Fixed tempid rewrite regression 126 | 127 | 0.4.7 128 | ----- 129 | - Upgraded to Om-alpha32 130 | - untangled.openid-client/setup, parses any openid claims from the webtoken in the url's hash fragments 131 | - Renamed load-collection/singleton to load-data. Old names are deprecated, but not yet removed. 132 | - Renamed :app/loading-data to :ui/loading-data 133 | - Added remote trigger method for doing loading from mutations. 134 | - Renamed everything in the internals that was prefixed app/ to untangled/ 135 | - Added global server error handler. 136 | - Added fallback support for load-data, load-field, etc. 137 | - Refactored networking send for better clarity 138 | - Fixed bug on mark/sweep of missing query results. It was being applied to mutations instead of reads. Added tests for this that need a bit more work. 139 | 140 | 0.4.6 141 | ----- 142 | - Fixed local read bug, and turned on path optimization 143 | - Fixed fallback handling of failed remote transactions, and added lots of tests 144 | 145 | 0.4.5 146 | ----- 147 | - Renamed react-key to ui/react-key 148 | - Renamed app/locale to ui/locale 149 | - Renamed mutation app/change-locale to ui/change-locale 150 | - Implemented a number of missing things in i18n 151 | - Removed a number of i18n helpers that were redundant to trf 152 | - Added :request-transform networking hook with spec 153 | - Modified load callback to a mutation symbol 154 | - Changed :params of loaders to allow you to specify which prop on the query gets the stated parameters 155 | - Added history method to application protocol, to make implementing history viewer in an app trivial 156 | 157 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing 2 | 3 | If you'd like to submit a PR, please follow these general guidelines: 4 | 5 | - Either talk to use about it in Slack, or open a github issue 6 | - Do development against the *develop* branch (we use git flow). PRs should be directed at the develop branch. Master is 7 | the latest release, not the live development. 8 | - In general, please squash your change into a single commit 9 | - Add an entry to the CHANGELOG describing the change 10 | 11 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | Copyright (c) 2015 NAVIS 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated 5 | documentation files (the "Software"), to deal in the Software without restriction, including without limitation the 6 | rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit 7 | persons to whom the Software is furnished to do so, subject to the following conditions: 8 | 9 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the 10 | Software. 11 | 12 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE 13 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 14 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR 15 | OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 16 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | tests: 2 | npm install 3 | lein doo chrome automated-tests once 4 | -------------------------------------------------------------------------------- /README.adoc: -------------------------------------------------------------------------------- 1 | # Untangled Client 2 | :source-highlighter: coderay 3 | :source-language: clojure 4 | :toc: 5 | :toc-placement: preamble 6 | :sectlinks: 7 | :sectanchors: 8 | :sectnums: 9 | 10 | The client library for the Untangled Web framework. 11 | 12 | What follows is a quick start tutorial that assumes at least a passing familiarity with ClojureScript and Figwheel. For 13 | an more information & depth, checkout the links in <>. 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 {}))) => "
A
B
")) 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 | --------------------------------------------------------------------------------