Merge branch 'epoch2'

This commit is contained in:
Daniel Compton 2018-01-18 15:14:55 +13:00
commit 7d79ef5937
57 changed files with 4757 additions and 291 deletions

View File

@ -9,6 +9,9 @@
:cursive.formatting/align-binding-forms true
:day8.re-frame.trace.utils.macros/with-cljs-devtools-prefs 1
}</ClojureCodeStyleSettings>
<MarkdownNavigatorCodeStyleSettings>
<option name="RIGHT_MARGIN" value="72" />
</MarkdownNavigatorCodeStyleSettings>
</value>
</option>
<option name="USE_PER_PROJECT_SETTINGS" value="true" />

View File

@ -37,6 +37,8 @@ You need both the re-frame-trace project _and_ a test project to develop it agai
:cljsbuild {:builds {:client {:source-paths ["checkouts/re-frame-trace/src"]}}}
```
- re-frame-trace has a debug panel useful when developing it. You can enable it by adding the :closure-define `"day8.re_frame.trace.debug_QMARK_" true` to your compiler settings.
- Now run your test project however you usually run it, and re-frame-trace should be in there. \o/
@ -52,12 +54,13 @@ We are using CSS preprocessing to isolate the panel styles, by namespacing the p
### Updating the internal version of re-frame used
We want to use re-frame, but we don't want to use the re-frame that the host is using, or tracing will get very messy. Instead, we use [mranderson](https://github.com/benedekfazekas/mranderson) to create source dependencies of re-frame.
We want to use re-frame, but we don't want to use the re-frame that the host is using, or tracing will get very messy. Instead, we use [mranderson](https://github.com/benedekfazekas/mranderson) to create source dependencies of re-frame and reagent.
```console
$ lein do clean
$ lein with-profile mranderson source-deps
$ cp -r target/srcdeps/mranderson047 src
$ cp -r target/srcdeps/mranderson047 src
# Then delete the META-INF directories
```
### How does re-frame-trace build?? I don't see anything in the project.clj that looks like it will build.

View File

@ -113,6 +113,19 @@ If you are using leiningen, modify `project.clj` in the following ways. When puz
- When the panel is closed, tracing is disabled.
## Use Cases
### app-db
* Inspect a portion of app-db's state with the path inspector, allowing you to focus on just the parts you care about.
* Reset app-db to before an event was run to run it again, instead of resetting the whole application
* Toggle app-db before and after states for running an event, to inspect UI changes.
### Timing
* Answer the question "Why is my app slow when it runs this event?"
* See whether time is spent in processing an event, or rendering the changes
## Troubleshooting
* Try a `lein clean`
@ -137,3 +150,7 @@ If you want to work on re-frame-trace, see [DEVELOPERS.md](DEVELOPERS.md).
* [Camera](https://thenounproject.com/search/?q=snapshot&i=200965) by Christian Shannon from the Noun Project
* [Delete](https://thenounproject.com/term/delete/926276) by logan from the Noun Project
* [Settings](https://thenounproject.com/search/?q=settings&i=1169241) by arjuazka from the Noun Project
* [Wrench](https://thenounproject.com/icon/1013218/) by Aleksandr Vector from the Noun Project
* [pause](https://thenounproject.com/icon/1376662/) by Bhuvan from the Noun Project
* [play]() by Bhuvan from the Noun Project
* [Log Out](https://thenounproject.com/icon/54484/) by Arthur Shlain from the Noun Project

View File

@ -0,0 +1,49 @@
# Capturing Epochs
**Status:** proposed
## Context:
### Intro
Conceptually, re-frame is built around an event loop. The user makes an action, which causes an event to be dispatched, which changes app-db, which causes subscriptions to rerun, which causes the UI to update. We will refer to this cycle as an epoch. A user developing a re-frame application will want to be able to debug from this perspective.
Currently, re-frame-trace offers three panels: app-db, subs, and traces. Each of these offers a view into the application state and allows the programmer to build up a mental model of what is happening. They are not going to go away, but there is room for a more integrated and holistic panel.
### Requirements
The new panel is organised around epochs. Information is grouped by epochs, and the user can switch between different epochs.
### Defining
There are several ways of defining an epoch:
* Starting when an event was dispatched and ending when a new event is dispatched. - This doesn't work well when one event causes others to be dispatched. It also doesn't give you very accurate timing for how long an epoch as a whole takes to run.
* Starting when an event was dispatched and ending when a new event is dispatched that causes the router to start running again. - This handles one event dispatching several other events, but it doesn't give you overall timing.
* Starting when an event was dispatched, and ending when there is a period of no traces being fired. - This is based on heuristics, rather than actually measuring.
* Starting when an event was dispatched, including all subscriptions and renders that happened, and ending when there is no re-render scheduled in Reagent. - What about events that trigger a dispatch to run in 50 ms, or other async callbacks?
We also have an additional wrinkle. Traces which are produced outside of an epoch are added to a mini epoch. This is for collecting traces which occur when Reagent re-renders, like when a local ratom hover state changes. No events are dispatched, so it is not a real epoch, but it is still useful information. We also have Figwheel re-renders which don't dispatch an event, but do cause a re-render and subscription creations and deletions. Epoch's will need to have a source property that can distinguish between user clicks, callbacks, figwheel re-renders, inter-epoch renders, and possibly other sources.
### Capturing epochs
From a JavaScript perspective, there are three separate calls which make up an epoch:
1. The initial dispatch from an on-click handler or callback. This adds the event to the queue but doesn't process it, instead deferring processing until the next tick.
2. Processing the event and updating app-db
3. Rendering the UI, which includes creating, running, disposing of subscriptions; creating and evaluating Hiccup (including sorting/filtering data structures); and React rendering. These are all intermingled due to the way that Reagent works.
## Decision:
* Each epoch has only one event in it, and starts when an event is handled, if multiple events are processed in the same router queue (either because the first event dispatched the second, or that two events were concurrently added to the queue) they will be treated as multiple epochs.
* End of epoch is when there is no longer any work in the reagent queue
### First approach
The start of the epoch will be defined as any event trace being emitted. The end of the epoch will be either a new event trace being emitted, or a Reagent callback being called when nothing is scheduled. This is not completely correct, as a downstream event will create its own epoch, but it should be good enough to start building a useful UI and gain more information about the approach.
After this is built we can review our understanding of what an epoch is and iterate on a second approach.
## Consequences:
TBA

View File

@ -0,0 +1,58 @@
What just happened
Reset to previous state and rerun
Compare previous events to understand the effect of my change
Performance, numbers are highly precise but not very accurate.
Measure the whole epoch
Rerun 50 times
- Timings
To assist a new user in navigating the codebase, file locations and line numbers
- reg-event-db, grab stack trace when registering event and subscription
;;;
How do we avoid people drifting away?
- Setup cost
- Paid by one person on the team
- Save the filtering across states
-
- Remove the debug interceptor
- Nominate which kinds of events to filter out
- Number of epochs
Capturing app-db
Capturing subscriptions
- Filter out low level stuff
- Processing
- Capturing
- Showing
- Filter out views
- It does mean something that you have h-box and v-box
- How do we do it?
- Filtering on namespaces?
- Filtering in or filtering out?
- Filter out subscriptions
-
# Sources of failure
- Usability issues
;;
Put together

View File

@ -1,16 +1,16 @@
(defproject day8.re-frame/trace "0.1.15-SNAPSHOT"
:description "Tracing and developer tools for re-frame apps"
:url "https://github.com/Day8/re-frame-trace"
:license {:name "MIT"}
:dependencies [[org.clojure/clojure "1.8.0"]
:url "https://github.com/Day8/re-frame-trace"
:license {:name "MIT"}
:dependencies [[org.clojure/clojure "1.9.0"]
[org.clojure/clojurescript "1.9.671"]
[reagent "0.6.0" :scope "provided"]
[reagent "0.6.0" :scope "provided"]
[re-frame "0.10.3-alpha2" :scope "provided"]
[binaryage/devtools "0.9.4"]
[binaryage/devtools "0.9.4"]
[garden "1.3.3"]]
:plugins [[thomasa/mranderson "0.4.7"]
[lein-less "RELEASE"]]
:deploy-repositories {"releases" :clojars
:deploy-repositories {"releases" :clojars
"snapshots" :clojars}
;:source-paths ["target/srcdeps"]
@ -30,11 +30,17 @@
:target-path "resources/day8/re_frame/trace"}
:profiles {:dev {:dependencies [[binaryage/dirac "RELEASE"]]}
:mranderson {:dependencies [^:source-dep [re-frame "0.10.2" :scope "provided"
:exclusions [org.clojure/clojurescript
reagent
cljsjs/react
cljsjs/react-dom
cljsjs/react-dom-server
org.clojure/tools.logging
net.cgrand/macrovich]]]}})
:mranderson {:dependencies ^:replace [^:source-dep [re-frame "0.10.2"
:exclusions [org.clojure/clojurescript
cljsjs/react
cljsjs/react-dom
cljsjs/react-dom-server
org.clojure/tools.logging
net.cgrand/macrovich]]
^:source-dep [reagent "0.6.0"
:exclusions [org.clojure/clojurescript
cljsjs/react
cljsjs/react-dom
cljsjs/react-dom-server
org.clojure/tools.logging
net.cgrand/macrovich]]]}})

View File

@ -0,0 +1,12 @@
<svg width="81" height="6" viewBox="0 0 81 6" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<title>Arrow 2.5</title>
<desc>Created using Figma</desc>
<g id="Canvas" transform="translate(114 -1093)">
<g id="Arrow 2.5">
<use xlink:href="#path0_stroke" transform="matrix(1 -3.46945e-18 3.46945e-18 1 -114 1096)" fill="#E0E0E0"/>
</g>
</g>
<defs>
<path id="path0_stroke" d="M 81 0L 76 -2.88675L 76 2.88675L 81 0ZM 0 0.5L 76.5 0.5L 76.5 -0.5L 0 -0.5L 0 0.5Z"/>
</defs>
</svg>

After

Width:  |  Height:  |  Size: 518 B

View File

@ -0,0 +1,16 @@
<svg width="18" height="13" viewBox="0 0 18 13" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<title>noun_934162</title>
<desc>Created using Figma</desc>
<g id="Canvas" transform="translate(-1443 -130)">
<g id="noun_934162">
<g id="Group">
<g id="Vector">
<use xlink:href="#path0_fill" transform="translate(1443.31 130.034)" fill="#8BE88B"/>
</g>
</g>
</g>
</g>
<defs>
<path id="path0_fill" d="M 5.34859 12.0646C 3.50351 11.9032 1.92026 10.9239 0.925618 9.32866C 0.302333 8.32903 -9.5292e-07 7.25259 -9.5292e-07 6.03303C -9.5292e-07 4.81348 0.302333 3.73704 0.925618 2.73741C 1.65337 1.57024 2.70351 0.724611 3.97056 0.285455C 4.54434 0.0865844 5.07606 0.00129226 5.74206 0.00129226C 6.71035 0.00129226 7.52536 0.206162 8.37837 0.663984L 8.62007 0.793712L 8.86178 0.663984C 9.46299 0.341304 10.0469 0.148532 10.7449 0.0423443C 11.1159 -0.0141147 11.8802 -0.0141147 12.2513 0.0423443C 13.5711 0.243154 14.7003 0.838189 15.6036 1.80889C 16.4865 2.75778 17.0152 3.89385 17.2011 5.24181C 17.2548 5.6316 17.2548 6.43447 17.2011 6.82426C 16.9538 8.61728 16.0517 10.118 14.6354 11.0925C 13.6838 11.7472 12.6591 12.0648 11.4981 12.0648C 10.5298 12.0648 9.71479 11.8599 8.86178 11.4021L 8.62007 11.2724L 8.37837 11.4021C 7.57275 11.8345 6.77227 12.0459 5.86573 12.0656C 5.64313 12.0705 5.41042 12.07 5.34859 12.0646L 5.34859 12.0646ZM 6.09057 11.6301C 6.62571 11.5897 7.03588 11.504 7.51834 11.3319C 7.73692 11.254 8.21535 11.0329 8.21535 11.0098C 8.21535 11.0043 8.11671 10.9212 7.99615 10.8251C 7.71087 10.5979 7.26786 10.1453 7.0392 9.84746C 6.36059 8.96363 5.95378 7.97508 5.7951 6.82426C 5.74135 6.43447 5.74135 5.6316 5.7951 5.24181C 5.95376 4.09118 6.35998 3.10391 7.03904 2.21858C 7.27324 1.91323 7.74364 1.43683 8.01851 1.22662C 8.13741 1.13569 8.2354 1.05487 8.23627 1.04704C 8.23909 1.02142 7.75997 0.796909 7.51834 0.710621C 6.36194 0.297674 5.17956 0.297325 4.01076 0.709589C 3.69344 0.821518 3.10889 1.12515 2.81909 1.32859C 1.69539 2.11742 0.911626 3.27317 0.581813 4.62772C 0.455362 5.14706 0.425866 5.41062 0.425866 6.02122C 0.425866 6.63183 0.455362 6.89539 0.581813 7.41473C 0.819251 8.3899 1.30828 9.29039 1.98646 10.0012C 2.40917 10.4443 2.85698 10.7777 3.41492 11.0646C 4.14356 11.4393 4.80497 11.6083 5.70834 11.6507C 5.74544 11.6525 5.91744 11.6432 6.09057 11.6301Z"/>
</defs>
</svg>

After

Width:  |  Height:  |  Size: 2.3 KiB

View File

@ -0,0 +1 @@
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" x="0px" y="0px" viewBox="15 15 70 70" enable-background="new 0 0 100 100" xml:space="preserve"><g fill="white" transform="rotate(-45, 50, 50)"><path d="M50.015,82.6c8.352,0,16.704-3.179,23.062-9.537c0.977-0.976,0.977-2.559,0-3.535s-2.559-0.977-3.535,0 c-10.769,10.766-28.287,10.765-39.054,0c-10.767-10.768-10.767-28.287,0-39.055c10.768-10.766,28.286-10.766,39.054,0 c0.977,0.977,2.559,0.977,3.535,0s0.977-2.56,0-3.535c-12.717-12.717-33.408-12.717-46.124,0c-12.717,12.717-12.717,33.408,0,46.125 C33.311,79.421,41.663,82.6,50.015,82.6z"/><path d="M94.37,48.229c-0.002-0.002-0.003-0.002-0.005-0.004L83.725,37.585c-0.977-0.977-2.559-0.977-3.535,0s-0.977,2.559,0,3.535 l6.38,6.38H57.063c-1.03-2.903-3.792-4.985-7.048-4.985c-4.134,0-7.485,3.351-7.485,7.485c0,4.134,3.351,7.485,7.485,7.485 c3.256,0,6.018-2.082,7.048-4.985h29.506l-6.38,6.38c-0.977,0.977-0.977,2.559,0,3.535c0.488,0.488,1.128,0.732,1.768,0.732 s1.279-0.244,1.768-0.732L96.14,50l-1.765-1.765C94.373,48.233,94.372,48.231,94.37,48.229z"/></g></svg>

After

Width:  |  Height:  |  Size: 1.1 KiB

View File

@ -1,3 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" viewBox="-1 -1 10 10" x="0px" y="0px">
<path fill="#444444" d="M0 0v8h8v-2h-1v1h-6v-6h1v-1h-2zm4 0l1.5 1.5-2.5 2.5 1 1 2.5-2.5 1.5 1.5v-4h-4z"/>
<path fill="white" d="M0 0v8h8v-2h-1v1h-6v-6h1v-1h-2zm4 0l1.5 1.5-2.5 2.5 1 1 2.5-2.5 1.5 1.5v-4h-4z"/>
</svg>

Before

Width:  |  Height:  |  Size: 196 B

After

Width:  |  Height:  |  Size: 194 B

View File

@ -0,0 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" version="1.1" x="0px" y="0px" viewBox="0 0 164 164" xml:space="preserve">
<path fill="#F2994A" fill-rule="evenodd" clip-rule="evenodd" d="M81.84,164c-15.38,0-29.768-4.246-42.059-11.625L77.6,114.557 c34.776,10.805,55.768-19.881,43.504-49.777L99.648,86.235C85.9,100.154,65.377,79.619,79.119,65.877l21.541-21.542 c-25.989-15.371-63.361,9.68-50.728,44.244l-37.29,37.289C4.638,113.223,0,98.233,0,82.16C0,36.961,36.641,0.32,81.84,0.32 c45.199,0,81.839,36.641,81.839,81.84S127.039,164,81.84,164z"/>
</svg>

After

Width:  |  Height:  |  Size: 546 B

View File

@ -0,0 +1 @@
<svg xmlns="http://www.w3.org/2000/svg" data-name="Layer 1" viewBox="15 15 70 70" x="0px" y="0px"><title>13</title><g fill="white" data-name="Group"><path data-name="Path" d="M41.79,35.26a2,2,0,0,0-2,2V62.74a2,2,0,1,0,4,0V37.26A2,2,0,0,0,41.79,35.26Z"/><path data-name="Path" d="M58.21,35.26a2,2,0,0,0-2,2V62.74a2,2,0,1,0,4,0V37.26A2,2,0,0,0,58.21,35.26Z"/><path data-name="Compound Path" d="M50,18.44A31.56,31.56,0,1,0,81.56,50,31.6,31.6,0,0,0,50,18.44Zm0,59.12A27.56,27.56,0,1,1,77.56,50,27.59,27.59,0,0,1,50,77.56Z"/></g></svg>

After

Width:  |  Height:  |  Size: 531 B

View File

@ -0,0 +1,8 @@
<svg xmlns="http://www.w3.org/2000/svg" data-name="Layer 1" viewBox="15 15 70 70" x="0px" y="0px">
<title>13</title>
<g fill="#F2994A" data-name="Group">
<path data-name="Compound Path" d="M40.78,67.37,67.55,50,40.78,32.63Zm4-27.38L60.2,50,44.78,60Z"/>
<path data-name="Compound Path"
d="M50,18.44A31.56,31.56,0,1,0,81.56,50,31.6,31.6,0,0,0,50,18.44Zm0,59.12A27.56,27.56,0,1,1,77.56,50,27.59,27.59,0,0,1,50,77.56Z"/>
</g>
</svg>

After

Width:  |  Height:  |  Size: 471 B

View File

@ -0,0 +1,12 @@
<svg width="34" height="32" viewBox="0 0 34 32" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<title>Vector</title>
<desc>Created using Figma</desc>
<g id="Canvas" transform="translate(-918 -1231)">
<g id="Vector">
<use xlink:href="#path0_stroke" transform="translate(921.009 1231)" fill="#767A7C"/>
</g>
</g>
<defs>
<path id="path0_stroke" d="M 0 0L -2.8822 5.00262L 2.8913 4.99737L 0 0ZM -0.495905 4.5006C -0.476808 11.1305 -0.366878 16.1392 0.247919 19.9008C 0.867102 23.6815 2.01224 26.3073 4.17733 28.0747C 6.32558 29.8284 9.39641 30.6673 13.6945 31.0836C 17.9937 31.4994 23.6227 31.5 30.9712 31.5L 30.9712 30.5C 23.6227 30.5 18.0419 30.5006 13.791 30.0883C 9.53899 29.6764 6.71945 28.859 4.8097 27.3001C 2.91677 25.7548 1.83627 23.4118 1.23477 19.7391C 0.628892 16.0473 0.523116 11.1182 0.504091 4.49773L -0.495905 4.5006Z"/>
</defs>
</svg>

After

Width:  |  Height:  |  Size: 894 B

View File

@ -0,0 +1,12 @@
<svg width="13" height="15" viewBox="0 0 13 15" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<title>Vector</title>
<desc>Created using Figma</desc>
<g id="Canvas" transform="translate(-1483 -129)">
<g id="Vector">
<use xlink:href="#path0_fill" transform="translate(1483.7 129.04)" fill="#6EC0E6"/>
</g>
</g>
<defs>
<path id="path0_fill" d="M 0.828912 13.2626C 0.828912 14.1744 1.57493 14.9204 2.48674 14.9204L 9.11804 14.9204C 10.0298 14.9204 10.7759 14.1744 10.7759 13.2626L 10.7759 3.31565L 0.828912 3.31565L 0.828912 13.2626ZM 11.6048 0.828912L 8.70358 0.828912L 7.87467 0L 3.73011 0L 2.90119 0.828912L 0 0.828912L 0 2.48674L 11.6048 2.48674L 11.6048 0.828912Z"/>
</defs>
</svg>

After

Width:  |  Height:  |  Size: 730 B

View File

@ -0,0 +1,12 @@
<svg width="12" height="7" viewBox="0 0 12 7" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<title>Polygon</title>
<desc>Created using Figma</desc>
<g id="Canvas" transform="translate(-2344 -40)">
<g id="Polygon">
<use xlink:href="#path0_fill" transform="matrix(-1 9.54098e-18 -9.54098e-18 -1 2356 47)" fill="#6EC0E6"/>
</g>
</g>
<defs>
<path id="path0_fill" d="M 6.05481 0L 12 7L 0 7L 6.05481 0Z"/>
</defs>
</svg>

After

Width:  |  Height:  |  Size: 462 B

View File

@ -0,0 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" version="1.1" x="0px" y="0px" viewBox="0 0 164 164" xml:space="preserve">
<path fill="white" fill-rule="evenodd" clip-rule="evenodd" d="M81.84,164c-15.38,0-29.768-4.246-42.059-11.625L77.6,114.557 c34.776,10.805,55.768-19.881,43.504-49.777L99.648,86.235C85.9,100.154,65.377,79.619,79.119,65.877l21.541-21.542 c-25.989-15.371-63.361,9.68-50.728,44.244l-37.29,37.289C4.638,113.223,0,98.233,0,82.16C0,36.961,36.641,0.32,81.84,0.32 c45.199,0,81.839,36.641,81.839,81.84S127.039,164,81.84,164z"/>
</svg>

After

Width:  |  Height:  |  Size: 544 B

View File

@ -12,7 +12,7 @@
[cljs.pprint :as pprint]
[clojure.string :as str]
[clojure.set :as set]
[reagent.core :as r]
[reagent.core :as real-reagent]
[reagent.interop :refer-macros [$ $!]]
[reagent.impl.util :as util]
[reagent.impl.component :as component]
@ -21,8 +21,10 @@
[goog.object :as gob]
[re-frame.interop :as interop]
[devtools.formatters.core :as devtools]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]))
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[mranderson047.reagent.v0v6v0.reagent.core :as r]))
(goog-define debug? false)
;; from https://github.com/reagent-project/reagent/blob/3fd0f1b1d8f43dbf169d136f0f905030d7e093bd/src/reagent/impl/component.cljs#L274
(defn fiber-component-path [fiber]
@ -52,7 +54,7 @@
(def static-fns
{:render
(fn render []
(fn mp-render [] ;; Monkeypatched render
(this-as c
(trace/with-trace {:op-type :render
:tags {:component-path (component-path c)}
@ -73,11 +75,14 @@
res)))))})
(defonce real-custom-wrapper reagent.impl.component/custom-wrapper)
(defonce real-next-tick reagent.impl.batching/next-tick)
(defonce real-schedule reagent.impl.batching/schedule)
(defonce do-after-render-trace-scheduled? (atom false))
(defn monkey-patch-reagent []
(let [#_#_real-renderer reagent.impl.component/do-render
real-custom-wrapper reagent.impl.component/custom-wrapper
real-next-tick reagent.impl.batching/next-tick
real-schedule reagent.impl.batching/schedule]
]
#_(set! reagent.impl.component/do-render
@ -89,8 +94,6 @@
:operation (last (str/split name #" > "))}
(real-renderer c)))))
(set! reagent.impl.component/static-fns static-fns)
(set! reagent.impl.component/custom-wrapper
@ -106,15 +109,40 @@
(real-custom-wrapper key f))))
#_(set! reagent.impl.batching/next-tick (fn [f]
(real-next-tick (fn []
(trace/with-trace {:op-type :raf}
(f))))))
(set! reagent.impl.batching/next-tick
(fn [f]
;; Schedule a trace to be emitted after a render if there is nothing else scheduled after that render.
;; This signals the end of the epoch.
#_(set! reagent.impl.batching/schedule schedule
#_(fn []
(reagent.impl.batching/do-after-render (fn [] (trace/with-trace {:op-type :raf-end})))
(real-schedule)))))
#_ (swap! do-after-render-trace-scheduled?
(fn [scheduled?]
(js/console.log "Setting up scheduled after" scheduled?)
(if scheduled?
scheduled?
(do (reagent.impl.batching/do-after-render ;; a do-after-flush would probably be a better spot to put this if it existed.
(fn []
(js/console.log "Do after render" reagent.impl.batching/render-queue)
(reset! do-after-render-trace-scheduled? false)
(when (false? (.-scheduled? reagent.impl.batching/render-queue))
(trace/with-trace {:op-type :reagent/quiescent}))))
true))))
(real-next-tick (fn []
(trace/with-trace {:op-type :raf}
(f)
(trace/with-trace {:op-type :raf-end})
(when (false? (.-scheduled? reagent.impl.batching/render-queue))
(trace/with-trace {:op-type :reagent/quiescent}))
)))))
#_(set! reagent.impl.batching/schedule
(fn []
(reagent.impl.batching/do-after-render
(fn []
(when @do-after-render-trace-scheduled?
(trace/with-trace {:op-type :do-after-render})
(reset! do-after-render-trace-scheduled? false))))
(real-schedule)))))
(defn init-tracing!
@ -205,7 +233,8 @@
(defn inject-devtools! []
(styles/inject-trace-styles js/document)
(r/render [devtools-outer events/traces {:panel-type :inline}] (panel-div)))
(r/render [devtools-outer events/traces {:panel-type :inline
:debug? debug?}] (panel-div)))
(defn init-db! []
(trace.db/init-db))

View File

@ -1,4 +1,7 @@
(ns day8.re-frame.trace.common-styles)
(ns day8.re-frame.trace.common-styles
(:require [garden.units :refer [px em]]))
;; TODO: Switch these to BM (or just use BM defs if available)
(def background-blue "#e7f1ff")
(def background-gray "#a8a8a8")
@ -14,9 +17,241 @@
(def light-blue "lightblue")
(def light-gray "#efeef1")
(def yellow "yellow")
(def text-color "#222")
(def text-color "#767A7C") ;; Was "#222" but now using bm: (def default-text-color "#767A7C")
(def text-color-muted "#8f8f8f")
(def event-color dark-gold)
(def subs-color dark-purple)
(def render-color dark-skyblue)
;; Golden section, base 50
(def gs-5 (px 5))
(def gs-7 (px 7))
(def gs-12 (px 12))
(def gs-19 (px 19))
(def gs-31 (px 31))
(def gs-50 (px 50))
(def gs-81 (px 81))
(def gs-131 (px 131))
;; TODO: figure out how to cast gs-* into strings, rather than manually making them here.
(def gs-5s "5px")
(def gs-7s "7px")
(def gs-12s "12px")
(def gs-19s "19px")
(def gs-31s "31px")
(def gs-50s "50px")
(def gs-81s "81px")
(def gs-131s "131px")
;; The colors defined below are (of course) available to your app without further ado
;;
;; However...
;;
;; To get access to the styles, your code needs to add the following requires:
;;
;; [day8.apps-lib.ux.blue-modern :as bm]
;; [day8.apps-lib.ux.stylesheet :as stylesheet]
;;
;; And the following line to the `mount-gui` function:
;;
;; (stylesheet/inject-garden-stylesheet! bm/blue-modern "blue-modern")
;;
;; Then to use the styles, simply add the corresponding names to the `:class` arg of your components:
;;
;; [rc/box
;; :class "standard-background"
;; :child [rc/button
;; :class "strong-button"
;; :label "Add"]]
;; =================================================================================================
;; Blue modern component colours
;; =================================================================================================
(def blue-modern-color "#6EC0E6") ;; Our standard rich blue colour
(def white-background-color "white")
(def white-background-border-color "#E3E9ED") ;; Light grey
(def standard-background-color "#F3F6F7") ;; Light grey
(def standard-background-border-color "transparent")
(def light-background-color "#FBFBFB") ;; Medium grey
(def light-background-border-color "#BFCCD6") ;; Slightly darker than medium grey
(def dark-background-color "#768895") ;; Darker grey
(def dark-background-border-color white-background-border-color)
(def border-line-color "#DCE3E8") ;; Slightly darker than light grey
(def table-row-line-color "#EAEEF1") ;; Light grey
(def text-title-color "#3C454B") ;; Darker grey than the standard text color
(def default-text-color "#767A7C") ;; Medium grey
;(def disabled-text-color "TBA???") ;; Placeholder (currently not specified)
(def disabled-background-color "#ECEDF0") ;; Light grey
(def disabled-border-color border-line-color)
(def strong-button-text-color "white")
(def strong-button-background-color blue-modern-color)
(def strong-button-border-color "#589AB8") ;; A darker version of the standard blue
(def active-button-text-color "white")
(def active-button-background-color "#F2994A")
(def muted-button-text-color strong-button-background-color)
(def muted-button-background-color "white")
(def muted-button-border-color white-background-border-color)
(def hyperlink-text-color strong-button-background-color)
(def tab-underline-color strong-button-background-color)
(def sidebar-background-color "#32323C") ;; Dark black
(def sidebar-heading-divider-color "#191919") ;; Darker black
(def sidebar-item-selected-color "#3C3C45") ;; Slightly lighter dark black
(def sidebar-item-check-color strong-button-background-color)
(def sidebar-text-color "white")
(def navbar-text-color "white")
(def wizard-panel-background-color "#636A6F") ;; Very dark grey
(def wizard-panel-text-color "white")
(def wizard-nav-button-background-color "white")
(def wizard-nav-button-text-color "#303234") ;; Almost black (also used for button arrows)
(def wizard-cancel-button-background-color "#D6D8D9") ;; Light grey
(def wizard-step-past-color "#E8FFC1") ;; Muted lime green
(def wizard-step-current-color "#C7FF66") ;; Bright lime green
(def wizard-step-future-color dark-background-color)
(def font-stack ["\"Segoe UI\"" "Roboto", "Helvetica", "sans-serif"])
;; =================================================================================================
;; Blue modern component styles (in garden format)
;; =================================================================================================
(def blue-modern
[;; ========== Specific blue-modern styles (must be added to :class arg)
:#--re-frame-trace--
[:.bm-white-background {:background-color white-background-color
:border (str "1px solid " white-background-border-color)}]
[:.bm-standard-background {:background-color standard-background-color
:border (str "1px solid " standard-background-border-color)}]
[:.bm-light-background {:background-color light-background-color
:border (str "1px solid " light-background-border-color)}]
[:.bm-dark-background {:background-color dark-background-color
:border (str "1px solid " dark-background-border-color)}]
[:.bm-title-text {:font-size "26px"
:color text-title-color
:-webkit-user-select "none"
:cursor "default"}]
[:.bm-heading-text {:font-size "19px"
:font-weight "600"
:color default-text-color
:-webkit-user-select "none"
:cursor "default"}]
[:.bm-body-text {:color default-text-color}]
[:.bm-textbox-label {:font-variant "small-caps"
:color default-text-color
:-webkit-user-select "none"
:cursor "default"}]
[:.bm-strong-button {:color strong-button-text-color
:background-color strong-button-background-color
:border (str "1px solid " strong-button-border-color)}]
[:.bm-active-button {:color active-button-text-color
:background-color active-button-background-color
:border (str "1px solid " active-button-background-color)}]
[:.bm-muted-button {:color muted-button-text-color
:background-color muted-button-background-color
:border (str "1px solid " strong-button-border-color)}]
[:.bm-disabled-button {;:color disabled-text-color (not yet defined)
:background-color disabled-background-color
:border (str "1px solid " strong-button-border-color)}]
[:.bm-popover-content-wrapper
[:>
[:.popover
[:>
[:.popover-arrow
[:polyline {:fill (str standard-background-color " !important")}]]]]]]
;; TODO: When there is a title section, the top left and right radius can be seen
[:.bm-popover-content-wrapper
[:>
[:.popover
[:>
[:.popover-content {:background-color standard-background-color
:border-radius "6px"}]]]]]
;; ========== General overrides to convert re-com/bootstrap components to blue modern automatically
;; Default text color overrides
[:body {:color default-text-color}]
[:.form-control {:color default-text-color}]
[:.btn-default {:color default-text-color}]
[:.raptor-editable-block {:color default-text-color}]
;; button components - to 26px high
[:button {:height "26px"
:border-radius "3px"}]
[:.btn {:padding "0px 12px"}]
;; input-text - set to 26px high
[:.rc-input-text
[:input {:height "26px"}]]
;; input-time - set to 26px high
[:.rc-input-time {:height "26px"}]
;; hyperlink components - set color
[:a.rc-hyperlink
:a.rc-hyperlink-href {:color hyperlink-text-color}]
;; title - set color
[:.rc-title {:color default-text-color
:cursor "default"
:-webkit-user-select "none"}]
;; single-dropdown - 26px high (and color it)
[:.chosen-container-single
[:.chosen-single {:height "26px"
:line-height "24px"}]]
[:.chosen-container-single
[:.chosen-single
[:div {:top "-4px"}]]]
[:.rc-dropdown {:align-self "initial !important"}]
[:.chosen-container-single
[:.chosen-default {:color default-text-color}]]
[:.chosen-container
[:.chosen-results {:color default-text-color}]]
;; selection-list - set background color of container
[:.rc-selection-list {:background-color "white"}] ;
;; datepicker-dropdowns - set to 26px high
[:.dropdown-button {:height "26px"}]
[:.dropdown-button
[:.zmdi-apps {:font-size "19px !important"}]]
[:.form-control.dropdown-button {:padding "3px 12px"}]
;; rc-tabs - color
[:.nav-tabs
[:>
[:li.active
[:>
[:a {:color default-text-color}
[:&:hover {:color default-text-color}]]]]]]
[:.btn-default
[:&:hover :&:focus :&:active {:color default-text-color}]]
[:.btn-default.active {:color default-text-color}]
[:.open
[:>
[:.dropdown-toggle.btn-default {:color default-text-color}]]]
])

View File

@ -5,9 +5,9 @@
(defn init-db []
(let [panel-width% (localstorage/get "panel-width-ratio" 0.35)
show-panel? (localstorage/get "show-panel" false)
selected-tab (localstorage/get "selected-tab" :traces)
selected-tab (localstorage/get "selected-tab" :event)
filter-items (localstorage/get "filter-items" [])
app-db-paths (localstorage/get "app-db-paths" '())
app-db-paths (into (sorted-map) (localstorage/get "app-db-paths" {}))
json-ml-paths (localstorage/get "app-db-json-ml-expansions" #{})
external-window? (localstorage/get "external-window?" false)
using-trace? (localstorage/get "using-trace?" true)
@ -21,6 +21,8 @@
(rf/dispatch [:global/launch-external]))
(rf/dispatch [:traces/filter-items filter-items])
(rf/dispatch [:traces/set-categories categories])
(rf/dispatch [:traces/update-show-epoch-traces? true]) ;; TODO: source this from LS.
(rf/dispatch [:app-db/paths app-db-paths])
(rf/dispatch [:app-db/set-json-ml-paths json-ml-paths])
(rf/dispatch [:global/add-unload-hook])))
(rf/dispatch [:global/add-unload-hook])
(rf/dispatch [:app-db/reagent-id])))

View File

@ -1,20 +1,23 @@
(ns day8.re-frame.trace.events
(:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[mranderson047.reagent.v0v6v0.reagent.core :as r]
[day8.re-frame.trace.utils.utils :as utils]
[day8.re-frame.trace.utils.localstorage :as localstorage]
[clojure.string :as str]
[reagent.core :as r]
[goog.object]
[re-frame.db]
[re-frame.interop]
[day8.re-frame.trace.view.container :as container]
[day8.re-frame.trace.styles :as styles]
[clojure.set :as set]))
[clojure.set :as set]
[day8.re-frame.trace.metamorphic :as metam]))
(defonce traces (r/atom []))
(defonce total-traces (r/atom 0))
(defn log-trace? [trace]
(let [render-operation? (= (:op-type trace) :render)
(let [render-operation? (or (= (:op-type trace) :render)
(= (:op-type trace) :componentWillUnmount))
component-path (get-in trace [:tags :component-path] "")]
(if-not render-operation?
true
@ -25,18 +28,21 @@
(defn enable-tracing! []
(re-frame.trace/register-trace-cb ::cb (fn [new-traces]
(when-let [new-traces (filter log-trace? new-traces)]
(when-let [new-traces (->> (filter log-trace? new-traces)
(sort-by :id))]
(swap! total-traces + (count new-traces))
(swap! traces
(fn [existing]
(let [new (reduce conj existing new-traces)
size (count new)]
(if (< 4000 size)
(let [new2 (subvec new (- size 2000))]
(if (< @total-traces 20000) ;; Create a new vector to avoid structurally sharing all traces forever
(if (< 8000 size)
(let [new2 (subvec new (- size 4000))]
(if (< @total-traces 40000) ;; Create a new vector to avoid structurally sharing all traces forever
(do (reset! total-traces 0)
(into [] new2))))
new))))))))
new))))
(rf/dispatch [:traces/update-traces @traces])
(rf/dispatch [:epochs/update-epochs (metam/parse-traces @traces)])))))
(defn dissoc-in
"Dissociates an entry from a nested associative structure returning a new
@ -65,12 +71,31 @@
(localstorage/save! "selected-tab" selected-tab)
(assoc-in db [:settings :selected-tab] selected-tab)))
(rf/reg-event-db
:settings/toggle-settings
(fn [db _]
(update-in db [:settings :showing-settings?] not)))
(rf/reg-event-db
:settings/show-panel?
(fn [db [_ show-panel?]]
(localstorage/save! "show-panel" show-panel?)
(assoc-in db [:settings :show-panel?] show-panel?)))
(rf/reg-event-db
:settings/factory-reset
(fn [db _]
(localstorage/delete-all-keys!)
(js/location.reload)
db))
(rf/reg-event-db
:settings/clear-epochs
(fn [db _]
(reset! traces [])
(reset! total-traces 0)
db))
(rf/reg-event-db
:settings/user-toggle-panel
(fn [db _]
@ -87,6 +112,18 @@
(assoc-in [:settings :using-trace?] using-trace?)
(assoc-in [:settings :show-panel?] now-showing?)))))
(rf/reg-event-db
:settings/pause
(fn [db _]
(assoc-in db [:settings :paused?] true)))
(rf/reg-event-db
:settings/play
(fn [db _]
(-> db
(assoc-in [:settings :paused?] false)
(assoc-in [:epochs :current-epoch-index] nil))))
;; Global
(defn mount [popup-window popup-document]
@ -230,16 +267,93 @@
(fn [categories [_ new-categories]]
new-categories))
(rf/reg-event-db
:traces/update-show-epoch-traces?
[(rf/path [:traces :show-epoch-traces?])]
(fn [_ [_ show-epoch-traces?]]
show-epoch-traces?))
;; App DB
(def app-db-path-mw
[(rf/path [:app-db :paths]) (rf/after #(localstorage/save! "app-db-paths" %))])
(rf/reg-event-db
:app-db/create-path
app-db-path-mw
(fn [paths _]
(assoc paths (js/Date.now) {:diff? false :open? true :path nil :path-str "[]" :valid-path? true})))
(defn read-string-maybe [s]
(try (cljs.tools.reader.edn/read-string s)
(catch :default e
nil)))
;; The core idea with :app-db/update-path and :app-db/update-path-blur
;; is that we need to separate the users text input (`path-str`) with the
;; parsing of that string (`path`). We let the user type any string that
;; they like, and check it for validity on each change. If it is valid
;; then we update `path` and mark the pod as valid. If it isn't valid then
;; we don't update `path` and mark the pod as invalid.
;;
;; On blur of the input, we reset path-str to the last valid path, if
;; the pod isn't currently valid.
(rf/reg-event-db
:app-db/update-path
app-db-path-mw
(fn [paths [_ path-id path-str]]
(let [path (read-string-maybe path-str)
paths (assoc-in paths [path-id :path-str] path-str)]
(if (or (and (some? path)
(sequential? path))
(str/blank? path-str))
(-> paths
(assoc-in [path-id :path] path)
(assoc-in [path-id :valid-path?] true))
(assoc-in paths [path-id :valid-path?] false)))))
(rf/reg-event-db
:app-db/update-path-blur
app-db-path-mw
(fn [paths [_ path-id]]
(let [{:keys [valid-path? path]} (get paths path-id)]
(if valid-path?
paths
(-> (assoc-in paths [path-id :path-str] (pr-str path))
(assoc-in [path-id :valid-path?] true))))))
(rf/reg-event-db
:app-db/set-path-visibility
app-db-path-mw
(fn [paths [_ path-id open?]]
(assoc-in paths [path-id :open?] open?)))
(rf/reg-event-db
:app-db/set-diff-visibility
app-db-path-mw
(fn [paths [_ path-id diff?]]
(let [open? (if diff?
true
(get-in paths [path-id :open?]))]
(-> paths
(assoc-in [path-id :diff?] diff?)
;; If we turn on diffing then we want to also expand the path
(assoc-in [path-id :open?] open?)))))
(rf/reg-event-db
:app-db/remove-path
app-db-path-mw
(fn [paths [_ path-id]]
(dissoc paths path-id)))
(rf/reg-event-db
:app-db/paths
app-db-path-mw
(fn [db [_ paths]]
(let [new-paths (into [] paths)] ;; Don't use sets, use vectors
(localstorage/save! "app-db-paths" paths)
(assoc-in db [:app-db :paths] paths))))
paths))
(rf/reg-event-db
#_(rf/reg-event-db
:app-db/remove-path
(fn [db [_ path]]
(let [new-db (update-in db [:app-db :paths] #(remove (fn [p] (= p path)) %))]
@ -247,7 +361,7 @@
;; TODO: remove from json-ml expansions too.
new-db)))
(rf/reg-event-db
#_(rf/reg-event-db
:app-db/add-path
(fn [db _]
(let [search-string (get-in db [:app-db :search-string])
@ -287,14 +401,61 @@
new-paths)))
(rf/reg-event-db
:snapshot/save-snapshot
[(rf/path [:snapshot])]
(fn [snapshot _]
(assoc snapshot :current-snapshot @re-frame.db/app-db)))
:app-db/reagent-id
[(rf/path [:app-db :reagent-id])]
(fn [paths _]
(re-frame.interop/reagent-id re-frame.db/app-db)))
(rf/reg-event-db
:snapshot/load-snapshot
[(rf/path [:snapshot])]
(fn [snapshot _]
(reset! re-frame.db/app-db (:current-snapshot snapshot))
snapshot))
(fn [db [_ new-db]]
(reset! re-frame.db/app-db new-db)
db))
;;;
(rf/reg-event-db
:epochs/update-epochs
[(rf/path [:epochs :matches])]
(fn [matches [_ rt]]
(:matches rt)))
(rf/reg-event-fx
:epochs/previous-epoch
[(rf/path [:epochs :current-epoch-index])]
(fn [ctx _]
{:db ((fnil dec 0) (:db ctx))
:dispatch [:settings/pause]}))
(rf/reg-event-fx
:epochs/next-epoch
[(rf/path [:epochs :current-epoch-index])]
(fn [ctx _]
{:db ((fnil inc 0) (:db ctx))
:dispatch [:settings/pause]}))
(rf/reg-event-db
:traces/update-traces
[(rf/path [:traces :all-traces])]
(fn [_ [_ traces]]
traces))
;;
(rf/reg-event-db
:subs/ignore-unchanged-subs?
[(rf/path [:subs :ignore-unchanged-subs?])]
(fn [_ [_ ignore?]]
ignore?))
(rf/reg-event-db
:subs/open-pod?
[(rf/path [:subs :expansions])]
(fn [expansions [_ id open?]]
(assoc-in expansions [id :open?] open?)))
(rf/reg-event-db
:subs/diff-pod?
[(rf/path [:subs :expansions])]
(fn [expansions [_ id diff?]]
(assoc-in expansions [id :diff?] diff?)))

View File

@ -0,0 +1,233 @@
(ns day8.re-frame.trace.metamorphic
(:require [mranderson047.re-frame.v0v10v2.re-frame.utils :as utils]))
;; What starts an epoch?
;;; idle -> dispatch -> running
;;; running -> dispatch -> handling new event
;; What ends an epoch?
;;; the start of a new epoch
;;; a Reagent animation frame ending AND nothing else being scheduled
;; Slight wrinkles
;;; Any renders that run between epochs deserve their own epoch really.
;;; Dispatch-sync's
;;;
;
;(defn add-event-from-idle? [event history pattern-sequence pattern]
; #_(println @history event)
;
; (and (= :re-frame.router/fsm-trigger (:op-type event))
; (= (:operation event)
; [:idle :add-event])))
;
;(defn event-run? [event history pattern-sequence pattern]
; (= :event (:op-type event)))
;
;(defn epoch-started? [event history pattern-sequence pattern]
; (or (add-event-from-idle? event history pattern-sequence pattern)
; (and (event-run? event history pattern-sequence pattern)
; (empty? @history))))
;
(defn fsm-trigger? [event]
(= :re-frame.router/fsm-trigger (:op-type event)))
;
;(defn redispatched-event? [event history pattern-sequence pattern]
; (and (fsm-trigger? event)
; (= (:operation event)
; [:running :add-event])))
;
;(defn router-scheduled? [event history pattern-sequence pattern]
; (and (fsm-trigger? event)
; (= (:operation event)
; [:running :finish-run])
; (= :running (get-in event [:tags :current-state]))
; (= :scheduled (get-in event [:tags :new-state]))))
;
;(defn router-finished? [event history pattern-sequence pattern]
; (and (fsm-trigger? event)
; (= (:operation event)
; [:running :finish-run])
; (= :running (get-in event [:tags :current-state]))
; (= :idle (get-in event [:tags :new-state]))))
;
;(defn quiescent? [event _ _ _]
; (= :reagent/quiescent (:op-type event)))
;
;(defn epoch-ended? [event history pattern-sequence pattern]
; (or (quiescent? event history pattern-sequence pattern)
; (epoch-started? event history pattern-sequence pattern)))
;
(defn elapsed-time [ev1 ev2]
(let [start-of-epoch (:start ev1)
end-of-epoch (:end ev2)]
(when (and (some? start-of-epoch) (some? end-of-epoch))
#?(:cljs (js/Math.round (- end-of-epoch start-of-epoch))
:clj (Math/round ^double (- end-of-epoch start-of-epoch))))))
(defn run-queue? [event]
(and (fsm-trigger? event)
(= (:operation event)
[:scheduled :run-queue])))
;
(defn request-animation-frame? [event]
(= :raf (:op-type event)))
;
;(defn request-animation-frame-end? [event history pattern-sequence pattern]
; (= :raf-end (:op-type event)))
;
(defn summarise-event [ev]
(-> ev
(dissoc :start :duration :end :child-of)
(utils/dissoc-in [:tags :app-db-before])
(utils/dissoc-in [:tags :app-db-after])))
(defn summarise-match [match]
(map summarise-event match))
;
(defn beginning-id [match]
(:id (first match)))
(defn ending-id [match]
(:id (last match)))
;
;(defn parse-traces-metam
; "Returns a metamorphic runtime"
; [traces]
; (let [runtime (-> (m/new-pattern-sequence "simple traces")
; (m/begin "new-epoch-started" epoch-started?)
; #_(m/followed-by "run-queue" run-queue? {:optional? true})
; ;(m/followed-by "event-run" event-run?)
; #_(m/followed-by "router-finished" router-finished?)
; ;(m/followed-by "raf" request-animation-frame?)
; ;(m/followed-by "raf-end" request-animation-frame-end?)
; (m/followed-by "epoch-ended" epoch-ended?)
; (rt/initialize-runtime))
; rt (reduce rt/evaluate-event runtime traces)]
; #_(println "Count"
; (count (:matches rt))
; (map count (:matches rt)))
; #_(map summarise-match (:matches rt))
; rt))
;;;;;;
;; TODO: this needs to be included too as a starting point.
(defn add-event-from-idle? [event]
(and (= :re-frame.router/fsm-trigger (:op-type event))
(= (:operation event)
[:idle :add-event])))
(defn subscription? [trace]
(and (= "sub" (namespace (:op-type trace)))
(not (get-in trace [:tags :cached?]))))
(defn subscription-created? [trace]
(and (= :sub/create (:op-type trace))
(not (get-in trace [:tags :cached?]))))
(defn subscription-re-run? [trace]
(= :sub/run (:op-type trace)))
(defn subscription-destroyed? [trace]
(= :sub/dispose (:op-type trace)))
(defn subscription-not-run? [trace]
false)
(defn unchanged-l2-subscription? [sub]
;; TODO: check if value changed
(and
(= :re-run (:type sub))
(= 2 (:layer sub))
;; Show any subs that ran multiple times
(nil? (:run-times sub))))
(defn finish-run? [event]
(and (fsm-trigger? event)
(= (:operation event)
[:running :finish-run])))
(defn event-run? [event]
(= :event (:op-type event)))
(defn start-of-epoch?
"Detects the start of a re-frame epoch
Normally an epoch would always start with the queue being run, but with a dispatch-sync, the event is run directly."
[event]
(or (run-queue? event)
(event-run? event)))
(defn start-of-epoch-and-prev-end?
"Detects that a new epoch has started and that the previous one ended on the previous event.
If multiple events are dispatched while processing the first event, each one is considered its
own epoch."
[event state]
(or (run-queue? event)
;; An event ran, and the previous event was not
;; a run-queue.
(and (event-run? event)
(not (run-queue? (:previous-event state))))))
(defn quiescent? [event]
(= :reagent/quiescent (:op-type event)))
(defn parse-traces [traces]
(let [partitions (reduce
(fn [state event]
(let [current-match (:current-match state)
previous-event (:previous-event state)
no-match? (nil? current-match)]
(-> (cond
;; No current match yet, check if this is the start of an epoch
no-match?
(if (start-of-epoch? event)
(assoc state :current-match [event])
state)
;; We are in an epoch match, and reagent has gone to a quiescent state
(quiescent? event)
(-> state
(update :partitions conj (conj current-match event))
(assoc :current-match nil))
;; We are in an epoch match, and we have started a new epoch
;; The previously seen event was the last event of the old epoch,
;; and we need to start a new one from this event.
(start-of-epoch-and-prev-end? event state)
(-> state
(update :partitions conj (conj current-match previous-event))
(assoc :current-match [event]))
(event-run? event)
(update state :current-match conj event)
:else
state
;; Add a timeout/warning if a match goes on for more than a second?
)
(assoc :previous-event event))))
{:current-match nil
:previous-event nil
:partitions []}
traces)
matches (:partitions partitions)]
{:matches matches}))
(defn matched-event [match]
(->> match
(filter event-run?)
(first)))

View File

@ -5,5 +5,5 @@
;; Use this namespace with the :preloads compiler option to perform the necessary setup for enabling tracing:
;; {:compiler {:preloads [day8.re-frame.trace.preload] ...}}
(trace/init-db!)
(trace/init-tracing!)
(defonce _ (trace/init-tracing!))
(trace/inject-devtools!)

View File

@ -5,9 +5,9 @@
[garden.color :as color]
[garden.selectors :as s]
[day8.re-frame.trace.common-styles :as common]
[day8.re-frame.trace.utils.re-com :as rc]))
[day8.re-frame.trace.utils.re-com :as rc]
[day8.re-frame.trace.view.app-db :as app-db]))
(def background-blue common/background-blue)
(def background-gray common/background-gray)
(def background-gray-hint common/background-gray-hint)
(def dark-green common/dark-green)
@ -42,9 +42,9 @@
:font-size (em 1)}]
;; Text-level semantics
[(s/a) (s/a s/visited) {:color text-color
:border-bottom [[(px 1) "#333" "dotted"]]}]
[(s/a s/hover) (s/a s/focus) {:border-bottom [[(px 1) "#666666" "solid"]]}]
[(s/a) (s/a s/visited) {:color text-color
:cursor "pointer"
:text-decoration "underline"}]
[:code {:font-family "monospace"
:font-size (em 1)}]
@ -58,17 +58,20 @@
[:img {:border-style "none"}]
[:option {:display "block"}]
[:button :input :optgroup :select :textarea
{:font-family ["\"courier new\"" "monospace"]
{:font-family common/font-stack
:font-size (percent 100)
:padding [[(px 3) (px 3) (px 1) (px 3)]]
:border [[(px 1) "solid" medium-gray]]}]
[:button :input {:overflow "visible"}]
[:button :select [(s/& s/focus) {:outline [[medium-gray "dotted" (px 1)]]}]]
#_[:button :select [(s/& s/focus) {:outline [[medium-gray "dotted" (px 1)]]}]]
[:button
(s/html (s/attr= "type" "button"))
(s/attr= "type" "reset")
(s/attr= "type" "submit")
{:-webkit-appearance "button"}]
[(s/input (s/attr= "type" "checkbox"))
{:-webkit-appearance "checkbox"
:box-sizing "border-box"}]
[:button:-moz-focusring
(s/attr= "type" "button")
@ -88,7 +91,7 @@
:-webkit-font-smoothing "inherit"
:letter-spacing "inherit"
:background "none"
#_ #_ :cursor "pointer"}]
#_#_:cursor "pointer"}]
[:img {:max-width (percent 100)
:height "auto"
:border "0"}]
@ -115,7 +118,28 @@
[:thead {:display "table-header-group"}]
[:tbody {:display "table-row-group"}]
[:th :td {:display "table-cell"}]
[:tr {:display "table-row"}]])
[:tr {:display "table-row"}]
;; SVG Reset
;; From https://chromium.googlesource.com/chromium/blink/+/master/Source/core/css/svg.css
["svg:not(:root), symbol, image, marker, pattern, foreignObject"
{:overflow "hidden"}]
["svg:root"
{:width "100%"
:height "100%"}]
["text, foreignObject"
{:display "block"}]
["text"
{:white-space "nowrap"}]
["tspan, textPath"
{:white-space "inherit"}]
;; No :focus rule
["*"
{:transform-origin "0px 0px 0px"}]
["html|* > svg"
{:transform-origin "50% 50%"}]
])
(def label-mixin {:color text-color
:background background-gray-hint
@ -134,9 +158,9 @@
(def re-frame-trace-styles
[:#--re-frame-trace--
{:background "white"
:font-family ["'courier new'" "monospace"]
:color text-color}
{:background-color common/background-gray
:font-family common/font-stack
:color text-color}
[:.label label-mixin]
@ -156,7 +180,7 @@
[(s/& ".trace--sub-run")
[".trace--op" {:color dark-purple}]]
[(s/& ".trace--event")
{:border-top [["1px" light-gray "solid"]]}
{:border-top [["2px" common/border-line-color "solid"]]}
[".trace--op" {:color common/event-color}]]
[(s/& ".trace--render")
[".trace--op" {:color dark-skyblue}]]
@ -219,16 +243,15 @@
[:.button {:padding "5px 5px 3px"
:margin "5px"
:border-radius "2px"
#_ #_ :cursor "pointer"}]
#_#_:cursor "pointer"}]
[:.text-button {:border-bottom "1px dotted #888"
:font-weight "normal"}
[(s/& s/focus) {:outline [[medium-gray "dotted" (px 1)]]}]]
:font-weight "normal"}]
[:.icon-button {:font-size "10px"}]
[:button.tab {}]
[:button.tab {:font-weight 300}]
[:.nav-icon
{:width "15px"
:height "15px"
{:width "30px"
:height "30px"
:cursor "pointer"
:padding "0 5px"
:margin "0 5px"}
@ -237,16 +260,16 @@
[:.tab
{:background "transparent"
:border-radius 0
:text-transform "uppercase"
:font-family "monospace"
:letter-spacing "2px"
:margin-bottom 0
:margin "10px 0 0 0"
:font-family common/font-stack
:padding-bottom "4px"
:vertical-align "bottom"}]
:vertical-align "bottom"
:cursor "pointer"}]
[:.tab.active
{:background "transparent"
:border-bottom [[(px 3) "solid" dark-gray]]
:color common/blue-modern-color
:border-bottom [[(px 3) "solid" common/blue-modern-color]]
:border-radius 0
:padding-bottom (px 1)}]
@ -278,7 +301,7 @@
:border-bottom [[(px 1) "solid" text-color-muted]]
:background "white"
:display "inline-block"
:font-family "'courier new', monospace"
:font-family common/font-stack
:font-size (em 1)
:padding "2px 0 0 0"
:-moz-appearance "menulist"
@ -296,12 +319,37 @@
[:.filter-control-input
{:display "flex"
:flex "0 0 auto"}]
[:.nav {:background light-gray
:color text-color}]
[:.nav {:background common/sidebar-background-color
:height (px 50)
:color "white"}
[:span.arrow {:color common/blue-modern-color ;; Should this be a button instead of a span?
:background-color common/standard-background-color
:padding (px 5)
:cursor "pointer"
:user-select "none"}]
[:span.arrow__disabled {:color common/disabled-background-color
:cursor "auto"}]
[:span.event-header {:color common/text-color
:background-color common/standard-background-color
:padding (px 5)
:font-weight "600"
;; TODO: figure out how to hide long events
:text-overflow "ellipsis"}]
]
[(s/& :.external-window) {:display "flex"
:height (percent 100)
:flex "1 1 auto"}]
[:.panel-content-top {}]
[:.panel-content-top {}
[:.bm-title-text {:color common/navbar-text-color}]
[:button {:width "81px"
:height "31px"
:font-weight 700
:font-size "14px"
:cursor "pointer"
:text-align "center"
:padding "0 5px"
:margin "0 5px"}]]
[:.panel-content-tabs {:background-color common/white-background-color :padding-left common/gs-19}]
[:.panel-content-scrollable panel-mixin]
[:.epoch-panel panel-mixin]
[:.tab-contents {:display "flex"
@ -319,6 +367,7 @@
:margin "5px"
:opacity "0.3"}]
[:.active {:opacity 1}]
[:.re-frame-trace--object
[:.toggle {:color text-color-muted
:cursor "pointer"
@ -330,10 +379,19 @@
:width (px 16)
:padding "0 2px"
:vertical-align "middle"}]
[:.bm-muted-button {:font-size "14px"
:height "23px"
:padding "0px 7px"}]
[:.noselect {:-webkit-touch-callout "none"
:-webkit-user-select "none"
:-khtml-user-select "none"
:-moz-user-select "none"
:-ms-user-select "none"
:user-select "none"}]
])
(def panel-styles (apply garden/css [css-reset (into [:#--re-frame-trace--] rc/re-com-css) re-frame-trace-styles]))
(def panel-styles (apply garden/css [css-reset [:#--re-frame-trace-- rc/re-com-css] common/blue-modern re-frame-trace-styles app-db/app-db-styles]))
;(def panel-styles (macros/slurp-macro "day8/re_frame/trace/main.css"))

View File

@ -1,5 +1,7 @@
(ns day8.re-frame.trace.subs
(:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]))
(:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[day8.re-frame.trace.metamorphic :as metam]
[day8.re-frame.trace.utils.utils :as utils]))
(rf/reg-sub
:settings/root
@ -22,7 +24,15 @@
:settings/selected-tab
:<- [:settings/root]
(fn [settings _]
(get settings :selected-tab)))
(if (:showing-settings? settings)
:settings
(get settings :selected-tab))))
(rf/reg-sub
:settings/paused?
:<- [:settings/root]
(fn [settings _]
(:paused? settings)))
;; App DB
@ -31,11 +41,24 @@
(fn [db _]
(get db :app-db)))
(rf/reg-sub
:app-db/current-epoch-app-db-after
:<- [:epochs/current-event-trace]
(fn [trace _]
(get-in trace [:tags :app-db-after])))
(rf/reg-sub
:app-db/current-epoch-app-db-before
:<- [:epochs/current-event-trace]
(fn [trace _]
(get-in trace [:tags :app-db-before])))
(rf/reg-sub
:app-db/paths
:<- [:app-db/root]
(fn [app-db-settings _]
(get app-db-settings :paths)))
(map #(assoc (val %) :id (key %))
(get app-db-settings :paths))))
(rf/reg-sub
:app-db/search-string
@ -55,8 +78,19 @@
(fn [expansions [_ path]]
(contains? expansions path)))
(rf/reg-sub
:app-db/reagent-id
:<- [:app-db/root]
(fn [root _]
(:reagent-id root)))
;;
(rf/reg-sub
:traces/trace-root
(fn [db _]
(:traces db)))
(rf/reg-sub
:traces/filter-items
(fn [db _]
@ -72,6 +106,34 @@
(fn [db _]
(get-in db [:traces :categories])))
(rf/reg-sub
:traces/all-traces
:<- [:traces/trace-root]
(fn [traces _]
(:all-traces traces)))
(rf/reg-sub
:traces/number-of-traces
:<- [:traces/trace-root]
(fn [traces _]
(count traces)))
(rf/reg-sub
:traces/current-event-traces
:<- [:traces/all-traces]
:<- [:epochs/beginning-trace-id]
:<- [:epochs/ending-trace-id]
(fn [[traces beginning ending] _]
(into [] (filter #(<= beginning (:id %) ending)) traces)))
(rf/reg-sub
:traces/show-epoch-traces?
:<- [:traces/trace-root]
(fn [trace-root]
(:show-epoch-traces? trace-root)))
;;
(rf/reg-sub
:global/unloading?
(fn [db _]
@ -89,3 +151,261 @@
:<- [:snapshot/snapshot-root]
(fn [snapshot _]
(contains? snapshot :current-snapshot)))
;;
(rf/reg-sub
:epochs/epoch-root
(fn [db _]
(:epochs db)))
(rf/reg-sub
:epochs/current-match
:<- [:epochs/epoch-root]
(fn [epochs _]
(let [matches (:matches epochs)
current-index (:current-epoch-index epochs)
match (nth matches (+ (count matches) (or current-index 0)) (last matches))]
match)))
(rf/reg-sub
:epochs/current-event-trace
:<- [:epochs/current-match]
(fn [match _]
(metam/matched-event match)))
(rf/reg-sub
:epochs/current-event
:<- [:epochs/current-event-trace]
(fn [trace _]
(get-in trace [:tags :event])))
(rf/reg-sub
:epochs/number-of-matches
:<- [:epochs/epoch-root]
(fn [epochs _]
(count (get epochs :matches))))
(rf/reg-sub
:epochs/current-event-index
:<- [:epochs/epoch-root]
(fn [epochs _]
(:current-epoch-index epochs)))
(rf/reg-sub
:epochs/event-position
:<- [:epochs/current-event-index]
:<- [:epochs/number-of-matches]
(fn [[current total]]
(str current " of " total)))
(rf/reg-sub
:epochs/beginning-trace-id
:<- [:epochs/current-match]
(fn [match]
(:id (first match))))
(rf/reg-sub
:epochs/ending-trace-id
:<- [:epochs/current-match]
(fn [match]
(:id (last match))))
(rf/reg-sub
:epochs/older-epochs-available?
:<- [:epochs/current-event-index]
:<- [:epochs/number-of-matches]
(fn [[current total]]
(pos? (+ current total -1))))
(rf/reg-sub
:epochs/newer-epochs-available?
:<- [:epochs/current-event-index]
:<- [:epochs/number-of-matches]
(fn [[current total]]
(and (not (zero? current))
(some? current))))
;;
(rf/reg-sub
:timing/total-epoch-time
:<- [:traces/current-event-traces]
(fn [traces]
(let [start-of-epoch (nth traces 0)
end-of-epoch (utils/last-in-vec traces)]
(metam/elapsed-time start-of-epoch end-of-epoch))))
(rf/reg-sub
:timing/animation-frame-count
:<- [:traces/current-event-traces]
(fn [traces]
(count (filter metam/request-animation-frame? traces))))
(rf/reg-sub
:timing/event-processing-time
:<- [:traces/current-event-traces]
(fn [traces]
(let [start-of-epoch (nth traces 0)
finish-run (first (filter metam/finish-run? traces))]
(metam/elapsed-time start-of-epoch finish-run))))
(rf/reg-sub
:timing/render-time
:<- [:traces/current-event-traces]
(fn [traces]
(let [start-of-render (first (filter metam/request-animation-frame? traces))
end-of-epoch (utils/last-in-vec traces)]
(metam/elapsed-time start-of-render end-of-epoch))))
(rf/reg-sub
:timing/data-available?
:<- [:traces/current-event-traces]
(fn [traces]
(not (empty? traces))))
;;
(rf/reg-sub
:subs/root
(fn [db _]
(:subs db)))
(rf/reg-sub
:subs/all-sub-traces
:<- [:traces/current-event-traces]
(fn [traces]
(filter metam/subscription? traces)))
(defn sub-sort-val
[sub]
(case (:type sub)
:created 1
:re-run 2
:destroyed 3
:not-run 4))
(def subscription-comparator
(fn [x y]
(compare (sub-sort-val x) (sub-sort-val y))))
(defn sub-op-type->type [t]
(case (:op-type t)
:sub/create :created
:sub/run :re-run
:sub/dispose :destroyed
:not-run))
(rf/reg-sub
:subs/all-subs
:<- [:subs/all-sub-traces]
:<- [:app-db/reagent-id]
(fn [[traces app-db-id]]
(let [raw (map (fn [trace] (let [pod-type (sub-op-type->type trace)
path-data (get-in trace [:tags :query-v])
;; TODO: detect layer 2/3 for sub/create and sub/destroy
;; This information needs to be accumulated.
layer (if (some #(= app-db-id %) (get-in trace [:tags :input-signals]))
2
3)]
{:id (str pod-type (get-in trace [:tags :reaction]))
:type pod-type
:layer layer
:path-data path-data
:path (pr-str path-data)
:value (get-in trace [:tags :value])
;; TODO: Get not run subscriptions
}))
traces)
re-run (->> raw
(filter #(= :re-run (:type %)))
(map (juxt :path-data identity))
(into {}))
created (->> raw
(filter #(= :created (:type %)))
(map (juxt :path-data identity))
(into {}))
raw (keep (fn [sub]
(case (:type sub)
:created (if-some [re-run-sub (get re-run (:path-data sub))]
(assoc sub :value (:value re-run-sub))
sub)
:re-run (when-not (contains? created (:path-data sub))
sub)
sub))
raw)
;; Filter out run if it was created
;; Group together run time
run-multiple? (into {}
(filter (fn [[k v]] (< 1 v)))
(frequencies (map :id raw)))
output (map (fn [sub] (assoc sub :run-times (get run-multiple? (:id sub)))) raw)]
(js/console.log "Output" output)
(js/console.log "Traces" traces)
(js/console.log "rerun" re-run)
(sort-by identity subscription-comparator output))))
(rf/reg-sub
:subs/visible-subs
:<- [:subs/all-subs]
:<- [:subs/ignore-unchanged-subs?]
(fn [[all-subs ignore-unchanged-l2?]]
(if ignore-unchanged-l2?
(remove metam/unchanged-l2-subscription? all-subs)
all-subs)))
(rf/reg-sub
:subs/sub-counts
:<- [:subs/visible-subs]
(fn [subs _]
(->> subs
(map :type)
(frequencies))))
(rf/reg-sub
:subs/created-count
:<- [:subs/sub-counts]
(fn [counts]
(get counts :created 0)))
(rf/reg-sub
:subs/re-run-count
:<- [:subs/sub-counts]
(fn [counts]
(get counts :re-run 0)))
(rf/reg-sub
:subs/destroyed-count
:<- [:subs/sub-counts]
(fn [counts]
(get counts :destroyed 0)))
(rf/reg-sub
:subs/not-run-count
:<- [:subs/sub-counts]
(fn [counts]
(get counts :not-run 0)))
(rf/reg-sub
:subs/unchanged-l2-subs-count
:<- [:subs/all-subs]
(fn [subs]
(count (filter metam/unchanged-l2-subscription? subs))))
(rf/reg-sub
:subs/ignore-unchanged-subs?
:<- [:subs/root]
(fn [subs _]
(:ignore-unchanged-subs? subs true)))
(rf/reg-sub
:subs/sub-expansions
:<- [:subs/root]
(fn [subs _]
(:expansions subs)))

View File

@ -1,14 +1,17 @@
(ns day8.re-frame.trace.utils.localstorage
(:require [goog.storage.Storage :as Storage]
[goog.storage.mechanism.HTML5LocalStorage :as html5localstore]
[cljs.reader :as reader])
[cljs.reader :as reader]
[clojure.string :as str])
(:refer-clojure :exclude [get]))
(def storage (goog.storage.Storage. (goog.storage.mechanism.HTML5LocalStorage.)))
(def safe-prefix "day8.re-frame.trace.")
(defn- safe-key [key]
"Adds a unique prefix to local storage keys to ensure they don't collide with the host application"
(str "day8.re-frame.trace." key))
(str safe-prefix key))
(defn get
"Gets a re-frame-trace value from local storage."
@ -24,3 +27,10 @@
"Saves a re-frame-trace value to local storage."
[key value]
(.set storage (safe-key key) (pr-str value)))
(defn delete-all-keys!
"Deletes all re-frame-trace config keys"
[]
(doseq [k (js/Object.keys js/localStorage)]
(when (str/starts-with? k safe-prefix)
(.remove storage k))))

View File

@ -203,6 +203,78 @@
attr)]
children)))
(defn scroll-style
"Determines the value for the 'overflow' attribute.
The scroll parameter is a keyword.
Because we're translating scroll into overflow, the keyword doesn't appear to match the attribute value"
[attribute scroll]
{attribute (case scroll
:auto "auto"
:off "hidden"
:on "scroll"
:spill "visible")})
(defn- box-base
"This should generally NOT be used as it is the basis for the box, scroller and border components"
[& {:keys [size scroll h-scroll v-scroll width height min-width min-height max-width max-height justify align align-self
margin padding border l-border r-border t-border b-border radius bk-color child class-name class style attr]}]
(let [s (merge
(flex-flow-style "inherit")
(flex-child-style size)
(when scroll (scroll-style :overflow scroll))
(when h-scroll (scroll-style :overflow-x h-scroll))
(when v-scroll (scroll-style :overflow-y v-scroll))
(when width {:width width})
(when height {:height height})
(when min-width {:min-width min-width})
(when min-height {:min-height min-height})
(when max-width {:max-width max-width})
(when max-height {:max-height max-height})
(when justify (justify-style justify))
(when align (align-style :align-items align))
(when align-self (align-style :align-self align-self))
(when margin {:margin margin}) ;; margin and padding: "all" OR "top&bottom right&left" OR "top right bottom left"
(when padding {:padding padding})
(when border {:border border})
(when l-border {:border-left l-border})
(when r-border {:border-right r-border})
(when t-border {:border-top t-border})
(when b-border {:border-bottom b-border})
(when radius {:border-radius radius})
(when bk-color
{:background-color bk-color})
style)]
[:div
(merge
{:class (str class-name "display-flex " class) :style s}
attr)
child]))
(defn box
"Returns hiccup which produces a box, which is generally used as a child of a v-box or an h-box.
By default, it also acts as a container for further child compenents, or another h-box or v-box"
[& {:keys [size width height min-width min-height max-width max-height justify align align-self margin padding child class style attr]
:or {size "none"}
:as args}]
(box-base :size size
:width width
:height height
:min-width min-width
:min-height min-height
:max-width max-width
:max-height max-height
:justify justify
:align align
:align-self align-self
:margin margin
:padding padding
:child child
:class-name "rc-box "
:class class
:style style
:attr attr))
(defn line
"Returns a component which produces a line between children in a v-box/h-box along the main axis.
Specify size in pixels and a stancard CSS color. Defaults to a 1px lightgray line"
@ -297,6 +369,150 @@
[& args]
(apply input-text-base :input-type :input args))
(defn label
"Returns markup for a basic label"
[& {:keys [label on-click width class style attr]
:as args}]
[box
:class "rc-label-wrapper display-inline-flex"
:width width
:align :start
:child [:span
(merge
{:class (str "rc-label " class)
:style (merge (flex-child-style "none")
style)}
(when on-click
{:on-click (handler-fn (on-click))})
attr)
label]])
(defn button
"Returns the markup for a basic button"
[]
(let [showing? (reagent/atom false)]
(fn
[& {:keys [label on-click disabled? class style attr]
:or {class "btn-default"}
:as args}]
(let [disabled? (deref-or-value disabled?)
the-button [:button
(merge
{:class (str "rc-button btn noselect " class)
:style (merge
(flex-child-style "none")
style)
:disabled disabled?
:on-click (handler-fn
(when (and on-click (not disabled?))
(on-click event)))}
attr)
label]]
(when disabled?
(reset! showing? false))
[box ;; Wrapper box is unnecessary but keeps the same structure as the re-com button
:class "rc-button-wrapper display-inline-flex"
:align :start
:child the-button]))))
(defn hyperlink
"Renders an underlined text hyperlink component.
This is very similar to the button component above but styled to looks like a hyperlink.
Useful for providing button functionality for less important functions, e.g. Cancel"
[]
(let [showing? (reagent/atom false)]
(fn
[& {:keys [label on-click disabled? class style attr] :as args}]
(let [label (deref-or-value label)
disabled? (deref-or-value disabled?)
the-button [box
:align :start
:child [:a
(merge
{:class (str "rc-hyperlink noselect " class)
:style (merge
(flex-child-style "none")
{:cursor (if disabled? "not-allowed" "pointer")
:color (when disabled? "grey")}
style)
:on-click (handler-fn
(when (and on-click (not disabled?))
(on-click event)))}
attr)
label]]]
[box
:class "rc-hyperlink-wrapper display-inline-flex"
:align :start
:child the-button]))))
(defn hyperlink-href
"Renders an underlined text hyperlink component.
This is very similar to the button component above but styled to looks like a hyperlink.
Useful for providing button functionality for less important functions, e.g. Cancel"
[]
(let [showing? (reagent/atom false)]
(fn
[& {:keys [label href target tooltip tooltip-position class style attr] :as args}]
(when-not tooltip (reset! showing? false)) ;; To prevent tooltip from still showing after button drag/drop
(let [label (deref-or-value label)
href (deref-or-value href)
target (deref-or-value target)
the-button [:a
(merge {:class (str "rc-hyperlink-href noselect " class)
:style (merge (flex-child-style "none")
style)
:href href
:target target}
(when tooltip
{:on-mouse-over (handler-fn (reset! showing? true))
:on-mouse-out (handler-fn (reset! showing? false))})
attr)
label]]
[box
:class "rc-hyperlink-href-wrapper display-inline-flex"
:align :start
:child the-button]))))
(defn checkbox
"I return the markup for a checkbox, with an optional RHS label"
[& {:keys [model on-change label disabled? label-class label-style class style attr]
:as args}]
(let [cursor "default"
model (deref-or-value model)
disabled? (deref-or-value disabled?)
callback-fn #(when (and on-change (not disabled?))
(on-change (not model)))] ;; call on-change with either true or false
[h-box
:class "rc-checkbox-wrapper noselect"
:align :start
:children [[:input
(merge
{:class (str "rc-checkbox " class)
:type "checkbox"
:style (merge (flex-child-style "none")
{:cursor cursor}
style)
:disabled disabled?
:checked (boolean model)
:on-change (handler-fn (callback-fn))}
attr)]
(when label
[:span
{:class label-class
:style (merge (flex-child-style "none")
{:padding-left "8px"
:cursor cursor}
label-style)
:on-click (handler-fn (callback-fn))}
label])]]))
(defn css-join [& args]
"Creates a single string from all passed args, separated by spaces (all args are coerced to strings)
Very simple, but handy
e.g. {:padding (css-join common/gs-12s (px 25))}"
(clojure.string/join " " args))
(def re-com-css
[[:.display-flex {:display "flex"}]
[:.display-inline-flex {:display "flex"}]])

View File

@ -1,2 +1,16 @@
(ns day8.re-frame.trace.utils.utils)
(defn last-in-vec
"Get the last element in the vector"
[v]
(nth v (dec (count v))))
(defn find-all-indexes-in-vec
"Gets the index of all items in vec that match the predicate"
[pred v]
(keep-indexed #(when (pred %2) %1) v))
(defn find-index-in-vec
"Gets the index of the first item in vec that matches the predicate"
[pred v]
(first (find-all-indexes-in-vec pred v)))

View File

@ -1,25 +1,314 @@
(ns day8.re-frame.trace.view.app-db
(:require [reagent.core :as r]
[clojure.string :as str]
[devtools.prefs]
(:require [devtools.prefs]
[devtools.formatters.core]
[day8.re-frame.trace.view.components :as components]
[day8.re-frame.trace.utils.re-com :as re-com]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[day8.re-frame.trace.utils.re-com :as rc])
[mranderson047.reagent.v0v6v0.reagent.core :as r]
[day8.re-frame.trace.utils.re-com :as rc :refer [css-join]]
[day8.re-frame.trace.common-styles :as common]
[clojure.data])
(:require-macros [day8.re-frame.trace.utils.macros :as macros]))
(def delete (macros/slurp-macro "day8/re_frame/trace/images/delete.svg"))
(def reload (macros/slurp-macro "day8/re_frame/trace/images/reload.svg"))
(def reload-disabled (macros/slurp-macro "day8/re_frame/trace/images/reload-disabled.svg"))
(def snapshot (macros/slurp-macro "day8/re_frame/trace/images/snapshot.svg"))
(def snapshot-ready (macros/slurp-macro "day8/re_frame/trace/images/snapshot-ready.svg"))
(def round-arrow (macros/slurp-macro "day8/re_frame/trace/images/round-arrow.svg"))
(def arrow-right (macros/slurp-macro "day8/re_frame/trace/images/arrow-right.svg"))
(def copy (macros/slurp-macro "day8/re_frame/trace/images/copy.svg"))
(def trash (macros/slurp-macro "day8/re_frame/trace/images/trash.svg"))
(defn render-state [data]
(let [subtree-input (r/atom "")
subtree-paths (rf/subscribe [:app-db/paths])
search-string (rf/subscribe [:app-db/search-string])
input-error (r/atom false)]
(def cljs-dev-tools-background "#e8ffe8")
(def pod-gap common/gs-19s)
(def pad-padding common/gs-7s)
(def border-radius "3px")
(def app-db-styles
[:#--re-frame-trace--
[:.app-db-path
{:background-color common/white-background-color
:border-bottom-left-radius border-radius
:border-bottom-right-radius border-radius}]
[:.app-db-path--header
{:background-color "#797B7B" ; Name this navbar tint-lighter
:color "white"
:height common/gs-31
:border-top-left-radius border-radius
:border-top-right-radius border-radius}]
[:.app-db-path--header__closed
{:border-bottom-left-radius border-radius
:border-bottom-right-radius border-radius}]
[:.app-db-path--button
{:width "25px"
:height "25px"
:padding "0px"
:border-radius border-radius
:cursor "pointer"}]
[:.app-db-path--label
{:color "#2D9CDB"
;:font-variant "small-caps"
;:text-transform "lowercase"
:text-decoration "underline"
:font-size "11px"
:margin-bottom "2px"
;:height common/gs-19
}]
[:.app-db-path--path-header
{:background-color common/white-background-color
:color "#48494A"
:margin "3px"}]
[:.app-db-path--path-text__empty
{:font-style "italic"}]
[:.app-db-path--link
{:margin (css-join "0px" pad-padding)
:height common/gs-19s}]
[:.app-db-panel-button
{:width "129px"
:padding "0px"}]
[:.data-viewer
{:background-color cljs-dev-tools-background
:padding common/gs-7s
:margin (css-join "0px" pad-padding)
:min-width "100px"
}]
])
;; TODO: START ========== LOCAL DATA - REPLACE WITH SUBS AND EVENTS
(def *pods (r/atom [{:id (gensym) :path "[\"x\" \"y\"]" :open? true :diff? true}
{:id (gensym) :path "[:abc 123]" :open? true :diff? false}
{:id (gensym) :path "[:a :b :c]" :open? false :diff? true}
{:id (gensym) :path nil :open? false :diff? false}
{:id (gensym) :path [:boot-state] :open? true :diff? true}]))
(defn add-pod []
(let [id (gensym)]
;(println "Added pod" id)
(swap! *pods concat [{:id id :path "" :open? true :diff? false}])))
(defn delete-pod [id]
;(println "Deleted pod" id)
(reset! *pods (filterv #(not= id (:id %)) @*pods)))
(defn update-pod-field
[id field new-val]
(let [f (fn [pod]
(if (= id (:id pod))
(do
;(println "Updated" field "in" (:id pod) "from" (get pod field) "to" new-val)
(assoc pod field new-val))
pod))]
(reset! *pods (mapv f @*pods))))
;; TODO: END ========== LOCAL DATA - REPLACE WITH SUBS AND EVENTS
(defn panel-header []
(let [app-db-after (rf/subscribe [:app-db/current-epoch-app-db-after])
app-db-before (rf/subscribe [:app-db/current-epoch-app-db-before])]
[rc/h-box
:justify :between
:align :center
:margin (css-join common/gs-19s "0px")
:children [[rc/button
:class "app-db-panel-button bm-muted-button"
:label [rc/v-box
:align :center
:children ["+ path inspector"]]
:on-click #(rf/dispatch [:app-db/create-path])]
[rc/h-box
:align :center
:gap common/gs-7s
:height "48px"
:padding (css-join "0px" common/gs-12s)
:style {:background-color "#fafbfc"
:border "1px solid #e3e9ed"
:border-radius border-radius}
:children [[rc/label :label "reset app-db to:"]
[rc/button
:class "app-db-panel-button bm-muted-button"
:label [rc/v-box
:align :center
:children ["initial epoch state"]]
:on-click #(rf/dispatch [:snapshot/load-snapshot @app-db-before])]
[rc/v-box
:width common/gs-81s
:align :center
:children [[rc/label
:style {:font-size "9px"}
:label "EVENT"]
[:img {:src (str "data:image/svg+xml;utf8," arrow-right)}]
[rc/label
:style {:font-size "9px"
:margin-top "-1px"}
:label "PROCESSING"]]]
[rc/button
:class "app-db-panel-button bm-muted-button"
:label [rc/v-box
:align :center
:children ["end epoch state"]]
:on-click #(rf/dispatch [:snapshot/load-snapshot @app-db-after])]]]]]))
(defn pod-header [{:keys [id path path-str open? diff?]}]
[rc/h-box
:class (str "app-db-path--header " (when-not open? "app-db-path--header__closed"))
:align :center
:height common/gs-31s
:children [[rc/box
:width "36px"
:height common/gs-31s
:class "noselect"
:style {:cursor "pointer"}
:attr {:title (str (if open? "Close" "Open") " the pod bay doors, HAL")
:on-click #(rf/dispatch [:app-db/set-path-visibility id (not open?)])}
:child [rc/box
:margin "auto"
:child [:span.arrow (if open? "▼" "▶")]]]
[rc/h-box
:class "app-db-path--path-header"
:size "auto"
:children [[rc/input-text
:attr {:on-blur (fn [e] (rf/dispatch [:app-db/update-path-blur id]))}
:style {:height "25px"
:padding (css-join "0px" common/gs-7s)
:width "-webkit-fill-available"} ;; This took a bit of finding!
:width "100%"
:model path-str
:on-change #(rf/dispatch [:app-db/update-path id %]) ;;(fn [input-string] (rf/dispatch [:app-db/search-string input-string]))
:on-submit #() ;; #(rf/dispatch [:app-db/add-path %])
:change-on-blur? false
:placeholder "Showing all of app-db. Try entering a path like [:todos 1]"]]]
[rc/gap-f :size common/gs-12s]
[rc/box
:class "app-db-path--button bm-muted-button noselect"
:attr {:title "Show diff"
:on-click #(rf/dispatch [:app-db/set-diff-visibility id (not diff?)])}
:child [:img
{:src (str "data:image/svg+xml;utf8," copy)
:style {:width "19px"
:margin "0px 3px"}}]]
[rc/gap-f :size common/gs-12s]
[rc/box
:class "app-db-path--button bm-muted-button noselect"
:attr {:title "Remove this pod"
:on-click #(rf/dispatch [:app-db/remove-path id])}
:child [:img
{:src (str "data:image/svg+xml;utf8," trash)
:style {:width "13px"
:margin "0px 6px"}}]]
[rc/gap-f :size common/gs-12s]]])
(defn pod [{:keys [id path open? diff?] :as pod-info}]
(let [render-diff? (and open? diff?)
app-db-after (rf/subscribe [:app-db/current-epoch-app-db-after])
app-db-before (rf/subscribe [:app-db/current-epoch-app-db-before])
[diff-before diff-after _] (when render-diff?
(clojure.data/diff (get-in @app-db-before path)
(get-in @app-db-after path)))]
[rc/v-box
:class "app-db-path"
:children [[pod-header pod-info]
(when open?
[rc/v-box
:class "data-viewer"
:style {:margin (css-join pad-padding pad-padding "0px" pad-padding)}
:children [[components/simple-render
(get-in @app-db-after path)
#_{:todos [1 2 3]}
#_(get-in @app-db path)
#_[rc/h-box
:align :center
:children [[:button.subtree-button
[:span.subtree-button-string
(str path)]]
[:img
{:src (str "data:image/svg+xml;utf8," delete)
:style {:cursor "pointer"
:height "10px"}
:on-click #(rf/dispatch [:app-db/remove-path path])}]]]
#_[path]]
#_"---main-section---"]])
(when render-diff?
(list
^{:key "only-before"}
[rc/v-box
:class "app-db-path--link"
:justify :end
:children [[rc/hyperlink-href
;:class "app-db-path--label"
:label "ONLY BEFORE"
:href "https://github.com/Day8/re-frame-trace/wiki/app-db#diff"]]]
^{:key "only-before-diff"}
[rc/v-box
:class "data-viewer"
:children [[components/simple-render
diff-before]]]
^{:key "only-after"}
[rc/v-box
:class "app-db-path--link"
:justify :end
:children [[rc/hyperlink-href
;:class "app-db-path--label"
:label "ONLY AFTER"
:href "https://github.com/Day8/re-frame-trace/wiki/app-db#diff"]]]
^{:key "only-after-diff"}
[rc/v-box
:class "data-viewer"
:children [[components/simple-render
diff-after]]]))
(when open?
[rc/gap-f :size pad-padding])]]))
(defn no-pods []
[rc/h-box
:margin (css-join "0px 0px 0px" common/gs-19s)
:gap common/gs-7s
:align :start
:align-self :start
:children [[:img {:src (str "data:image/svg+xml;utf8," round-arrow)}]
[rc/label
:style {:width "150px"
:margin-top "22px"}
:label "add inspectors to show what happened to app-db"]]])
(defn pod-section []
(let [pods @(rf/subscribe [:app-db/paths])]
[rc/v-box
:gap pod-gap
:children (if (empty? pods)
[[no-pods]]
(doall (for [p pods]
^{:key (:id pods)}
[pod p])))]))
;; TODO: OLD UI - REMOVE
(defn original-render [app-db]
(let [subtree-input (r/atom "")
subtree-paths (rf/subscribe [:app-db/paths])
search-string (rf/subscribe [:app-db/search-string])
input-error (r/atom false)
snapshot-ready? (rf/subscribe [:snapshot/snapshot-ready?])]
(fn []
[:div {:style {:flex "1 1 auto" :display "flex" :flex-direction "column"}}
[:div
{:style {:flex "1 1 auto"
:display "flex"
:flex-direction "column"
:border "1px solid lightgrey"}}
[:div.panel-content-scrollable
[re-com/input-text
[rc/input-text
:model search-string
:on-change (fn [input-string] (rf/dispatch [:app-db/search-string input-string]))
:on-submit #(rf/dispatch [:app-db/add-path %])
@ -30,6 +319,8 @@
; [:div.input-error {:style {:color "red" :margin-top 5}}
; "Please enter a valid path."])]]
[:div.subtrees {:style {:margin "20px 0"}}
(doall
(map (fn [path]
@ -37,19 +328,26 @@
[:div.subtree-wrapper {:style {:margin "10px 0"}}
[:div.subtree
[components/subtree
(get-in @data path)
(get-in @app-db path)
[rc/h-box
:align :center
:children
[[:button.subtree-button
[:span.subtree-button-string
(str path)]]
[:img
{:src (str "data:image/svg+xml;utf8," delete)
:style {:cursor "pointer"
:height "10px"}
:on-click #(rf/dispatch [:app-db/remove-path path])}]]]
:children [[:button.subtree-button
[:span.subtree-button-string
(str path)]]
[:img
{:src (str "data:image/svg+xml;utf8," delete)
:style {:cursor "pointer"
:height "10px"}
:on-click #(rf/dispatch [:app-db/remove-path path])}]]]
[path]]]])
@subtree-paths))]
[:div {:style {:margin-bottom "20px"}}
[components/subtree @data [:span.label "app-db"] [:app-db]]]]])))
[components/subtree @app-db [:span.label "app-db"] [:app-db]]]]])))
(defn render [app-db]
[rc/v-box
:style {:margin-right common/gs-19s
:overflow "hidden"}
:children [[panel-header]
[pod-section]
[rc/gap-f :size pod-gap]]])

View File

@ -1,11 +1,11 @@
(ns day8.re-frame.trace.view.components
(:require [reagent.core :as r]
[clojure.string :as str]
(:require [clojure.string :as str]
[goog.fx.dom :as fx]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[day8.re-frame.trace.utils.localstorage :as localstorage]
[clojure.string :as str]
[day8.re-frame.trace.utils.re-com :as rc])
[day8.re-frame.trace.utils.re-com :as rc]
[mranderson047.reagent.v0v6v0.reagent.core :as r])
(:require-macros [day8.re-frame.trace.utils.macros :refer [with-cljs-devtools-prefs]]))
(defn search-input [{:keys [title placeholder on-save on-change on-stop]}]

View File

@ -2,83 +2,159 @@
(:require-macros [day8.re-frame.trace.utils.macros :as macros])
(:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[re-frame.db :as db]
[day8.re-frame.trace.view.event :as event]
[day8.re-frame.trace.view.app-db :as app-db]
[day8.re-frame.trace.view.traces :as traces]
[day8.re-frame.trace.view.subs :as subs]
[day8.re-frame.trace.view.views :as views]
[day8.re-frame.trace.view.traces :as traces]
[day8.re-frame.trace.view.timing :as timing]
[day8.re-frame.trace.view.debug :as debug]
[day8.re-frame.trace.view.settings :as settings]
[garden.core :refer [css style]]
[garden.units :refer [px]]
[re-frame.trace]
[reagent.core :as r]
[day8.re-frame.trace.utils.re-com :as rc]))
[day8.re-frame.trace.utils.re-com :as rc]
[day8.re-frame.trace.common-styles :as common]))
(def triangle-down (macros/slurp-macro "day8/re_frame/trace/images/triangle-down.svg"))
(defn tab-button [panel-id title]
(let [selected-tab @(rf/subscribe [:settings/selected-tab])]
[:button {:class (str "tab button " (when (= selected-tab panel-id) "active"))
:on-click #(rf/dispatch [:settings/selected-tab panel-id])} title]))
[rc/v-box
:style {:margin-bottom "-8px"
:z-index 1}
:children [[:button {:class (str "tab button bm-heading-text " (when (= selected-tab panel-id) "active"))
:on-click #(rf/dispatch [:settings/selected-tab panel-id])} title]
[:img {:src (str "data:image/svg+xml;utf8," triangle-down)
:style {:opacity (if (= selected-tab panel-id) "1" "0")}}]]]))
(def reload (macros/slurp-macro "day8/re_frame/trace/images/reload.svg"))
(def reload-disabled (macros/slurp-macro "day8/re_frame/trace/images/reload-disabled.svg"))
(def open-external (macros/slurp-macro "day8/re_frame/trace/images/open-external.svg"))
(def snapshot (macros/slurp-macro "day8/re_frame/trace/images/snapshot.svg"))
(def snapshot-ready (macros/slurp-macro "day8/re_frame/trace/images/snapshot-ready.svg"))
(def open-external (macros/slurp-macro "day8/re_frame/trace/images/logout.svg"))
(def settings-svg (macros/slurp-macro "day8/re_frame/trace/images/wrench.svg"))
(def orange-settings-svg (macros/slurp-macro "day8/re_frame/trace/images/orange-wrench.svg"))
(def pause-svg (macros/slurp-macro "day8/re_frame/trace/images/pause.svg"))
(def play-svg (macros/slurp-macro "day8/re_frame/trace/images/play.svg"))
(def settings-svg (macros/slurp-macro "day8/re_frame/trace/images/settings.svg"))
(def outer-margins {:margin (str "0px " common/gs-19s)})
(defn right-hand-buttons [external-window?]
(let [selected-tab (rf/subscribe [:settings/selected-tab])
paused? (rf/subscribe [:settings/paused?])
showing-settings? (= @selected-tab :settings)]
[rc/h-box
:align :center
:children [(when showing-settings?
[:button {:class "bm-active-button"
:on-click #(rf/dispatch [:settings/toggle-settings])} "Done"])
(if @paused?
[:img.nav-icon.noselect
{:title "Play"
:src (str "data:image/svg+xml;utf8,"
play-svg)
:on-click #(rf/dispatch [:settings/play])}]
[:img.nav-icon.noselect
{:title "Pause"
:src (str "data:image/svg+xml;utf8,"
pause-svg)
:on-click #(rf/dispatch [:settings/pause])}])
[:img.nav-icon.noselect
{:title "Settings"
:src (str "data:image/svg+xml;utf8,"
(if showing-settings? orange-settings-svg settings-svg))
:on-click #(rf/dispatch [:settings/toggle-settings])}]
(when-not external-window?
[:img.nav-icon.active.noselect
{:title "Pop out"
:src (str "data:image/svg+xml;utf8,"
open-external)
:on-click #(rf/dispatch-sync [:global/launch-external])}])]])
)
(defn settings-header [external-window?]
[[rc/h-box
:align :center
:size "auto"
:gap common/gs-12s
:children [[rc/label :class "bm-title-text" :label "Settings"]]]
;; TODO: this line needs to be between Done and other buttons
[rc/gap-f :size common/gs-12s]
[rc/line :size "2px" :color common/sidebar-heading-divider-color]
[rc/gap-f :size common/gs-12s]
[right-hand-buttons external-window?]])
(defn standard-header [external-window?]
(let [current-event @(rf/subscribe [:epochs/current-event])
older-epochs-available? @(rf/subscribe [:epochs/older-epochs-available?])
newer-epochs-available? @(rf/subscribe [:epochs/newer-epochs-available?])]
[[rc/h-box
:align :center
:size "auto"
:gap common/gs-12s
:children [[:span.arrow (if older-epochs-available?
{:on-click #(rf/dispatch [:epochs/previous-epoch])}
{:class "arrow__disabled"}) "◀"]
[rc/v-box
:size "auto"
:children [[:span.event-header (prn-str current-event)]]]
[:span.arrow (if newer-epochs-available?
{:on-click #(rf/dispatch [:epochs/next-epoch])}
{:class "arrow__disabled"})
"▶"]]]
[rc/gap-f :size common/gs-12s]
[rc/line :size "2px" :color common/sidebar-heading-divider-color]
[right-hand-buttons external-window?]])
)
(defn devtools-inner [traces opts]
(let [selected-tab (rf/subscribe [:settings/selected-tab])
panel-type (:panel-type opts)
external-window? (= panel-type :popup)
unloading? (rf/subscribe [:global/unloading?])
snapshot-ready? (rf/subscribe [:snapshot/snapshot-ready?])]
(let [selected-tab (rf/subscribe [:settings/selected-tab])
panel-type (:panel-type opts)
external-window? (= panel-type :popup)
unloading? (rf/subscribe [:global/unloading?])
showing-settings? (= @selected-tab :settings)]
[:div.panel-content
{:style {:width "100%" :display "flex" :flex-direction "column"}}
[rc/h-box
:class "panel-content-top nav"
:justify :between
:children
[[rc/h-box
:align :center
:children
[(tab-button :traces "Traces")
(tab-button :app-db "App DB")
(tab-button :subs "Subs")
#_[:img.nav-icon
{:title "Settings"
:src (str "data:image/svg+xml;utf8,"
settings-svg)
:on-click #(rf/dispatch [:settings/selected-tab :settings])}]]]
{:style {:width "100%" :display "flex" :flex-direction "column" :background-color common/standard-background-color}}
(if showing-settings?
[rc/h-box
:align :center
:children
[[:img.nav-icon
{:title "Load app-db snapshot"
:class (when-not @snapshot-ready? "inactive")
:src (str "data:image/svg+xml;utf8,"
(if @snapshot-ready?
reload
reload-disabled))
:on-click #(when @snapshot-ready? (rf/dispatch-sync [:snapshot/load-snapshot]))}]
[:img.nav-icon
{:title "Snapshot app-db"
:class (when @snapshot-ready? "active")
:src (str "data:image/svg+xml;utf8,"
(if @snapshot-ready?
snapshot-ready
snapshot))
:on-click #(rf/dispatch-sync [:snapshot/save-snapshot])}]
(when-not external-window?
[:img.nav-icon.active
{:src (str "data:image/svg+xml;utf8,"
open-external)
:on-click #(rf/dispatch-sync [:global/launch-external])}])]]]]
:class "panel-content-top nav"
:style {:padding "0px 19px"}
:children (settings-header external-window?)]
[rc/h-box
:class "panel-content-top nav"
:style {:padding "0px 19px"}
:children (standard-header external-window?)])
(when-not showing-settings?
[rc/h-box
:class "panel-content-tabs"
:justify :between
:children [[rc/h-box
:gap "7px"
:align :end
:height "50px"
:children [(tab-button :event "Event")
(tab-button :app-db "app-db")
(tab-button :subs "Subs")
;(tab-button :views "Views")
(tab-button :traces "Trace")
(tab-button :timing "Timing")
(when (:debug? opts)
(tab-button :debug "Debug"))]]]])
[rc/line :color "#EEEEEE"]
(when (and external-window? @unloading?)
[:h1.host-closed "Host window has closed. Reopen external window to continue tracing."])
(when-not (re-frame.trace/is-trace-enabled?)
[:h1.host-closed {:style {:word-wrap "break-word"}} "Tracing is not enabled. Please set " [:pre "{\"re_frame.trace.trace_enabled_QMARK_\" true}"] " in " [:pre ":closure-defines"]])
(case @selected-tab
:traces [traces/render-trace-panel traces]
:app-db [app-db/render-state db/app-db]
:subs [subs/subs-panel]
:settings [settings/render]
[app-db/render-state db/app-db])]))
[rc/v-box
:size "auto"
:style {:margin-left common/gs-19s
:overflow "auto"}
:children [(case @selected-tab
:event [event/render traces]
:app-db [app-db/render db/app-db]
:subs [subs/render]
:views [views/render]
:traces [traces/render traces]
:timing [timing/render]
:debug [debug/render]
:settings [settings/render]
[app-db/render db/app-db])]]]))

View File

@ -0,0 +1,23 @@
(ns day8.re-frame.trace.view.debug
(:require [day8.re-frame.trace.utils.re-com :as rc]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[day8.re-frame.trace.metamorphic :as metam]))
(defn render []
[rc/v-box
:gap "5px"
:children
[
[rc/label :label (str "Number of epochs " (prn-str @(rf/subscribe [:epochs/number-of-matches])))]
[rc/label :label (str "Beginning trace " (prn-str @(rf/subscribe [:epochs/beginning-trace-id])))]
[rc/label :label (str "Ending " (prn-str @(rf/subscribe [:epochs/ending-trace-id])))]
[rc/label :label "Epochs"]
(for [match (:matches @(rf/subscribe [:epochs/epoch-root]))]
^{:key (:id (first match))}
[rc/v-box
:style {:border "1px solid black"}
:children (doall (map (fn [event] [rc/label :label (prn-str event)]) (metam/summarise-match match)))
])
]]
)

View File

@ -0,0 +1,19 @@
(ns day8.re-frame.trace.view.event
(:require [day8.re-frame.trace.utils.re-com :as rc]
[day8.re-frame.trace.metamorphic :as metam]))
(defn render [traces]
[rc/v-box
:padding "12px 0px"
:children [[rc/label :label "Event"]
[rc/label :label "Dispatch Point"]
[rc/label :label "Coeffects"]
[rc/label :label "Effects"]
[rc/label :label "Interceptors"]
[rc/h-box
:children [[:p "Subs Run"] [:p "Created"] [:p "Destroyed"]]]
[:p "Views Rendered"]
[rc/h-box
:children [[:p "Timing"] [:p "Animation Frames"]]]
]])

View File

@ -1,6 +1,63 @@
(ns day8.re-frame.trace.view.settings)
(ns day8.re-frame.trace.view.settings
(:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[day8.re-frame.trace.utils.re-com :as rc]
[day8.re-frame.trace.common-styles :as common]))
(defn explanation-text [children]
[rc/v-box
:width "150px"
:gap common/gs-19s
:children children])
(defn settings-box
"settings and explanation are both children of re-com boxes"
[settings explanation]
[rc/h-box
:justify :between
:children [[rc/v-box
:children settings]
[explanation-text explanation]]])
(defn render []
[:h1 "Settings"]
[rc/v-box
:style {:padding-top common/gs-31s}
:gap common/gs-19s
:children
[(let [num-epochs @(rf/subscribe [:epochs/number-of-matches])
num-traces @(rf/subscribe [:traces/number-of-traces])]
[settings-box
[[rc/label :label "Retain last 10 epochs"]
[:button "Clear All Epochs"]]
[[:p num-epochs " epochs currently retained, involving " num-traces " traces."]]])
)
[rc/line]
[settings-box
[[rc/label :label "Ignore epochs for:"]
[:button "+ event-id"]]
[[:p "All trace associated with these events will be ignored."]
[:p "Useful if you want to ignore a periodic background polling event."]]]
[rc/line]
[settings-box
[[rc/label :label "Filter out trace for views in "]
[:button "+ namespace"]]
[[:p "Sometimes you want to focus on just your own views, and the trace associated with library views is just noise."]
[:p "Nominate one or more namespaces"]]]
[rc/line]
[settings-box
[[rc/label :label "Remove low level trace"]
[rc/checkbox :model false :on-change #(rf/dispatch [:settings/low-level-trace :reagent %]) :label "reagent internals"]
[rc/checkbox :model false :on-change #(rf/dispatch [:settings/low-level-trace :re-frame %]) :label "re-frame internals"]]
[[:p "Most of the time, low level trace is noisy and you want it filtered out."]]]
[rc/line]
[settings-box
[[:button "Factory Reset"]]
[[:p "Reset all settings (will refresh browser)."]]]
]])

View File

@ -1,9 +1,10 @@
(ns day8.re-frame.trace.view.subs
(:require [re-frame.subs :as subs]
[day8.re-frame.trace.utils.re-com :as rc]
;[cljs.spec.alpha :as s]
[day8.re-frame.trace.view.components :as components]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]))
(:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[mranderson047.reagent.v0v6v0.reagent.core :as r]
[day8.re-frame.trace.utils.re-com :as rc :refer [css-join]]
[day8.re-frame.trace.common-styles :as common]
[day8.re-frame.trace.view.components :as components])
(:require-macros [day8.re-frame.trace.utils.macros :as macros]))
;(s/def ::query-v any?)
;(s/def ::dyn-v any?)
@ -12,29 +13,270 @@
;(s/def ::query-cache (s/map-of ::query-cache-params ::deref))
;(assert (s/valid? ::query-cache (rc/deref-or-value-peek subs/query->reaction)))
(def copy (macros/slurp-macro "day8/re_frame/trace/images/copy.svg"))
(def cljs-dev-tools-background "#e8ffe8")
(def pod-gap common/gs-19s)
(def pad-padding common/gs-7s)
;; TODO: START ========== LOCAL DATA - REPLACE WITH SUBS AND EVENTS
(defn subs-panel []
(def *pods (r/atom [{:id (gensym) :type :destroyed :layer "3" :path "[:todo/blah]" :open? true :diff? false}
{:id (gensym) :type :created :layer "3" :path "[:todo/completed]" :open? true :diff? true}
{:id (gensym) :type :re-run :layer "3" :path "[:todo/completed]" :open? true :diff? false}
{:id (gensym) :type :re-run :layer "2" :path "[:todo/blah]" :open? true :diff? false}
{:id (gensym) :type :not-run :layer "3" :path "[:todo/blah]" :open? true :diff? false}]))
(defn update-pod-field
[id field new-val]
(let [f (fn [pod]
(if (= id (:id pod))
(do
;(println "Updated" field "in" (:id pod) "from" (get pod field) "to" new-val)
(assoc pod field new-val))
pod))]
(reset! *pods (mapv f @*pods))))
;; TODO: END ========== LOCAL DATA - REPLACE WITH SUBS AND EVENTS
(defn tag-color [type]
(let [types {:created "#9b51e0"
:destroyed "#f2994a"
:re-run "#219653"
:not-run "#bdbdbd"}]
(get types type "black")))
(def tag-types {:created {:long "CREATED" :short "CREATED"}
:destroyed {:long "DESTROYED" :short "DESTROY"}
:re-run {:long "RE-RUN" :short "RE-RUN"}
:not-run {:long "NOT-RUN" :short "NOT-RUN"}})
(defn long-tag-desc [type]
(get-in tag-types [type :long] "???"))
(defn short-tag-desc [type]
(get-in tag-types [type :short] "???"))
(defn tag [type label]
[rc/box
:class "noselect"
:style {:color "white"
:background-color (tag-color type)
:width "48px" ;common/gs-50s
:height "17px" ;common/gs-19s
:font-size "10px"
:font-weight "bold"
:border "1px solid #bdbdbd"
:border-radius "3px"}
:child [:span {:style {:margin "auto"}} label]])
(defn title-tag [type title label]
[rc/v-box
:class "noselect"
:align :center
:gap "2px"
:children [[:span {:style {:font-size "9px"}} title]
[tag type label]]])
(defn panel-header []
(let [created-count (rf/subscribe [:subs/created-count])
re-run-count (rf/subscribe [:subs/re-run-count])
destroyed-count (rf/subscribe [:subs/destroyed-count])
not-run-count (rf/subscribe [:subs/not-run-count])
ignore-unchanged? (rf/subscribe [:subs/ignore-unchanged-subs?])
ignore-unchanged-l2-count (rf/subscribe [:subs/unchanged-l2-subs-count])]
[rc/h-box
:justify :between
:align :center
:margin (css-join common/gs-19s "0px")
:children [[rc/h-box
:align :center
:gap common/gs-19s
:height "48px"
:padding (css-join "0px" common/gs-19s)
:style {:background-color "#fafbfc"
:border "1px solid #e3e9ed"
:border-radius "3px"}
:children [[:span {:style {:color "#828282"
:font-size "18px"
:font-weight "lighter"}}
"Summary:"]
[title-tag :created (long-tag-desc :created) @created-count]
[title-tag :re-run (long-tag-desc :re-run) @re-run-count]
[title-tag :destroyed (long-tag-desc :destroyed) @destroyed-count]
[title-tag :not-run (long-tag-desc :not-run) @not-run-count]]]
[rc/h-box
:align :center
:gap common/gs-19s
:height "48px"
:padding (css-join "0px" common/gs-19s)
:style {:background-color "#fafbfc"
:border "1px solid #e3e9ed"
:border-radius "3px"}
:children [[rc/checkbox
:model ignore-unchanged?
:label [:span "Ignore " [:b {:style {:font-weight "700"}} @ignore-unchanged-l2-count] " unchanged" [:br] "layer 2 subs"]
:style {:margin-top "6px"}
:on-change #(rf/dispatch [:subs/ignore-unchanged-subs? %])]]]]]))
(defn pod-header [{:keys [id type layer path open? diff? run-times]}]
[rc/h-box
:class "app-db-path--header"
:style (merge {:border-top-left-radius "3px"
:border-top-right-radius "3px"}
(when-not open?
{:border-bottom-left-radius "3px"
:border-bottom-right-radius "3px"}))
:align :center
:height common/gs-31s
:children [[rc/box
:width "36px"
:height common/gs-31s
:class "noselect"
:style {:cursor "pointer"}
:attr {:title (str (if open? "Close" "Open") " the pod bay doors, HAL")
:on-click #(rf/dispatch [:subs/open-pod? id (not open?)])}
:child [rc/box
:margin "auto"
:child [:span.arrow (if open? "▼" "▶")]]]
[rc/box
:width "64px" ;; (100-36)px from box above
:child [tag type (short-tag-desc type)]]
(when run-times
[:span "Warning: run " run-times " times"])
[rc/h-box
:size "auto"
:class "app-db-path--path-header"
:children [[rc/input-text
:style {:height "25px"
:padding (css-join "0px" common/gs-7s)
:width "-webkit-fill-available"} ;; This took a bit of finding!
:width "100%"
:model path
:disabled? true
:on-change #(update-pod-field id :path %) ;;(fn [input-string] (rf/dispatch [:app-db/search-string input-string]))
:on-submit #() ;; #(rf/dispatch [:app-db/add-path %])
:change-on-blur? false
:placeholder "Showing all of app-db. Try entering a path like [:todos 1]"]]]
[rc/gap-f :size common/gs-12s]
[rc/label :label (str "Layer " layer)]
[rc/gap-f :size common/gs-12s]
[rc/box
:class "bm-muted-button noselect"
:style {:width "25px"
:height "25px"
:padding "0px"
:border-radius "3px"
:cursor "pointer"}
:attr {:title "Show diff"
:on-click #(rf/dispatch [:subs/diff-pod? id (not diff?)])}
:child [:img
{:src (str "data:image/svg+xml;utf8," copy)
:style {:width "19px"
:margin "0px 3px"}}]]
[rc/gap-f :size common/gs-12s]]])
(defn pod [{:keys [id type layer path open? diff?] :as pod-info}]
[rc/v-box
:class "app-db-path"
:style {:border-bottom-left-radius "3px"
:border-bottom-right-radius "3px"}
:children [[pod-header pod-info]
(when open?
[rc/v-box
:min-width "100px"
:style {:background-color cljs-dev-tools-background
:padding common/gs-7s
:margin (css-join pad-padding pad-padding "0px" pad-padding)}
:children [[components/simple-render
(:value pod-info)]]])
(when (and open? diff?)
[rc/v-box
:height common/gs-19s
:justify :end
:style {:margin (css-join "0px" pad-padding)}
:children [[rc/hyperlink
;:class "app-db-path--label"
:label "ONLY BEFORE"
:on-click #(println "Clicked [ONLY BEFORE]")]]])
(when (and open? diff?)
[rc/v-box
:height "60px"
:min-width "100px"
:style {:background-color cljs-dev-tools-background
:padding common/gs-7s
:margin (css-join "0px" pad-padding)}
:children ["---before-diff---"]])
(when (and open? diff?)
[rc/v-box
:height common/gs-19s
:justify :end
:style {:margin (css-join "0px" pad-padding)}
:children [[rc/hyperlink
;:class "app-db-path--label"
:label "ONLY AFTER"
:on-click #(println "Clicked [ONLY AFTER]")]]])
(when (and open? diff?)
[rc/v-box
:height "60px"
:min-width "100px"
:style {:background-color cljs-dev-tools-background
:padding common/gs-7s
:margin (css-join "0px" pad-padding)}
:children ["---after-diff---"]])
(when open?
[rc/gap-f :size pad-padding])]])
(defn no-pods []
[rc/h-box
:margin (css-join "0px 0px 0px" common/gs-19s)
:gap common/gs-7s
:align :start
:align-self :start
:children [[rc/label :label "There are no subscriptions to show"]]])
(defn pod-section []
(let [all-subs @(rf/subscribe [:subs/visible-subs])
sub-expansions @(rf/subscribe [:subs/sub-expansions])]
(js/console.log sub-expansions)
[rc/v-box
:gap pod-gap
:children (if (empty? all-subs)
[[no-pods]]
(doall (for [p all-subs]
^{:key (:id p)}
[pod (merge p (get sub-expansions (:id p)))])))]))
(defn render []
[]
[:div {:style {:flex "1 1 auto" :display "flex" :flex-direction "column"}}
[:div.panel-content-scrollable
[:div.subtrees {:style {:margin "20px 0"}}
(doall
(->> @subs/query->reaction
(sort-by (fn [me] (ffirst (key me))))
(map (fn [me]
(let [[query-v dyn-v :as inputs] (key me)]
^{:key query-v}
[:div.subtree-wrapper {:style {:margin "10px 0"}}
[:div.subtree
[components/subscription-render
(rc/deref-or-value-peek (val me))
[:button.subtree-button {:on-click #(rf/dispatch [:app-db/remove-path (key me)])}
[:span.subtree-button-string
(prn-str (first (key me)))]]
(into [:subs] query-v)]]]))
)))
(do @re-frame.db/app-db
nil)]]])
[rc/v-box
:style {:margin-right common/gs-19s
:overflow "hidden"}
:children [[panel-header]
[pod-section]
[rc/gap-f :size pod-gap]
;; TODO: OLD UI - REMOVE
#_[:div.panel-content-scrollable
{:style {:border "1px solid lightgrey"
:margin "0px"}}
[:div.subtrees
{:style {:margin "20px 0"}}
(doall
(->> @subs/query->reaction
(sort-by (fn [me] (ffirst (key me))))
(map (fn [me]
(let [[query-v dyn-v :as inputs] (key me)]
^{:key query-v}
[:div.subtree-wrapper {:style {:margin "10px 0"}}
[:div.subtree
[components/subscription-render
(rc/deref-or-value-peek (val me))
[:button.subtree-button {:on-click #(rf/dispatch [:app-db/remove-path (key me)])}
[:span.subtree-button-string
(prn-str (first (key me)))]]
(into [:subs] query-v)]]]))
)))
(do @re-frame.db/app-db
nil)]]]])

View File

@ -0,0 +1,24 @@
(ns day8.re-frame.trace.view.timing
(:require [clojure.string :as str]
[devtools.prefs]
[devtools.formatters.core]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[day8.re-frame.trace.utils.re-com :as rc])
(:require-macros [day8.re-frame.trace.utils.macros :as macros]))
(defn render []
(let [timing-data-available? @(rf/subscribe [:timing/data-available?])]
(if timing-data-available?
[rc/v-box
:padding "12px 0px"
:children [[rc/label :label "Total Epoch Time"]
[rc/label :label (str @(rf/subscribe [:timing/total-epoch-time]) "ms")]
[rc/label :label "Animation Frames"]
[rc/label :label @(rf/subscribe [:timing/animation-frame-count])]
[rc/label :label "Event time"]
[rc/label :label (str @(rf/subscribe [:timing/event-processing-time]) "ms")]
[rc/label :label "Render/Subscription time"]
[rc/label :label (str @(rf/subscribe [:timing/render-time]) "ms")]]]
[rc/v-box
:padding "12px 0px"
:children [[:h1 "No timing data available currently."]]])))

View File

@ -3,11 +3,12 @@
[day8.re-frame.trace.utils.pretty-print-condensed :as pp]
[re-frame.trace :as trace]
[clojure.string :as str]
[reagent.core :as r]
[day8.re-frame.trace.utils.localstorage :as localstorage]
[cljs.pprint :as pprint]
[clojure.set :as set]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]))
[mranderson047.reagent.v0v6v0.reagent.core :as r]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[day8.re-frame.trace.utils.re-com :as rc]))
(defn query->fn [query]
(if (= :contains (:filter-type query))
@ -64,7 +65,8 @@
(str/join ", ")
(pp/truncate-string :middle 40)))]]]
[:td.trace--meta
(.toFixed duration 1) " ms"]]
id
#_ #_(.toFixed duration 1) " ms"]]
(when show-row?
[:tr.trace--details {:key (str id "-details")
:tab-index 0}
@ -80,22 +82,30 @@
[:td.trace--meta.trace--details-icon
{:on-click #(.log js/console tags)}]]))))))))
(defn render-trace-panel [traces]
(defn render [traces]
(let [filter-input (r/atom "")
filter-items (rf/subscribe [:traces/filter-items])
filter-type (r/atom :contains)
input-error (r/atom false)
categories (rf/subscribe [:traces/categories])
trace-detail-expansions (rf/subscribe [:traces/expansions])]
trace-detail-expansions (rf/subscribe [:traces/expansions])
beginning (rf/subscribe [:epochs/beginning-trace-id])
end (rf/subscribe [:epochs/ending-trace-id])
current-traces (rf/subscribe [:traces/current-event-traces])
show-epoch-traces? (rf/subscribe [:traces/show-epoch-traces?])]
(fn []
(let [toggle-category-fn #(rf/dispatch [:traces/toggle-categories %])
visible-traces (cond->> @traces
traces-to-filter (if @show-epoch-traces?
@current-traces
@traces)
visible-traces (cond->> traces-to-filter
;; Remove cached subscriptions. Could add this back in as a setting later
;; but it's pretty low signal/noise 99% of the time.
true (remove (fn [trace] (and (= :sub/create (:op-type trace))
(get-in trace [:tags :cached?]))))
(seq @categories) (filter (fn [trace] (when (contains? @categories (:op-type trace)) trace)))
(seq @filter-items) (filter (apply every-pred (map query->fn @filter-items))))
(seq @filter-items) (filter (apply every-pred (map query->fn @filter-items)))
true (sort-by :id))
save-query (fn [_]
(if (and (= @filter-type :slower-than)
(js/isNaN (js/parseFloat @filter-input)))
@ -103,6 +113,7 @@
(do
(reset! input-error false)
(add-filter filter-items @filter-input @filter-type))))]
[:div.tab-contents
[:div.filter
[:div.filter-control
@ -119,6 +130,10 @@
[:li.filter-category {:class (when (contains? @categories :re-frame.router/fsm-trigger) "active")
:on-click #(rf/dispatch [:traces/toggle-categories #{:re-frame.router/fsm-trigger :componentWillUnmount}])}
"internals"]]
[rc/checkbox
:model show-epoch-traces?
:on-change #(rf/dispatch [:traces/update-show-epoch-traces? %])
:label "Show only traces for this epoch?"]
[:div.filter-fields
[:select {:value @filter-type
:on-change #(reset! filter-type (keyword (.. % -target -value)))}
@ -154,10 +169,10 @@
:on-click #(rf/dispatch [:traces/reset-filter-items])}
(when (pos? (count @filter-items))
(str (count visible-traces) " of "))
(str (count @traces))]
(str (count @current-traces))]
" traces "
(when (pos? (count @traces))
[:span "(" [:button.text-button {:on-click #(do (trace/reset-tracing!) (reset! traces []))} "clear"] ")"])]
(when (pos? (count @current-traces))
[:span "(" [:button.text-button {:on-click #(do (trace/reset-tracing!) (reset! current-traces []))} "clear"] ")"])]
[:th {:style {:text-align "right"}} "meta"]]
[:tbody (render-traces visible-traces filter-items filter-input trace-detail-expansions)]]]]))))

View File

@ -0,0 +1,3 @@
(ns day8.re-frame.trace.view.views)
(defn render [])

View File

@ -48,7 +48,7 @@
(defn make-reaction
"On JVM Clojure, return a `deref`-able thing which invokes the given function
on every `deref`. That is, `make-reaction` here provides precisely none of the
benefits of `reagent.ratom/make-reaction` (which only invokes its function if
benefits of `mranderson047.reagent.v0v6v0.reagent.ratom/make-reaction` (which only invokes its function if
the reactions that the function derefs have changed value). But so long as `f`
only depends on other reactions (which also behave themselves), the only
difference is one of efficiency. That is, your tests should see no difference

View File

@ -1,13 +1,13 @@
(ns mranderson047.re-frame.v0v10v2.re-frame.interop
(:require [goog.async.nextTick]
[reagent.core]
[reagent.ratom]))
[mranderson047.reagent.v0v6v0.reagent.core]
[mranderson047.reagent.v0v6v0.reagent.ratom]))
(def next-tick goog.async.nextTick)
(def empty-queue #queue [])
(def after-render reagent.core/after-render)
(def after-render mranderson047.reagent.v0v6v0.reagent.core/after-render)
;; Make sure the Google Closure compiler sees this as a boolean constant,
;; otherwise Dead Code Elimination won't happen in `:advanced` builds.
@ -16,23 +16,23 @@
(def ^boolean debug-enabled? "@define {boolean}" ^boolean js/goog.DEBUG)
(defn ratom [x]
(reagent.core/atom x))
(mranderson047.reagent.v0v6v0.reagent.core/atom x))
(defn ratom? [x]
(satisfies? reagent.ratom/IReactiveAtom x))
(satisfies? mranderson047.reagent.v0v6v0.reagent.ratom/IReactiveAtom x))
(defn deref? [x]
(satisfies? IDeref x))
(defn make-reaction [f]
(reagent.ratom/make-reaction f))
(mranderson047.reagent.v0v6v0.reagent.ratom/make-reaction f))
(defn add-on-dispose! [a-ratom f]
(reagent.ratom/add-on-dispose! a-ratom f))
(mranderson047.reagent.v0v6v0.reagent.ratom/add-on-dispose! a-ratom f))
(defn dispose! [a-ratom]
(reagent.ratom/dispose! a-ratom))
(mranderson047.reagent.v0v6v0.reagent.ratom/dispose! a-ratom))
(defn set-timeout! [f ms]
(js/setTimeout f ms))
@ -46,11 +46,11 @@
"Produces an id for reactive Reagent values
e.g. reactions, ratoms, cursors."
[reactive-val]
(when (implements? reagent.ratom/IReactiveAtom reactive-val)
(when (implements? mranderson047.reagent.v0v6v0.reagent.ratom/IReactiveAtom reactive-val)
(str (condp instance? reactive-val
reagent.ratom/RAtom "ra"
reagent.ratom/RCursor "rc"
reagent.ratom/Reaction "rx"
reagent.ratom/Track "tr"
mranderson047.reagent.v0v6v0.reagent.ratom/RAtom "ra"
mranderson047.reagent.v0v6v0.reagent.ratom/RCursor "rc"
mranderson047.reagent.v0v6v0.reagent.ratom/Reaction "rx"
mranderson047.reagent.v0v6v0.reagent.ratom/Track "tr"
"other")
(hash reactive-val))))

View File

@ -0,0 +1,9 @@
(ns mranderson047.reagent.v0v6v0.reagent.core
(:require [mranderson047.reagent.v0v6v0.reagent.ratom :as ra]))
(defmacro with-let [bindings & body]
"Bind variables as with let, except that when used in a component
the bindings are only evaluated once. Also takes an optional finally
clause at the end, that is executed when the component is
destroyed."
`(ra/with-let ~bindings ~@body))

View File

@ -0,0 +1,359 @@
(ns mranderson047.reagent.v0v6v0.reagent.core
(:require-macros [mranderson047.reagent.v0v6v0.reagent.core])
(:refer-clojure :exclude [partial atom flush])
(:require [mranderson047.reagent.v0v6v0.reagent.impl.template :as tmpl]
[mranderson047.reagent.v0v6v0.reagent.impl.component :as comp]
[mranderson047.reagent.v0v6v0.reagent.impl.util :as util]
[mranderson047.reagent.v0v6v0.reagent.impl.batching :as batch]
[mranderson047.reagent.v0v6v0.reagent.ratom :as ratom]
[mranderson047.reagent.v0v6v0.reagent.debug :as deb :refer-macros [dbg prn]]
[mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]]
[mranderson047.reagent.v0v6v0.reagent.dom :as dom]
[mranderson047.reagent.v0v6v0.reagent.dom.server :as server]))
(def is-client util/is-client)
(def react util/react)
(defn create-element
"Create a native React element, by calling React.createElement directly.
That means the second argument must be a javascript object (or nil), and
that any Reagent hiccup forms must be processed with as-element. For example
like this:
(r/create-element \"div\" #js{:className \"foo\"}
\"Hi \" (r/as-element [:strong \"world!\"])
which is equivalent to
[:div.foo \"Hi\" [:strong \"world!\"]]"
([type]
(create-element type nil))
([type props]
(assert (not (map? props)))
($ react createElement type props))
([type props child]
(assert (not (map? props)))
($ react createElement type props child))
([type props child & children]
(assert (not (map? props)))
(apply ($ react :createElement) type props child children)))
(defn as-element
"Turns a vector of Hiccup syntax into a React element. Returns form
unchanged if it is not a vector."
[form]
(tmpl/as-element form))
(defn adapt-react-class
"Returns an adapter for a native React class, that may be used
just like a Reagent component function or class in Hiccup forms."
[c]
(assert c)
(tmpl/adapt-react-class c))
(defn reactify-component
"Returns an adapter for a Reagent component, that may be used from
React, for example in JSX. A single argument, props, is passed to
the component, converted to a map."
[c]
(assert c)
(comp/reactify-component c))
(defn render
"Render a Reagent component into the DOM. The first argument may be
either a vector (using Reagent's Hiccup syntax), or a React element.
The second argument should be a DOM node.
Optionally takes a callback that is called when the component is in place.
Returns the mounted component instance."
([comp container]
(dom/render comp container))
([comp container callback]
(dom/render comp container callback)))
(defn unmount-component-at-node
"Remove a component from the given DOM node."
[container]
(dom/unmount-component-at-node container))
(defn render-to-string
"Turns a component into an HTML string."
[component]
(server/render-to-string component))
;; For backward compatibility
(def as-component as-element)
(def render-component render)
(def render-component-to-string render-to-string)
(defn render-to-static-markup
"Turns a component into an HTML string, without data-react-id attributes, etc."
[component]
(server/render-to-static-markup component))
(defn ^:export force-update-all
"Force re-rendering of all mounted Reagent components. This is
probably only useful in a development environment, when you want to
update components in response to some dynamic changes to code.
Note that force-update-all may not update root components. This
happens if a component 'foo' is mounted with `(render [foo])` (since
functions are passed by value, and not by reference, in
ClojureScript). To get around this you'll have to introduce a layer
of indirection, for example by using `(render [#'foo])` instead."
[]
(ratom/flush!)
(dom/force-update-all)
(batch/flush-after-render))
(defn create-class
"Create a component, React style. Should be called with a map,
looking like this:
{:get-initial-state (fn [this])
:component-will-receive-props (fn [this new-argv])
:should-component-update (fn [this old-argv new-argv])
:component-will-mount (fn [this])
:component-did-mount (fn [this])
:component-will-update (fn [this new-argv])
:component-did-update (fn [this old-argv])
:component-will-unmount (fn [this])
:reagent-render (fn [args....])} ;; or :render (fn [this])
Everything is optional, except either :reagent-render or :render."
[spec]
(comp/create-class spec))
(defn current-component
"Returns the current React component (a.k.a this) in a component
function."
[]
comp/*current-component*)
(defn state-atom
"Returns an atom containing a components state."
[this]
(assert (comp/reagent-component? this))
(comp/state-atom this))
(defn state
"Returns the state of a component, as set with replace-state or set-state.
Equivalent to (deref (r/state-atom this))"
[this]
(assert (comp/reagent-component? this))
(deref (state-atom this)))
(defn replace-state
"Set state of a component.
Equivalent to (reset! (state-atom this) new-state)"
[this new-state]
(assert (comp/reagent-component? this))
(assert (or (nil? new-state) (map? new-state)))
(reset! (state-atom this) new-state))
(defn set-state
"Merge component state with new-state.
Equivalent to (swap! (state-atom this) merge new-state)"
[this new-state]
(assert (comp/reagent-component? this))
(assert (or (nil? new-state) (map? new-state)))
(swap! (state-atom this) merge new-state))
(defn force-update
"Force a component to re-render immediately.
If the second argument is true, child components will also be
re-rendered, even is their arguments have not changed."
([this]
(force-update this false))
([this deep]
(ratom/flush!)
(util/force-update this deep)
(batch/flush-after-render)))
(defn props
"Returns the props passed to a component."
[this]
(assert (comp/reagent-component? this))
(comp/get-props this))
(defn children
"Returns the children passed to a component."
[this]
(assert (comp/reagent-component? this))
(comp/get-children this))
(defn argv
"Returns the entire Hiccup form passed to the component."
[this]
(assert (comp/reagent-component? this))
(comp/get-argv this))
(defn dom-node
"Returns the root DOM node of a mounted component."
[this]
(dom/dom-node this))
(defn merge-props
"Utility function that merges two maps, handling :class and :style
specially, like React's transferPropsTo."
[defaults props]
(util/merge-props defaults props))
(defn flush
"Render dirty components immediately to the DOM.
Note that this may not work in event handlers, since React.js does
batching of updates there."
[]
(batch/flush))
;; Ratom
(defn atom
"Like clojure.core/atom, except that it keeps track of derefs.
Reagent components that derefs one of these are automatically
re-rendered."
([x] (ratom/atom x))
([x & rest] (apply ratom/atom x rest)))
(defn track
"Takes a function and optional arguments, and returns a derefable
containing the output of that function. If the function derefs
Reagent atoms (or track, etc), the value will be updated whenever
the atom changes.
In other words, @(track foo bar) will produce the same result
as (foo bar), but foo will only be called again when the atoms it
depends on changes, and will only trigger updates of components when
its result changes.
track is lazy, i.e the function is only evaluated on deref."
[f & args]
{:pre [(ifn? f)]}
(ratom/make-track f args))
(defn track!
"An eager version of track. The function passed is called
immediately, and continues to be called when needed, until stopped
with dispose!."
[f & args]
{:pre [(ifn? f)]}
(ratom/make-track! f args))
(defn dispose!
"Stop the result of track! from updating."
[x]
(ratom/dispose! x))
(defn wrap
"Provide a combination of value and callback, that looks like an atom.
The first argument can be any value, that will be returned when the
result is deref'ed.
The second argument should be a function, that is called with the
optional extra arguments provided to wrap, and the new value of the
resulting 'atom'.
Use for example like this:
(wrap (:foo @state)
swap! state assoc :foo)
Probably useful only for passing to child components."
[value reset-fn & args]
(assert (ifn? reset-fn))
(ratom/make-wrapper value reset-fn args))
;; RCursor
(defn cursor
"Provide a cursor into a Reagent atom.
Behaves like a Reagent atom but focuses updates and derefs to
the specified path within the wrapped Reagent atom. e.g.,
(let [c (cursor ra [:nested :content])]
... @c ;; equivalent to (get-in @ra [:nested :content])
... (reset! c 42) ;; equivalent to (swap! ra assoc-in [:nested :content] 42)
... (swap! c inc) ;; equivalence to (swap! ra update-in [:nested :content] inc)
)
The first parameter can also be a function, that should look
something like this:
(defn set-get
([k] (get-in @state k))
([k v] (swap! state assoc-in k v)))
The function will be called with one argument the path passed to
cursor when the cursor is deref'ed, and two arguments (path and
new value) when the cursor is modified.
Given that set-get function, (and that state is a Reagent atom, or
another cursor) these cursors are equivalent:
(cursor state [:foo]) and (cursor set-get [:foo]).
Note that a cursor is lazy: its value will not change until it is
used. This may be noticed with add-watch."
([src path]
(ratom/cursor src path)))
;; Utilities
(defn rswap!
"Swaps the value of a to be (apply f current-value-of-atom args).
rswap! works like swap!, except that recursive calls to rswap! on
the same atom are allowed and it always returns nil."
[a f & args]
{:pre [(satisfies? IAtom a)
(ifn? f)]}
(if a.rswapping
(-> (or a.rswapfs (set! a.rswapfs (array)))
(.push #(apply f % args)))
(do (set! a.rswapping true)
(try (swap! a (fn [state]
(loop [s (apply f state args)]
(if-some [sf (some-> a.rswapfs .shift)]
(recur (sf s))
s))))
(finally
(set! a.rswapping false)))))
nil)
(defn next-tick
"Run f using requestAnimationFrame or equivalent.
f will be called just before components are rendered."
[f]
(batch/do-before-flush f))
(defn after-render
"Run f using requestAnimationFrame or equivalent.
f will be called just after any queued renders in the next animation
frame (and even if no renders actually occur)."
[f]
(batch/do-after-render f))
(defn partial
"Works just like clojure.core/partial, except that it is an IFn, and
the result can be compared with ="
[f & args]
(util/partial-ifn. f args nil))
(defn component-path
;; Try to return the path of component c as a string.
;; Maybe useful for debugging and error reporting, but may break
;; with future versions of React (and return nil).
[c]
(comp/component-path c))

View File

@ -0,0 +1,73 @@
(ns mranderson047.reagent.v0v6v0.reagent.debug
(:refer-clojure :exclude [prn println time]))
(defmacro log
"Print with console.log, if it exists."
[& forms]
`(when mranderson047.reagent.v0v6v0.reagent.debug.has-console
(.log js/console ~@forms)))
(defmacro warn
"Print with console.warn."
[& forms]
(when *assert*
`(when mranderson047.reagent.v0v6v0.reagent.debug.has-console
(.warn (if mranderson047.reagent.v0v6v0.reagent.debug.tracking
mranderson047.reagent.v0v6v0.reagent.debug.track-console js/console)
(str "Warning: " ~@forms)))))
(defmacro warn-unless
[cond & forms]
(when *assert*
`(when (not ~cond)
(warn ~@forms))))
(defmacro error
"Print with console.error."
[& forms]
(when *assert*
`(when mranderson047.reagent.v0v6v0.reagent.debug.has-console
(.error (if mranderson047.reagent.v0v6v0.reagent.debug.tracking
mranderson047.reagent.v0v6v0.reagent.debug.track-console js/console)
(str ~@forms)))))
(defmacro println
"Print string with console.log"
[& forms]
`(log (str ~@forms)))
(defmacro prn
"Like standard prn, but prints using console.log (so that we get
nice clickable links to source in modern browsers)."
[& forms]
`(log (pr-str ~@forms)))
(defmacro dbg
"Useful debugging macro that prints the source and value of x,
as well as package name and line number. Returns x."
[x]
(let [ns (str cljs.analyzer/*cljs-ns*)]
`(let [x# ~x]
(println (str "dbg "
~ns ":"
~(:line (meta &form))
": "
~(pr-str x)
": "
(pr-str x#)))
x#)))
(defmacro dev?
"True if assertions are enabled."
[]
(if *assert* true false))
(defmacro time [& forms]
(let [ns (str cljs.analyzer/*cljs-ns*)
label (str ns ":" (:line (meta &form)))]
`(let [label# ~label
res# (do
(js/console.time label#)
~@forms)]
(js/console.timeEnd label#)
res#)))

View File

@ -0,0 +1,27 @@
(ns mranderson047.reagent.v0v6v0.reagent.debug
(:require-macros [mranderson047.reagent.v0v6v0.reagent.debug]))
(def ^:const has-console (exists? js/console))
(def ^boolean tracking false)
(defonce warnings (atom nil))
(defonce track-console
(let [o #js{}]
(set! (.-warn o)
(fn [& args]
(swap! warnings update-in [:warn] conj (apply str args))))
(set! (.-error o)
(fn [& args]
(swap! warnings update-in [:error] conj (apply str args))))
o))
(defn track-warnings [f]
(set! tracking true)
(reset! warnings nil)
(f)
(let [warns @warnings]
(reset! warnings nil)
(set! tracking false)
warns))

View File

@ -0,0 +1,78 @@
(ns mranderson047.reagent.v0v6v0.reagent.dom
(:require [cljsjs.react.dom]
[mranderson047.reagent.v0v6v0.reagent.impl.util :as util]
[mranderson047.reagent.v0v6v0.reagent.impl.template :as tmpl]
[mranderson047.reagent.v0v6v0.reagent.impl.batching :as batch]
[mranderson047.reagent.v0v6v0.reagent.ratom :as ratom]
[mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg]]
[mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]]))
(defonce ^:private imported nil)
(defn module []
(cond
(some? imported) imported
(exists? js/ReactDOM) (set! imported js/ReactDOM)
(exists? js/require) (or (set! imported (js/require "react-dom"))
(throw (js/Error. "require('react-dom') failed")))
:else
(throw (js/Error. "js/ReactDOM is missing"))))
(defonce ^:private roots (atom {}))
(defn- unmount-comp [container]
(swap! roots dissoc container)
($ (module) unmountComponentAtNode container))
(defn- render-comp [comp container callback]
(binding [util/*always-update* true]
(->> ($ (module) render (comp) container
(fn []
(binding [util/*always-update* false]
(swap! roots assoc container [comp container])
(batch/flush-after-render)
(if (some? callback)
(callback))))))))
(defn- re-render-component [comp container]
(render-comp comp container nil))
(defn render
"Render a Reagent component into the DOM. The first argument may be
either a vector (using Reagent's Hiccup syntax), or a React element. The second argument should be a DOM node.
Optionally takes a callback that is called when the component is in place.
Returns the mounted component instance."
([comp container]
(render comp container nil))
([comp container callback]
(ratom/flush!)
(let [f (fn []
(tmpl/as-element (if (fn? comp) (comp) comp)))]
(render-comp f container callback))))
(defn unmount-component-at-node [container]
(unmount-comp container))
(defn dom-node
"Returns the root DOM node of a mounted component."
[this]
($ (module) findDOMNode this))
(defn force-update-all
"Force re-rendering of all mounted Reagent components. This is
probably only useful in a development environment, when you want to
update components in response to some dynamic changes to code.
Note that force-update-all may not update root components. This
happens if a component 'foo' is mounted with `(render [foo])` (since
functions are passed by value, and not by reference, in
ClojureScript). To get around this you'll have to introduce a layer
of indirection, for example by using `(render [#'foo])` instead."
[]
(ratom/flush!)
(doseq [v (vals @roots)]
(apply re-render-component v))
"Updated")

View File

@ -0,0 +1,33 @@
(ns mranderson047.reagent.v0v6v0.reagent.dom.server
(:require [cljsjs.react.dom.server]
[mranderson047.reagent.v0v6v0.reagent.impl.util :as util]
[mranderson047.reagent.v0v6v0.reagent.impl.template :as tmpl]
[mranderson047.reagent.v0v6v0.reagent.ratom :as ratom]
[mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]]))
(defonce ^:private imported nil)
(defn module []
(cond
(some? imported) imported
(exists? js/ReactDOMServer) (set! imported js/ReactDOMServer)
(exists? js/require) (or (set! imported (js/require "react-dom/server"))
(throw (js/Error.
"require('react-dom/server') failed")))
:else
(throw (js/Error. "js/ReactDOMServer is missing"))))
(defn render-to-string
"Turns a component into an HTML string."
[component]
(ratom/flush!)
(binding [util/*non-reactive* true]
($ (module) renderToString (tmpl/as-element component))))
(defn render-to-static-markup
"Turns a component into an HTML string, without data-react-id attributes, etc."
[component]
(ratom/flush!)
(binding [util/*non-reactive* true]
($ (module) renderToStaticMarkup (tmpl/as-element component))))

View File

@ -0,0 +1,113 @@
(ns mranderson047.reagent.v0v6v0.reagent.impl.batching
(:refer-clojure :exclude [flush])
(:require [mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg]]
[mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]]
[mranderson047.reagent.v0v6v0.reagent.impl.util :refer [is-client]]
[clojure.string :as string]))
;;; Update batching
(defonce mount-count 0)
(defn next-mount-count []
(set! mount-count (inc mount-count)))
(defn fake-raf [f]
(js/setTimeout f 16))
(def next-tick
(if-not is-client
fake-raf
(let [w js/window]
(or ($ w :requestAnimationFrame)
($ w :webkitRequestAnimationFrame)
($ w :mozRequestAnimationFrame)
($ w :msRequestAnimationFrame)
fake-raf))))
(defn compare-mount-order [c1 c2]
(- ($ c1 :cljsMountOrder)
($ c2 :cljsMountOrder)))
(defn run-queue [a]
;; sort components by mount order, to make sure parents
;; are rendered before children
(.sort a compare-mount-order)
(dotimes [i (alength a)]
(let [c (aget a i)]
(when (true? ($ c :cljsIsDirty))
($ c forceUpdate)))))
;; Set from ratom.cljs
(defonce ratom-flush (fn []))
(deftype RenderQueue [^:mutable ^boolean scheduled?]
Object
(enqueue [this k f]
(assert (some? f))
(when (nil? (aget this k))
(aset this k (array)))
(.push (aget this k) f)
(.schedule this))
(run-funs [this k]
(when-some [fs (aget this k)]
(aset this k nil)
(dotimes [i (alength fs)]
((aget fs i)))))
(schedule [this]
(when-not scheduled?
(set! scheduled? true)
(next-tick #(.run-queues this))))
(queue-render [this c]
(.enqueue this "componentQueue" c))
(add-before-flush [this f]
(.enqueue this "beforeFlush" f))
(add-after-render [this f]
(.enqueue this "afterRender" f))
(run-queues [this]
(set! scheduled? false)
(.flush-queues this))
(flush-after-render [this]
(.run-funs this "afterRender"))
(flush-queues [this]
(.run-funs this "beforeFlush")
(ratom-flush)
(when-some [cs (aget this "componentQueue")]
(aset this "componentQueue" nil)
(run-queue cs))
(.flush-after-render this)))
(defonce render-queue (RenderQueue. false))
(defn flush []
(.flush-queues render-queue))
(defn flush-after-render []
(.flush-after-render render-queue))
(defn queue-render [c]
(when-not ($ c :cljsIsDirty)
($! c :cljsIsDirty true)
(.queue-render render-queue c)))
(defn mark-rendered [c]
($! c :cljsIsDirty false))
(defn do-before-flush [f]
(.add-before-flush render-queue f))
(defn do-after-render [f]
(.add-after-render render-queue f))
(defn schedule []
(when (false? (.-scheduled? render-queue))
(.schedule render-queue)))

View File

@ -0,0 +1,317 @@
(ns mranderson047.reagent.v0v6v0.reagent.impl.component
(:require [mranderson047.reagent.v0v6v0.reagent.impl.util :as util]
[mranderson047.reagent.v0v6v0.reagent.impl.batching :as batch]
[mranderson047.reagent.v0v6v0.reagent.ratom :as ratom]
[mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]]
[mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg prn dev? warn error warn-unless]]))
(declare ^:dynamic *current-component*)
;;; Argv access
(defn shallow-obj-to-map [o]
(let [ks (js-keys o)
len (alength ks)]
(loop [m {} i 0]
(if (< i len)
(let [k (aget ks i)]
(recur (assoc m (keyword k) (aget o k)) (inc i)))
m))))
(defn extract-props [v]
(let [p (nth v 1 nil)]
(if (map? p) p)))
(defn extract-children [v]
(let [p (nth v 1 nil)
first-child (if (or (nil? p) (map? p)) 2 1)]
(if (> (count v) first-child)
(subvec v first-child))))
(defn props-argv [c p]
(if-some [a ($ p :argv)]
a
[(.-constructor c) (shallow-obj-to-map p)]))
(defn get-argv [c]
(props-argv c ($ c :props)))
(defn get-props [c]
(let [p ($ c :props)]
(if-some [v ($ p :argv)]
(extract-props v)
(shallow-obj-to-map p))))
(defn get-children [c]
(let [p ($ c :props)]
(if-some [v ($ p :argv)]
(extract-children v)
(->> ($ p :children)
($ util/react Children.toArray)
(into [])))))
(defn ^boolean reagent-class? [c]
(and (fn? c)
(some? (some-> c .-prototype ($ :reagentRender)))))
(defn ^boolean react-class? [c]
(and (fn? c)
(some? (some-> c .-prototype ($ :render)))))
(defn ^boolean reagent-component? [c]
(some? ($ c :reagentRender)))
(defn cached-react-class [c]
($ c :cljsReactClass))
(defn cache-react-class [c constructor]
($! c :cljsReactClass constructor))
;;; State
(defn state-atom [this]
(let [sa ($ this :cljsState)]
(if-not (nil? sa)
sa
($! this :cljsState (ratom/atom nil)))))
;; avoid circular dependency: this gets set from template.cljs
(defonce as-element nil)
;;; Rendering
(defn wrap-render [c]
(let [f ($ c :reagentRender)
_ (assert (ifn? f))
res (if (true? ($ c :cljsLegacyRender))
(.call f c c)
(let [v (get-argv c)
n (count v)]
(case n
1 (.call f c)
2 (.call f c (nth v 1))
3 (.call f c (nth v 1) (nth v 2))
4 (.call f c (nth v 1) (nth v 2) (nth v 3))
5 (.call f c (nth v 1) (nth v 2) (nth v 3) (nth v 4))
(.apply f c (.slice (into-array v) 1)))))]
(cond
(vector? res) (as-element res)
(ifn? res) (let [f (if (reagent-class? res)
(fn [& args]
(as-element (apply vector res args)))
res)]
($! c :reagentRender f)
(recur c))
:else res)))
(declare comp-name)
(defn do-render [c]
(binding [*current-component* c]
(if (dev?)
;; Log errors, without using try/catch (and mess up call stack)
(let [ok (array false)]
(try
(let [res (wrap-render c)]
(aset ok 0 true)
res)
(finally
(when-not (aget ok 0)
(error (str "Error rendering component"
(comp-name)))))))
(wrap-render c))))
;;; Method wrapping
(def rat-opts {:no-cache true})
(def static-fns
{:render
(fn render []
(this-as c (if util/*non-reactive*
(do-render c)
(let [rat ($ c :cljsRatom)]
(batch/mark-rendered c)
(if (nil? rat)
(ratom/run-in-reaction #(do-render c) c "cljsRatom"
batch/queue-render rat-opts)
(._run rat false))))))})
(defn custom-wrapper [key f]
(case key
:getDefaultProps
(assert false "getDefaultProps not supported")
:getInitialState
(fn getInitialState []
(this-as c (reset! (state-atom c) (.call f c c))))
:componentWillReceiveProps
(fn componentWillReceiveProps [nextprops]
(this-as c (.call f c c (props-argv c nextprops))))
:shouldComponentUpdate
(fn shouldComponentUpdate [nextprops nextstate]
(or util/*always-update*
(this-as c
;; Don't care about nextstate here, we use forceUpdate
;; when only when state has changed anyway.
(let [old-argv ($ c :props.argv)
new-argv ($ nextprops :argv)
noargv (or (nil? old-argv) (nil? new-argv))]
(cond
(nil? f) (or noargv (not= old-argv new-argv))
noargv (.call f c c (get-argv c) (props-argv c nextprops))
:else (.call f c c old-argv new-argv))))))
:componentWillUpdate
(fn componentWillUpdate [nextprops]
(this-as c (.call f c c (props-argv c nextprops))))
:componentDidUpdate
(fn componentDidUpdate [oldprops]
(this-as c (.call f c c (props-argv c oldprops))))
:componentWillMount
(fn componentWillMount []
(this-as c
($! c :cljsMountOrder (batch/next-mount-count))
(when-not (nil? f)
(.call f c c))))
:componentDidMount
(fn componentDidMount []
(this-as c (.call f c c)))
:componentWillUnmount
(fn componentWillUnmount []
(this-as c
(some-> ($ c :cljsRatom)
ratom/dispose!)
(batch/mark-rendered c)
(when-not (nil? f)
(.call f c c))))
nil))
(defn get-wrapper [key f name]
(let [wrap (custom-wrapper key f)]
(when (and wrap f)
(assert (ifn? f)
(str "Expected function in " name key " but got " f)))
(or wrap f)))
(def obligatory {:shouldComponentUpdate nil
:componentWillMount nil
:componentWillUnmount nil})
(def dash-to-camel (util/memoize-1 util/dash-to-camel))
(defn camelify-map-keys [fun-map]
(reduce-kv (fn [m k v]
(assoc m (-> k dash-to-camel keyword) v))
{} fun-map))
(defn add-obligatory [fun-map]
(merge obligatory fun-map))
(defn wrap-funs [fmap]
(when (dev?)
(let [renders (select-keys fmap [:render :reagentRender :componentFunction])
render-fun (-> renders vals first)]
(assert (pos? (count renders)) "Missing reagent-render")
(assert (== 1 (count renders)) "Too many render functions supplied")
(assert (ifn? render-fun) (str "Render must be a function, not "
(pr-str render-fun)))))
(let [render-fun (or (:reagentRender fmap)
(:componentFunction fmap))
legacy-render (nil? render-fun)
render-fun (or render-fun
(:render fmap))
name (str (or (:displayName fmap)
(util/fun-name render-fun)))
name (case name
"" (str (gensym "reagent"))
name)
fmap (reduce-kv (fn [m k v]
(assoc m k (get-wrapper k v name)))
{} fmap)]
(assoc fmap
:displayName name
:autobind false
:cljsLegacyRender legacy-render
:reagentRender render-fun
:render (:render static-fns))))
(defn map-to-js [m]
(reduce-kv (fn [o k v]
(doto o
(aset (name k) v)))
#js{} m))
(defn cljsify [body]
(-> body
camelify-map-keys
add-obligatory
wrap-funs
map-to-js))
(defn create-class [body]
{:pre [(map? body)]}
(->> body
cljsify
($ util/react createClass)))
(defn component-path [c]
(let [elem (some-> (or (some-> c ($ :_reactInternalInstance))
c)
($ :_currentElement))
name (some-> elem
($ :type)
($ :displayName))
path (some-> elem
($ :_owner)
component-path
(str " > "))
res (str path name)]
(when-not (empty? res) res)))
(defn comp-name []
(if (dev?)
(let [c *current-component*
n (or (component-path c)
(some-> c .-constructor util/fun-name))]
(if-not (empty? n)
(str " (in " n ")")
""))
""))
(defn fn-to-class [f]
(assert (ifn? f) (str "Expected a function, not " (pr-str f)))
(warn-unless (not (and (react-class? f)
(not (reagent-class? f))))
"Using native React classes directly in Hiccup forms "
"is not supported. Use create-element or "
"adapt-react-class instead: " (let [n (util/fun-name f)]
(if (empty? n) f n))
(comp-name))
(if (reagent-class? f)
(cache-react-class f f)
(let [spec (meta f)
withrender (assoc spec :reagent-render f)
res (create-class withrender)]
(cache-react-class f res))))
(defn as-class [tag]
(if-some [cached-class (cached-react-class tag)]
cached-class
(fn-to-class tag)))
(defn reactify-component [comp]
(if (react-class? comp)
comp
(as-class comp)))

View File

@ -0,0 +1,395 @@
(ns mranderson047.reagent.v0v6v0.reagent.impl.template
(:require [clojure.string :as string]
[clojure.walk :refer [prewalk]]
[mranderson047.reagent.v0v6v0.reagent.impl.util :as util :refer [is-client]]
[mranderson047.reagent.v0v6v0.reagent.impl.component :as comp]
[mranderson047.reagent.v0v6v0.reagent.impl.batching :as batch]
[mranderson047.reagent.v0v6v0.reagent.ratom :as ratom]
[mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]]
[mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg prn println log dev?
warn warn-unless]]))
;; From Weavejester's Hiccup, via pump:
(def ^{:doc "Regular expression that parses a CSS-style id and class
from a tag name."}
re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")
(deftype NativeWrapper [])
;;; Common utilities
(defn ^boolean named? [x]
(or (keyword? x)
(symbol? x)))
(defn ^boolean hiccup-tag? [x]
(or (named? x)
(string? x)))
(defn ^boolean valid-tag? [x]
(or (hiccup-tag? x)
(ifn? x)
(instance? NativeWrapper x)))
;;; Props conversion
(def prop-name-cache #js{:class "className"
:for "htmlFor"
:charset "charSet"})
(defn cache-get [o k]
(when ^boolean (.hasOwnProperty o k)
(aget o k)))
(defn cached-prop-name [k]
(if (named? k)
(if-some [k' (cache-get prop-name-cache (name k))]
k'
(aset prop-name-cache (name k)
(util/dash-to-camel k)))
k))
(defn ^boolean js-val? [x]
(not (identical? "object" (goog/typeOf x))))
(declare convert-prop-value)
(defn kv-conv [o k v]
(doto o
(aset (cached-prop-name k)
(convert-prop-value v))))
(defn convert-prop-value [x]
(cond (js-val? x) x
(named? x) (name x)
(map? x) (reduce-kv kv-conv #js{} x)
(coll? x) (clj->js x)
(ifn? x) (fn [& args]
(apply x args))
:else (clj->js x)))
(defn oset [o k v]
(doto (if (nil? o) #js{} o)
(aset k v)))
(defn oget [o k]
(if (nil? o) nil (aget o k)))
(defn set-id-class [p id-class]
(let [id ($ id-class :id)
p (if (and (some? id)
(nil? (oget p "id")))
(oset p "id" id)
p)]
(if-some [class ($ id-class :className)]
(let [old (oget p "className")]
(oset p "className" (if (nil? old)
class
(str class " " old))))
p)))
(defn convert-props [props id-class]
(-> props
convert-prop-value
(set-id-class id-class)))
;;; Specialization for input components
;; <input type="??" >
;; The properites 'selectionStart' and 'selectionEnd' only exist on some inputs
;; See: https://html.spec.whatwg.org/multipage/forms.html#do-not-apply
(def these-inputs-have-selection-api #{"text" "textarea" "password" "search"
"tel" "url"})
(defn ^boolean has-selection-api?
[input-type]
(contains? these-inputs-have-selection-api input-type))
(defn input-set-value [this]
(when-some [node ($ this :cljsInputElement)]
($! this :cljsInputDirty false)
(let [rendered-value ($ this :cljsRenderedValue)
dom-value ($ this :cljsDOMValue)]
(when (not= rendered-value dom-value)
(if-not (and (identical? node ($ js/document :activeElement))
(has-selection-api? ($ node :type))
(string? rendered-value)
(string? dom-value))
;; just set the value, no need to worry about a cursor
(do
($! this :cljsDOMValue rendered-value)
($! node :value rendered-value))
;; Setting "value" (below) moves the cursor position to the
;; end which gives the user a jarring experience.
;;
;; But repositioning the cursor within the text, turns out to
;; be quite a challenge because changes in the text can be
;; triggered by various events like:
;; - a validation function rejecting a user inputted char
;; - the user enters a lower case char, but is transformed to
;; upper.
;; - the user selects multiple chars and deletes text
;; - the user pastes in multiple chars, and some of them are
;; rejected by a validator.
;; - the user selects multiple chars and then types in a
;; single new char to repalce them all.
;; Coming up with a sane cursor repositioning strategy hasn't
;; been easy ALTHOUGH in the end, it kinda fell out nicely,
;; and it appears to sanely handle all the cases we could
;; think of.
;; So this is just a warning. The code below is simple
;; enough, but if you are tempted to change it, be aware of
;; all the scenarios you have handle.
(let [node-value ($ node :value)]
(if (not= node-value dom-value)
;; IE has not notified us of the change yet, so check again later
(batch/do-after-render #(input-set-value this))
(let [existing-offset-from-end (- (count node-value)
($ node :selectionStart))
new-cursor-offset (- (count rendered-value)
existing-offset-from-end)]
($! this :cljsDOMValue rendered-value)
($! node :value rendered-value)
($! node :selectionStart new-cursor-offset)
($! node :selectionEnd new-cursor-offset)))))))))
(defn input-handle-change [this on-change e]
($! this :cljsDOMValue (-> e .-target .-value))
;; Make sure the input is re-rendered, in case on-change
;; wants to keep the value unchanged
(when-not ($ this :cljsInputDirty)
($! this :cljsInputDirty true)
(batch/do-after-render #(input-set-value this)))
(on-change e))
(defn input-render-setup [this jsprops]
;; Don't rely on React for updating "controlled inputs", since it
;; doesn't play well with async rendering (misses keystrokes).
(when (and (some? jsprops)
(.hasOwnProperty jsprops "onChange")
(.hasOwnProperty jsprops "value"))
(let [v ($ jsprops :value)
value (if (nil? v) "" v)
on-change ($ jsprops :onChange)]
(when (nil? ($ this :cljsInputElement))
;; set initial value
($! this :cljsDOMValue value))
($! this :cljsRenderedValue value)
(js-delete jsprops "value")
(doto jsprops
($! :defaultValue value)
($! :onChange #(input-handle-change this on-change %))
($! :ref #($! this :cljsInputElement %1))))))
(defn ^boolean input-component? [x]
(case x
("input" "textarea") true
false))
(def reagent-input-class nil)
(declare make-element)
(def input-spec
{:display-name "ReagentInput"
:component-did-update input-set-value
:reagent-render
(fn [argv comp jsprops first-child]
(let [this comp/*current-component*]
(input-render-setup this jsprops)
(make-element argv comp jsprops first-child)))})
(defn reagent-input []
(when (nil? reagent-input-class)
(set! reagent-input-class (comp/create-class input-spec)))
reagent-input-class)
;;; Conversion from Hiccup forms
(defn parse-tag [hiccup-tag]
(let [[tag id class] (->> hiccup-tag name (re-matches re-tag) next)
class (when-not (nil? class)
(string/replace class #"\." " "))]
(assert tag (str "Invalid tag: '" hiccup-tag "'"
(comp/comp-name)))
#js{:name tag
:id id
:className class}))
(defn try-get-key [x]
;; try catch to avoid clojurescript peculiarity with
;; sorted-maps with keys that are numbers
(try (get x :key)
(catch :default e)))
(defn get-key [x]
(when (map? x)
(try-get-key x)))
(defn key-from-vec [v]
(if-some [k (-> (meta v) get-key)]
k
(-> v (nth 1 nil) get-key)))
(defn reag-element [tag v]
(let [c (comp/as-class tag)
jsprops #js{:argv v}]
(when-some [key (key-from-vec v)]
($! jsprops :key key))
($ util/react createElement c jsprops)))
(defn adapt-react-class [c]
(doto (NativeWrapper.)
($! :name c)
($! :id nil)
($! :class nil)))
(def tag-name-cache #js{})
(defn cached-parse [x]
(if-some [s (cache-get tag-name-cache x)]
s
(aset tag-name-cache x (parse-tag x))))
(declare as-element)
(defn native-element [parsed argv first]
(let [comp ($ parsed :name)]
(let [props (nth argv first nil)
hasprops (or (nil? props) (map? props))
jsprops (convert-props (if hasprops props) parsed)
first-child (+ first (if hasprops 1 0))]
(if (input-component? comp)
(-> [(reagent-input) argv comp jsprops first-child]
(with-meta (meta argv))
as-element)
(let [key (-> (meta argv) get-key)
p (if (nil? key)
jsprops
(oset jsprops "key" key))]
(make-element argv comp p first-child))))))
(defn str-coll [coll]
(if (dev?)
(str (prewalk (fn [x]
(if (fn? x)
(let [n (util/fun-name x)]
(case n "" x (symbol n)))
x)) coll))
(str coll)))
(defn hiccup-err [v & msg]
(str (apply str msg) ": " (str-coll v) "\n" (comp/comp-name)))
(defn vec-to-elem [v]
(assert (pos? (count v)) (hiccup-err v "Hiccup form should not be empty"))
(let [tag (nth v 0 nil)]
(assert (valid-tag? tag) (hiccup-err v "Invalid Hiccup form"))
(cond
(hiccup-tag? tag)
(let [n (name tag)
pos (.indexOf n ">")]
(case pos
-1 (native-element (cached-parse n) v 1)
0 (let [comp (nth v 1 nil)]
;; Support [:> comp ...]
(assert (= ">" n) (hiccup-err v "Invalid Hiccup tag"))
(assert (or (string? comp) (fn? comp))
(hiccup-err v "Expected React component in"))
(native-element #js{:name comp} v 2))
;; Support extended hiccup syntax, i.e :div.bar>a.foo
(recur [(subs n 0 pos)
(assoc v 0 (subs n (inc pos)))])))
(instance? NativeWrapper tag)
(native-element tag v 1)
:else (reag-element tag v))))
(declare expand-seq)
(declare expand-seq-check)
(defn as-element [x]
(cond (js-val? x) x
(vector? x) (vec-to-elem x)
(seq? x) (if (dev?)
(expand-seq-check x)
(expand-seq x))
(named? x) (name x)
(satisfies? IPrintWithWriter x) (pr-str x)
:else x))
(set! comp/as-element as-element)
(defn expand-seq [s]
(let [a (into-array s)]
(dotimes [i (alength a)]
(aset a i (as-element (aget a i))))
a))
(defn expand-seq-dev [s o]
(let [a (into-array s)]
(dotimes [i (alength a)]
(let [val (aget a i)]
(when (and (vector? val)
(nil? (key-from-vec val)))
($! o :no-key true))
(aset a i (as-element val))))
a))
(defn expand-seq-check [x]
(let [ctx #js{}
[res derefed] (ratom/check-derefs #(expand-seq-dev x ctx))]
(when derefed
(warn (hiccup-err x "Reactive deref not supported in lazy seq, "
"it should be wrapped in doall")))
(when ($ ctx :no-key)
(warn (hiccup-err x "Every element in a seq should have a unique :key")))
res))
;; From https://github.com/babel/babel/commit/1d0e68f5a19d721fe8799b1ea331041d8bf9120e
;; (def react-element-type (or (and (exists? js/Symbol)
;; ($ js/Symbol :for)
;; ($ js/Symbol for "react.element"))
;; 60103))
;; (defn make-element-fast [argv comp jsprops first-child]
;; (let [key (some-> jsprops ($ :key))
;; ref (some-> jsprops ($ :ref))
;; props (if (nil? jsprops) (js-obj) jsprops)]
;; ($! props :children
;; (case (- (count argv) first-child)
;; 0 nil
;; 1 (as-element (nth argv first-child))
;; (reduce-kv (fn [a k v]
;; (when (>= k first-child)
;; (.push a (as-element v)))
;; a)
;; #js[] argv)))
;; (js-obj "key" key
;; "ref" ref
;; "props" props
;; "$$typeof" react-element-type
;; "type" comp
;; ;; "_store" (js-obj)
;; )))
(defn make-element [argv comp jsprops first-child]
(case (- (count argv) first-child)
;; Optimize cases of zero or one child
0 ($ util/react createElement comp jsprops)
1 ($ util/react createElement comp jsprops
(as-element (nth argv first-child nil)))
(.apply ($ util/react :createElement) nil
(reduce-kv (fn [a k v]
(when (>= k first-child)
(.push a (as-element v)))
a)
#js[comp jsprops] argv))))

View File

@ -0,0 +1,102 @@
(ns mranderson047.reagent.v0v6v0.reagent.impl.util
(:require [cljsjs.react]
[mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg log warn]]
[mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]]
[clojure.string :as string]))
(defonce react
(cond (exists? js/React) js/React
(exists? js/require) (or (js/require "react")
(throw (js/Error. "require('react') failed")))
:else (throw (js/Error. "js/React is missing"))))
(def is-client (and (exists? js/window)
(-> js/window ($ :document) nil? not)))
(def ^:dynamic ^boolean *non-reactive* false)
;;; Props accessors
;; Misc utilities
(defn memoize-1 [f]
(let [mem (atom {})]
(fn [arg]
(let [v (get @mem arg)]
(if-not (nil? v)
v
(let [ret (f arg)]
(swap! mem assoc arg ret)
ret))))))
(def dont-camel-case #{"aria" "data"})
(defn capitalize [s]
(if (< (count s) 2)
(string/upper-case s)
(str (string/upper-case (subs s 0 1)) (subs s 1))))
(defn dash-to-camel [dashed]
(if (string? dashed)
dashed
(let [name-str (name dashed)
[start & parts] (string/split name-str #"-")]
(if (dont-camel-case start)
name-str
(apply str start (map capitalize parts))))))
(defn fun-name [f]
(let [n (or (and (fn? f)
(or ($ f :displayName)
($ f :name)))
(and (implements? INamed f)
(name f))
(let [m (meta f)]
(if (map? m)
(:name m))))]
(-> n
str
(clojure.string/replace "$" "."))))
(deftype partial-ifn [f args ^:mutable p]
IFn
(-invoke [_ & a]
(or p (set! p (apply clojure.core/partial f args)))
(apply p a))
IEquiv
(-equiv [_ other]
(and (= f (.-f other)) (= args (.-args other))))
IHash
(-hash [_] (hash [f args])))
(defn- merge-class [p1 p2]
(let [class (when-let [c1 (:class p1)]
(when-let [c2 (:class p2)]
(str c1 " " c2)))]
(if (nil? class)
p2
(assoc p2 :class class))))
(defn- merge-style [p1 p2]
(let [style (when-let [s1 (:style p1)]
(when-let [s2 (:style p2)]
(merge s1 s2)))]
(if (nil? style)
p2
(assoc p2 :style style))))
(defn merge-props [p1 p2]
(if (nil? p1)
p2
(do
(assert (map? p1))
(merge-style p1 (merge-class p1 (merge p1 p2))))))
(def ^:dynamic *always-update* false)
(defn force-update [comp deep]
(if deep
(binding [*always-update* true]
($ comp forceUpdate))
($ comp forceUpdate)))

View File

@ -0,0 +1,75 @@
(ns mranderson047.reagent.v0v6v0.reagent.interop
(:require [clojure.string :as string :refer [join]]
[clojure.java.io :as io]))
(defn- js-call [f args]
(let [argstr (->> (repeat (count args) "~{}")
(join ","))]
(list* 'js* (str "~{}(" argstr ")") f args)))
(defn- dot-args [object member]
(assert (or (symbol? member)
(keyword? member))
(str "Symbol or keyword expected, not " member))
(assert (or (not (symbol? object))
(not (re-find #"\." (name object))))
(str "Dot not allowed in " object))
(let [n (name member)
field? (or (keyword? member)
(= (subs n 0 1) "-"))
names (-> (if (symbol? member)
(string/replace n #"^-" "")
n)
(string/split #"\."))]
[field? names]))
(defmacro $
"Access member in a javascript object, in a Closure-safe way.
'member' is assumed to be a field if it is a keyword or if
the name starts with '-', otherwise the named function is
called with the optional args.
'member' may contain '.', to allow access in nested objects.
If 'object' is a symbol it is not allowed contain '.'.
($ o :foo) is equivalent to (.-foo o), except that it gives
the same result under advanced compilation.
($ o foo arg1 arg2) is the same as (.foo o arg1 arg2)."
[object member & args]
(let [[field names] (dot-args object member)]
(if field
(do
(assert (empty? args)
(str "Passing args to field doesn't make sense: " member))
`(aget ~object ~@names))
(js-call (list* 'aget object names) args))))
(defmacro $!
"Set field in a javascript object, in a Closure-safe way.
'field' should be a keyword or a symbol starting with '-'.
'field' may contain '.', to allow access in nested objects.
If 'object' is a symbol it is not allowed contain '.'.
($! o :foo 1) is equivalent to (set! (.-foo o) 1), except that it
gives the same result under advanced compilation."
[object field value]
(let [[field names] (dot-args object field)]
(assert field (str "Field name must start with - in " field))
`(aset ~object ~@names ~value)))
(defmacro .' [& args]
;; Deprecated since names starting with . cause problems with bootstrapped cljs.
(let [ns (str cljs.analyzer/*cljs-ns*)
line (:line (meta &form))]
(binding [*out* *err*]
(println "WARNING: mranderson047.reagent.v0v6v0.reagent.interop/.' is deprecated in " ns " line " line
". Use mranderson047.reagent.v0v6v0.reagent.interop/$ instead.")))
`($ ~@args))
(defmacro .! [& args]
;; Deprecated since names starting with . cause problems with bootstrapped cljs.
(let [ns (str cljs.analyzer/*cljs-ns*)
line (:line (meta &form))]
(binding [*out* *err*]
(println "WARNING: mranderson047.reagent.v0v6v0.reagent.interop/.! is deprecated in " ns " line " line
". Use mranderson047.reagent.v0v6v0.reagent.interop/$! instead.")))
`($! ~@args))

View File

@ -0,0 +1,2 @@
(ns mranderson047.reagent.v0v6v0.reagent.interop
(:require-macros [mranderson047.reagent.v0v6v0.reagent.interop]))

View File

@ -0,0 +1,53 @@
(ns mranderson047.reagent.v0v6v0.reagent.ratom
(:refer-clojure :exclude [run!])
(:require [mranderson047.reagent.v0v6v0.reagent.debug :as d]))
(defmacro reaction [& body]
`(mranderson047.reagent.v0v6v0.reagent.ratom/make-reaction
(fn [] ~@body)))
(defmacro run!
"Runs body immediately, and runs again whenever atoms deferenced in the body change. Body should side effect."
[& body]
`(let [co# (mranderson047.reagent.v0v6v0.reagent.ratom/make-reaction (fn [] ~@body)
:auto-run true)]
(deref co#)
co#))
(defmacro with-let [bindings & body]
(assert (vector? bindings))
(let [v (gensym "with-let")
k (keyword v)
init (gensym "init")
bs (into [init `(zero? (alength ~v))]
(map-indexed (fn [i x]
(if (even? i)
x
(let [j (quot i 2)]
`(if ~init
(aset ~v ~j ~x)
(aget ~v ~j)))))
bindings))
[forms destroy] (let [fin (last body)]
(if (and (list? fin)
(= 'finally (first fin)))
[(butlast body) `(fn [] ~@(rest fin))]
[body nil]))
add-destroy (when destroy
`(let [destroy# ~destroy]
(if (mranderson047.reagent.v0v6v0.reagent.ratom/reactive?)
(when (nil? (.-destroy ~v))
(set! (.-destroy ~v) destroy#))
(destroy#))))
asserting (if *assert* true false)]
`(let [~v (mranderson047.reagent.v0v6v0.reagent.ratom/with-let-values ~k)]
(when ~asserting
(when-some [c# mranderson047.reagent.v0v6v0.reagent.ratom/*ratom-context*]
(when (== (.-generation ~v) (.-ratomGeneration c#))
(d/error "Warning: The same with-let is being used more "
"than once in the same reactive context."))
(set! (.-generation ~v) (.-ratomGeneration c#))))
(let ~bs
(let [res# (do ~@forms)]
~add-destroy
res#)))))

View File

@ -0,0 +1,592 @@
(ns mranderson047.reagent.v0v6v0.reagent.ratom
(:refer-clojure :exclude [atom])
(:require-macros [mranderson047.reagent.v0v6v0.reagent.ratom :refer [with-let]])
(:require [mranderson047.reagent.v0v6v0.reagent.impl.util :as util]
[mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg log warn error dev? time]]
[mranderson047.reagent.v0v6v0.reagent.impl.batching :as batch]
[clojure.set :as s]))
(declare ^:dynamic *ratom-context*)
(defonce ^boolean debug false)
(defonce ^:private generation 0)
(defonce ^:private -running (clojure.core/atom 0))
(defn ^boolean reactive? []
(some? *ratom-context*))
;;; Utilities
(defn running []
(+ @-running))
(defn- ^number arr-len [x]
(if (nil? x) 0 (alength x)))
(defn- ^boolean arr-eq [x y]
(let [len (arr-len x)]
(and (== len (arr-len y))
(loop [i 0]
(or (== i len)
(if (identical? (aget x i) (aget y i))
(recur (inc i))
false))))))
(defn- in-context [obj f]
(binding [*ratom-context* obj]
(f)))
(defn- deref-capture [f r]
(set! (.-captured r) nil)
(when (dev?)
(set! (.-ratomGeneration r) (set! generation (inc generation))))
(let [res (in-context r f)
c (.-captured r)]
(set! (.-dirty? r) false)
;; Optimize common case where derefs occur in same order
(when-not (arr-eq c (.-watching r))
(._update-watching r c))
res))
(defn- notify-deref-watcher! [derefed]
(when-some [r *ratom-context*]
(let [c (.-captured r)]
(if (nil? c)
(set! (.-captured r) (array derefed))
(.push c derefed)))))
(defn- check-watches [old new]
(when debug
(swap! -running + (- (count new) (count old))))
new)
(defn- add-w [this key f]
(let [w (.-watches this)]
(set! (.-watches this) (check-watches w (assoc w key f)))
(set! (.-watchesArr this) nil)))
(defn- remove-w [this key]
(let [w (.-watches this)]
(set! (.-watches this) (check-watches w (dissoc w key)))
(set! (.-watchesArr this) nil)))
(defn- notify-w [this old new]
(let [w (.-watchesArr this)
a (if (nil? w)
;; Copy watches to array for speed
(->> (.-watches this)
(reduce-kv #(doto %1 (.push %2) (.push %3)) #js[])
(set! (.-watchesArr this)))
w)]
(let [len (alength a)]
(loop [i 0]
(when (< i len)
(let [k (aget a i)
f (aget a (inc i))]
(f k this old new))
(recur (+ 2 i)))))))
(defn- pr-atom [a writer opts s]
(-write writer (str "#<" s " "))
(pr-writer (binding [*ratom-context* nil] (-deref a)) writer opts)
(-write writer ">"))
;;; Queueing
(defonce ^:private rea-queue nil)
(defn- rea-enqueue [r]
(when (nil? rea-queue)
(set! rea-queue (array))
(batch/schedule))
(.push rea-queue r))
(defn flush! []
(loop []
(let [q rea-queue]
(when-not (nil? q)
(set! rea-queue nil)
(dotimes [i (alength q)]
(._queued-run (aget q i)))
(recur)))))
(set! batch/ratom-flush flush!)
;;; Atom
(defprotocol IReactiveAtom)
(deftype RAtom [^:mutable state meta validator ^:mutable watches]
IAtom
IReactiveAtom
IEquiv
(-equiv [o other] (identical? o other))
IDeref
(-deref [this]
(notify-deref-watcher! this)
state)
IReset
(-reset! [a new-value]
(when-not (nil? validator)
(assert (validator new-value) "Validator rejected reference state"))
(let [old-value state]
(set! state new-value)
(when-not (nil? watches)
(notify-w a old-value new-value))
new-value))
ISwap
(-swap! [a f] (-reset! a (f state)))
(-swap! [a f x] (-reset! a (f state x)))
(-swap! [a f x y] (-reset! a (f state x y)))
(-swap! [a f x y more] (-reset! a (apply f state x y more)))
IMeta
(-meta [_] meta)
IPrintWithWriter
(-pr-writer [a w opts] (pr-atom a w opts "Atom:"))
IWatchable
(-notify-watches [this old new] (notify-w this old new))
(-add-watch [this key f] (add-w this key f))
(-remove-watch [this key] (remove-w this key))
IHash
(-hash [this] (goog/getUid this)))
(defn atom
"Like clojure.core/atom, except that it keeps track of derefs."
([x] (RAtom. x nil nil nil))
([x & {:keys [meta validator]}] (RAtom. x meta validator nil)))
;;; track
(declare make-reaction)
(def ^{:private true :const true} cache-key "reagReactionCache")
(defn- cached-reaction [f o k obj destroy]
(let [m (aget o cache-key)
m (if (nil? m) {} m)
r (m k nil)]
(cond
(some? r) (-deref r)
(nil? *ratom-context*) (f)
:else (let [r (make-reaction
f :on-dispose (fn [x]
(when debug (swap! -running dec))
(as-> (aget o cache-key) _
(dissoc _ k)
(aset o cache-key _))
(when (some? obj)
(set! (.-reaction obj) nil))
(when (some? destroy)
(destroy x))))
v (-deref r)]
(aset o cache-key (assoc m k r))
(when debug (swap! -running inc))
(when (some? obj)
(set! (.-reaction obj) r))
v))))
(deftype Track [f args ^:mutable reaction]
IReactiveAtom
IDeref
(-deref [this]
(if-some [r reaction]
(-deref r)
(cached-reaction #(apply f args) f args this nil)))
IEquiv
(-equiv [_ other]
(and (instance? Track other)
(= f (.-f other))
(= args (.-args other))))
IHash
(-hash [_] (hash [f args]))
IPrintWithWriter
(-pr-writer [a w opts] (pr-atom a w opts "Track:")))
(defn make-track [f args]
(Track. f args nil))
(defn make-track! [f args]
(let [t (make-track f args)
r (make-reaction #(-deref t)
:auto-run true)]
@r
r))
(defn track [f & args]
{:pre [(ifn? f)]}
(make-track f args))
(defn track! [f & args]
{:pre [(ifn? f)]}
(make-track! f args))
;;; cursor
(deftype RCursor [ratom path ^:mutable reaction
^:mutable state ^:mutable watches]
IAtom
IReactiveAtom
IEquiv
(-equiv [_ other]
(and (instance? RCursor other)
(= path (.-path other))
(= ratom (.-ratom other))))
Object
(_peek [this]
(binding [*ratom-context* nil]
(-deref this)))
(_set-state [this oldstate newstate]
(when-not (identical? oldstate newstate)
(set! state newstate)
(when (some? watches)
(notify-w this oldstate newstate))))
IDeref
(-deref [this]
(let [oldstate state
newstate (if-some [r reaction]
(-deref r)
(let [f (if (satisfies? IDeref ratom)
#(get-in @ratom path)
#(ratom path))]
(cached-reaction f ratom path this nil)))]
(._set-state this oldstate newstate)
newstate))
IReset
(-reset! [this new-value]
(let [oldstate state]
(._set-state this oldstate new-value)
(if (satisfies? IDeref ratom)
(if (= path [])
(reset! ratom new-value)
(swap! ratom assoc-in path new-value))
(ratom path new-value))
new-value))
ISwap
(-swap! [a f] (-reset! a (f (._peek a))))
(-swap! [a f x] (-reset! a (f (._peek a) x)))
(-swap! [a f x y] (-reset! a (f (._peek a) x y)))
(-swap! [a f x y more] (-reset! a (apply f (._peek a) x y more)))
IPrintWithWriter
(-pr-writer [a w opts] (pr-atom a w opts (str "Cursor: " path)))
IWatchable
(-notify-watches [this old new] (notify-w this old new))
(-add-watch [this key f] (add-w this key f))
(-remove-watch [this key] (remove-w this key))
IHash
(-hash [_] (hash [ratom path])))
(defn cursor
[src path]
(assert (or (satisfies? IReactiveAtom src)
(and (ifn? src)
(not (vector? src))))
(str "src must be a reactive atom or a function, not "
(pr-str src)))
(RCursor. src path nil nil nil))
;;; with-let support
(defn with-let-destroy [v]
(when-some [f (.-destroy v)]
(f)))
(defn with-let-values [key]
(if-some [c *ratom-context*]
(cached-reaction array c key
nil with-let-destroy)
(array)))
;;;; reaction
(defprotocol IDisposable
(dispose! [this])
(add-on-dispose! [this f]))
(defprotocol IRunnable
(run [this]))
(defn- handle-reaction-change [this sender old new]
(._handle-change this sender old new))
(deftype Reaction [f ^:mutable state ^:mutable ^boolean dirty? ^boolean nocache?
^:mutable watching ^:mutable watches ^:mutable auto-run
^:mutable caught]
IAtom
IReactiveAtom
IWatchable
(-notify-watches [this old new] (notify-w this old new))
(-add-watch [this key f] (add-w this key f))
(-remove-watch [this key]
(let [was-empty (empty? watches)]
(remove-w this key)
(when (and (not was-empty)
(empty? watches)
(nil? auto-run))
(dispose! this))))
IReset
(-reset! [a newval]
(assert (fn? (.-on-set a)) "Reaction is read only.")
(let [oldval state]
(set! state newval)
(.on-set a oldval newval)
(notify-w a oldval newval)
newval))
ISwap
(-swap! [a f] (-reset! a (f (._peek-at a))))
(-swap! [a f x] (-reset! a (f (._peek-at a) x)))
(-swap! [a f x y] (-reset! a (f (._peek-at a) x y)))
(-swap! [a f x y more] (-reset! a (apply f (._peek-at a) x y more)))
Object
(_peek-at [this]
(binding [*ratom-context* nil]
(-deref this)))
(_handle-change [this sender oldval newval]
(when-not (or (identical? oldval newval)
dirty?)
(if (nil? auto-run)
(do
(set! dirty? true)
(rea-enqueue this))
(if (true? auto-run)
(._run this false)
(auto-run this)))))
(_update-watching [this derefed]
(let [new (set derefed)
old (set watching)]
(set! watching derefed)
(doseq [w (s/difference new old)]
(-add-watch w this handle-reaction-change))
(doseq [w (s/difference old new)]
(-remove-watch w this))))
(_queued-run [this]
(when (and dirty? (some? watching))
(._run this true)))
(_try-capture [this f]
(try
(set! caught nil)
(deref-capture f this)
(catch :default e
(set! state e)
(set! caught e)
(set! dirty? false))))
(_run [this check]
(let [oldstate state
res (if check
(._try-capture this f)
(deref-capture f this))]
(when-not nocache?
(set! state res)
;; Use = to determine equality from reactions, since
;; they are likely to produce new data structures.
(when-not (or (nil? watches)
(= oldstate res))
(notify-w this oldstate res)))
res))
(_set-opts [this {:keys [auto-run on-set on-dispose no-cache]}]
(when (some? auto-run)
(set! (.-auto-run this) auto-run))
(when (some? on-set)
(set! (.-on-set this) on-set))
(when (some? on-dispose)
(set! (.-on-dispose this) on-dispose))
(when (some? no-cache)
(set! (.-nocache? this) no-cache)))
IRunnable
(run [this]
(flush!)
(._run this false))
IDeref
(-deref [this]
(when-some [e caught]
(throw e))
(let [non-reactive (nil? *ratom-context*)]
(when non-reactive
(flush!))
(if (and non-reactive (nil? auto-run))
(when dirty?
(let [oldstate state]
(set! state (f))
(when-not (or (nil? watches) (= oldstate state))
(notify-w this oldstate state))))
(do
(notify-deref-watcher! this)
(when dirty?
(._run this false)))))
state)
IDisposable
(dispose! [this]
(let [s state
wg watching]
(set! watching nil)
(set! state nil)
(set! auto-run nil)
(set! dirty? true)
(doseq [w (set wg)]
(-remove-watch w this))
(when (some? (.-on-dispose this))
(.on-dispose this s))
(when-some [a (.-on-dispose-arr this)]
(dotimes [i (alength a)]
((aget a i) this)))))
(add-on-dispose! [this f]
;; f is called with the reaction as argument when it is no longer active
(if-some [a (.-on-dispose-arr this)]
(.push a f)
(set! (.-on-dispose-arr this) (array f))))
IEquiv
(-equiv [o other] (identical? o other))
IPrintWithWriter
(-pr-writer [a w opts] (pr-atom a w opts (str "Reaction " (hash a) ":")))
IHash
(-hash [this] (goog/getUid this)))
(defn make-reaction [f & {:keys [auto-run on-set on-dispose]}]
(let [reaction (Reaction. f nil true false nil nil nil nil)]
(._set-opts reaction {:auto-run auto-run
:on-set on-set
:on-dispose on-dispose})
reaction))
(def ^:private temp-reaction (make-reaction nil))
(defn run-in-reaction [f obj key run opts]
(let [r temp-reaction
res (deref-capture f r)]
(when-not (nil? (.-watching r))
(set! temp-reaction (make-reaction nil))
(._set-opts r opts)
(set! (.-f r) f)
(set! (.-auto-run r) #(run obj))
(aset obj key r))
res))
(defn check-derefs [f]
(let [ctx (js-obj)
res (in-context ctx f)]
[res (some? (.-captured ctx))]))
;;; wrap
(deftype Wrapper [^:mutable state callback ^:mutable ^boolean changed
^:mutable watches]
IAtom
IDeref
(-deref [this]
(when (dev?)
(when (and changed (some? *ratom-context*))
(warn "derefing stale wrap: "
(pr-str this))))
state)
IReset
(-reset! [this newval]
(let [oldval state]
(set! changed true)
(set! state newval)
(when (some? watches)
(notify-w this oldval newval))
(callback newval)
newval))
ISwap
(-swap! [a f] (-reset! a (f state)))
(-swap! [a f x] (-reset! a (f state x)))
(-swap! [a f x y] (-reset! a (f state x y)))
(-swap! [a f x y more] (-reset! a (apply f state x y more)))
IEquiv
(-equiv [_ other]
(and (instance? Wrapper other)
;; If either of the wrappers have changed, equality
;; cannot be relied on.
(not changed)
(not (.-changed other))
(= state (.-state other))
(= callback (.-callback other))))
IWatchable
(-notify-watches [this old new] (notify-w this old new))
(-add-watch [this key f] (add-w this key f))
(-remove-watch [this key] (remove-w this key))
IPrintWithWriter
(-pr-writer [a w opts] (pr-atom a w opts "Wrap:")))
(defn make-wrapper [value callback-fn args]
(Wrapper. value
(util/partial-ifn. callback-fn args nil)
false nil))
#_(do
(defn ratom-perf []
(set! debug false)
(dotimes [_ 10]
(let [nite 100000
a (atom 0)
f (fn []
(quot @a 10))
mid (make-reaction f)
res (track! (fn []
;; (with-let [x 1])
;; @(track f)
(inc @mid)
))]
@res
(time (dotimes [x nite]
(swap! a inc)
(flush!)))
(dispose! res))))
(ratom-perf))

File diff suppressed because one or more lines are too long

View File

@ -1,53 +0,0 @@
(ns day8.re-frame.trace.graph-test
(:require [day8.re-frame.trace.graph :as graph]
[clojure.test :refer :all]))
(def t1
'({:id 1, :operation :initialise-db, :type :event, :tags {:event [:initialise-db]}, :child-of nil}
{:id 2, :operation "todomvc.core.wrapper", :type :render, :tags {:component-path "todomvc.core.wrapper", :reaction "rx2", :input-signals ("ra18")}, :child-of nil}
{:id 5, :operation :sorted-todos, :type :sub/create, :tags {:query-v [:sorted-todos], :cached? false, :reaction "rx3"}, :child-of 4}
{:id 4, :operation :todos, :type :sub/create, :tags {:query-v [:todos], :cached? false, :reaction "rx4"}, :child-of 3}
{:id 7, :operation :sorted-todos, :type :sub/run, :tags {:query-v [:sorted-todos], :reaction "rx3", :input-signals ["ra5"]}, :child-of 6}
{:id 6, :operation :todos, :type :sub/run, :tags {:query-v [:todos], :reaction "rx4", :input-signals ["rx3"]}, :child-of 3}
{:id 3, :operation "todomvc.views.todo_app", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app", :reaction "rx6", :input-signals ("rx4")}, :child-of nil}
{:id 8, :operation "todomvc.views.task_entry", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_entry", :reaction nil, :input-signals nil}, :child-of nil}
{:id 9, :operation "todomvc.views.todo_input", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_entry > todomvc.views.todo_input", :reaction "rx7", :input-signals ("ra19")}, :child-of nil}
{:id 10, :operation "ReagentInput", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_entry > todomvc.views.todo_input > ReagentInput", :reaction nil, :input-signals nil}, :child-of nil}
{:id 13, :operation :todos, :type :sub/create, :tags {:query-v [:todos], :cached? true, :reaction "rx4"}, :child-of 12}
{:id 14, :operation :showing, :type :sub/create, :tags {:query-v [:showing], :cached? false, :reaction "rx8"}, :child-of 12}
{:id 12, :operation :visible-todos, :type :sub/create, :tags {:query-v [:visible-todos], :cached? false, :reaction "rx9"}, :child-of 11}
{:id 16, :operation :todos, :type :sub/create, :tags {:query-v [:todos], :cached? true, :reaction "rx4"}, :child-of 15}
{:id 15, :operation :all-complete?, :type :sub/create, :tags {:query-v [:all-complete?], :cached? false, :reaction "rx10"}, :child-of 11}
{:id 17, :operation :all-complete?, :type :sub/run, :tags {:query-v [:all-complete?], :reaction "rx10", :input-signals ["rx4"]}, :child-of 11}
{:id 19, :operation :showing, :type :sub/run, :tags {:query-v [:showing], :reaction "rx8", :input-signals ["ra5"]}, :child-of 18}
{:id 18, :operation :visible-todos, :type :sub/run, :tags {:query-v [:visible-todos], :reaction "rx9", :input-signals ("rx4" "rx8")}, :child-of 11}
{:id 11, :operation "todomvc.views.task_list", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_list", :reaction "rx11", :input-signals ("rx10" "rx9")}, :child-of nil}
{:id 20, :operation "ReagentInput", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_list > ReagentInput", :reaction nil, :input-signals nil}, :child-of nil}
{:id 21, :operation "todomvc.views.todo_item", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_list > todomvc.views.todo_item", :reaction "rx12", :input-signals ("ra20" "ra20")}, :child-of nil}
{:id 22, :operation "ReagentInput", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_list > todomvc.views.todo_item > ReagentInput", :reaction nil, :input-signals nil}, :child-of nil}
{:id 24, :operation :footer-counts, :type :sub/create, :tags {:query-v [:footer-counts], :cached? false, :reaction "rx13"}, :child-of 23}
{:id 25, :operation :showing, :type :sub/create, :tags {:query-v [:showing], :cached? true, :reaction "rx8"}, :child-of 23}
{:id 27, :operation :todos, :type :sub/create, :tags {:query-v [:todos], :cached? true, :reaction "rx4"}, :child-of 26}
{:id 29, :operation :todos, :type :sub/create, :tags {:query-v [:todos], :cached? true, :reaction "rx4"}, :child-of 28}
{:id 28, :operation :completed-count, :type :sub/create, :tags {:query-v [:completed-count], :cached? false, :reaction "rx14"}, :child-of 26}
{:id 30, :operation :completed-count, :type :sub/run, :tags {:query-v [:completed-count], :reaction "rx14", :input-signals ["rx4"]}, :child-of 26}
{:id 26, :operation :footer-counts, :type :sub/run, :tags {:query-v [:footer-counts], :reaction "rx13", :input-signals ("rx4" "rx14")}, :child-of 23}
{:id 23, :operation "todomvc.views.footer_controls", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.footer_controls", :reaction "rx15", :input-signals ("rx13" "rx8" "rx8" "rx8")}, :child-of nil}))
(deftest sub-graph-test
(is (= {:links []
:nodes [{:id "rx4"
:r 10
:title ""
:group 2
:data {:id 1
:tags {:cached? false
:reaction "rx4"}
:type :sub/create}}]}
(graph/trace->sub-graph [{:id 1 :type :sub/create :tags {:cached? false :reaction "rx4"}}] []))))
(deftest dispose-view-test
(is (= {:links []
:nodes []}
(graph/trace->sub-graph [{:id 1 :type :render :tags {:cached? false :reaction "rx4"}}
{:id 2 :type :componentWillUnmount :tags {:reaction "rx4"}}] []))))

View File

@ -0,0 +1,39 @@
(ns day8.re-frame.trace.metamorphic-test
(:require [clojure.test :refer :all])
(:require [day8.re-frame.trace.metamorphic :as m]))
(defn trace-events [file]
(->> (slurp (str "test-resources/" file))
(clojure.edn/read-string {:readers {'utc identity
'object (fn [x] "<object>")}})
(sort-by :id)))
(deftest parse-app-trace1-test
(let [rt (m/parse-traces (trace-events "app-trace1.edn"))
matches (:matches rt)
[m1 m2 m3 m4 m5 m6] matches]
(is (= (count matches) 6))
(is (= (m/beginning-id m1) 1))
(is (= (m/ending-id m1) 34))
(is (= (:operation (m/matched-event m1)) :bootstrap))
(is (= (m/beginning-id m2) 35))
(is (= (m/ending-id m2) 38))
(is (= (:operation (m/matched-event m2)) :acme.myapp.events/boot-flow))
(is (= (m/beginning-id m3) 39))
(is (= (m/ending-id m3) 42))
(is (= (:operation (m/matched-event m3)) :acme.myapp.events/init-db))
(is (= (m/beginning-id m4) 43))
(is (= (m/ending-id m4) 47))
(is (= (:operation (m/matched-event m4)) :acme.myapp.events/boot-flow))
(is (= (m/beginning-id m5) 48))
(is (= (m/ending-id m5) 49))
(is (= (:operation (m/matched-event m5)) :acme.myapp.events/start-intercom))
(is (= (m/beginning-id m6) 50))
(is (= (m/ending-id m6) 181))
(is (= (:operation (m/matched-event m6)) :acme.myapp.events/success-bootstrap))))