status-im
/
re-frame-10x
mirror of https://github.com/status-im/re-frame-10x.git
2
0
Fork 0
Code Issues Projects Releases Wiki Activity

Release 0.1.17 

-----BEGIN PGP SIGNATURE-----
 Version: GnuPG v2
 
 iQEcBAABCAAGBQJacGMuAAoJEKbk3FKDtdzs/cQIAIn+RViYB47ke9QlX3oZq2CK
 FEAe6UN1QZhPdDdCpCqPhxOJ+J505y95K2qRYaQ3XW+PDZK24UKZ4/FZWdO0bBzm
 sZvEF0/RjU34I/ra+z109QB8ryIcMpTuwTBi+vcwQJWBtMlw6wvcPLYh3ZY83d+2
 Y9sBF6aw9YFbJQLanuxj1OYzawsQgzc/r3h3g0PjVgPl02tPvW97XhnYgv6DGEeA
 3ZO6shW+lg+5wtyh44XrsXeo1LteKF7s9gzkGK9kdWvjjw/4luiDFUpaW5QFodck
 1OV6Bnq4+5zHoxPPA6qJWOyZywltBCsCmrllKqrUVbWdRmBEwLovPb480nE5SeI=
 =W05B
 -----END PGP SIGNATURE-----

Merge tag '0.1.17' into react-16

Release 0.1.17
This commit is contained in:
Daniel Compton 2018-01-31 01:35:07 +13:00
parent e5bc58cfd0 d07a9f5aad
commit 4416b046ea
37 changed files with 4128 additions and 447 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
CHANGELOG.md
View File

@ -3,6 +3,41 @@ All notable changes to this project will be documented in this file. This change
## Unreleased
## [0.1.17] - 2018-01-31
This version requires re-frame 0.10.4 to make use of the newly added Event panel.
### Added
* New event panel. This panel shows the coeffects given to your event handler, the effects your event handler produced, and all of the interceptors in the chain.
* Debugging instructions if re-frame-trace fails to start.
* Setting to drop low level traces. This reduces the memory overhead of re-frame-trace as we can drop more traces that you are unlikely to want most of the time.
* Diff the previous value of a subscription with its current value.
### Changed
* In the subs panel "Ignore **n** layer 2 subs" is now "Ignore **n** unchanged layer 2 subs". This is a more useful filter, as you can filter out noisy layer 2 subscriptions, while still seeing the changes that do happen to layer 2 subs.
* The version of Garden that re-frame-trace uses is now bundled as a source dependency so you should no longer get conflicts if you use Garden 2.
* Refactored re-frame-trace trace parsing internals to incrementally parse new traces.
* Clicking on a trace's expanded information now prints the entire trace to the console instead of just the tags.
* Improved efficency of rendering views that do not need to filter out view namespaces.
* app-db and subs panel now have a slightly more responsive design.
### Fixed
* External windows not loading
* All app-db and subscription path expansions are now independent of each other [#134](https://github.com/Day8/re-frame-trace/issues/134).
* Layer 2/3 calculations are more accurate now. We now use the last seen layer level when a subscription runs, to inform it's layer level if it was created or destroyed.
* View namespaces that are ignored are no longer shown when showing traces for all epochs.
* Distinguish between subscriptions that return `nil` values and those that haven't run yet.
* Timing panel not showing elapsed event processing time.
## [0.1.16] - 2018-01-26
There is now a React 16 variant of re-frame-trace available under the version `0.1.16-react16`. If your application uses React 16 and Reagent 0.8.0-alpha2 or higher, this is the version that you will need to use.
### Added
* Setting to control how many epochs are retained

10
README.md
View File

@ -5,7 +5,7 @@ application, allowing you to better understand it and debug it.
**Status:** Beta. [![Clojars Project](https://img.shields.io/clojars/v/day8.re-frame/trace.svg)](https://clojars.org/day8.re-frame/trace)
**Note** [the latest version 0.1.15](https://github.com/Day8/re-frame-trace/releases/tag/0.1.15) ALSO requires the latest version of re-frame itself - `v0.10.3`.
**Note** [the latest version 0.1.16](https://github.com/Day8/re-frame-trace/releases/tag/0.1.16) ALSO requires the latest version of re-frame itself - `v0.10.3`.
This `react-16` branch bundles Reagent 0.8.0-alpha2 and requires your application to use React 16, and to be on a relatively recent ClojureScript compiler (Tested on 1.9.908, should work back as far as 1.9.854).
@ -95,6 +95,8 @@ If you are using leiningen, modify `project.clj` in the following ways. When puz
{:dependencies [[some-other-package "0.0.0"]
[day8.re-frame/trace "0.0.0 (see version above)"]] }}
```
If your project uses React 16 and Reagent 0.8.0-alpha2 (or higher) then you will need to add the qualifier `-react16` to the version, e.g. `[day8.re-frame/trace "0.0.0-react16"]`.
- Locate the `:compiler` map under `:dev` and add:
@ -143,6 +145,12 @@ If you are using leiningen, modify `project.clj` in the following ways. When puz
* Try a `lein clean`
* Make sure you have followed all the installation steps.
### If re-frame-trace throws an exception on startup
* Reset the settings to factory defaults in the settings panel
* If you can't load the settings panel, run `day8.re_frame.trace.factory_reset_BANG_()` in the JavaScript console.
* If neither of those work, remove all of the keys with the prefix `day8.re-frame.trace` from your browser's Local Storage.
## How does it work?
re-frame is instrumented - all important activity generates trace data. `re-frame-trace` consumes this trace data and renders useful visualisations of the `re-frame` process. Currently, re-frame's tracing capabilities are in alpha and are subject to change at any time. We're testing the utility of the the trace by building an app on top.

52
docs/HyperlinkedInformation/UnchangedLayer2.md
View File

@ -1,43 +1,59 @@
This document briefly explains why `re-frame-trace` gives you an option to
ignore unchanged layer 2 subscriptions.
This document briefly explains why `re-frame-trace` gives you an option to
ignore unchanged layer 2 subscriptions.
### Background
The `re-frame` docs
The `re-frame` docs
[make a distinction](https://github.com/Day8/re-frame/blob/master/docs/SubscriptionInfographic.md)
between `layer 2` and `layer 3` subscriptions:
- `layer 2` subscriptions extract data directly from `app-db` and should be
trivial in nature. There should be no computation in them beyond
what is necessary to extract a value from `app-db`
- `layer 3` subscriptions take values from `layer 2` nodes as inputs, and
compute a materialised view of those values. Just to repeat: they never directly
- `layer 3` subscriptions take values from `layer 2` nodes as inputs, and
compute a materialised view of those values. Just to repeat: they never directly
extract values from `app-db`. They create new values where necessary, and because of it
they to do more serious CPU work. So we never want to run a
`layer 3` subscriptions unless it is necessary.
This structure delivers efficiency. You see, **all** (currently instantiated) `layer 2` subscriptions
`layer 3` subscriptions unless it is necessary.
This structure delivers efficiency. You see, **all** (currently instantiated) `layer 2` subscriptions
will run **every** time `app-db` changes in any way. All of them. Every time.
And `app-db` changes on almost every event, so we want them to be computationally
trivial.
And `app-db` changes on almost every event, so we want them to be computationally
trivial.
If the value of a `layer 2` subscription tests `=` to its previous value, then the further
propagation of values through the signal graph will be pruned.
The more computationally intensive `layer 3` subscriptions, and ultimately
the views, will only recompute if and when there has been a change in their data inputs.
We don't want your app recomputing views only to find that nothing has changed. Inefficient.
We don't want your app recomputing views only to find that nothing has changed. Inefficient.
### Back To Tracing
Because `layer 2` subs run on every single modification of `app-db`, and because
very often nothing has changed, their trace can be a bit noisy. Yes, it happened,
very often nothing has changed, their trace can be a bit noisy. Yes, it happened,
but it just isn't that interesting.
So `re-frame-trace` gives you the option of filtering out trace for
the `layer 2` subscriptions where the value "this time" is the same as the
So `re-frame-trace` gives you the option of filtering out trace for
the `layer 2` subscriptions where the value "this time" is the same as the
value "last time".
On the other hand, if a `layer 2` subscription runs and its value is
different to last time, that's potentially fascinating and you'll want to
be told all about it. :-)
On the other hand, if a `layer 2` subscription runs and its value is
different to last time, that's potentially fascinating and you'll want to
be told all about it. :-)
### Why do I sometimes see "Layer ?" when viewing a subscription?
To determine whether a subscription is a layer 2 or layer 3, re-frame-trace
looks at the input signals to a subscription. If one of the input signals is
app-db then the subscription is a layer 2 sub, otherwise it is a layer 3. If
a subscription hasn't run yet, then we can't know if it is a layer 2 or 3.
In almost all cases, a subscription will be created (by `(subscribe [:my-sub])`)
and run (by dereferencing the subscription) within the same epoch, providing
the layer level. If you see "Layer ?" this means that a subscription was created
but not used. This may indicate a bug in your application, although there are
cases where this is ok.
In most cases, after a few more epochs, that subscription will have run, and we
know it's layer level, and can use it for any subscriptions shown on any future
(and past) epochs.

7
project.clj
View File

@ -1,4 +1,4 @@
(defproject day8.re-frame/trace "0.1.16-react16"
(defproject day8.re-frame/trace "0.1.17-react16"
:description "Tracing and developer tools for re-frame apps"
:url "https://github.com/Day8/re-frame-trace"
:license {:name "MIT"}
@ -7,7 +7,6 @@
[reagent "0.8.0-alpha2" :scope "provided"]
[re-frame "0.10.3" :scope "provided"]
[binaryage/devtools "0.9.4"]
[garden "1.3.3"]
[cljsjs/react-flip-move "2.9.17-0"]]
:plugins [[thomasa/mranderson "0.4.7"]
[lein-less "RELEASE"]]
@ -46,4 +45,6 @@
cljsjs/react-dom-server
cljsjs/create-react-class
org.clojure/tools.logging
net.cgrand/macrovich]]]}})
net.cgrand/macrovich]]
^:source-dep [garden "1.3.3"
:exclusions [com.yahoo.platform.yui/yuicompressor]]]}})

1
source-deps.sh
View File

@ -5,4 +5,5 @@ lein with-profile mranderson source-deps
# Then delete the META-INF directories
rm -r target/srcdeps/mranderson047/reagent/v0v8v0-alpha2/META-INF
rm -r target/srcdeps/mranderson047/re-frame
rm -r target/srcdeps/mranderson047/garden/v1v3v3/META-INF
cp -r target/srcdeps/mranderson047 src

65
src/day8/re_frame/trace.cljs
View File

@ -1,18 +1,11 @@
(ns day8.re-frame.trace
(:require [day8.re-frame.trace.view.app-db :as app-db]
[day8.re-frame.trace.styles :as styles]
[day8.re-frame.trace.view.components :as components]
(:require [day8.re-frame.trace.styles :as styles]
[day8.re-frame.trace.view.container :as container]
[day8.re-frame.trace.utils.localstorage :as localstorage]
[day8.re-frame.trace.events :as events]
[day8.re-frame.trace.subs]
[day8.re-frame.trace.events]
[day8.re-frame.trace.db :as trace.db]
[re-frame.trace :as trace :include-macros true]
[re-frame.db :as db]
[cljs.pprint :as pprint]
[clojure.string :as str]
[clojure.set :as set]
[reagent.core :as real-reagent]
[reagent.interop :refer-macros [$ $!]]
[reagent.impl.util :as util]
[reagent.impl.component :as component]
@ -20,7 +13,6 @@
[reagent.ratom :as ratom]
[goog.object :as gob]
[re-frame.interop :as interop]
[devtools.formatters.core :as devtools]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[mranderson047.reagent.v0v8v0-alpha2.reagent.core :as r]))
@ -114,18 +106,18 @@
;; 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.
#_ (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))))
#_(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)
@ -136,13 +128,13 @@
)))))
#_(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)))))
(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!
@ -157,7 +149,7 @@
(def ease-transition "left 0.2s ease-out, top 0.2s ease-out, width 0.2s ease-out, height 0.2s ease-out")
(defn devtools-outer [traces opts]
(defn devtools-outer [opts]
;; Add clear button
;; Filter out different trace types
(let [position (r/atom :right)
@ -190,7 +182,7 @@
(reset! window-width new-window-width))))
handle-mouse-up (fn [e] (reset! dragging? false))]
(r/create-class
{:component-did-mount (fn []
{:component-did-mount (fn []
(js/window.addEventListener "keydown" handle-keys)
(js/window.addEventListener "mousemove" handle-mousemove)
(js/window.addEventListener "mouseup" handle-mouse-up)
@ -217,7 +209,7 @@
:transition transition}}
[:div.panel-resizer {:style (resizer-style draggable-area)
:on-mouse-down #(reset! dragging? true)}]
[container/devtools-inner traces opts]]]))})))
[container/devtools-inner opts]]]))})))
(defn panel-div []
@ -233,8 +225,11 @@
(defn inject-devtools! []
(styles/inject-trace-styles js/document)
(r/render [devtools-outer events/traces {:panel-type :inline
:debug? debug?}] (panel-div)))
(r/render [devtools-outer {:panel-type :inline
:debug? debug?}] (panel-div)))
(defn init-db! []
(trace.db/init-db))
(trace.db/init-db debug?))
(defn ^:export factory-reset! []
(rf/dispatch [:settings/factory-reset]))

7
src/day8/re_frame/trace/common_styles.cljs
View File

@ -1,6 +1,6 @@
(ns day8.re-frame.trace.common-styles
(:require [garden.units :refer [px em]]
[garden.compiler :refer [render-css]]))
(:require [mranderson047.garden.v1v3v3.garden.units :refer [px em]]
[mranderson047.garden.v1v3v3.garden.compiler :refer [render-css]]))
;; TODO: Switch these to BM (or just use BM defs if available)
@ -50,6 +50,8 @@
(def sub-re-run-color "#219653")
(def sub-not-run-color "#bdbdbd")
(def expansion-button-horizontal-padding (px 2))
(defn panel-style
([border-radius]
{:background-color "#fafbfc"
@ -128,6 +130,7 @@
(def sidebar-item-check-color strong-button-background-color)
(def sidebar-text-color "white")
(def navbar-text-color "white")
(def navbar-tint-lighter "#797B7B")
(def wizard-panel-background-color "#636A6F") ;; Very dark grey
(def wizard-panel-text-color "white")

5
src/day8/re_frame/trace/db.cljs
View File

@ -2,7 +2,7 @@
(:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[day8.re-frame.trace.utils.localstorage :as localstorage]))
(defn init-db []
(defn init-db [debug?]
(let [panel-width% (localstorage/get "panel-width-ratio" 0.35)
show-panel? (localstorage/get "show-panel" false)
selected-tab (localstorage/get "selected-tab" :app-db)
@ -12,6 +12,7 @@
external-window? (localstorage/get "external-window?" false)
using-trace? (localstorage/get "using-trace?" true)
ignored-events (localstorage/get "ignored-events" {})
low-level-trace (localstorage/get "low-level-trace" {:reagent true :re-frame true})
filtered-view-trace (localstorage/get "filtered-view-trace" (let [id1 (random-uuid)
id2 (random-uuid)]
{id1 {:id id1 :ns-str "re-com.box" :ns 're-com.box :sort 0}
@ -25,7 +26,9 @@
(rf/dispatch [:settings/selected-tab selected-tab])
(rf/dispatch [:settings/set-ignored-events ignored-events])
(rf/dispatch [:settings/set-filtered-view-trace filtered-view-trace])
(rf/dispatch [:settings/set-low-level-trace low-level-trace])
(rf/dispatch [:settings/set-number-of-retained-epochs num-epochs])
(rf/dispatch [:settings/debug? debug?])
(when external-window?
(rf/dispatch [:global/launch-external]))
(rf/dispatch [:traces/filter-items filter-items])

163
src/day8/re_frame/trace/events.cljs
View File

@ -2,7 +2,7 @@
(:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[mranderson047.reagent.v0v8v0-alpha2.reagent.core :as r]
[cljs.tools.reader.edn]
[day8.re-frame.trace.utils.utils :as utils]
[day8.re-frame.trace.utils.utils :as utils :refer [spy]]
[day8.re-frame.trace.utils.localstorage :as localstorage]
[clojure.string :as str]
[goog.object]
@ -14,13 +14,6 @@
[day8.re-frame.trace.metamorphic :as metam]
[re-frame.trace]))
(def default-number-of-epochs-to-retain 5)
(defonce traces (r/atom []))
(defonce total-traces (r/atom 0))
(defonce number-of-epochs-to-retain (atom default-number-of-epochs-to-retain))
(defonce events-to-ignore (atom #{}))
(defn log-trace? [trace]
(let [render-operation? (or (= (:op-type trace) :render)
(= (:op-type trace) :componentWillUnmount))
@ -33,33 +26,7 @@
(re-frame.trace/remove-trace-cb ::cb))
(defn enable-tracing! []
(re-frame.trace/register-trace-cb ::cb (fn [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 (< 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))))
;; TODO: there is a bit of double handling here with retaining the last n epochs,
;; that will be cleaned up when the epoch parsing is refactored.
(let [matches (:matches (metam/parse-traces @traces))
matches (remove (fn [match]
(let [event (get-in (metam/matched-event match) [:tags :event])]
(contains? @events-to-ignore (first event)))) matches)
retained-epochs (take-last @number-of-epochs-to-retain matches)
first-id-to-retain (:id (ffirst retained-epochs))
new-traces (into [] (drop-while #(< (:id %) first-id-to-retain)) @traces)]
(reset! traces new-traces)
(reset! total-traces (count new-traces))
(rf/dispatch [:traces/update-traces new-traces])
(rf/dispatch [:epochs/update-epochs {:matches retained-epochs}]))))))
(re-frame.trace/register-trace-cb ::cb #(rf/dispatch [:epochs/receive-new-traces %])))
(defn dissoc-in
"Dissociates an entry from a nested associative structure returning a new
@ -110,13 +77,6 @@
(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 _]
@ -157,13 +117,12 @@
(let [num (js/parseInt num-str)
num (if (and (not (js/isNaN num)) (pos-int? num))
num
default-number-of-epochs-to-retain)]
(reset! number-of-epochs-to-retain num)
5)]
(localstorage/save! "retained-epochs" num)
(assoc-in db [:settings :number-of-epochs] num))))
(def ignored-event-mw
[(rf/path [:settings :ignored-events]) (rf/after #(localstorage/save! "ignored-events" %)) (rf/after #(reset! events-to-ignore (->> % vals (map :event-id) set)))])
[(rf/path [:settings :ignored-events]) (rf/after #(localstorage/save! "ignored-events" %))])
(rf/reg-event-db
:settings/add-ignored-event
@ -226,36 +185,49 @@
(fn [_ [_ ignored-events]]
ignored-events))
(def low-level-trace-mw [(rf/path [:settings :low-level-trace]) (rf/after #(localstorage/save! "low-level-trace" %))])
(rf/reg-event-db
:settings/set-low-level-trace
low-level-trace-mw
(fn [_ [_ low-level]]
low-level))
(rf/reg-event-db
:settings/low-level-trace
[(rf/path [:settings :low-level-trace])]
low-level-trace-mw
(fn [low-level [_ trace-type capture?]]
(assoc low-level trace-type capture?)))
(rf/reg-event-db
:settings/debug?
(fn [db [_ debug?]]
(assoc-in db [:settings :debug?] debug?)))
;; Global
(defn mount [popup-window popup-document]
(let [app (.getElementById popup-document " --re-frame-trace-- ")
(let [app (.getElementById popup-document "--re-frame-trace--")
doc js/document]
(styles/inject-trace-styles popup-document)
(goog.object/set popup-window " onunload " #(rf/dispatch [:global/external-closed]))
(goog.object/set popup-window "onunload" #(rf/dispatch [:global/external-closed]))
(r/render
[(r/create-class
{:display-name " devtools outer external "
{:display-name "devtools outer external"
:reagent-render (fn []
[container/devtools-inner traces {:panel-type :popup}
])})]
[container/devtools-inner {:panel-type :popup}])})]
app)))
(defn open-debugger-window
" Copied from re-frisk.devtool/open-debugger-window "
"Copied from re-frisk.devtool/open-debugger-window"
[]
(let [{:keys [ext_height ext_width]} (:prefs {})
w (js/window.open " " " Debugger " (str " width= " (or ext_width 800) ", height= " (or ext_height 800)
", resizable=yes, scrollbars=yes, status=no, directories=no, toolbar=no, menubar=no "))
w (js/window.open "" "Debugger" (str "width=" (or ext_width 800) ",height=" (or ext_height 800)
",resizable=yes,scrollbars=yes,status=no,directories=no,toolbar=no,menubar=no"))
d (.-document w)]
(.open d)
(.write d " <head></head><body style= \"margin: 0px ;\"><div id=\"--re-frame-trace--\" class=\"external-window\"></div></body>")
(.write d "<head></head><body style=\"margin: 0px;\"><div id=\"--re-frame-trace--\" class=\"external-window\"></div></body>")
(goog.object/set w "onload" #(mount w d))
(.close d)))
@ -521,17 +493,70 @@
(defn first-match-id
[m]
(-> m first :id))
(-> m :match-info first :id))
(rf/reg-event-db
:epochs/update-epochs
[(rf/path [:epochs])]
(fn [epochs [_ rt]]
(let [matches (:matches rt)]
(assoc epochs
:matches matches
:matches-by-id (into {} (map (juxt first-match-id identity)) matches)
:match-ids (mapv first-match-id matches)))))
:epochs/receive-new-traces
(fn [db [_ new-traces]]
(if-let [filtered-traces (->> (filter log-trace? new-traces)
(sort-by :id))]
(let [number-of-epochs-to-retain (get-in db [:settings :number-of-epochs])
events-to-ignore (->> (get-in db [:settings :ignored-events]) vals (map :event-id) set)
previous-traces (get-in db [:traces :all-traces] [])
parse-state (get-in db [:epochs :parse-state] metam/initial-parse-state)
{drop-re-frame :re-frame drop-reagent :reagent} (get-in db [:settings :low-level-trace])
all-traces (reduce conj previous-traces filtered-traces)
parse-state (metam/parse-traces parse-state filtered-traces)
new-matches (:partitions parse-state)
previous-matches (get-in db [:epochs :matches] [])
parse-state (assoc parse-state :partitions []) ;; Remove matches we know about
new-matches (remove (fn [match]
(let [event (get-in (metam/matched-event match) [:tags :event])]
(contains? events-to-ignore (first event)))) new-matches)
;; subscription-info is calculated separately from subscription-match-state because they serve different purposes:
;; - subscription-info collects all the data that we know about the subscription itself, like its layer, inputs and other
;; things that are defined as part of the reg-sub.
;; - subscription-match-state collects all the data that we know about the state of specific instances of subscriptions
;; like its reagent id, when it was created, run, disposed, what values it returned, e.t.c.
subscription-info (metam/subscription-info (get-in db [:epochs :subscription-info] {}) filtered-traces (get-in db [:app-db :reagent-id]))
sub-state (get-in db [:epochs :sub-state] {})
subscription-match-state (metam/subscription-match-state sub-state filtered-traces new-matches)
subscription-matches (rest subscription-match-state)
new-sub-state (last subscription-match-state)
timing (mapv (fn [match]
(let [epoch-traces (into []
(comp
(utils/id-between-xf (:id (first match)) (:id (last match))))
filtered-traces)
start-of-epoch (nth epoch-traces 0)
finish-run (or (first (filter metam/finish-run? epoch-traces))
(utils/last-in-vec epoch-traces))]
{:re-frame/event-time (metam/elapsed-time start-of-epoch finish-run)}))
new-matches)
new-matches (map (fn [match sub-match t] {:match-info match
:sub-state sub-match
:timing t})
new-matches subscription-matches timing)
all-matches (reduce conj previous-matches new-matches)
retained-matches (into [] (take-last number-of-epochs-to-retain all-matches))
first-id-to-retain (first-match-id (first retained-matches))
retained-traces (into [] (comp (drop-while #(< (:id %) first-id-to-retain))
(remove (fn [trace]
(or (when drop-reagent (metam/low-level-reagent-trace? trace))
(when drop-re-frame (metam/low-level-re-frame-trace? trace)))))) all-traces)]
(-> db
(assoc-in [:traces :all-traces] retained-traces)
(update :epochs (fn [epochs]
(assoc epochs
:matches retained-matches
:matches-by-id (into {} (map (juxt first-match-id identity)) retained-matches)
:match-ids (mapv first-match-id retained-matches)
:parse-state parse-state
:sub-state new-sub-state
:subscription-info subscription-info)))))
;; Else
db)))
(rf/reg-event-fx
:epochs/previous-epoch
@ -563,20 +588,12 @@
:epochs/reset
(fn [db]
(re-frame.trace/reset-tracing!)
(reset! traces [])
(reset! total-traces 0)
(dissoc db :epochs :traces)))
(rf/reg-event-db
:traces/update-traces
[(rf/path [:traces :all-traces])]
(fn [_ [_ traces]]
traces))
;;
(rf/reg-event-db
:subs/ignore-unchanged-subs?
:subs/ignore-unchanged-l2-subs?
[(rf/path [:subs :ignore-unchanged-subs?])]
(fn [_ [_ ignore?]]
ignore?))

168
src/day8/re_frame/trace/metamorphic.cljc
View File

@ -1,5 +1,10 @@
(ns day8.re-frame.trace.metamorphic
(:require [mranderson047.re-frame.v0v10v2.re-frame.utils :as utils]))
(ns day8.re-frame.trace.metamorphic)
(defn id-between-xf
;; Copied here because I got undeclared Var warnings from figwheel when requiring a CLJC utils ns.
"Returns a transducer that filters for :id between beginning and ending."
[beginning ending]
(filter #(<= beginning (:id %) ending)))
;; What starts an epoch?
@ -69,7 +74,7 @@
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))))))
:clj (Math/round ^double (- end-of-epoch start-of-epoch))))))
(defn run-queue? [event]
(and (fsm-trigger? event)
@ -85,8 +90,7 @@
(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])))
(update :tags dissoc :app-db-before :app-db-after :effects :coeffects :interceptors)))
(defn summarise-match [match]
@ -142,16 +146,28 @@
(defn subscription-not-run? [trace]
false)
(defn low-level-re-frame-trace?
"Is this part of re-frame internals?"
[trace]
(case (:op-type trace)
(:re-frame.router/fsm-trigger) true
false))
(defn low-level-reagent-trace?
"Is this part of reagent internals?"
[trace]
(= :componentWillUnmount (:op-type trace)))
(defn render? [trace]
(= :render (:op-type trace)))
(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))))
(and (contains? sub :previous-value)
(contains? sub :value)
(= (:previous-value sub) (:value sub)))))
(defn finish-run? [event]
@ -185,52 +201,114 @@
(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
(def initial-parse-state
{:current-match nil
:previous-event nil
:partitions []})
;; 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)
(defn parse-traces [parse-state traces]
(reduce
(fn [state event]
(let [current-match (:current-match state)
previous-event (:previous-event state)
no-match? (nil? current-match)]
(-> (cond
;; 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))
;; 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 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]))
;; 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))
(event-run? event)
(update state :current-match conj event)
;; 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?
: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}))
)
(assoc :previous-event event))))
parse-state
traces))
(defn matched-event [match]
(->> match
(filter event-run?)
(first)))
(defn subscription-info
"Collect information about the subscription that we'd like
to know, like its layer."
[initial-state filtered-traces app-db-id]
(->> filtered-traces
(filter subscription-re-run?)
(reduce (fn [state trace]
;; Can we take any shortcuts by assuming that a sub with
;; multiple input signals is a layer 3? I don't *think* so because
;; one of those input signals could be a naughty subscription to app-db
;; directly.
;; If we knew when subscription handlers were loaded/reloaded then
;; we could avoid doing most of this work, and only check the input
;; signals if we hadn't seen it before, or it had been reloaded.
(assoc-in state
[(:operation trace) :layer]
;; If any of the input signals are app-db, it is a layer 2 sub, else 3
(if (some #(= app-db-id %) (get-in trace [:tags :input-signals]))
2
3)))
initial-state)))
(defn subscription-match-state
"Build up the state of re-frame's running subscriptions over each matched epoch.
Returns initial state as first item in list"
[sub-state filtered-traces new-matches]
(reductions (fn [state match]
(let [epoch-traces (into []
(comp
(id-between-xf (:id (first match)) (:id (last match)))
(filter subscription?))
filtered-traces)
reset-state (into {}
(comp
(filter (fn [me] (when-not (:disposed? (val me)) me)))
(map (fn [[k v]]
[k (dissoc v :order :created? :run? :disposed? :previous-value)])))
state)]
(->> epoch-traces
(reduce (fn [state trace]
(let [tags (get trace :tags)
reaction-id (:reaction tags)]
(case (:op-type trace)
:sub/create (assoc state reaction-id {:created? true
:subscription (:query-v tags)
:order [:sub/create]})
:sub/run (update state reaction-id (fn [sub-state]
(-> (if (contains? sub-state :value)
(assoc sub-state :previous-value (:value sub-state))
sub-state)
(assoc :run? true
:value (:value tags))
(update :order (fnil conj []) :sub/run))))
:sub/dispose (-> (assoc-in state [reaction-id :disposed?] true)
(update-in [reaction-id :order] (fnil conj []) :sub/dispose))
(do #?(:cljs (js/console.warn "Unhandled sub trace, this is a bug, report to re-frame-trace please" trace))
state))))
reset-state))))
sub-state
new-matches))

21
src/day8/re_frame/trace/styles.cljs
View File

@ -1,15 +1,14 @@
(ns day8.re-frame.trace.styles
(:require-macros [day8.re-frame.trace.utils.macros :as macros])
(:require [garden.core :as garden]
[garden.units :refer [em px percent]]
[garden.color :as color]
[garden.selectors :as s]
(:require [mranderson047.garden.v1v3v3.garden.core :as garden]
[mranderson047.garden.v1v3v3.garden.units :refer [em px percent]]
[mranderson047.garden.v1v3v3.garden.color :as color]
[mranderson047.garden.v1v3v3.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.view.app-db :as app-db]
[cljs.spec.alpha :as spec]
[day8.re-frame.trace.view.timing :as timing]
[day8.re-frame.trace.view.settings :as settings]))
[day8.re-frame.trace.view.settings :as settings]
[day8.re-frame.trace.view.event :as event]))
(def background-gray common/background-gray)
(def background-gray-hint common/background-gray-hint)
@ -408,12 +407,13 @@
[:.toggle {:color text-color-muted
:cursor "pointer"
:line-height 1}]
["> span" {:vertical-align "text-top"}]]
["> span" {:vertical-align "text-top"}]
[:li {:margin 0}]]
[:.host-closed {:font-size (em 4)
:background-color (color/rgba 255 255 0 0.8)}]
[:.expansion-button {:font-family "sans-serif"
:width (px 16)
:padding "0 2px"
:padding [[0 common/expansion-button-horizontal-padding]]
:vertical-align "middle"}]
[:.bm-muted-button {:font-size "14px"
:height "23px"
@ -433,9 +433,8 @@
re-frame-trace-styles
app-db/app-db-styles
timing/timing-styles
event/event-styles
settings/settings-styles]))
;(def panel-styles (macros/slurp-macro "day8/re_frame/trace/main.css"))
(defn inject-style [document id style]
(let [styles-el (.getElementById document id)

127
src/day8/re_frame/trace/subs.cljs
View File

@ -61,6 +61,12 @@
(fn [settings]
(:low-level-trace settings)))
(rf/reg-sub
:settings/debug?
:<- [:settings/root]
(fn [settings]
(:debug? settings)))
;; App DB
(rf/reg-sub
@ -145,28 +151,36 @@
(fn [traces _]
(count traces)))
(rf/reg-sub
:traces/all-visible-traces
:<- [:traces/all-traces]
:<- [:settings/filtered-view-trace]
(fn [[all-traces filtered-views] _]
(let [munged-ns (->> filtered-views
(map (comp munge :ns-str))
(set))]
(into []
;; Filter out view namespaces we don't care about.
(remove
(fn [trace] (and (metam/render? trace)
(contains? munged-ns (subs (:operation trace) 0 (str/last-index-of (:operation trace) "."))))))
all-traces))))
(rf/reg-sub
:traces/current-event-traces
:<- [:traces/all-visible-traces]
:<- [:traces/all-traces]
:<- [:epochs/beginning-trace-id]
:<- [:epochs/ending-trace-id]
(fn [[traces beginning ending] _]
(into [] (filter #(<= beginning (:id %) ending)) traces)))
(into [] (utils/id-between-xf beginning ending) traces)))
(defn filter-ignored-views [[traces filtered-views] _]
(let [munged-ns (->> filtered-views
(map (comp munge :ns-str))
(set))]
(into []
;; Filter out view namespaces we don't care about.
(remove
(fn [trace] (and (metam/render? trace)
(contains? munged-ns (subs (:operation trace) 0 (str/last-index-of (:operation trace) "."))))))
traces)))
(rf/reg-sub
:traces/current-event-visible-traces
:<- [:traces/current-event-traces]
:<- [:settings/filtered-view-trace]
filter-ignored-views)
(rf/reg-sub
:traces/all-visible-traces
:<- [:traces/all-traces]
:<- [:settings/filtered-view-trace]
filter-ignored-views)
(rf/reg-sub
:traces/show-epoch-traces?
@ -202,7 +216,7 @@
(:epochs db)))
(rf/reg-sub
:epochs/current-match
:epochs/current-match-state
:<- [:epochs/epoch-root]
:<- [:epochs/match-ids]
(fn [[epochs match-ids] _]
@ -216,6 +230,12 @@
:else (get (:matches-by-id epochs) current-id))]
match)))
(rf/reg-sub
:epochs/current-match
:<- [:epochs/current-match-state]
(fn [match-state _]
(:match-info match-state)))
(rf/reg-sub
:epochs/current-event-trace
:<- [:epochs/current-match]
@ -314,15 +334,11 @@
[start end] (first (drop (dec frame-number) frames))]
(metam/elapsed-time start end))))
(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))))
:<- [:epochs/current-match-state]
(fn [match]
(get-in match [:timing :re-frame/event-time])))
(rf/reg-sub
:timing/render-time
@ -351,6 +367,24 @@
(fn [traces]
(filter metam/subscription? traces)))
(rf/reg-sub
:subs/subscription-info
:<- [:epochs/epoch-root]
(fn [epoch]
(:subscription-info epoch)))
(rf/reg-sub
:subs/sub-state
:<- [:epochs/epoch-root]
(fn [epochs]
(:sub-state epochs)))
(rf/reg-sub
:subs/current-epoch-sub-state
:<- [:epochs/current-match-state]
(fn [match-state]
(:sub-state match-state)))
(defn sub-sort-val
[sub]
(case (:type sub)
@ -375,23 +409,28 @@
: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
}))
:<- [:subs/subscription-info]
:<- [:subs/current-epoch-sub-state]
(fn [[traces app-db-id sub-info sub-state]]
(let [raw (map (fn [trace]
(let [pod-type (sub-op-type->type trace)
path-data (get-in trace [:tags :query-v])
reagent-id (get-in trace [:tags :reaction])
sub (-> {:id (str pod-type reagent-id)
:reagent-id reagent-id
:type pod-type
:layer (get-in sub-info [(:operation trace) :layer])
:path-data path-data
:path (pr-str path-data)
;; TODO: Get not run subscriptions
})
sub (if (contains? (:tags trace) :value)
(assoc sub :value (get-in trace [:tags :value]))
sub)
sub (if (contains? (get sub-state reagent-id) :previous-value)
(assoc sub :previous-value (get-in sub-state [reagent-id :previous-value]))
sub)]
sub))
traces)
re-run (->> raw
(filter #(= :re-run (:type %)))
@ -425,7 +464,7 @@
(rf/reg-sub
:subs/visible-subs
:<- [:subs/all-subs]
:<- [:subs/ignore-unchanged-subs?]
:<- [:subs/ignore-unchanged-l2-subs?]
(fn [[all-subs ignore-unchanged-l2?]]
(if ignore-unchanged-l2?
(remove metam/unchanged-l2-subscription? all-subs)
@ -470,7 +509,7 @@
(count (filter metam/unchanged-l2-subscription? subs))))
(rf/reg-sub
:subs/ignore-unchanged-subs?
:subs/ignore-unchanged-l2-subs?
:<- [:subs/root]
(fn [subs _]
(:ignore-unchanged-subs? subs true)))

4
src/day8/re_frame/trace/utils/localstorage.cljs
View File

@ -1,6 +1,6 @@
(ns day8.re-frame.trace.utils.localstorage
(:require [goog.storage.Storage :as Storage]
[goog.storage.mechanism.HTML5LocalStorage :as html5localstore]
(:require [goog.storage.Storage]
[goog.storage.mechanism.HTML5LocalStorage]
[cljs.reader :as reader]
[clojure.string :as str])
(:refer-clojure :exclude [get]))

8
src/day8/re_frame/trace/utils/re_com.cljs
View File

@ -510,6 +510,14 @@
:align :start
:child the-button]))))
(defn link [{:keys [label href]}]
[:a
{:rel "noopener noreferrer"
:class "rc-hyperlink-href noselect "
:href href
:target "_blank"}
label])
(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]

31
src/day8/re_frame/trace/utils/utils.cljs
View File

@ -16,3 +16,34 @@
"Gets the index of the first item in vec that matches the predicate"
[pred v]
(first (find-all-indexes-in-vec pred v)))
(defn id-between-xf
"Returns a transducer that filters for :id between beginning and ending."
[beginning ending]
(filter #(<= beginning (:id %) ending)))
(defn spy
([x]
(js/console.log x)
x)
([label x]
(js/console.log label x)
x))
(defn pluralize
"Return a pluralized phrase, appending an s to the singular form if no plural is provided.
For example:
(pluralize 5 \"month\") => \"5 months\"
(pluralize 1 \"month\") => \"1 month\"
(pluralize 1 \"radius\" \"radii\") => \"1 radius\"
(pluralize 9 \"radius\" \"radii\") => \"9 radii\"
From https://github.com/flatland/useful/blob/194950/src/flatland/useful/string.clj#L25-L33"
[num singular & [plural]]
(str num " " (if (= 1 num) singular (or plural (str singular "s")))))
(defn pluralize-
"Same as pluralize, but doesn't prepend the number to the pluralized string."
[num singular & [plural]]
(if (= 1 num)
singular
(or plural (str singular "s"))))

83
src/day8/re_frame/trace/view/app_db.cljs
View File

@ -46,7 +46,7 @@
:border-bottom-right-radius border-radius}]
[:.app-db-path--header
{:background-color "#797B7B" ; Name this navbar tint-lighter
{:background-color common/navbar-tint-lighter
:color "white"
:height common/gs-31
:border-top-left-radius border-radius
@ -107,6 +107,7 @@
:justify :between
:align :center
:margin (css-join common/gs-19s "0px")
:style {:flex-flow "row wrap"}
:children [[rc/button
:class "bm-muted-button app-db-panel-button"
:label [rc/v-box
@ -196,11 +197,7 @@
(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)))]
app-db-after (rf/subscribe [:app-db/current-epoch-app-db-after])]
[rc/v-box
:style {:margin-bottom pod-gap
:margin-right "1px"}
@ -241,41 +238,45 @@
:leave-animation "accordionVertical"
:duration animation-duration})
(when render-diff?
[rc/v-box
:children [[rc/v-box
:class "app-db-path--link"
:justify :end
:children [[rc/hyperlink-href
;:class "app-db-path--label"
:label "ONLY BEFORE"
:style {:margin-left common/gs-7s}
:attr {:rel "noopener noreferrer"}
:target "_blank"
:href utils/diff-link]]]
[rc/v-box
:class "data-viewer data-viewer--top-rule"
:style {:overflow-x "auto"
:overflow-y "hidden"}
:children [[components/simple-render
diff-before
["app-db-diff" path]]]]
[rc/v-box
:class "app-db-path--link"
:justify :end
:children [[rc/hyperlink-href
;:class "app-db-path--label"
:label "ONLY AFTER"
:style {:margin-left common/gs-7s}
:attr {:rel "noopener noreferrer"}
:target "_blank"
:href utils/diff-link]]]
[rc/v-box
:class "data-viewer data-viewer--top-rule rounded-bottom"
:style {:overflow-x "auto"
:overflow-y "hidden"}
:children [[components/simple-render
diff-after
["app-db-diff" path]]]]]])]
(let [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
:children [[rc/v-box
:class "app-db-path--link"
:justify :end
:children [[rc/hyperlink-href
;:class "app-db-path--label"
:label "ONLY BEFORE"
:style {:margin-left common/gs-7s}
:attr {:rel "noopener noreferrer"}
:target "_blank"
:href utils/diff-link]]]
[rc/v-box
:class "data-viewer data-viewer--top-rule"
:style {:overflow-x "auto"
:overflow-y "hidden"}
:children [[components/simple-render
diff-before
["app-db-diff" path]]]]
[rc/v-box
:class "app-db-path--link"
:justify :end
:children [[rc/hyperlink-href
;:class "app-db-path--label"
:label "ONLY AFTER"
:style {:margin-left common/gs-7s}
:attr {:rel "noopener noreferrer"}
:target "_blank"
:href utils/diff-link]]]
[rc/v-box
:class "data-viewer data-viewer--top-rule rounded-bottom"
:style {:overflow-x "auto"
:overflow-y "hidden"}
:children [[components/simple-render
diff-after
["app-db-diff" path]]]]]]))]
(when open?
[rc/gap-f :size pod-padding])]]]]))

8
src/day8/re_frame/trace/view/components.cljs
View File

@ -2,7 +2,6 @@
(: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]
[mranderson047.reagent.v0v8v0-alpha2.reagent.core :as r])
@ -209,12 +208,13 @@
(nil? data))) [:div {:style {:margin "10px 0"}} (prn-str data)]
@expanded? (jsonml->hiccup (cljs-devtools-header data) (conj path 0)))]])))
(defn simple-render [data path]
(defn simple-render [data path & [class]]
(let [expanded? (r/atom true) #_(rf/subscribe [:app-db/node-expanded? path])]
(fn [data]
[:div
{:class (str/join " " ["re-frame-trace--object"
(when @expanded? "expanded")])}
(when @expanded? "expanded")
class])}
#_[:span {:class "toggle"
:on-click #(rf/dispatch [:app-db/toggle-expansion path])}
[:button.expansion-button (if @expanded? "▼ " "▶ ")]]
@ -225,7 +225,7 @@
(number? data)
(boolean? data)
(nil? data))) [:div {:style {:margin "10px 0"}} (prn-str data)]
@expanded? (jsonml->hiccup (cljs-devtools-header data) (conj [] 0)))]])))
@expanded? (jsonml->hiccup (cljs-devtools-header data) (conj path 0)))]])))
(defn tag [class label]
[rc/box

16
src/day8/re_frame/trace/view/container.cljs
View File

@ -10,8 +10,8 @@
[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]]
[mranderson047.garden.v1v3v3.garden.core :refer [css style]]
[mranderson047.garden.v1v3v3.garden.units :refer [px]]
[re-frame.trace]
[day8.re-frame.trace.utils.re-com :as rc]
[day8.re-frame.trace.common-styles :as common]))
@ -108,7 +108,7 @@
[rc/line :size "2px" :color common/sidebar-heading-divider-color]
[right-hand-buttons external-window?]]))
(defn devtools-inner [traces opts]
(defn devtools-inner [opts]
(let [selected-tab (rf/subscribe [:settings/selected-tab])
panel-type (:panel-type opts)
external-window? (= panel-type :popup)
@ -133,9 +133,7 @@
:gap "7px"
:align :end
:height "50px"
;; TODO: event tab
:children [(when (:debug? opts)
(tab-button :event "Event"))
:children [(tab-button :event "Event")
(tab-button :app-db "app-db")
(tab-button :subs "Subs")
;(tab-button :views "Views")
@ -151,16 +149,16 @@
[rc/v-box
:size "auto"
:style {:margin-left common/gs-19s
:overflow-y (if (contains? #{:timing :debug} @selected-tab)
:overflow-y (if (contains? #{:timing :debug :event} @selected-tab)
"auto" "initial")
;:overflow "auto" ;; TODO: Might have to put this back or add scrolling within the panels
}
:children [(case @selected-tab
:event [event/render traces]
:event [event/render]
:app-db [app-db/render db/app-db]
:subs [subs/render]
:views [views/render]
:traces [traces/render traces]
:traces [traces/render]
:timing [timing/render]
:debug [debug/render]
:settings [settings/render]

13
src/day8/re_frame/trace/view/debug.cljs
View File

@ -1,5 +1,6 @@
(ns day8.re-frame.trace.view.debug
(:require [day8.re-frame.trace.utils.re-com :as rc]
[day8.re-frame.trace.view.components :as components]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[day8.re-frame.trace.metamorphic :as metam]))
@ -14,16 +15,20 @@
[rc/label :label (str "Ending " (prn-str @(rf/subscribe [:epochs/ending-trace-id])))]
[rc/label :label (str "Current epoch ID " (prn-str @(rf/subscribe [:epochs/current-epoch-id])))]
[:h2 "Subscriptions"]
[components/simple-render @(rf/subscribe [:subs/sub-state]) ["debug-subs"]]
[rc/label :label "Epochs"]
(let [current-match @(rf/subscribe [:epochs/current-match])]
(for [match (:matches @(rf/subscribe [:epochs/epoch-root]))]
^{:key (:id (first match))}
(for [match (:matches @(rf/subscribe [:epochs/epoch-root]))
:let [match-info (:match-info match)]]
^{:key (:id (first match-info))}
[rc/v-box
:style {:border "1px solid black"
:font-weight (if (= current-match match)
:font-weight (if (= current-match match-info)
"bold"
"normal")}
:children (doall (map (fn [event] [rc/label :label (prn-str event)]) (metam/summarise-match match)))
:children (doall (map (fn [event] [rc/label :label (prn-str event)]) (metam/summarise-match match-info)))
]))
]]
)

58
src/day8/re_frame/trace/view/event.cljs
View File

@ -1,19 +1,49 @@
(ns day8.re-frame.trace.view.event
(:require [day8.re-frame.trace.utils.re-com :as rc]
[day8.re-frame.trace.metamorphic :as metam]))
[day8.re-frame.trace.view.components :as components]
[day8.re-frame.trace.common-styles :as common]
[mranderson047.garden.v1v3v3.garden.units :as units]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf])
(:require-macros [day8.re-frame.trace.utils.macros :refer [with-cljs-devtools-prefs]]))
(defn render [traces]
(def pod-border-color "#daddde")
(def pod-border-edge (str "1px solid " pod-border-color))
(def border-radius "3px")
(def event-styles
[:#--re-frame-trace--
[:.event-panel
{:padding "39px 19px 0px 0px"}]
[:.event-section]
[:.event-section--header
{:background-color common/navbar-tint-lighter
:color common/navbar-text-color
:height common/gs-19
:font-size "14px"
:padding [[0 common/gs-12]]
}]
[:.event-section--data
{:background-color "rgba(100, 255, 100, 0.08)"
:padding-left (units/px- common/gs-12 common/expansion-button-horizontal-padding)
:overflow-x "auto"}]
])
(defn event-section [title data]
[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"]
:class "event-section"
:children
[[rc/h-box
:class "event-section--header app-db-path--header"
:align :center
:children [[:h2 title]]]
[rc/h-box
:children [[:p "Subs Run"] [:p "Created"] [:p "Destroyed"]]]
[:p "Views Rendered"]
[rc/h-box
:children [[:p "Timing"] [:p "Animation Frames"]]]
]])
[components/simple-render data [title] "event-section--data app-db-path--pod-border"]]])
(defn render []
(let [event-trace @(rf/subscribe [:epochs/current-event-trace])]
[rc/v-box
:class "event-panel"
:gap common/gs-19s
:children [[event-section "Coeffects" (get-in event-trace [:tags :coeffects])]
[event-section "Effects" (get-in event-trace [:tags :effects])]
[event-section "Interceptors" (get-in event-trace [:tags :interceptors])]]]))

10
src/day8/re_frame/trace/view/settings.cljs
View File

@ -1,10 +1,9 @@
(ns day8.re-frame.trace.view.settings
(:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[mranderson047.reagent.v0v8v0-alpha2.reagent.core :as r]
[day8.re-frame.trace.utils.re-com :as rc :refer [css-join]]
[day8.re-frame.trace.common-styles :as common]
[garden.units :as units]
[garden.compiler :refer [render-css]]))
[mranderson047.garden.v1v3v3.garden.units :as units]
[mranderson047.garden.v1v3v3.garden.compiler :refer [render-css]]))
(def comp-section-width "400px")
(def instruction--section-width "190px")
@ -149,9 +148,8 @@
[:p "Nominate one or more namespaces."]]
settings-box-131]
;; TODO: remove low level trace
#_[rc/line]
#_(let [low-level-trace @(rf/subscribe [:settings/low-level-trace])]
[rc/line]
(let [low-level-trace @(rf/subscribe [:settings/low-level-trace])]
[settings-box
[[rc/label :label "Remove low level trace"]
[rc/checkbox

260
src/day8/re_frame/trace/view/subs.cljs
View File

@ -20,10 +20,10 @@
(defn sub-tag-class [type]
(case type
:created "rft-tag__subscription_created"
:created "rft-tag__subscription_created"
:destroyed "rft-tag__subscription_destroyed"
:re-run "rft-tag__subscription_re_run"
:not-run "rft-tag__subscription_not_run"
:re-run "rft-tag__subscription_re_run"
:not-run "rft-tag__subscription_not_run"
""))
(def tag-types {:created {:long "CREATED" :short "CREATED"}
@ -45,9 +45,9 @@
(defn title-tag [type title label]
[rc/v-box
:class "noselect"
:align :center
:gap "2px"
:class "noselect"
:align :center
:gap "2px"
:children [[:span {:style {:font-size "9px"}} title]
[components/tag (sub-tag-class type) label]]])
@ -56,11 +56,12 @@
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-subs? (rf/subscribe [:subs/ignore-unchanged-l2-subs?])
ignore-unchanged-l2-count (rf/subscribe [:subs/unchanged-l2-subs-count])]
[rc/h-box
:justify :between
:align :center
:style {:flex-flow "row wrap"}
:margin (css-join common/gs-19s "0px")
:children [[rc/h-box
:align :center
@ -88,59 +89,57 @@
:border "1px solid #e3e9ed"
:border-radius border-radius}
:children [[rc/checkbox
:model ignore-unchanged?
;; TODO: change from l2 subs to ignored l2 subs
:label [:span "Ignore " [:b {:style {:font-weight "700"}} @ignore-unchanged-l2-count] #_ " unchanged" [:br] "layer 2 subs "
[:a
{:rel "noopener noreferrer"
:class "rc-hyperlink-href noselect "
:href "https://github.com/Day8/re-frame-trace/blob/master/docs/HyperlinkedInformation/UnchangedLayer2.md"
:target "_blank"}
"?"]]
:model ignore-unchanged-l2-subs?
:label [:span "Ignore " [:b {:style {:font-weight "700"}} @ignore-unchanged-l2-count] " unchanged" [:br]
[rc/link {:label (str "layer 2 " (utils/pluralize- @ignore-unchanged-l2-count "sub"))
:href "https://github.com/Day8/re-frame-trace/blob/master/docs/HyperlinkedInformation/UnchangedLayer2.md"}]]
:style {:margin-top "6px"}
:on-change #(rf/dispatch [:subs/ignore-unchanged-subs? %])]]]]]))
:on-change #(rf/dispatch [:subs/ignore-unchanged-l2-subs? %])]]]]]))
(defn pod-header [{:keys [id type layer path open? diff? run-times]}]
[rc/h-box
:class (str "app-db-path--header " (when-not open? "rounded-bottom"))
:align :center
:height common/gs-31s
:class (str "app-db-path--header " (when-not open? "rounded-bottom"))
:align :center
:height common/gs-31s
:children [[rc/box
:width "36px"
: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? "▼" "▶")]]]
: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
:width "64px" ;; (100-36)px from box above
:child [sub-tag type (short-tag-desc type)]]
;; TODO: report if a sub was run multiple times
#_(when run-times
[:span "Warning: run " run-times " times"])
[:span "Warning: run " run-times " times"])
[rc/h-box
:class "app-db-path--path-header"
:size "auto"
:class "app-db-path--path-header"
:size "auto"
: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
:width "100%"
:model path
:disabled? true]]]
(when @(rf/subscribe [:settings/debug?])
[rc/label :label (str id)])
[rc/gap-f :size common/gs-12s]
[rc/label :label (str "Layer " layer)]
[rc/label :label (if (some? layer)
(str "Layer " layer)
[rc/link {:label "Layer ?"
:href "https://github.com/Day8/re-frame-trace/blob/master/docs/HyperlinkedInformation/UnchangedLayer2.md#why-do-i-sometimes-see-layer--when-viewing-a-subscription"}])]
;; TODO: capture previous sub run value and allow diffing it.
#_[rc/gap-f :size common/gs-12s]
#_[rc/box
[rc/gap-f :size common/gs-12s]
[rc/box
:class "bm-muted-button app-db-path--button noselect"
:attr {:title "Show diff"
:on-click #(when open? (rf/dispatch [:subs/diff-pod? id (not diff?)]))}
:attr {:title "Show diff"
:on-click #(when open? (rf/dispatch [:subs/diff-pod? id (not diff?)]))}
:child [:img
{:src (str "data:image/svg+xml;utf8," copy)
:style {:width "19px"
@ -148,82 +147,99 @@
[rc/gap-f :size common/gs-12s]]])
(defn pod [{:keys [id type layer 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)))]
(let [render-diff? (and open? diff?)
value? (contains? pod-info :value)
previous-value? (contains? pod-info :previous-value)]
[rc/v-box
:style {:margin-bottom pod-gap
:margin-right "1px"}
:style {:margin-bottom pod-gap
:margin-right "1px"}
:children [[pod-header pod-info]
[rc/v-box
:class (when open? "app-db-path--pod-border")
:class (when open? "app-db-path--pod-border")
:children [[animated/component
(animated/v-box-options {:enter-animation "accordionVertical"
:leave-animation "accordionVertical"
:duration animation-duration})
(when open?
[rc/v-box
:class (str "data-viewer" (when-not diff? " rounded-bottom"))
:style {:margin (css-join pod-padding pod-padding "0px" pod-padding)
:overflow-x "auto"
:overflow-y "hidden"}
:children [[components/simple-render
(:value pod-info)]]])]
(let [main-value (cond value? (:value pod-info)
previous-value? (:previous-value pod-info)
:else nil)]
[rc/v-box
:class (str "data-viewer" (when-not diff? " rounded-bottom"))
:style {:margin (css-join pod-padding pod-padding "0px" pod-padding)
:overflow-x "auto"
:overflow-y "hidden"}
:children [(if (or value? previous-value?)
[components/simple-render
main-value
["sub-path" path]]
[rc/label :style {:font-style "italic"} :label "Subscription not run, so no value produced."]
)]]))]
[animated/component
(animated/v-box-options {:enter-animation "accordionVertical"
:leave-animation "accordionVertical"
:duration animation-duration})
(when render-diff?
[rc/v-box
:children [[rc/v-box
:class "app-db-path--link"
:justify :end
:children [[rc/hyperlink-href
;:class "app-db-path--label"
:label "ONLY BEFORE"
:style {:margin-left common/gs-7s}
:attr {:rel "noopener noreferrer"}
:target "_blank"
:href utils/diff-link]]]
[rc/v-box
:class "data-viewer data-viewer--top-rule"
:style {:overflow-x "auto"
:overflow-y "hidden"}
:height "50px"
:children ["---before-diff---"]]
[rc/v-box
:class "app-db-path--link"
:justify :end
:children [[rc/hyperlink-href
;:class "app-db-path--label"
:label "ONLY AFTER"
:style {:margin-left common/gs-7s}
:attr {:rel "noopener noreferrer"}
:target "_blank"
:href utils/diff-link]]]
[rc/v-box
:class "data-viewer data-viewer--top-rule rounded-bottom"
:style {:overflow-x "auto"
:overflow-y "hidden"}
:height "50px"
:children ["---after-diff---"]]]])]
(let [diffable? (and value? previous-value?)
[diff-before diff-after _] (when render-diff?
(clojure.data/diff (:previous-value pod-info)
(:value pod-info)))]
[rc/v-box
:children [[rc/v-box
:class "app-db-path--link"
:justify :end
:children [[rc/hyperlink-href
;:class "app-db-path--label"
:label "ONLY BEFORE"
:style {:margin-left common/gs-7s}
:attr {:rel "noopener noreferrer"}
:target "_blank"
:href utils/diff-link]]]
[rc/v-box
:class "data-viewer data-viewer--top-rule"
:style {:overflow-x "auto"
:overflow-y "hidden"}
:children [(if diffable?
[components/simple-render
diff-before
["app-db-diff" path]]
[:p {:style {:font-style "italic"}} "No previous value exists to diff"])]]
[rc/v-box
:class "app-db-path--link"
:justify :end
:children [[rc/hyperlink-href
;:class "app-db-path--label"
:label "ONLY AFTER"
:style {:margin-left common/gs-7s}
:attr {:rel "noopener noreferrer"}
:target "_blank"
:href utils/diff-link]]]
[rc/v-box
:class "data-viewer data-viewer--top-rule rounded-bottom"
:style {:overflow-x "auto"
:overflow-y "hidden"}
:children [(if diffable?
[components/simple-render
diff-after
["app-db-diff" path]]
[:p {:style {:font-style "italic"}} "No previous value exists to diff"])]]]]))]
(when open?
[rc/gap-f :size pod-padding])]]]]))
(defn no-pods []
[rc/h-box
:margin (css-join "0px 0px 0px" common/gs-19s)
:gap common/gs-7s
:align :start
: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"]]])
: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])]
sub-expansions @(rf/subscribe [:subs/sub-expansions])
all-subs (if @(rf/subscribe [:settings/debug?])
(cons {:id "debug" :value @(rf/subscribe [:subs/current-epoch-sub-state])} all-subs)
all-subs)]
[rc/v-box
:size "1"
;:gap pod-gap
@ -240,48 +256,48 @@
[animated/component
(animated/v-box-options {:on-finish #(reset! *finished-animation? true)
:duration animation-duration
:style {:flex "1 1 0px"
:style {:flex "1 1 0px"
:overflow-x "hidden"
:overflow-y "auto"}})
(for [p all-subs]
^{:key (:id p)}
[pod (merge p (get sub-expansions (:id p)))])]]
]))
(defn render []
[]
[rc/v-box
:size "1"
:style {:margin-right common/gs-19s
;:overflow "hidden"
}
:size "1"
: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)]]]])
{: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)]]]])

6
src/day8/re_frame/trace/view/timing.cljs
View File

@ -1,12 +1,10 @@
(ns day8.re-frame.trace.view.timing
(:require [clojure.string :as str]
[devtools.prefs]
(:require [devtools.prefs]
[devtools.formatters.core]
[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]
[day8.re-frame.trace.view.components :as components])
(:require-macros [day8.re-frame.trace.utils.macros :as macros]))
[day8.re-frame.trace.view.components :as components]))
(def timing-styles
[:#--re-frame-trace--

12
src/day8/re_frame/trace/view/traces.cljs
View File

@ -1,11 +1,7 @@
(ns day8.re-frame.trace.view.traces
(:require [day8.re-frame.trace.view.components :as components]
[day8.re-frame.trace.utils.pretty-print-condensed :as pp]
[re-frame.trace :as trace]
[clojure.string :as str]
[day8.re-frame.trace.utils.localstorage :as localstorage]
[cljs.pprint :as pprint]
[clojure.set :as set]
[mranderson047.reagent.v0v8v0-alpha2.reagent.core :as r]
[mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
[day8.re-frame.trace.utils.re-com :as rc]))
@ -71,7 +67,7 @@
:tab-index 0}
[:td]
[:td.trace--details-tags {:col-span 2
:on-click #(.log js/console tags)}
:on-click #(.log js/console trace)}
[:div.trace--details-tags-text
(let [tag-str (prn-str tags)]
(str (subs tag-str 0 400)
@ -80,7 +76,7 @@
[:td.trace--meta.trace--details-icon
{:on-click #(.log js/console tags)}]]))))))))
(defn render [traces]
(defn render []
(let [filter-input (r/atom "")
filter-items (rf/subscribe [:traces/filter-items])
filter-type (r/atom :contains)
@ -89,8 +85,8 @@
trace-detail-expansions (rf/subscribe [:traces/expansions])
beginning (rf/subscribe [:epochs/beginning-trace-id])
end (rf/subscribe [:epochs/ending-trace-id])
traces (rf/subscribe [:traces/all-traces])
current-traces (rf/subscribe [:traces/current-event-traces])
traces (rf/subscribe [:traces/all-visible-traces])
current-traces (rf/subscribe [:traces/current-event-visible-traces])
show-epoch-traces? (rf/subscribe [:traces/show-epoch-traces?])]
(fn []
(let [toggle-category-fn #(rf/dispatch [:traces/toggle-categories %])

92
src/mranderson047/garden/v1v3v3/garden/arithmetic.cljc Normal file
View File

@ -0,0 +1,92 @@
(ns mranderson047.garden.v1v3v3.garden.arithmetic
"Generic arithmetic operators for computing sums, differences,
products, and quotients between CSSUnits, CSSColors, and numbers."
(:refer-clojure :exclude [+ - * /])
(:require [mranderson047.garden.v1v3v3.garden.units :as u :refer [unit?]]
[mranderson047.garden.v1v3v3.garden.color :as c :refer [color?]]))
;; The motivation for the functions in this namespace is the
;; contention that working with unit arithmetic functions (`px+`,
;; `px-`, etc.) and color arithmetic functions (`color+`, `color-`,
;; etc.) can at times be a bit unweildly. In some cases it would be
;; nice to have functions which could transparently perform unit and
;; color math without the verbosity.
;; Here, such functions are provided.
;; All operations favor `CSSUnit` and `CSSColor` types and fall back to
;; the standard `clojure.core` arithmetic functions. The preference for
;; this order stems from the assertion that it is far more likely unit
;; arithmetic will be performed in the context of a stylesheet versus
;; color or numeric.
(defn +
"Generic addition operator. Transparently computes the sum of
`CSSUnit`s,`CSSColor`s, and numbers."
([] 0)
([x] x)
([x y]
(cond
(unit? x) ((u/make-unit-adder (:unit x)) x y)
(color? x) (c/color+ x y)
:else (if (or (unit? y) (color? y))
(+ y x)
(clojure.core/+ x y))))
([x y & more]
(reduce + (+ x y) more)))
(defn -
"Generic subtraction operator. Transparently computes the difference
between `CSSUnit`s, `CSSColor`s, and numbers."
([x]
(cond
(unit? x) (update-in x [:magnitude] clojure.core/-)
;; Colors shouldn't have negative semantics.
(color? x) x
:else (clojure.core/- x)))
([x y]
(cond
(unit? x) ((u/make-unit-subtractor (:unit x)) x y)
(color? x) (c/color- x y)
:else (cond
(unit? y) (let [{m :magnitude} y]
(assoc y :magnitude (clojure.core/- x m)))
(color? y) (c/color- x y)
:else (clojure.core/- x y))))
([x y & more]
(reduce - (- x y) more)))
(defn *
"Generic multiplication operation. Transparently computes the product
between `CSSUnit`s, `CSSColor`s, and numbers."
([] 1)
([x] x)
([x y]
(cond
(unit? x) ((u/make-unit-multiplier (:unit x)) x y)
(color? x) (c/color* x y)
:else (if (or (unit? y) (color? y))
(* y x)
(clojure.core/* x y))))
([x y & more]
(reduce * (* x y) more)))
(defn /
"Generic division operation. Transparently computes the quotient
between `CSSUnit`s, `CSSColor`s, and numbers."
([x]
(cond
(unit? x) (update-in x [:magnitude] clojure.core//)
(color? x) (c/color-div x)
:else (clojure.core// x)))
([x y]
(cond
(unit? x) ((u/make-unit-divider (:unit x)) x y)
(color? x) (c/color-div x y)
:else (cond
(unit? y) (let [{m :magnitude} y]
(assoc y :magnitude (clojure.core// x m)))
(color? y) (c/color-div x y)
:else (clojure.core// x y))))
([x y & more]
(reduce / (/ x y) more)))

619
src/mranderson047/garden/v1v3v3/garden/color.cljc Normal file
View File

@ -0,0 +1,619 @@
(ns mranderson047.garden.v1v3v3.garden.color
"Utilities for color creation, conversion, and manipulation."
(:refer-clojure :exclude [complement])
#?(:cljs
(:require-macros
[mranderson047.garden.v1v3v3.garden.color :refer [defcolor-operation]]))
(:require
[clojure.string :as string]
[mranderson047.garden.v1v3v3.garden.util :as util])
#?(:clj
(:import clojure.lang.IFn)))
;; Many of the functions in this namespace were ported or inspired by
;; the implementations included with Sass
;; (http://sass-lang.com/docs/yardoc/Sass/Script/Functions.html).
;; Some additional functions have been added such as `triad` and
;; `tetrad` for generating sets of colors.
;; Converts a color to a hexadecimal string (implementation below).
(declare as-hex)
(defrecord CSSColor [red green blue hue saturation lightness alpha]
IFn
#?(:clj
(invoke [this] this))
#?(:clj
(invoke [this k]
(get this k)))
#?(:clj
(invoke [this k missing]
(get this k missing)))
#?(:cljs
(-invoke [this] this))
#?(:cljs
(-invoke [this k]
(get this k)))
#?(:cljs
(-invoke [this k missing]
(get this k missing)))
#?(:clj
(applyTo [this args]
(clojure.lang.AFn/applyToHelper this args))))
(def as-color map->CSSColor)
(defn rgb
"Create an RGB color."
([[r g b :as vs]]
(if (every? #(util/between? % 0 255) vs)
(as-color {:red r :green g :blue b})
(throw
(ex-info "RGB values must be between 0 and 255" {}))))
([r g b]
(rgb [r g b])))
(defn rgba
"Create an RGBA color."
([[r g b a]]
(if (util/between? a 0 1)
(as-color (assoc (rgb [r g b]) :alpha a))
(throw
(ex-info "Alpha value must be between 0 and 1" {}))))
([r g b a]
(rgba [r g b a])))
(defn hsl
"Create an HSL color."
([[h s l]]
;; Handle CSSUnits.
(let [[h s l] (map #(get % :magnitude %) [h s l])]
(if (and (util/between? s 0 100)
(util/between? l 0 100))
(as-color {:hue (mod h 360) :saturation s :lightness l})
(throw
(ex-info "Saturation and lightness must be between 0(%) and 100(%)" {})))))
([h s l]
(hsl [h s l])))
(defn hsla
"Create an HSLA color."
([[h s l a]]
(if (util/between? a 0 1)
(as-color (assoc (hsl [h s l]) :alpha a))
(throw
(ex-info "Alpha value must be between 0 and 1" {}))))
([h s l a]
(hsla [h s l a])))
(defn rgb?
"Return true if color is an RGB color."
[color]
(and (map? color)
(every? color #{:red :green :blue})))
(defn hsl?
"Return true if color is an HSL color."
[color]
(and (map? color)
(every? color #{:hue :saturation :lightness})))
(defn color?
"Return true if x is a color."
[x]
(or (rgb? x) (hsl? x)))
(def ^{:doc "Regular expression for matching a hexadecimal color.
Matches hexadecimal colors of length three or six possibly
lead by a \"#\". The color portion is captured."}
;; Quantifier must be in this order or JavaScript engines will match
;; 3 chars even when 6 are provided (failing re-matches).
hex-re #"#?([\da-fA-F]{6}|[\da-fA-F]{3})")
(defn hex?
"Returns true if x is a hexadecimal color."
[x]
(boolean (and (string? x) (re-matches hex-re x))))
(defn hex->rgb
"Convert a hexadecimal color to an RGB color map."
[s]
(when-let [[_ hex] (re-matches hex-re s)]
(let [hex (if (= 3 (count hex))
(apply str (mapcat #(list % %) hex))
hex)]
(->> (re-seq #"[\da-fA-F]{2}" hex)
(map #(util/string->int % 16))
(rgb)))))
(defn rgb->hex
"Convert an RGB color map to a hexadecimal color."
[{r :red g :green b :blue}]
(letfn [(hex-part [v]
(-> (util/format "%2s" (util/int->string v 16))
(string/replace " " "0")))]
(apply str "#" (map hex-part [r g b]))))
(defn trim-one [x]
(if (< 1 x) 1 x))
(defn rgb->hsl
"Convert an RGB color map to an HSL color map."
[{:keys [red green blue] :as color}]
(if (hsl? color)
color
(let [[r g b] (map #(/ % 255) [red green blue])
mx (max r g b)
mn (min r g b)
d (- mx mn)
h (condp = mx
mn 0
r (* 60 (/ (- g b) d))
g (+ (* 60 (/ (- b r) d)) 120)
b (+ (* 60 (/ (- r g) d)) 240))
l (trim-one (/ (+ mx mn) 2))
s (trim-one
(cond
(= mx mn) 0
(< l 0.5) (/ d (* 2 l))
:else (/ d (- 2 (* 2 l)))))]
(hsl (mod h 360) (* 100 s) (* 100 l)))))
(declare hue->rgb)
;; SEE: http://www.w3.org/TR/css3-color/#hsl-color.
(defn hsl->rgb
"Convert an HSL color map to an RGB color map."
[{:keys [hue saturation lightness] :as color}]
(if (rgb? color)
color
(let [h (/ hue 360.0)
s (/ saturation 100.0)
l (/ lightness 100.0)
m2 (if (<= l 0.5)
(* l (inc s))
(- (+ l s) (* l s)))
m1 (- (* 2 l) m2)
[r g b] (map #(Math/round (* % 0xff))
[(hue->rgb m1 m2 (+ h (/ 1.0 3)))
(hue->rgb m1 m2 h)
(hue->rgb m1 m2 (- h (/ 1.0 3)))])]
(rgb [r g b]))))
(defn- hue->rgb
[m1 m2 h]
(let [h (cond
(< h 0) (inc h)
(> h 1) (dec h)
:else h)]
(cond
(< (* 6 h) 1) (+ m1 (* (- m2 m1) h 6))
(< (* 2 h) 1) m2
(< (* 3 h) 2) (+ m1 (* (- m2 m1) (- (/ 2.0 3) h) 6))
:else m1)))
(defn hsl->hex
"Convert an HSL color map to a hexadecimal string."
[color]
(-> color hsl->rgb rgb->hex))
(defn hex->hsl
"Convert a hexadecimal color to an HSL color."
[color]
(-> color hex->rgb rgb->hsl))
(def percent-clip
(partial util/clip 0 100))
(def rgb-clip
(partial util/clip 0 255))
(defn as-hex
"Convert a color to a hexadecimal string."
[x]
(cond
(hex? x) x
(rgb? x) (rgb->hex x)
(hsl? x) (hsl->hex x)
:else (throw (ex-info (str "Can't convert " x " to a color.") {}))))
(defn as-rgb
"Convert a color to a RGB."
[x]
(cond
(rgb? x) x
(hsl? x) (hsl->rgb x)
(hex? x) (hex->rgb x)
(number? x) (rgb (map rgb-clip [x x x]))
:else (throw (ex-info (str "Can't convert " x " to a color.") {}))))
(defn as-hsl
"Convert a color to a HSL."
[x]
(cond
(hsl? x) x
(rgb? x) (rgb->hsl x)
(hex? x) (hex->hsl x)
(number? x) (hsl [x (percent-clip x) (percent-clip x)])
:else (throw (ex-info (str "Can't convert " x " to a color.") {}))))
(defn- restrict-rgb
[m]
(select-keys m [:red :green :blue]))
(defn- make-color-operation
[op]
(fn color-op
([a] a)
([a b]
(let [o (comp rgb-clip op)
a (restrict-rgb (as-rgb a))
b (restrict-rgb (as-rgb b))]
(as-color (merge-with o a b))))
([a b & more]
(reduce color-op (color-op a b) more))))
#?(:clj
(defmacro ^:private defcolor-operation [name operator]
`(def ~name (make-color-operation ~operator))))
(defcolor-operation
^{:doc "Add the RGB components of two or more colors."
:arglists '([a] [a b] [a b & more])}
color+ +)
(defcolor-operation
^{:doc "Subtract the RGB components of two or more colors."
:arglists '([a] [a b] [a b & more])}
color- -)
(defcolor-operation
^{:doc "Multiply the RGB components of two or more colors."
:arglists '([a] [a b] [a b & more])}
color* *)
(defcolor-operation
^{:doc "Multiply the RGB components of two or more colors."
:arglists '([a] [a b] [a b & more])}
color-div /)
(defn- update-color [color field f v]
(let [v (or (:magnitude v) v)]
(update-in (as-hsl color) [field] f v)))
(defn rotate-hue
"Rotates the hue value of a given color by amount."
[color amount]
(update-color color :hue (comp #(mod % 360) +) amount))
(defn saturate
"Increase the saturation value of a given color by amount."
[color amount]
(update-color color :saturation (comp percent-clip +) amount))
(defn desaturate
"Decrease the saturation value of a given color by amount."
[color amount]
(update-color color :saturation (comp percent-clip -) amount))
(defn lighten
"Increase the lightness value a given color by amount."
[color amount]
(update-color color :lightness (comp percent-clip +) amount))
(defn darken
"Decrease the lightness value a given color by amount."
[color amount]
(update-color color :lightness (comp percent-clip -) amount))
(defn invert
"Return the inversion of a color."
[color]
(as-color (merge-with - {:red 255 :green 255 :blue 255} (as-rgb color))))
(defn mix
"Mix two or more colors by averaging their RGB channels."
([color-1 color-2]
(let [c1 (restrict-rgb (as-rgb color-1))
c2 (restrict-rgb (as-rgb color-2))]
(as-color (merge-with util/average c1 c2))))
([color-1 color-2 & more]
(reduce mix (mix color-1 color-2) more)))
;;;; Color wheel functions.
(defn complement
"Return the complement of a color."
[color]
(rotate-hue color 180))
(defn- hue-rotations
([color & amounts]
(map (partial rotate-hue color) amounts)))
(defn analogous
"Given a color return a triple of colors which are 0, 30, and 60
degrees clockwise from it. If a second falsy argument is passed the
returned values will be in a counter-clockwise direction."
([color]
(analogous color true))
([color clockwise?]
(let [sign (if clockwise? + -)]
(hue-rotations color 0 (sign 30) (sign 60)))))
(defn triad
"Given a color return a triple of colors which are equidistance apart
on the color wheel."
[color]
(hue-rotations color 0 120 240))
(defn split-complement
"Given a color return a triple of the color and the two colors on
either side of it's complement."
([color]
(split-complement color 130))
([color distance-from-complement]
(let [d (util/clip 1 179 distance-from-complement)]
(hue-rotations color 0 d (- d)))))
(defn tetrad
"Given a color return a quadruple of four colors which are
equidistance on the color wheel (ie. a pair of complements). An
optional angle may be given for color of the second complement in the
pair (this defaults to 90 when only color is passed)."
([color]
(tetrad color 90))
([color angle]
(let [a (util/clip 1 90 (Math/abs (:magnitude angle angle)))
color-2 (rotate-hue color a)]
[(rotate-hue color 0)
(complement color)
color-2
(complement color-2)])))
(defn shades
"Given a color return a list of shades from lightest to darkest by
a step. By default the step is 10. White and black are excluded from
the returned list."
([color]
(shades color 10))
([color step]
(let [c (as-hsl color)]
(for [i (range 1 (Math/floor (/ 100.0 step)))]
(assoc c :lightness (* i step))))))
;; ---------------------------------------------------------------------
;; CSS color name conversion
(def color-name->hex
{:aquamarine "#7fffd4"
:aliceblue "#f0f8ff"
:antiquewhite "#faebd7"
:aqua "#00ffff"
:azure "#f0ffff"
:beige "#f5f5dc"
:bisque "#ffe4c4"
:black "#000000"
:blanchedalmond "#ffebcd"
:blue "#0000ff"
:blueviolet "#8a2be2"
:brown "#a52a2a"
:burlywood "#deb887"
:cadetblue "#5f9ea0"
:chartreuse "#7fff00"
:chocolate "#d2691e"
:coral "#ff7f50"
:cornflowerblue "#6495ed"
:cornsilk "#fff8dc"
:crimson "#dc143c"
:cyan "#00ffff"
:darkblue "#00008b"
:darkcyan "#008b8b"
:darkgoldenrod "#b8860b"
:darkgray "#a9a9a9"
:darkgreen "#006400"
:darkgrey "#a9a9a9"
:darkkhaki "#bdb76b"
:darkmagenta "#8b008b"
:darkolivegreen "#556b2f"
:darkorange "#ff8c00"
:darkorchid "#9932cc"
:darkred "#8b0000"
:darksalmon "#e9967a"
:darkseagreen "#8fbc8f"
:darkslateblue "#483d8b"
:darkslategray "#2f4f4f"
:darkslategrey "#2f4f4f"
:darkturquoise "#00ced1"
:darkviolet "#9400d3"
:deeppink "#ff1493"
:deepskyblue "#00bfff"
:dimgray "#696969"
:dimgrey "#696969"
:dodgerblue "#1e90ff"
:firebrick "#b22222"
:floralwhite "#fffaf0"
:forestgreen "#228b22"
:fuchsia "#ff00ff"
:gainsboro "#dcdcdc"
:ghostwhite "#f8f8ff"
:gold "#ffd700"
:goldenrod "#daa520"
:gray "#808080"
:green "#008000"
:greenyellow "#adff2f"
:honeydew "#f0fff0"
:hotpink "#ff69b4"
:indianred "#cd5c5c"
:indigo "#4b0082"
:ivory "#fffff0"
:khaki "#f0e68c"
:lavender "#e6e6fa"
:lavenderblush "#fff0f5"
:lawngreen "#7cfc00"
:lemonchiffon "#fffacd"
:lightblue "#add8e6"
:lightcoral "#f08080"
:lightcyan "#e0ffff"
:lightgoldenrodyellow "#fafad2"
:lightgray "#d3d3d3"
:lightgreen "#90ee90"
:lightgrey "#d3d3d3"
:lightpink "#ffb6c1"
:lightsalmon "#ffa07a"
:lightseagreen "#20b2aa"
:lightskyblue "#87cefa"
:lightslategray "#778899"
:lightslategrey "#778899"
:lightsteelblue "#b0c4de"
:lightyellow "#ffffe0"
:lime "#00ff00"
:limegreen "#32cd32"
:linen "#faf0e6"
:magenta "#ff00ff"
:maroon "#800000"
:mediumaquamarine "#66cdaa"
:mediumblue "#0000cd"
:mediumorchid "#ba55d3"
:mediumpurple "#9370db"
:mediumseagreen "#3cb371"
:mediumslateblue "#7b68ee"
:mediumspringgreen "#00fa9a"
:mediumturquoise "#48d1cc"
:mediumvioletred "#c71585"
:midnightblue "#191970"
:mintcream "#f5fffa"
:mistyrose "#ffe4e1"
:moccasin "#ffe4b5"
:navajowhite "#ffdead"
:navy "#000080"
:oldlace "#fdf5e6"
:olive "#808000"
:olivedrab "#6b8e23"
:orange "#ffa500"
:orangered "#ff4500"
:orchid "#da70d6"
:palegoldenrod "#eee8aa"
:palegreen "#98fb98"
:paleturquoise "#afeeee"
:palevioletred "#db7093"
:papayawhip "#ffefd5"
:peachpuff "#ffdab9"
:peru "#cd853f"
:pink "#ffc0cb"
:plum "#dda0dd"
:powderblue "#b0e0e6"
:purple "#800080"
:red "#ff0000"
:rosybrown "#bc8f8f"
:royalblue "#4169e1"
:saddlebrown "#8b4513"
:salmon "#fa8072"
:sandybrown "#f4a460"
:seagreen "#2e8b57"
:seashell "#fff5ee"
:sienna "#a0522d"
:silver "#c0c0c0"
:skyblue "#87ceeb"
:slateblue "#6a5acd"
:slategray "#708090"
:slategrey "#708090"
:snow "#fffafa"
:springgreen "#00ff7f"
:steelblue "#4682b4"
:tan "#d2b48c"
:teal "#008080"
:thistle "#d8bfd8"
:tomato "#ff6347"
:turquoise "#40e0d0"
:violet "#ee82ee"
:wheat "#f5deb3"
:white "#ffffff"
:whitesmoke "#f5f5f5"
:yellow "#ffff00"
:yellowgreen "#9acd32"})
(defn- ex-info-color-name
"Helper function for from-name. Returns an instance of ExceptionInfo
for unknown colors."
[n]
(ex-info
(str "Unknown color " (pr-str n) " see (:expected (ex-data e)) for a list of color names")
{:given n
:expected (set (keys color-name->hex))}))
(def
^{:private true
:doc "Helper function for from-name."}
color-name->color
(memoize (fn [k] (color-name->hex k))))
(defn from-name
"Given a CSS color name n return an instance of CSSColor."
[n]
(if-let [h (color-name->color (keyword n))]
h
(throw (ex-info-color-name n))))
(defn- scale-color-value
[value amount]
(+ value (if (pos? amount)
(* (- 100 value) (/ amount 100))
(/ (* value amount) 100))))
(defn scale-lightness
"Scale the lightness of a color by amount"
[color amount]
(update-color color :lightness scale-color-value amount))
(defn scale-saturation
"Scale the saturation of a color by amount"
[color amount]
(update-color color :saturation scale-color-value amount))
(defn- decrown-hex [hex]
(string/replace hex #"^#" ""))
(defn- crown-hex [hex]
(if (re-find #"^#" hex)
hex
(str "#" hex)))
(defn- expand-hex
"(expand-hex \"#abc\") -> \"aabbcc\"
(expand-hex \"333333\") -> \"333333\""
[hex]
(as-> (decrown-hex hex) _
(cond
(= 3 (count _)) (string/join (mapcat vector _ _))
(= 1 (count _)) (string/join (repeat 6 _))
:else _)))
(defn- hex->long
"(hex->long \"#abc\") -> 11189196"
[hex]
(-> hex
(string/replace #"^#" "")
(expand-hex)
#?(:clj (Long/parseLong 16)
:cljs (js/parseInt 16))))
(defn- long->hex
"(long->hex 11189196) -> \"aabbcc\""
[long]
#?(:clj (Integer/toHexString long)
:cljs (.toString long 16)))
(defn weighted-mix
"`weight` is number 0 to 100 (%).
At 0, it weighs color-1 at 100%.
At 100, it weighs color-2 at 100%.
Returns hex string."
[color-1 color-2 weight]
(let [[weight-1 weight-2] (map #(/ % 100) [(- 100 weight) weight])
[long-1 long-2] (map (comp hex->long as-hex)
[color-1 color-2])]
(-> (+ (* long-1 weight-1) (* long-2 weight-2))
(long->hex)
(expand-hex)
(crown-hex))))

753
src/mranderson047/garden/v1v3v3/garden/compiler.cljc Normal file
View File

@ -0,0 +1,753 @@
(ns mranderson047.garden.v1v3v3.garden.compiler
"Functions for compiling Clojure data structures to CSS."
(:require
[clojure.string :as string]
#?(:clj [mranderson047.garden.v1v3v3.garden.color :as color]
:cljs [mranderson047.garden.v1v3v3.garden.color :as color :refer [CSSColor]])
[mranderson047.garden.v1v3v3.garden.compression :as compression]
[mranderson047.garden.v1v3v3.garden.selectors :as selectors]
[mranderson047.garden.v1v3v3.garden.units :as units]
[mranderson047.garden.v1v3v3.garden.util :as util]
#?(:cljs
[mranderson047.garden.v1v3v3.garden.types :refer [CSSUnit CSSFunction CSSAtRule]]))
#?(:cljs
(:require-macros
[mranderson047.garden.v1v3v3.garden.compiler :refer [with-media-query-context with-selector-context]]))
#?(:clj
(:import (mranderson047.garden.v1v3v3.garden.types CSSUnit CSSFunction CSSAtRule)
(mranderson047.garden.v1v3v3.garden.color CSSColor))))
;; ---------------------------------------------------------------------
;; Compiler flags
(def
^{:dynamic true
:private true
:doc "The current compiler flags."}
*flags*
{;; When set to `true` the compiled stylesheet will be "pretty
;; printed." This would be equivalent to setting
;; `{:ouput-style => :expanded}` in Sass. When set to `false`
;; the compiled stylesheet will be compressed with the YUI
;; compressor.
:pretty-print? true
;; A sequence of files to prepend to the output file.
:preamble []
;; Location to save a stylesheet after compiling.
:output-to nil
;; A list of vendor prefixes to prepend to things like
;; `@keyframes`, properties within declarations containing the
;; `^:prefix` meta data, and properties defined in `:auto-prefix`.
:vendors []
;; A set of properties to automatically prefix with `:vendors`.
:auto-prefix #{}
;; `@media-query` specific configuration.
:media-expressions {;; May either be `:merge` or `:default`. When
;; set to `:merge` nested media queries will
;; have their expressions merged with their
;; parent's.
:nesting-behavior :default}})
(def
^{:private true
:doc "Retun a function to call when rendering a media expression.
The returned function accepts two arguments: the media
expression being evaluated and the current media expression context.
Both arguments are maps. This is used to provide semantics for nested
media queries."}
media-expression-behavior
{:merge (fn [expr context] (merge context expr))
:default (fn [expr _] expr)})
(def
^{:dynamic true
:private true
:doc "The current parent selector context."}
*selector-context* nil)
(def
^{:dynamic true
:private true
:doc "The current media query context."}
*media-query-context* nil)
;; ---------------------------------------------------------------------
;; Utilities
(defmacro with-selector-context
[selector-context & body]
`(binding [*selector-context* ~selector-context]
(do ~@body)))
(defmacro with-media-query-context
[selector-context & body]
`(binding [*media-query-context* ~selector-context]
(do ~@body)))
(defn- vendors
"Return the current list of browser vendors specified in `*flags*`."
[]
(seq (:vendors *flags*)))
(defn- auto-prefixed-properties
"Return the current list of auto-prefixed properties specified in `*flags*`."
[]
(set (map name (:auto-prefix *flags*))))
(defn- auto-prefix?
[property]
(contains? (auto-prefixed-properties) property))
(defn- top-level-expression? [x]
(or (util/rule? x)
(util/at-import? x)
(util/at-media? x)
(util/at-keyframes? x)))
(defn- divide-vec
"Return a vector of [(filter pred coll) (remove pred coll)]."
[pred coll]
((juxt filter remove) pred coll))
#?(:clj
(defn- save-stylesheet
"Save a stylesheet to disk."
[path stylesheet]
(spit path stylesheet)))
;; =====================================================================
;; Expansion
;; The expansion process ensures that before a stylesheet is rendered
;; it is in a format that can be easily digested. That is, it produces
;; a new data structure which is a list of only one level.
;; This intermediate process between input and compilation separates
;; concerns between parsing data structures and compiling them to CSS.
;; All data types that implement `IExpandable` should produce a list.
(defprotocol IExpandable
(expand [this]
"Return a list containing the expanded form of `this`."))
;; ---------------------------------------------------------------------
;; List expansion
(defn- expand-seqs
"Like flatten but only affects seqs."
[coll]
(mapcat
(fn [x]
(if (seq? x)
(expand-seqs x)
(list x)))
coll))
;; ---------------------------------------------------------------------
;; Declaration expansion
(defn expand-declaration-1
[declaration]
{:pre [(map? declaration)]}
(let [prefix #(util/as-str %1 "-" %2)]
(reduce
(fn [m [k v]]
(if (util/hash-map? v)
(reduce
(fn [m1 [k1 v1]]
(assoc m1 (prefix k k1) v1))
m
(expand-declaration-1 v))
(assoc m (util/to-str k) v)))
(empty declaration)
declaration)))
(defn- expand-declaration
[declaration]
(if (empty? declaration)
declaration
(with-meta (expand-declaration-1 declaration) (meta declaration))))
;; ---------------------------------------------------------------------
;; Rule expansion
(def
^{:private true
:doc "Matches a single \"&\" or \"&\" follow by one or more
non-whitespace characters."}
parent-selector-re
#"^&(?:\S+)?$")
(defn- extract-reference
"Extract the selector portion of a parent selector reference."
[selector]
(when-let [reference (->> (last selector)
(util/to-str)
(re-find parent-selector-re))]
(apply str (rest reference))))
(defn- expand-selector-reference
[selector]
(if-let [reference (extract-reference selector)]
(let [parent (butlast selector)]
(concat (butlast parent)
(-> (last parent)
(util/as-str reference)
(list))))
selector))
(defn- expand-selector [selector parent]
(let [selector (map selectors/css-selector selector)
selector (if (seq parent)
(->> (util/cartesian-product parent selector)
(map flatten))
(map list selector))]
(map expand-selector-reference selector)))
(defn- expand-rule
[rule]
(let [[selector children] (split-with selectors/selector? rule)
selector (expand-selector selector *selector-context*)
children (expand children)
[declarations xs] (divide-vec util/declaration? children)
ys (with-selector-context
(if (seq selector)
selector
*selector-context*)
(doall (mapcat expand xs)))]
(->> (mapcat expand declarations)
(conj [selector])
(conj ys))))
;; ---------------------------------------------------------------------
;; At-rule expansion
(defmulti ^:private expand-at-rule :identifier)
(defmethod expand-at-rule :default
[at-rule]
(list at-rule))
;; @keyframes expansion
(defmethod expand-at-rule :keyframes
[{:keys [value]}]
(let [{:keys [identifier frames]} value]
(->> {:identifier (util/to-str identifier)
:frames (mapcat expand frames)}
(CSSAtRule. :keyframes)
(list))))
;; @media expansion
(defn- expand-media-query-expression [expression]
(if-let [f (->> [:media-expressions :nesting-behavior]
(get-in *flags*)
(media-expression-behavior))]
(f expression *media-query-context*)
expression))
(defmethod expand-at-rule :media
[{:keys [value]}]
(let [{:keys [media-queries rules]} value
media-queries (expand-media-query-expression media-queries)
xs (with-media-query-context media-queries (doall (mapcat expand (expand rules))))
;; Though media-queries may be nested, they may not be nested
;; at compile time. Here we make sure this is the case.
[subqueries rules] (divide-vec util/at-media? xs)]
(cons
(CSSAtRule. :media {:media-queries media-queries
:rules rules})
subqueries)))
;; ---------------------------------------------------------------------
;; Stylesheet expansion
(defn- expand-stylesheet [xs]
(->> (expand xs)
(map expand)
(apply concat)))
(extend-protocol IExpandable
#?(:clj clojure.lang.ISeq
:cljs IndexedSeq)
(expand [this] (expand-seqs this))
#?(:cljs LazySeq)
#?(:cljs (expand [this] (expand-seqs this)))
#?(:cljs RSeq)
#?(:cljs(expand [this] (expand-seqs this)))
#?(:cljs NodeSeq)
#?(:cljs (expand [this] (expand-seqs this)))
#?(:cljs ArrayNodeSeq)
#?(:cljs (expand [this] (expand-seqs this)))
#?(:cljs Cons)
#?(:cljs (
expand [this] (expand-seqs this)))
#?(:cljs ChunkedCons)
#?(:cljs (expand [this] (expand-seqs this)))
#?(:cljs ChunkedSeq)
(expand [this] (expand-seqs this))
#?(:cljs PersistentArrayMapSeq)
#?(:cljs (expand [this] (expand-seqs this)))
#?(:cljs List)
#?(:cljs (expand [this] (expand-seqs this)))
#?(:clj clojure.lang.IPersistentVector
:cljs PersistentVector)
(expand [this] (expand-rule this))
#?(:cljs Subvec)
#?(:cljs (expand [this] (expand-rule this)))
#?(:cljs BlackNode)
#?(:cljs (expand [this] (expand-rule this)))
#?(:cljs RedNode)
#?(:cljs (expand [this] (expand-rule this)))
#?(:clj clojure.lang.IPersistentMap
:cljs PersistentArrayMap)
(expand [this] (list (expand-declaration this)))
#?(:cljs PersistentHashMap)
#?(:cljs (expand [this] (list (expand-declaration this))))
#?(:cljs PersistentTreeMap)
#?(:cljs (expand [this] (list (expand-declaration this))))
#?(:clj Object
:cljs default)
(expand [this] (list this))
CSSFunction
(expand [this] (list this))
CSSAtRule
(expand [this] (expand-at-rule this))
CSSColor
(expand [this] (list this))
nil
(expand [this] nil))
;; ---------------------------------------------------------------------
;; Rendering
(defprotocol CSSRenderer
(render-css [this]
"Convert a Clojure data type in to a string of CSS."))
;; ---------------------------------------------------------------------
;; Punctuation
(def ^:private comma ", ")
(def ^:private colon ": ")
(def ^:private semicolon ";")
(def ^:private l-brace " {\n")
(def ^:private r-brace "\n}")
(def ^:private l-brace-1 " {\n\n")
(def ^:private r-brace-1 "\n\n}")
(def ^:private rule-sep "\n\n")
(def ^:private indent " ")
(defn- space-separated-list
"Return a space separated list of values."
([xs]
(space-separated-list render-css xs))
([f xs]
(string/join " " (map f xs))))
(defn- comma-separated-list
"Return a comma separated list of values. Subsequences are joined with
spaces."
([xs]
(comma-separated-list render-css xs))
([f xs]
(let [ys (for [x xs]
(if (sequential? x)
(space-separated-list f x)
(f x)))]
(string/join comma ys))))
(defn- rule-join [xs]
(string/join rule-sep xs))
(def
^{:private true
:doc "Match the start of a line if the characters immediately
after it are spaces or used in a CSS id (#), class (.), or tag name."}
indent-loc-re
#?(:clj
#"(?m)(?=[\sA-z#.}-]+)^")
#?(:cljs
(js/RegExp. "(?=[ A-Za-z#.}-]+)^" "gm")))
(defn- indent-str [s]
#?(:clj
(string/replace s indent-loc-re indent))
#?(:cljs
(.replace s indent-loc-re indent)))
;; ---------------------------------------------------------------------
;; Declaration rendering
(defn- render-value
"Render the value portion of a declaration."
[x]
(if (util/at-keyframes? x)
(util/to-str (get-in x [:value :identifier]))
(render-css x)))
(defn- render-property-and-value
[[prop val]]
(if (set? val)
(->> (interleave (repeat prop) val)
(partition 2)
(map render-property-and-value)
(string/join "\n"))
(let [val (if (sequential? val)
(comma-separated-list render-value val)
(render-value val))]
(util/as-str prop colon val semicolon))))
(defn- add-blocks
"For each block in `declaration`, add sequence of blocks
returned from calling `f` on the block."
[f declaration]
(mapcat #(cons % (f %)) declaration))
(defn- prefixed-blocks
"Sequence of blocks with their properties prefixed by
each vendor in `vendors`."
[vendors [p v]]
(for [vendor vendors]
[(util/vendor-prefix vendor (name p)) v]))
(defn- prefix-all-properties
"Add prefixes to all blocks in `declaration` using
vendor prefixes in `vendors`."
[vendors declaration]
(add-blocks (partial prefixed-blocks vendors) declaration))
(defn- prefix-auto-properties
"Add prefixes to all blocks in `declaration` when property
is in the `:auto-prefix` set."
[vendors declaration]
(add-blocks
(fn [block]
(let [[p _] block]
(when (auto-prefix? (name p))
(prefixed-blocks vendors block))))
declaration))
(defn- prefix-declaration
"Prefix properties within a `declaration` if `{:prefix true}` is
set in its meta, or if a property is in the `:auto-prefix` set."
[declaration]
(let [vendors (or (:vendors (meta declaration)) (vendors))
prefix-fn (if (:prefix (meta declaration))
prefix-all-properties
prefix-auto-properties)]
(prefix-fn vendors declaration)))
(defn- render-declaration
[declaration]
(->> (prefix-declaration declaration)
(map render-property-and-value)
(string/join "\n")))
;; ---------------------------------------------------------------------
;; Rule rendering
(defn- render-selector
[selector]
(comma-separated-list selector))
(defn- render-rule
"Convert a vector to a CSS rule string. The vector is expected to be
fully expanded."
[[selector declarations :as rule]]
(when (and (seq rule) (every? seq rule))
(str (render-selector selector)
l-brace
(->> (map render-css declarations)
(string/join "\n")
(indent-str))
r-brace)))
;; ---------------------------------------------------------------------
;; Media query rendering
(defn- render-media-expr-part
"Render the individual components of a media expression."
[[k v]]
(let [[sk sv] (map render-value [k v])]
(cond
(true? v) sk
(false? v) (str "not " sk)
(= "only" sv) (str "only " sk)
:else (if (and v (seq sv))
(str "(" sk colon sv ")")
(str "(" sk ")")))))
(defn- render-media-expr
"Make a media query expession from one or more maps. Keys are not
validated but values have the following semantics:
`true` as in `{:screen true}` == \"screen\"
`false` as in `{:screen false}` == \"not screen\"
`:only` as in `{:screen :only} == \"only screen\""
[expr]
(if (sequential? expr)
(->> (map render-media-expr expr)
(comma-separated-list))
(->> (map render-media-expr-part expr)
(string/join " and "))))
;; ---------------------------------------------------------------------
;; Garden type rendering
(defn- render-unit
"Render a CSSUnit."
[css-unit]
(let [{:keys [magnitude unit]} css-unit
magnitude #?(:cljs magnitude)
#?(:clj (if (ratio? magnitude)
(float magnitude)
magnitude))]
(str magnitude (name unit))))
(defn- render-function
"Render a CSS function."
[css-function]
(let [{:keys [function args]} css-function
args (if (sequential? args)
(comma-separated-list args)
(util/to-str args))]
(util/format "%s(%s)" (util/to-str function) args)))
(defn ^:private render-color [c]
(if-let [a (:alpha c)]
(let [{:keys [hue saturation lightness]} (color/as-hsl c)
[s l] (map units/percent [saturation lightness])]
(util/format "hsla(%s)" (comma-separated-list [hue s l a])))
(color/as-hex c)))
;; ---------------------------------------------------------------------
;; At-rule rendering
(defmulti ^:private render-at-rule
"Render a CSS at-rule"
:identifier)
(defmethod render-at-rule :default [_] nil)
;; @import
(defmethod render-at-rule :import
[{:keys [value]}]
(let [{:keys [url media-queries]} value
url (if (string? url)
(util/wrap-quotes url)
(render-css url))
queries (when media-queries
(render-media-expr media-queries))]
(str "@import "
(if queries (str url " " queries) url)
semicolon)))
;; @keyframes
(defmethod render-at-rule :keyframes
[{:keys [value]}]
(let [{:keys [identifier frames]} value]
(when (seq frames)
(let [body (str (util/to-str identifier)
l-brace-1
(->> (map render-css frames)
(rule-join)
(indent-str))
r-brace-1)
prefix (fn [vendor]
(str "@" (util/vendor-prefix vendor "keyframes ")))]
(->> (map prefix (vendors))
(cons "@keyframes ")
(map #(str % body))
(rule-join))))))
;; @media
(defmethod render-at-rule :media
[{:keys [value]}]
(let [{:keys [media-queries rules]} value]
(when (seq rules)
(str "@media "
(render-media-expr media-queries)
l-brace-1
(-> (map render-css rules)
(rule-join)
(indent-str))
r-brace-1))))
;; ---------------------------------------------------------------------
;; CSSRenderer implementation
(extend-protocol CSSRenderer
#?(:clj clojure.lang.ISeq
:cljs IndexedSeq)
(render-css [this] (map render-css this))
#?(:cljs LazySeq)
#?(:cljs (render-css [this] (map render-css this)))
#?(:cljs RSeq)
#?(:cljs (render-css [this] (map render-css this)))
#?(:cljs NodeSeq)
#?(:cljs (render-css [this] (map render-css this)))
#?(:cljs ArrayNodeSeq)
#?(:cljs (render-css [this] (map render-css this)))
#?(:cljs Cons)
#?(:cljs (render-css [this] (map render-css this)))
#?(:cljs ChunkedCons)
#?(:cljs (render-css [this] (map render-css this)))
#?(:cljs ChunkedSeq)
#?(:cljs (render-css [this] (map render-css this)))
#?(:cljs PersistentArrayMapSeq)
#?(:cljs (render-css [this] (map render-css this)))
#?(:cljs List)
#?(:cljs (render-css [this] (map render-css this)))
#?(:clj clojure.lang.IPersistentVector
:cljs PersistentVector)
(render-css [this] (render-rule this))
#?(:cljs Subvec)
#?(:cljs (render-css [this] (render-rule this)))
#?(:cljs BlackNode)
#?(:cljs (render-css [this] (render-rule this)))
#?(:cljs RedNode)
#?(:cljs (render-css [this] (render-rule this)))
#?(:clj clojure.lang.IPersistentMap
:cljs PersistentArrayMap)
(render-css [this] (render-declaration this))
#?(:cljs PersistentHashMap)
#?(:cljs (render-css [this] (render-declaration this)))
#?(:cljs PersistentTreeMap)
#?(:cljs (render-css [this] (render-declaration this)))
#?(:clj clojure.lang.Ratio)
#?(:clj (render-css [this] (str (float this))))
#?(:cljs number)
#?(:cljs (render-css [this] (str this)))
#?(:clj clojure.lang.Keyword
:cljs Keyword)
(render-css [this] (name this))
CSSUnit
(render-css [this] (render-unit this))
CSSFunction
(render-css [this] (render-function this))
CSSAtRule
(render-css [this] (render-at-rule this))
#?(:clj CSSColor
:cljs color/CSSColor)
(render-css [this] (render-color this))
#?(:clj Object
:cljs default)
(render-css [this] (str this))
nil
(render-css [this] ""))
;; ---------------------------------------------------------------------
;; Compilation
(defn compile-style
"Convert a sequence of maps into CSS for use with the HTML style
attribute."
[ms]
(->> (filter util/declaration? ms)
(reduce merge)
(expand)
(render-css)
(first)))
(defn- do-compile
"Return a string of CSS."
[flags rules]
(binding [*flags* flags]
(->> (expand-stylesheet rules)
(filter top-level-expression?)
(map render-css)
(remove nil?)
(rule-join))))
(defn- do-preamble
"Prefix stylesheet with files in preamble. Not available in
ClojureScript."
[{:keys [preamble]} stylesheet]
#?(:clj
(string/join "\n" (conj (mapv slurp preamble) stylesheet)))
#?(:cljs
stylesheet))
(defn- do-compression
"Compress CSS if the pretty-print(?) flag is true."
[{:keys [pretty-print? pretty-print]} stylesheet]
;; Also accept pretty-print like CLJS.
(if (or pretty-print? pretty-print)
stylesheet
(compression/compress-stylesheet stylesheet)))
(defn- do-output-to
"Write contents of stylesheet to disk."
[{:keys [output-to]} stylesheet]
#?(:clj
(when output-to
(save-stylesheet output-to stylesheet)
(println "Wrote:" output-to)))
stylesheet)
(defn compile-css
"Convert any number of Clojure data structures to CSS."
[flags & rules]
(let [[flags rules] (if (and (util/hash-map? flags)
(some (set (keys flags)) (keys *flags*)))
[(merge *flags* flags) rules]
[*flags* (cons flags rules)])]
(->> (do-compile flags rules)
(do-preamble flags)
(do-compression flags)
(do-output-to flags))))

97
src/mranderson047/garden/v1v3v3/garden/compression.cljc Normal file
View File

@ -0,0 +1,97 @@
(ns mranderson047.garden.v1v3v3.garden.compression
"Stylesheet compression utilities."
#?(:clj
(:import (java.io StringReader StringWriter)
(com.yahoo.platform.yui.compressor CssCompressor))))
;; ---------------------------------------------------------------------
;; Clojure
;; Clojure stylesheet compression leverages the YUI Compressor as it
;; provides a performant and excellent solution to CSS compression.
#?(:clj
(defn compress-stylesheet
"Compress a stylesheet with the YUI CSSCompressor. Set
line-break-position to -1 for no line breaks, 0 for a line break
after each rule, and n > 0 for a line break after at most n
columns. Defaults to no -1"
([stylesheet]
(compress-stylesheet stylesheet -1))
([^String stylesheet line-break-position]
(with-open [reader (StringReader. stylesheet)
writer (StringWriter.)]
(doto (CssCompressor. reader)
(.compress writer line-break-position))
(str writer)))))
;; ---------------------------------------------------------------------
;; ClojureScript
;; ClojureScript stylesheet compression uses a simple tokenizer and
;; loop/recur to construct a new string of minified CSS.
#?(:cljs
(defn- token-fn
"Return a function which when given a string will return a map
containing the chunk of text matched by re, it's size, and tag."
[[tag re]]
(fn [s]
(when-let [chunk (re-find re s)]
{:tag tag
:chunk chunk
:size (count chunk)}))))
#?(:cljs
(defn- tokenizer
"Given an arbitrary number of [tag regex] pairs, return a function
which when given a string s will return the first matching token of s.
Token precedence is determined by the order of the pairs. The first
and last pairs have the highest and lowest precedence respectively."
[& tags+regexes]
(let [fs (map token-fn tags+regexes)]
(fn [s]
(some #(% s) fs)))))
#?(:cljs
(def
^{:private true
:doc "Tokenizer used during stylesheet compression."}
stylesheet-tokenizer
(tokenizer
;; String literals
[:string #"^\"(?:\\.|[^\"])*\""]
;; Delimiters
[:r-brace #"^\s*\{\s*"]
[:l-brace #"^;?\s*}"]
[:r-paren #"^\s*\(\s*"]
[:l-paren #"^\s*\)"]
[:comma #"^,\s*"]
[:colon #"^:\s*"]
[:semicolon #"^;"]
;; White space
[:space+ #"^ +"]
[:white-space+ #"^\s+"]
;; Everything else
[:any #"^."])))
#?(:cljs
(defn compress-stylesheet
"Compress a string of CSS using a basic compressor."
[stylesheet]
(loop [s1 stylesheet s2 ""]
(if-let [{:keys [tag chunk size]} (stylesheet-tokenizer s1)]
(recur (subs s1 size)
(str s2 (case tag
:string chunk
:r-brace "{"
:l-brace "}"
:r-paren "("
:l-paren ")"
:comma ","
:semi-comma ";"
:colon ":"
:space+ " "
:white-space+ ""
chunk)))
s2))))

17
src/mranderson047/garden/v1v3v3/garden/core.cljc Normal file
View File

@ -0,0 +1,17 @@
(ns mranderson047.garden.v1v3v3.garden.core
"Convert Clojure data structures to CSS."
(:require [mranderson047.garden.v1v3v3.garden.compiler :as compiler]))
(defn ^String css
"Convert a variable number of Clojure data structure to a string of
CSS. The first argument may be a list of flags for the compiler."
{:arglists '([rules] [flags? rules])}
[& rules]
(apply compiler/compile-css rules))
(defn ^String style
"Convert a variable number of maps into a string of CSS for use with
the HTML `style` attribute."
[& maps]
(compiler/compile-style maps))

119
src/mranderson047/garden/v1v3v3/garden/def.clj Normal file
View File

@ -0,0 +1,119 @@
(ns mranderson047.garden.v1v3v3.garden.def
(:require [mranderson047.garden.v1v3v3.garden.types]
[mranderson047.garden.v1v3v3.garden.util :as util]
[mranderson047.garden.v1v3v3.garden.core])
(:import garden.types.CSSFunction
garden.types.CSSAtRule))
(defmacro defstyles
"Convenience macro equivalent to `(def name (list styles*))`."
[name & styles]
`(def ~name (list ~@styles)))
(defmacro defstylesheet
"Convenience macro equivalent to `(def name (css opts? styles*))`."
[name & styles]
`(def ~name (mranderson047.garden.v1v3v3.garden.core/css ~@styles)))
(defmacro defrule
"Define a function for creating rules. If only the `name` argument is
provided the rule generating function will default to using it as the
primary selector.
Ex.
(defrule a)
;; => #'user/a
(a {:text-decoration \"none\"})
;; => [:a {:text-decoration \"none\"}]
Ex.
(defrule sub-headings :h4 :h5 :h6)
;; => #'user/sub-headings
(sub-headings {:font-weight \"normal\"})
;; => [:h4 :h5 :h6 {:font-weight \"normal\"}]"
[sym & selectors]
(let [rule (if (seq selectors)
`(vec '~selectors)
[(keyword sym)])
[_ sym spec] (macroexpand `(defn ~sym [~'& ~'children]
(into ~rule ~'children)))]
`(def ~sym ~spec)))
(defmacro ^{:arglists '([name] [name docstring? & fn-tail])}
defcssfn
"Define a function for creating custom CSS functions. The generated
function will automatically create an instance of
`garden.types.CSSFunction` of which the `:args` field will be set
to whatever the return value of the original function is. The
`:function` field will be set to `(str name)`.
If only the `name` argument is provided the returned function will
accept any number of arguments.
Ex.
(defcssfn url)
;; => #'user/url
(url \"http://fonts.googleapis.com/css?family=Lato\")
;; => #garden.types.CSSFunction{:function \"url\", :args \"http://fonts.googleapis.com/css?family=Lato\"}
(css (url \"http://fonts.googleapis.com/css?family=Lato\"))
;; => url(http://fonts.googleapis.com/css?family=Lato)
Ex.
(defcssfn attr
([name] name)
([name type-or-unit]
[[name type-or-unit]])
([name type-or-unit fallback]
[name [type-or-unit fallback]]))
;; => #'user/attr
(attr :vertical :length)
;; => #garden.types.CSSFunction{:function \"url\", :args [:vertical :length]}
(css (attr :vertical :length))
;; => \"attr(vertical length)\"
(attr :end-of-quote :string :inherit)
;; => #garden.types.CSSFunction{:function \"url\", :args [:end-of-quote [:string :inherit]]}
(css (attr :end-of-quote :string :inherit))
;; => \"attr(end-of-quote string, inherit)\""
([sym]
(let [[_ sym fn-tail] (macroexpand
`(defn ~sym [& ~'args]
(CSSFunction. ~(str sym) ~'args)))]
`(def ~sym ~fn-tail)))
([sym & fn-tail]
(let [[_ sym [_ & fn-spec]] (macroexpand `(defn ~sym ~@fn-tail))
cssfn-name (str sym)]
`(def ~sym
(fn [& args#]
(CSSFunction. ~cssfn-name (apply (fn ~@fn-spec) args#)))))))
(defmacro defkeyframes
"Define a CSS @keyframes animation.
Ex.
(defkeyframes my-animation
[:from
{:background \"red\"}]
[:to
{:background \"yellow\"}])
(css {:vendors [\"webkit\"]}
my-animation ;; Include the animation in the stylesheet.
[:div
^:prefix ;; Use vendor prefixing (optional).
{:animation [[my-animation \"5s\"]]}])"
[sym & frames]
(let [value {:identifier `(str '~sym)
:frames `(list ~@frames)}
obj `(CSSAtRule. :keyframes ~value)]
`(def ~sym ~obj)))

27
src/mranderson047/garden/v1v3v3/garden/media.cljc Normal file
View File

@ -0,0 +1,27 @@
(ns mranderson047.garden.v1v3v3.garden.media
"Utility functions for working with media queries.")
;; See: http://www.w3.org/TR/css3-mediaqueries/#media1
(def media-features
#{:all
:aspect-ratio :min-aspect-ratio :max-aspect-ratio
:braille
:color :min-color :max-color
:color-index :min-color-index :max-color-index
:device-height :min-device-height :max-device-height
:device-width :min-device-width :max-device-width
:embossed
:grid
:handheld
:height :min-height :max-height
:monochrome :min-monochrome :max-monochrome
:orientation
:print
:projection
:resolution :min-resolution :max-resolution
:scan
:screen
:speech
:tty
:tv
:width :min-width :max-width})

31
src/mranderson047/garden/v1v3v3/garden/repl.clj Normal file
View File

@ -0,0 +1,31 @@
(ns mranderson047.garden.v1v3v3.garden.repl
"Method definitions for `print-method` with Garden types."
(:require [mranderson047.garden.v1v3v3.garden.compiler :as compiler]
[mranderson047.garden.v1v3v3.garden.util :as util]
[mranderson047.garden.v1v3v3.garden.types]
[mranderson047.garden.v1v3v3.garden.color]
[mranderson047.garden.v1v3v3.garden.selectors :as selectors])
(:import (mranderson047.garden.v1v3v3.garden.types CSSUnit
CSSFunction
CSSAtRule)
(mranderson047.garden.v1v3v3.garden.color CSSColor)
(mranderson047.garden.v1v3v3.garden.selectors CSSSelector)))
(defmethod print-method CSSUnit [css-unit writer]
(.write writer (compiler/render-css css-unit)))
(defmethod print-method CSSFunction [css-function writer]
(.write writer (compiler/render-css css-function)))
(defmethod print-method CSSColor [color writer]
(.write writer (compiler/render-css color)))
(defmethod print-method CSSAtRule [css-at-rule writer]
(let [f (if (or (util/at-keyframes? css-at-rule)
(util/at-media? css-at-rule))
compiler/compile-css
compiler/render-css)]
(.write writer (f css-at-rule))))
(defmethod print-method CSSSelector [css-selector writer]
(.write writer (selectors/css-selector css-selector)))

1057
src/mranderson047/garden/v1v3v3/garden/selectors.cljc Normal file
View File

File diff suppressed because it is too large Load Diff

79
src/mranderson047/garden/v1v3v3/garden/stylesheet.cljc Normal file
View File

@ -0,0 +1,79 @@
(ns mranderson047.garden.v1v3v3.garden.stylesheet
"Utility functions for CSS properties, directives and functions."
(:require [mranderson047.garden.v1v3v3.garden.util :as util]
[mranderson047.garden.v1v3v3.garden.color :as color]
[mranderson047.garden.v1v3v3.garden.types :as t])
#?(:clj
(:import garden.types.CSSFunction
garden.types.CSSAtRule)))
;;;; ## Stylesheet helpers
(defn rule
"Create a rule function for the given selector. The `selector`
argument must be valid selector (ie. a keyword, string, or symbol).
Additional arguments may consist of extra selectors or
declarations.
The returned function accepts any number of arguments which represent
the rule's children.
Ex.
(let [text-field (rule \"[type=\"text\"])]
(text-field {:border [\"1px\" :solid \"black\"]}))
;; => [\"[type=\"text\"] {:boder [\"1px\" :solid \"black\"]}]"
[selector & more]
(if-not (or (keyword? selector)
(string? selector)
(symbol? selector))
(throw (ex-info
"Selector must be either a keyword, string, or symbol." {}))
(fn [& children]
(into (apply vector selector more) children))))
(defn cssfn [fn-name]
(fn [& args]
(t/CSSFunction. fn-name args)))
;;;; ## At-rules
(defn- at-rule [identifier value]
(t/CSSAtRule. identifier value))
(defn at-font-face
"Create a CSS @font-face rule."
[& font-properties]
["@font-face" font-properties])
(defn at-import
"Create a CSS @import rule."
([url]
(at-rule :import {:url url
:media-queries nil}))
([url & media-queries]
(at-rule :import {:url url
:media-queries media-queries})))
(defn at-media
"Create a CSS @media rule."
[media-queries & rules]
(at-rule :media {:media-queries media-queries
:rules rules}))
(defn at-keyframes
"Create a CSS @keyframes rule."
[identifier & frames]
(at-rule :keyframes {:identifier identifier
:frames frames}))
;;;; ## Functions
(defn rgb
"Create a color from RGB values."
[r g b]
(color/rgb [r g b]))
(defn hsl
"Create a color from HSL values."
[h s l]
(color/hsl [h s l]))

8
src/mranderson047/garden/v1v3v3/garden/types.cljc Normal file
View File

@ -0,0 +1,8 @@
(ns mranderson047.garden.v1v3v3.garden.types
"Internal types used by Garden.")
(defrecord CSSUnit [unit magnitude])
(defrecord CSSFunction [function args])
(defrecord CSSAtRule [identifier value])

327
src/mranderson047/garden/v1v3v3/garden/units.cljc Normal file
View File

@ -0,0 +1,327 @@
(ns mranderson047.garden.v1v3v3.garden.units
"Functions and macros for working with CSS units."
(:refer-clojure :exclude [rem])
#?@(:clj
[(:require
[mranderson047.garden.v1v3v3.garden.types :as types]
[mranderson047.garden.v1v3v3.garden.util :as util])
(:import
[mranderson047.garden.v1v3v3.garden.types CSSUnit])])
#?@(:cljs
[(:require
[cljs.reader :refer [read-string]]
[mranderson047.garden.v1v3v3.garden.types :as types :refer [CSSUnit]]
[mranderson047.garden.v1v3v3.garden.util :as util])
(:require-macros
[mranderson047.garden.v1v3v3.garden.units :refer [defunit]])]))
;;;; ## Unit families
(def length-units
#{:in :cm :pc :mm :pt :px (keyword "%")})
(def angular-units
#{:deg :grad :rad :turn})
(def time-units
#{:s :ms})
(def frequency-units
#{:Hz :kHz})
(def resolution-units
#{:dpi :dpcm :dppx})
;;;; ## Unit predicates
(defn unit?
"True if x is of type CSSUnit."
[x]
(instance? CSSUnit x))
(defn length?
[x]
(and (unit? x)
(contains? length-units (:unit x))))
(defn angle?
[x]
(and (unit? x)
(contains? angular-units (:unit x))))
(defn time?
[x]
(and (unit? x)
(contains? time-units (:unit x))))
(defn frequency?
[x]
(and (unit? x)
(contains? frequency-units (:unit x))))
(defn resolution?
[x]
(and (unit? x)
(contains? resolution-units (:unit x))))
;;;; ## Unit conversion
(def ^{:private true
:doc "Map associating CSS unit types to their conversion values."}
conversions
{;; Absolute units
:cm {:cm 1
:mm 10
:pc 2.36220473
:pt 28.3464567
:px 37.795275591}
:in {:cm 2.54
:in 1
:mm 25.4
:pc 6
:pt 72
:px 96}
:mm {:mm 1
:pt 2.83464567
:px 3.7795275591}
:pc {:mm 4.23333333
:pc 1
:pt 12
:px 16}
:pt {:pt 1
:px 1.3333333333}
:px {:px 1}
(keyword "%") {(keyword "%") 1}
;; Relative untis
:em {:em 1}
:rem {:rem 1}
;; Angular units
:deg {:deg 1
:grad 1.111111111
:rad 0.0174532925
:turn 0.002777778}
:grad {:grad 1
:rad 63.661977237
:turn 0.0025}
:rad {:rad 1
:turn 0.159154943}
:turn {:turn 1}
;; Time units
:s {:ms 1000
:s 1}
:ms {:ms 1}
;; Frequency units
:Hz {:Hz 1
:kHz 0.001}
:kHz {:kHz 1}})
(defn- convertable?
"True if unit is a key of convertable-units, false otherwise."
[unit]
(contains? conversions unit))
(defn- convert
"Convert a Unit with :unit left to a Unit with :unit right if possible."
[{m :magnitude left :unit} right]
(if (every? convertable? [left right])
(let [v1 (get-in conversions [left right])
v2 (get-in conversions [right left])]
(cond
v1
(CSSUnit. right (* v1 m))
v2
(CSSUnit. right (/ m v2))
;; Both units are convertible but no conversion between them exists.
:else
(throw
(ex-info
(util/format "Can't convert %s to %s" (name left) (name right)) {}))))
;; Display the inconvertible unit.
(let [x (first (drop-while convertable? [left right]))]
(throw (ex-info (str "Inconvertible unit " (name x)) {})))))
;;;; ## Unit helpers
(def ^{:doc "Regular expression for matching a CSS unit. The magnitude
and unit are captured."
:private true}
unit-re
#"([+-]?\d+(?:\.?\d+)?)(p[xtc]|in|[cm]m|%|r?em|ex|ch|v(?:[wh]|m(?:in|ax))|deg|g?rad|turn|m?s|k?Hz|dp(?:i|cm|px))")
(defn read-unit
"Read a `CSSUnit` object from the string `s`."
[s]
(when-let [[_ magnitude unit] (re-matches unit-re s)]
(let [unit (keyword unit)
magnitude (if magnitude (read-string magnitude) 0)]
(CSSUnit. unit magnitude))))
(defn make-unit-predicate
"Creates a function for verifying the given unit type."
[unit]
(fn [x] (and (unit? x) (= (:unit x) unit))))
(defn make-unit-fn
"Creates a function for creating and converting `CSSUnit`s for the
given unit. If a number n is passed the function it will produce a
new `CSSUnit` record with a the magnitude set to n. If a `CSSUnit`
is passed the function will attempt to convert it."
[unit]
(fn [x]
(cond
(number? x)
(CSSUnit. unit x)
(unit? x)
(if (and (= (unit x) unit))
x
(convert x unit))
:else
(let [;; Does `.getName` even work in CLJS? -- @noprompt
ex-message (util/format "Unable to convert from %s to %s"
(.getName type)
(name unit))
;; TODO: This needs to be populated with more helpful
;; data.
ex-data {:given {:type type
:unit unit}}]
(throw
(ex-info ex-message ex-data))))))
(defn make-unit-adder
"Create a addition function for adding Units."
[unit]
(let [u (make-unit-fn unit)]
(fn u+
([] (u 0))
([x] (u x))
([x y]
(let [{m1 :magnitude} (u x)
{m2 :magnitude} (u y)]
(u (+ m1 m2))))
([x y & more]
(reduce u+ (u+ x y) more)))))
(defn make-unit-subtractor
"Create a subtraction function for subtracting Units."
[unit]
(let [u (make-unit-fn unit)]
(fn u-
([x] (u (- x)))
([x y]
(let [{m1 :magnitude} (u x)
{m2 :magnitude} (u y)]
(u (- m1 m2))))
([x y & more]
(reduce u- (u- x y) more)))))
(defn make-unit-multiplier
"Create a multiplication function for multiplying Units."
[unit]
(let [u (make-unit-fn unit)]
(fn u*
([] (u 1))
([x] (u x))
([x y]
(let [{m1 :magnitude} (u x)
{m2 :magnitude} (u y)]
(u (* m1 m2))))
([x y & more]
(reduce u* (u* x y) more)))))
(defn make-unit-divider
"Create a division function for dividing Units."
[unit]
(let [u (make-unit-fn unit)]
(fn ud
([x] (u (/ 1 x)))
([x y]
(let [{m1 :magnitude} (u x)
{m2 :magnitude} (u y)]
(u (/ m1 m2))))
([x y & more]
(reduce ud (ud x y) more)))))
#?(:clj
(defmacro defunit
"Create a suite of functions for unit creation, conversion,
validation, and arithmetic."
([name]
`(defunit ~name ~name))
([name unit]
(let [k (keyword unit)
append #(symbol (str name %))]
`(do
(def ~name (make-unit-fn ~k))
(def ~(append \?) (make-unit-predicate ~k))
(def ~(append \+) (make-unit-adder ~k))
(def ~(append \-) (make-unit-subtractor ~k))
(def ~(append \*) (make-unit-multiplier ~k))
(def ~(append "-div") (make-unit-divider ~k)))))))
(comment
;; This:
(defunit px)
;; Is equivalent to:
(def px (make-unit-fn :px))
(def px? (make-unit-predicate :px))
(def px+ (make-unit-adder :px))
(def px- (make-unit-subtractor :px))
(def px* (make-unit-multiplier :px))
(def px-div (make-unit-divider :px)))
;; # Predefined units
;; Absolute units
(defunit cm)
(defunit mm)
(defunit in)
(defunit px)
(defunit pt)
(defunit pc)
(defunit percent "%")
;; Font-relative units
(defunit em)
(defunit ex)
(defunit ch)
(defunit rem)
;; Viewport-percentage lengths
(defunit vw)
(defunit vh)
(defunit vmin)
(defunit vmax)
;; Angles
(defunit deg)
(defunit grad)
(defunit rad)
(defunit turn)
;; Times
(defunit s)
(defunit ms)
;; Frequencies
(defunit Hz)
(defunit kHz)
;; Resolutions
(defunit dpi)
(defunit dpcm)
(defunit dppx)

179
src/mranderson047/garden/v1v3v3/garden/util.cljc Normal file
View File

@ -0,0 +1,179 @@
(ns mranderson047.garden.v1v3v3.garden.util
"Utility functions used by Garden."
(:require
[clojure.string :as str]
[mranderson047.garden.v1v3v3.garden.types :as t]
#?@(:cljs
[[goog.string]
[goog.string.format]]))
#?(:clj
(:refer-clojure :exclude [format]))
#?(:clj
(:import garden.types.CSSAtRule)))
;; ---------------------------------------------------------------------
;; String utilities
#?(:cljs
(defn format
"Formats a string using goog.string.format."
[fmt & args]
(apply goog.string/format fmt args)))
;; To avoid the pain of #?cljs :refer.
#?(:clj
(def format #'clojure.core/format))
(defprotocol ToString
(^String to-str [this] "Convert a value into a string."))
(extend-protocol ToString
#?(:clj clojure.lang.Keyword)
#?(:cljs Keyword)
(to-str [this] (name this))
#?(:clj Object)
#?(:cljs default)
(to-str [this] (str this))
nil (to-str [this] ""))
(defn ^String as-str
"Convert a variable number of values into strings."
[& args]
(apply str (map to-str args)))
(defn string->int
"Convert a string to an integer with optional base."
[s & [radix]]
(let [radix (or radix 10)]
#?(:clj
(Integer/parseInt ^String s ^Long radix))
#?(:cljs
(js/parseInt s radix))))
(defn int->string
"Convert an integer to a string with optional base."
[i & [radix]]
(let [radix (or radix 10)]
#?(:clj
(Integer/toString ^Long i ^Long radix))
#?(:cljs
(.toString i radix))))
(defn space-join
"Return a space separated list of values."
[xs]
(str/join " " (map to-str xs)))
(defn comma-join
"Return a comma separated list of values. Subsequences are joined with
spaces."
[xs]
(let [ys (for [x xs]
(if (sequential? x)
(space-join x)
(to-str x)))]
(str/join ", " ys)))
(defn wrap-quotes
"Wrap a string with double quotes."
[s]
(str \" s \"))
;; ---------------------------------------------------------------------
;; Predicates
(defn hash-map?
"True if `(map? x)` and `x` does not satisfy `clojure.lang.IRecord`."
[x]
(and (map? x) (not (record? x))))
(def
^{:doc "Alias to `vector?`."}
rule? vector?)
(def
^{:doc "Alias to `hash-map?`."}
declaration? hash-map?)
(defn at-rule?
[x]
(instance? #?(:clj CSSAtRule) #?(:cljs t/CSSAtRule) x))
(defn at-media?
"True if `x` is a CSS `@media` rule."
[x]
(and (at-rule? x) (= (:identifier x) :media)))
(defn at-keyframes?
"True if `x` is a CSS `@keyframes` rule."
[x]
(and (at-rule? x) (= (:identifier x) :keyframes)))
(defn at-import?
"True if `x` is a CSS `@import` rule."
[x]
(and (at-rule? x) (= (:identifier x) :import)))
(defn prefix
"Attach a CSS style prefix to s."
[p s]
(let [p (to-str p)]
(if (= \- (last p))
(str p s)
(str p \- s))))
(defn vendor-prefix
"Attach a CSS vendor prefix to s."
[p s]
(let [p (to-str p)]
(if (= \- (first p))
(prefix p s)
(prefix (str \- p) s))))
;; ---------------------------------------------------------------------
;; Math utilities
(defn natural?
"True if n is a natural number."
[n]
(and (integer? n) (pos? n)))
(defn between?
"True if n is a number between a and b."
[n a b]
(let [bottom (min a b)
top (max a b)]
(and (>= n bottom) (<= n top))))
(defn clip
"Return a number such that n is no less than a and no more than b."
[a b n]
(let [[a b] (if (<= a b) [a b] [b a])]
(max a (min b n))))
(defn average
"Return the average of two or more numbers."
[n m & more]
(/ (apply + n m more) (+ 2.0 (count more))))
;; Taken from clojure.math.combinatorics.
(defn cartesian-product
"All the ways to take one item from each sequence."
[& seqs]
(let [v-original-seqs (vec seqs)
step
(fn step [v-seqs]
(let [increment
(fn [v-seqs]
(loop [i (dec (count v-seqs)), v-seqs v-seqs]
(if (= i -1) nil
(if-let [rst (next (v-seqs i))]
(assoc v-seqs i rst)
(recur (dec i) (assoc v-seqs i (v-original-seqs i)))))))]
(when v-seqs
(cons (map first v-seqs)
(lazy-seq (step (increment v-seqs)))))))]
(when (every? seq seqs)
(lazy-seq (step v-original-seqs)))))