From e98329641e24bfdd89e3af120e4e73739c1538af Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Fri, 26 Jan 2018 21:52:52 +1300 Subject: [PATCH 01/35] Version 0.1.17-SNAPSHOT --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 4aae312..8c123b3 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject day8.re-frame/trace "0.1.16" +(defproject day8.re-frame/trace "0.1.17-SNAPSHOT" :description "Tracing and developer tools for re-frame apps" :url "https://github.com/Day8/re-frame-trace" :license {:name "MIT"} From 0047658825998946b18de41559645fd5b26d10db Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Fri, 26 Jan 2018 21:56:04 +1300 Subject: [PATCH 02/35] Fixup source dependency of re-frame to match what is on disk --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 8c123b3..68718a2 100644 --- a/project.clj +++ b/project.clj @@ -31,7 +31,7 @@ :target-path "resources/day8/re_frame/trace"} :profiles {:dev {:dependencies [[binaryage/dirac "RELEASE"]]} - :mranderson {:dependencies ^:replace [^:source-dep [re-frame "0.10.3" + :mranderson {:dependencies ^:replace [^:source-dep [re-frame "0.10.2" :exclusions [org.clojure/clojurescript cljsjs/react cljsjs/react-dom From 7977aa2f3afcdc8c40854fbc30ddee8611ebce7b Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Fri, 26 Jan 2018 22:01:11 +1300 Subject: [PATCH 03/35] Update README with React 16 instructions --- README.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 82bbb0a..98a128b 100644 --- a/README.md +++ b/README.md @@ -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`. ### Helpful How? @@ -93,6 +93,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: From a425ebf5190a481708603957a9c007fea9fb4fcd Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Fri, 26 Jan 2018 22:01:54 +1300 Subject: [PATCH 04/35] Update changelog --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4fe0e7b..630b953 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,10 @@ All notable changes to this project will be documented in this file. This change ## Unreleased + + +## [0.1.16] - 2018-01-26 + ### Added * Setting to control how many epochs are retained From 547822e7d992af71dd958ea787f3d337a3366101 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Fri, 26 Jan 2018 22:03:01 +1300 Subject: [PATCH 05/35] Update changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 630b953..8013ede 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,8 @@ All notable changes to this project will be documented in this file. This change ## [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 From f20dd1b0d08bd99f5b3d5cf516f12ff9e36204b1 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sat, 27 Jan 2018 18:44:45 +1300 Subject: [PATCH 06/35] Bundle garden to avoid source conflicts with garden 2.0.0 --- project.clj | 5 +- source-deps.sh | 1 + src/day8/re_frame/trace/common_styles.cljs | 4 +- src/day8/re_frame/trace/styles.cljs | 8 +- src/day8/re_frame/trace/view/container.cljs | 4 +- src/day8/re_frame/trace/view/settings.cljs | 4 +- .../garden/v1v3v3/garden/arithmetic.cljc | 92 ++ .../garden/v1v3v3/garden/color.cljc | 619 ++++++++++ .../garden/v1v3v3/garden/compiler.cljc | 753 ++++++++++++ .../garden/v1v3v3/garden/compression.cljc | 97 ++ .../garden/v1v3v3/garden/core.cljc | 17 + .../garden/v1v3v3/garden/def.clj | 119 ++ .../garden/v1v3v3/garden/media.cljc | 27 + .../garden/v1v3v3/garden/repl.clj | 31 + .../garden/v1v3v3/garden/selectors.cljc | 1057 +++++++++++++++++ .../garden/v1v3v3/garden/stylesheet.cljc | 79 ++ .../garden/v1v3v3/garden/types.cljc | 8 + .../garden/v1v3v3/garden/units.cljc | 327 +++++ .../garden/v1v3v3/garden/util.cljc | 179 +++ 19 files changed, 3419 insertions(+), 12 deletions(-) create mode 100644 src/mranderson047/garden/v1v3v3/garden/arithmetic.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/color.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/compiler.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/compression.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/core.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/def.clj create mode 100644 src/mranderson047/garden/v1v3v3/garden/media.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/repl.clj create mode 100644 src/mranderson047/garden/v1v3v3/garden/selectors.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/stylesheet.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/types.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/units.cljc create mode 100644 src/mranderson047/garden/v1v3v3/garden/util.cljc diff --git a/project.clj b/project.clj index 68718a2..1d11907 100644 --- a/project.clj +++ b/project.clj @@ -7,7 +7,6 @@ [reagent "0.6.0" :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]]]}}) diff --git a/source-deps.sh b/source-deps.sh index 8911085..4ea2b97 100755 --- a/source-deps.sh +++ b/source-deps.sh @@ -5,4 +5,5 @@ lein with-profile mranderson source-deps # Then delete the META-INF directories rm -r target/srcdeps/mranderson047/reagent/v0v7v0/META-INF rm -r target/srcdeps/mranderson047/re-frame +rm -r target/srcdeps/mranderson047/garden/v1v3v3/META-INF cp -r target/srcdeps/mranderson047 src diff --git a/src/day8/re_frame/trace/common_styles.cljs b/src/day8/re_frame/trace/common_styles.cljs index 55ff3ae..70134b9 100644 --- a/src/day8/re_frame/trace/common_styles.cljs +++ b/src/day8/re_frame/trace/common_styles.cljs @@ -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) diff --git a/src/day8/re_frame/trace/styles.cljs b/src/day8/re_frame/trace/styles.cljs index b083b50..e09a8cd 100644 --- a/src/day8/re_frame/trace/styles.cljs +++ b/src/day8/re_frame/trace/styles.cljs @@ -1,9 +1,9 @@ (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] diff --git a/src/day8/re_frame/trace/view/container.cljs b/src/day8/re_frame/trace/view/container.cljs index 7285c55..45a9137 100644 --- a/src/day8/re_frame/trace/view/container.cljs +++ b/src/day8/re_frame/trace/view/container.cljs @@ -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])) diff --git a/src/day8/re_frame/trace/view/settings.cljs b/src/day8/re_frame/trace/view/settings.cljs index 51ac35b..0f90efe 100644 --- a/src/day8/re_frame/trace/view/settings.cljs +++ b/src/day8/re_frame/trace/view/settings.cljs @@ -3,8 +3,8 @@ [mranderson047.reagent.v0v7v0.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") diff --git a/src/mranderson047/garden/v1v3v3/garden/arithmetic.cljc b/src/mranderson047/garden/v1v3v3/garden/arithmetic.cljc new file mode 100644 index 0000000..f20e7c7 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/arithmetic.cljc @@ -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))) diff --git a/src/mranderson047/garden/v1v3v3/garden/color.cljc b/src/mranderson047/garden/v1v3v3/garden/color.cljc new file mode 100644 index 0000000..20a4d78 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/color.cljc @@ -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)))) diff --git a/src/mranderson047/garden/v1v3v3/garden/compiler.cljc b/src/mranderson047/garden/v1v3v3/garden/compiler.cljc new file mode 100644 index 0000000..fbab912 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/compiler.cljc @@ -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)))) diff --git a/src/mranderson047/garden/v1v3v3/garden/compression.cljc b/src/mranderson047/garden/v1v3v3/garden/compression.cljc new file mode 100644 index 0000000..df6bf39 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/compression.cljc @@ -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)))) diff --git a/src/mranderson047/garden/v1v3v3/garden/core.cljc b/src/mranderson047/garden/v1v3v3/garden/core.cljc new file mode 100644 index 0000000..c8c582d --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/core.cljc @@ -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)) + diff --git a/src/mranderson047/garden/v1v3v3/garden/def.clj b/src/mranderson047/garden/v1v3v3/garden/def.clj new file mode 100644 index 0000000..9d83e6d --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/def.clj @@ -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))) + + diff --git a/src/mranderson047/garden/v1v3v3/garden/media.cljc b/src/mranderson047/garden/v1v3v3/garden/media.cljc new file mode 100644 index 0000000..4e20ead --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/media.cljc @@ -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}) diff --git a/src/mranderson047/garden/v1v3v3/garden/repl.clj b/src/mranderson047/garden/v1v3v3/garden/repl.clj new file mode 100644 index 0000000..7cd25ce --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/repl.clj @@ -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))) diff --git a/src/mranderson047/garden/v1v3v3/garden/selectors.cljc b/src/mranderson047/garden/v1v3v3/garden/selectors.cljc new file mode 100644 index 0000000..8122b93 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/selectors.cljc @@ -0,0 +1,1057 @@ +(ns mranderson047.garden.v1v3v3.garden.selectors + "Macros and functions for working with CSS selectors." + (:require + [clojure.string :as string]) + #?(:clj + (:refer-clojure :exclude [+ - > empty first map meta not time var])) + #?(:clj + (:import clojure.lang.Keyword + clojure.lang.Symbol + clojure.lang.IFn + clojure.lang.Named)) + #?(:cljs + (:refer-clojure :exclude [+ - > empty first map meta not time])) + #?(:cljs + (:require-macros + [mranderson047.garden.v1v3v3.garden.selectors :refer [defselector + defid + defpseudoclass + defpseudoelement + gen-type-selector-defs + gen-pseudo-class-defs]]))) + +(defprotocol ICSSSelector + (css-selector [this])) + +(defn selector? [x] + (satisfies? ICSSSelector x)) + +(extend-protocol ICSSSelector + #?(:clj String + :cljs string) + (css-selector [this] this) + + Keyword + (css-selector [this] + (name this)) + + Symbol + (css-selector [this] + (name this))) + +#?(:clj + (defrecord CSSSelector [selector] + ICSSSelector + (css-selector [this] + (css-selector (:selector this))) + + IFn + (invoke [this] + this) + (invoke [this a] + (CSSSelector. (str (css-selector this) + (css-selector a)))) + (invoke [this a b] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b)))) + (invoke [this a b c] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c)))) + (invoke [this a b c d] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d)))) + (invoke [this a b c d e] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e)))) + (invoke [this a b c d e f] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f)))) + (invoke [this a b c d e f g] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g)))) + (invoke [this a b c d e f g h] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h)))) + (invoke [this a b c d e f g h i] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i)))) + (invoke [this a b c d e f g h i j] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j)))) + (invoke [this a b c d e f g h i j k] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k)))) + (invoke [this a b c d e f g h i j k l] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l)))) + (invoke [this a b c d e f g h i j k l m] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m)))) + (invoke [this a b c d e f g h i j k l m n] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n)))) + (invoke [this a b c d e f g h i j k l m n o] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o)))) + (invoke [this a b c d e f g h i j k l m n o p] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p)))) + (invoke [this a b c d e f g h i j k l m n o p q] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q)))) + (invoke [this a b c d e f g h i j k l m n o p q r] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r)))) + (invoke [this a b c d e f g h i j k l m n o p q r s] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r) + (css-selector s)))) + (invoke [this a b c d e f g h i j k l m n o p q r s t] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r) + (css-selector s) + (css-selector t)))) + + (applyTo [this args] + (clojure.lang.AFn/applyToHelper this args)))) + +#?(:cljs + (defrecord CSSSelector [selector] + ICSSSelector + (css-selector [this] + (css-selector (:selector this))) + + IFn + (-invoke [this] + this) + (-invoke [this a] + (CSSSelector. (str (css-selector this) + (css-selector a)))) + (-invoke [this a b] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b)))) + (-invoke [this a b c] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c)))) + (-invoke [this a b c d] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d)))) + (-invoke [this a b c d e] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e)))) + (-invoke [this a b c d e f] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f)))) + (-invoke [this a b c d e f g] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g)))) + (-invoke [this a b c d e f g h] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h)))) + (-invoke [this a b c d e f g h i] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i)))) + (-invoke [this a b c d e f g h i j] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j)))) + (-invoke [this a b c d e f g h i j k] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k)))) + (-invoke [this a b c d e f g h i j k l] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l)))) + (-invoke [this a b c d e f g h i j k l m] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m)))) + (-invoke [this a b c d e f g h i j k l m n] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n)))) + (-invoke [this a b c d e f g h i j k l m n o] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o)))) + (-invoke [this a b c d e f g h i j k l m n o p] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p)))) + (-invoke [this a b c d e f g h i j k l m n o p q] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q)))) + (-invoke [this a b c d e f g h i j k l m n o p q r] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r)))) + (-invoke [this a b c d e f g h i j k l m n o p q r s] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r) + (css-selector s)))) + (-invoke [this a b c d e f g h i j k l m n o p q r s t] + (CSSSelector. (str (css-selector this) + (css-selector a) + (css-selector b) + (css-selector c) + (css-selector d) + (css-selector e) + (css-selector f) + (css-selector g) + (css-selector h) + (css-selector i) + (css-selector j) + (css-selector k) + (css-selector l) + (css-selector m) + (css-selector n) + (css-selector o) + (css-selector p) + (css-selector q) + (css-selector r) + (css-selector s) + (css-selector t)))))) + + +(defn selector [x] + (CSSSelector. x)) + +;; --------------------------------------------------------------------- +;; Macros + +#?(:clj + (defmacro defselector + "Define an instance of a CSSSelector named sym for creating a + CSS selector. This instance doubles as both a function and a + literal (when passed to the css-selector). When the function is called + it will return a new instance that possesses the same properties. All + arguments to the function must satisfy ICSSSelector. + + Example: + + (defselector a) + ;; => #'user/a + (a \":hover\") + ;; => # + (css-selector a) + ;; => \"a\" + (css-selector (a \":hover\")) + ;; => \"a:hover\" + " + ([sym] + `(defselector ~sym ~(name sym))) + ([sym strval] + {:pre [(string? strval)]} + (let [[_ sym v] (macroexpand `(def ~sym (selector ~strval))) + sym (vary-meta sym assoc :arglists `'([~'& ~'selectors]))] + `(def ~sym ~v))))) + +#?(:clj + (defmacro defclass [sym] + `(defselector ~sym ~(str "." (name sym))))) + +#?(:clj + (defmacro defid [sym] + `(defselector ~sym ~(str "#" (name sym))))) + +#?(:clj + (defmacro defpseudoclass + "Define an instance of a CSSSelector named sym for creating a CSS + pseudo class. This instance doubles as both a function and a + literal (when passed to the css-selector). When the function is called + it will return a new instance that possesses the same properties. All + arguments to the function must satisfy ICSSSelector. + + Optionally fn-tail may be passed to create a structual pseudo class. + The return value of the function constructed from fn-tail will be + cast to a string via css-selector or str. + + Example: + + (defselector a) + ;; => #'user/a + (defpseudoclass hover) + ;; => #'user/hover + (hover) + ;; => # + (p/selector (a hover)) + ;; => \"a:hover\" + + Example: + + (defpseudoclass not [x] + (p/selector x)) + ;; => #'user/not + (p/selector (a hover (not \"span\")) + ;; => a:hover:not(span) + + ;; Where p/selector is mranderson047.garden.v1v3v3.garden.protocols/selector + " + [sym & fn-tail] + (if (seq fn-tail) + (let [fn1 (macroexpand `(fn ~fn-tail)) + arglists (clojure.core/map clojure.core/first (rest fn1)) + [_ sym fn2] (macroexpand + `(defn ~sym [& args#] + (let [v# (apply ~fn1 args#) + v# (if (selector? v#) + (css-selector v#) + v#)] + (selector (str \: ~(name sym) "(" v# ")"))))) + sym (vary-meta sym assoc :arglists `'~arglists)] + `(def ~sym ~fn2)) + `(defselector ~sym ~(str \: (name sym)))))) + +#?(:clj + (defmacro defpseudoelement + "Define an instance of a CSSSelector named sym for creating a CSS + pseudo element. This instance doubles as both a function and a + literal (when passed to the css-selector). When the function is called + it will return a new instance that possesses the same properties. All + arguments to the function must satisfy ICSSSelector. + + Example: + + (defselector p) + ;; => #'user/p + (defpseudoelement first-letter) + ;; => #'user/first-letter + (first-letter) + ;; => # + (p/selector (p first-letter)) + ;; => \"p::first-letter\" + + ;; Where p/selector is mranderson047.garden.v1v3v3.garden.protocols/selector + " + [sym] + `(defselector ~sym ~(str "::" (name sym))))) + +;;---------------------------------------------------------------------- +;; Type selectors classes + +(def ^:private html-tags + '[a + abbr + address + area + article + aside + audio + b + base + bdi + bdo + blockquote + body + br + button + canvas + caption + cite + code + col + colgroup + command + datalist + dd + del + details + dfn + div + dl + dt + em + embed + fieldset + figcaption + figure + footer + form + h1 + h2 + h3 + h4 + h5 + h6 + head + header + hgroup + hr + html + i + iframe + img + input + ins + kbd + keygen + label + legend + li + link + map + mark + math + menu + meta + meter + nav + noscript + object + ol + optgroup + option + output + p + param + pre + progress + q + rp + rt + ruby + s + samp + script + section + select + small + source + span + strong + style + sub + summary + sup + svg + table + tbody + td + textarea + tfoot + th + thead + time + title + tr + track + u + ul + var + video + wbr]) + +#?(:clj + (defmacro ^:private gen-type-selector-defs [] + `(do + ~@(for [tag html-tags + :let [doc (str "CSS " tag " type selector.") + tag (vary-meta tag assoc :doc doc)]] + `(defselector ~tag))))) + +(gen-type-selector-defs) + +;;---------------------------------------------------------------------- +;; Pseudo classes + +(def ^:private pseudo-classes + '[active + checked + default + disabled + empty + enabled + first + first-child + first-of-type + fullscreen + focus + hover + indeterminate + in-range + invalid + last-child + last-of-type + left + links + only-child + only-of-type + optional + out-of-range + read-only + read-write + required + right + root + scope + target + valid + visited]) + +#?(:clj + (defn- gen-pseudo-class-def [p] + (let [p (vary-meta p assoc :doc (str "CSS :" p " pseudo-class selector."))] + `(defpseudoclass ~p)))) + +#?(:clj + (defmacro ^:private gen-pseudo-class-defs [] + `(do + ~@(for [p pseudo-classes] + (gen-pseudo-class-def p))))) + +(gen-pseudo-class-defs) + +;;---------------------------------------------------------------------- +;; Structural pseudo classes + +(defpseudoclass lang [language] + (name language)) + +(defpseudoclass not [selector] + (css-selector selector)) + +;; SEE: http://www.w3.org/TR/selectors/#nth-child-pseudo +(def nth-child-re + #?(:clj + #"\s*(?i:[-+]?\d+n\s*(?:[-+]\s*\d+)?|[-+]?\d+|odd|even)\s*") + #?(:cljs + (js/RegExp. "\\s*(?:[-+]?\\d+n\\s*(?:[-+]\\s*\\d+)?|[-+]?\\d+|odd|even)\\s*" + "i"))) + +(defn nth-x + "nth-child helper." + [x] + (assert (or (string? x) (keyword? x) (symbol? x)) + "Agument must be a string, keyword, or symbol") + (let [s (name x)] + (if-let [m (re-matches nth-child-re s)] + m + (throw (ex-info + "Selector must be either a keyword, string, or symbol." (str "Invalid value " (pr-str s))))))) + +(defpseudoclass + ^{:doc "CSS :nth-child pseudo class selector."} + nth-child [x] + (if (number? x) + (nth-x (str x "n")) + (nth-x x))) + +(defpseudoclass + ^{:doc "CSS :nth-last-child pseudo class selector."} + nth-last-child [x] + (nth-x x)) + +(defpseudoclass + ^{:doc "CSS :nth-of-type pseudo class selector."} + nth-of-type [x] + (nth-x x)) + +(defpseudoclass + ^{:doc "CSS :nth-last-of-type pseudo class selector."} + nth-last-of-type [x] + (nth-x x)) + +;; --------------------------------------------------------------------- +;; Pseudo elements + +(defpseudoelement + ^{:doc "CSS ::after pseudo element selector."} + after) + +(defpseudoelement + ^{:doc "CSS ::before pseudo element selector."} + before) + +(defpseudoelement + ^{:doc "CSS ::first-letter pseudo element selector."} + first-letter) + +(defpseudoelement + ^{:doc "CSS ::first-line pseudo element selector."} + first-line) + +;; --------------------------------------------------------------------- +;; Attribute selectors + +;; SEE: http://www.w3.org/TR/selectors/#attribute-selectors + +(defn attr + ([attr-name] + (selector (str \[ (name attr-name) \]))) + ([attr-name op attr-value] + (let [v (name attr-value) + ;; Wrap the value in quotes unless it's already + ;; quoted to prevent emitting bad selectors. + v (if (re-matches #"\"(\\|[^\"])*\"|'(\\|[^\'])*'" v) + v + (pr-str v))] + (selector (str \[ (name attr-name) (name op) v \]))))) + +(defn attr= [attr-name attr-value] + (attr attr-name "=" attr-value)) + +(defn attr-contains [attr-name attr-value] + (attr attr-name "~=" attr-value)) + +(defn attr-starts-with [attr-name attr-value] + (attr attr-name "^=" attr-value)) + +;; TODO: This needs a better name. +(defn attr-starts-with* [attr-name attr-value] + (attr attr-name "|=" attr-value)) + +(defn attr-ends-with [attr-name attr-value] + (attr attr-name "$=" attr-value)) + +(defn attr-matches [attr-name attr-value] + (attr attr-name "*=" attr-value)) + +;;---------------------------------------------------------------------- +;; Selectors combinators + +;; SEE: http://www.w3.org/TR/selectors/#combinators + +(defn descendant + "Descendant combinator." + ([a b] + (selector (str (css-selector a) " " (css-selector b)))) + ([a b & more] + (->> (cons (descendant a b) more) + (clojure.core/map css-selector) + (string/join " ") + (selector)))) + +(defn + + "Adjacent sibling combinator." + [a b] + (selector (str (css-selector a) " + " (css-selector b)))) + +(defn - + "General sibling combinator." + [a b] + (selector (str (css-selector a) " ~ " (css-selector b)))) + +(defn > + "Child combinator." + ([a] + (selector a)) + ([a b] + (selector (str (css-selector a) " > " (css-selector b)))) + ([a b & more] + (->> (cons (> a b) more) + (clojure.core/map css-selector) + (string/join " > ") + (selector)))) + +;; --------------------------------------------------------------------- +;; Special selectors + +(defselector + ^{:doc "Parent selector."} + &) + +;;---------------------------------------------------------------------- +;; Specificity + +;; SEE: http://www.w3.org/TR/selectors/#specificity + +(defn- lex-specificity [s] + (let [id-selector-re #"^\#[a-zA-Z][\w-]*" + class-selector-re #"^\.[a-zA-Z][\w-]*" + attribute-selector-re #"^\[[^\]]*\]" + type-selector-re #"^[a-zA-Z][\w-]" + pseudo-class-re #"^:[a-zA-Z][\w-]*(?:\([^\)]+\))?" + pseudo-element-re #"^::[a-zA-Z][\w-]*"] + (some + (fn [[re k]] + (if-let [m (re-find re s)] + [m k])) + [[id-selector-re :a] + [class-selector-re :b] + [attribute-selector-re :b] + [pseudo-class-re :b] + [type-selector-re :c] + [pseudo-element-re :c]]))) + +(defn- specificity* [selector] + (let [s (css-selector selector) + score {:a 0 :b 0 :c 0}] + (loop [s s, score score] + (if (empty? s) + score + (if-let [[m k] (lex-specificity s)] + ;; The negation pseudo class is a special case. + (if-let [[_ inner] (re-find #"^:not\(([^\)]*)\)" m)] + (recur (subs s (count m)) + (merge-with clojure.core/+ score (specificity* inner))) + (recur (subs s (count m)) (update-in score [k] inc))) + (recur (subs s 1) score)))))) + +(defn specificity + "Calculate a CSS3 selector's specificity. + + Example: + + (specificity \"#s12:not(FOO)\") + ;; => 101 + (specificity (a hover)) + ;; => 10 + " + [selector] + {:pre [(satisfies? ICSSSelector selector)]} + (let [{:keys [a b c]} (specificity* selector) + sv (string/replace (str a b c) #"^0*" "")] + (if (empty? sv) + 0 + #?(:clj (Integer. sv) + :cljs (js/parseInt sv))))) diff --git a/src/mranderson047/garden/v1v3v3/garden/stylesheet.cljc b/src/mranderson047/garden/v1v3v3/garden/stylesheet.cljc new file mode 100644 index 0000000..8d0b1a1 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/stylesheet.cljc @@ -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])) diff --git a/src/mranderson047/garden/v1v3v3/garden/types.cljc b/src/mranderson047/garden/v1v3v3/garden/types.cljc new file mode 100644 index 0000000..841021e --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/types.cljc @@ -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]) diff --git a/src/mranderson047/garden/v1v3v3/garden/units.cljc b/src/mranderson047/garden/v1v3v3/garden/units.cljc new file mode 100644 index 0000000..0da5cf5 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/units.cljc @@ -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) diff --git a/src/mranderson047/garden/v1v3v3/garden/util.cljc b/src/mranderson047/garden/v1v3v3/garden/util.cljc new file mode 100644 index 0000000..d8c1e16 --- /dev/null +++ b/src/mranderson047/garden/v1v3v3/garden/util.cljc @@ -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))))) From ddcee6b2c8ca16c87b2f9dc5c6c8ec967130b941 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sat, 27 Jan 2018 22:50:36 +1300 Subject: [PATCH 07/35] Remove ratom state and centralise it in re-frame's app-db --- src/day8/re_frame/trace/events.cljs | 82 +++++++++++++++-------------- 1 file changed, 42 insertions(+), 40 deletions(-) diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index 2fc9b65..7447824 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -17,9 +17,6 @@ (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) @@ -33,33 +30,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 +81,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 _] @@ -158,12 +122,11 @@ num (if (and (not (js/isNaN num)) (pos-int? num)) num default-number-of-epochs-to-retain)] - (reset! number-of-epochs-to-retain num) (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 @@ -523,6 +486,46 @@ [m] (-> m first :id)) +(rf/reg-event-db + :epochs/receive-new-traces + (fn [db [_ new-traces]] + (when-let [new-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) + + + #_ #_ total-traces (get-in db [:traces :total-traces]) + #_ #_ new-total-traces (+ total-traces (count new-traces))] + #_(swap! total-traces + (count new-traces)) + ;; TODO: add this back in once the algorithm is better defined + #_(swap! traces + (fn [existing] + (let [new (reduce conj existing new-traces) + size (count new)] + (if (< 8000 size) + (let [new2 (subvec new (- size 4000))] + (if (< new-total-traces 40000) ;; Create a new vector to avoid structurally sharing all traces forever + (do (comment "Total traces set to 0") ;(reset! total-traces 0) + (into [] new2)))) + new)))) + (swap! traces (fn [existing] (reduce conj existing new-traces))) + ;; 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 to new traces + #_(reset! total-traces (count new-traces)) + (rf/dispatch [:traces/update-traces new-traces]) + (rf/dispatch [:epochs/update-epochs {:matches retained-epochs}])))) + db)) + (rf/reg-event-db :epochs/update-epochs [(rf/path [:epochs])] @@ -564,7 +567,6 @@ (fn [db] (re-frame.trace/reset-tracing!) (reset! traces []) - (reset! total-traces 0) (dissoc db :epochs :traces))) (rf/reg-event-db From 2b414ff9f2bb8d4b35e6bdc7d5baf608f0eb735c Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sat, 27 Jan 2018 23:06:33 +1300 Subject: [PATCH 08/35] Fix displaying external windows The bug was introduced in 022a070fb86ffad655b5a6799f018e659a73492d. --- CHANGELOG.md | 4 ++++ src/day8/re_frame/trace/events.cljs | 15 ++++++++------- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8013ede..30ad512 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,10 @@ All notable changes to this project will be documented in this file. This change ## Unreleased +### Fixed + +* External windows not loading + ## [0.1.16] - 2018-01-26 diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index 7447824..720f85b 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -198,27 +198,28 @@ ;; 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} ])})] 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 "
") + (.write d "
") (goog.object/set w "onload" #(mount w d)) (.close d))) From d9d8ec049d57f4b21673bdeeaa12e44bb2aa2030 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sat, 27 Jan 2018 23:35:34 +1300 Subject: [PATCH 09/35] Make all pod expansions independent of each other Fixes #134 --- CHANGELOG.md | 1 + src/day8/re_frame/trace/view/components.cljs | 2 +- src/day8/re_frame/trace/view/subs.cljs | 4 +++- 3 files changed, 5 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 30ad512..aa2f68e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,7 @@ All notable changes to this project will be documented in this file. This change ### 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). diff --git a/src/day8/re_frame/trace/view/components.cljs b/src/day8/re_frame/trace/view/components.cljs index 6793d9c..dd2fb29 100644 --- a/src/day8/re_frame/trace/view/components.cljs +++ b/src/day8/re_frame/trace/view/components.cljs @@ -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 diff --git a/src/day8/re_frame/trace/view/subs.cljs b/src/day8/re_frame/trace/view/subs.cljs index 307c3c3..190fb2a 100644 --- a/src/day8/re_frame/trace/view/subs.cljs +++ b/src/day8/re_frame/trace/view/subs.cljs @@ -171,7 +171,9 @@ :overflow-x "auto" :overflow-y "hidden"} :children [[components/simple-render - (:value pod-info)]]])] + (:value pod-info) + ["sub-path" path] + ]]])] [animated/component (animated/v-box-options {:enter-animation "accordionVertical" :leave-animation "accordionVertical" From 3235e5a50de33544cc321f01a0e3d66312908844 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sat, 27 Jan 2018 23:59:33 +1300 Subject: [PATCH 10/35] Remove all local ratom state for storing traces --- src/day8/re_frame/trace.cljs | 48 +++++++++---------- src/day8/re_frame/trace/events.cljs | 52 ++++++--------------- src/day8/re_frame/trace/view/container.cljs | 6 +-- src/day8/re_frame/trace/view/event.cljs | 2 +- src/day8/re_frame/trace/view/traces.cljs | 2 +- 5 files changed, 42 insertions(+), 68 deletions(-) diff --git a/src/day8/re_frame/trace.cljs b/src/day8/re_frame/trace.cljs index f03f2b7..8ae82f0 100644 --- a/src/day8/re_frame/trace.cljs +++ b/src/day8/re_frame/trace.cljs @@ -114,18 +114,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 +136,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 +157,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 +190,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 +217,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 +233,8 @@ (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)) diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index 720f85b..f115353 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -14,10 +14,6 @@ [day8.re-frame.trace.metamorphic :as metam] [re-frame.trace])) -(def default-number-of-epochs-to-retain 5) - -(defonce traces (r/atom [])) - (defn log-trace? [trace] (let [render-operation? (or (= (:op-type trace) :render) (= (:op-type trace) :componentWillUnmount)) @@ -121,7 +117,7 @@ (let [num (js/parseInt num-str) num (if (and (not (js/isNaN num)) (pos-int? num)) num - default-number-of-epochs-to-retain)] + 5)] (localstorage/save! "retained-epochs" num) (assoc-in db [:settings :number-of-epochs] num)))) @@ -206,8 +202,7 @@ [(r/create-class {: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 @@ -494,37 +489,17 @@ (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) - - - #_ #_ total-traces (get-in db [:traces :total-traces]) - #_ #_ new-total-traces (+ total-traces (count new-traces))] - #_(swap! total-traces + (count new-traces)) - ;; TODO: add this back in once the algorithm is better defined - #_(swap! traces - (fn [existing] - (let [new (reduce conj existing new-traces) - size (count new)] - (if (< 8000 size) - (let [new2 (subvec new (- size 4000))] - (if (< new-total-traces 40000) ;; Create a new vector to avoid structurally sharing all traces forever - (do (comment "Total traces set to 0") ;(reset! total-traces 0) - (into [] new2)))) - new)))) - (swap! traces (fn [existing] (reduce conj existing new-traces))) - ;; 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 to new traces - #_(reset! total-traces (count new-traces)) - (rf/dispatch [:traces/update-traces new-traces]) - (rf/dispatch [:epochs/update-epochs {:matches retained-epochs}])))) + existing-traces (get-in db [:traces :all-traces]) + new-traces (reduce conj existing-traces new-traces) + matches (:matches (metam/parse-traces new-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)) new-traces)] + (rf/dispatch [:traces/update-traces new-traces]) + (rf/dispatch [:epochs/update-epochs {:matches retained-epochs}]))) db)) (rf/reg-event-db @@ -567,7 +542,6 @@ :epochs/reset (fn [db] (re-frame.trace/reset-tracing!) - (reset! traces []) (dissoc db :epochs :traces))) (rf/reg-event-db diff --git a/src/day8/re_frame/trace/view/container.cljs b/src/day8/re_frame/trace/view/container.cljs index 45a9137..c6f782c 100644 --- a/src/day8/re_frame/trace/view/container.cljs +++ b/src/day8/re_frame/trace/view/container.cljs @@ -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) @@ -156,11 +156,11 @@ ;: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] diff --git a/src/day8/re_frame/trace/view/event.cljs b/src/day8/re_frame/trace/view/event.cljs index ef6eaa6..9f7629d 100644 --- a/src/day8/re_frame/trace/view/event.cljs +++ b/src/day8/re_frame/trace/view/event.cljs @@ -2,7 +2,7 @@ (:require [day8.re-frame.trace.utils.re-com :as rc] [day8.re-frame.trace.metamorphic :as metam])) -(defn render [traces] +(defn render [] [rc/v-box :padding "12px 0px" :children [[rc/label :label "Event"] diff --git a/src/day8/re_frame/trace/view/traces.cljs b/src/day8/re_frame/trace/view/traces.cljs index a24546e..14fe6f4 100644 --- a/src/day8/re_frame/trace/view/traces.cljs +++ b/src/day8/re_frame/trace/view/traces.cljs @@ -80,7 +80,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) From 6c5623a5d0d5b5be239543383a81f2c02b7e677c Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sun, 28 Jan 2018 10:02:17 +1300 Subject: [PATCH 11/35] Update changelog --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index aa2f68e..91f6e5e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,10 @@ All notable changes to this project will be documented in this file. This change ## Unreleased +### Changed + +* The version of Garden that re-frame-trace uses is now bundled as a source dependency so you should no longer get conflicts. + ### Fixed * External windows not loading From af4afbae8838fd5e45d1bc8537868bab4aca21f0 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sun, 28 Jan 2018 10:01:13 +1300 Subject: [PATCH 12/35] Handle initial state when there are no previous traces (reduce conj existing ...) was returning a seq instead of a vector for the first received traces, because it was existing was nil instead of the empty vector. --- src/day8/re_frame/trace/events.cljs | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index f115353..d1bb403 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -485,22 +485,23 @@ (rf/reg-event-db :epochs/receive-new-traces (fn [db [_ new-traces]] - (when-let [new-traces (->> (filter log-trace? new-traces) - (sort-by :id))] + (if-let [new-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) - existing-traces (get-in db [:traces :all-traces]) - new-traces (reduce conj existing-traces new-traces) - matches (:matches (metam/parse-traces new-traces)) + previous-traces (get-in db [:traces :all-traces] []) + all-traces (reduce conj previous-traces new-traces) + matches (:matches (metam/parse-traces all-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)) new-traces)] - (rf/dispatch [:traces/update-traces new-traces]) - (rf/dispatch [:epochs/update-epochs {:matches retained-epochs}]))) - db)) + retained-traces (into [] (drop-while #(< (:id %) first-id-to-retain)) all-traces)] + (rf/dispatch [:epochs/update-epochs {:matches retained-epochs}]) + (assoc-in db [:traces :all-traces] retained-traces)) + ;; Else + db))) (rf/reg-event-db :epochs/update-epochs @@ -544,12 +545,6 @@ (re-frame.trace/reset-tracing!) (dissoc db :epochs :traces))) -(rf/reg-event-db - :traces/update-traces - [(rf/path [:traces :all-traces])] - (fn [_ [_ traces]] - traces)) - ;; (rf/reg-event-db From 631fa684484e37c038f37057fec10ef95958cb7a Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sun, 28 Jan 2018 10:46:02 +1300 Subject: [PATCH 13/35] Incrementally parse traces Rather than re-parsing them every time we get a new set of traces. This is much more efficient and lets us do more useful things in the future. --- src/day8/re_frame/trace/events.cljs | 41 ++++++------- src/day8/re_frame/trace/metamorphic.cljc | 75 ++++++++++++------------ 2 files changed, 59 insertions(+), 57 deletions(-) diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index d1bb403..ecc740a 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -485,34 +485,35 @@ (rf/reg-event-db :epochs/receive-new-traces (fn [db [_ new-traces]] - (if-let [new-traces (->> (filter log-trace? new-traces) - (sort-by :id))] + (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] []) - all-traces (reduce conj previous-traces new-traces) - matches (:matches (metam/parse-traces all-traces)) - matches (remove (fn [match] + parse-state (get-in db [:epochs :parse-state] metam/initial-parse-state) + 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)))) matches) - retained-epochs (take-last number-of-epochs-to-retain matches) - first-id-to-retain (:id (ffirst retained-epochs)) + (contains? events-to-ignore (first event)))) new-matches) + all-matches (reduce conj previous-matches new-matches) + retained-matches (into [] (take-last number-of-epochs-to-retain all-matches)) + first-id-to-retain (:id (ffirst retained-matches)) retained-traces (into [] (drop-while #(< (:id %) first-id-to-retain)) all-traces)] - (rf/dispatch [:epochs/update-epochs {:matches retained-epochs}]) - (assoc-in db [:traces :all-traces] retained-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))))) ;; Else db))) -(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))))) - (rf/reg-event-fx :epochs/previous-epoch [(rf/path [:epochs])] diff --git a/src/day8/re_frame/trace/metamorphic.cljc b/src/day8/re_frame/trace/metamorphic.cljc index 3c0722d..e34a5ab 100644 --- a/src/day8/re_frame/trace/metamorphic.cljc +++ b/src/day8/re_frame/trace/metamorphic.cljc @@ -185,50 +185,51 @@ (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 From 70cefc4022ffaa79f83415fa34f96a1ef94bf9aa Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sun, 28 Jan 2018 11:26:43 +1300 Subject: [PATCH 14/35] Add debugging instructions if re-frame-trace fails to start --- CHANGELOG.md | 4 ++++ README.md | 6 ++++++ src/day8/re_frame/trace.cljs | 3 +++ 3 files changed, 13 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 91f6e5e..3d6e128 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,10 @@ All notable changes to this project will be documented in this file. This change ## Unreleased +### Added + +* Debugging instructions if re-frame-trace fails to start. + ### Changed * The version of Garden that re-frame-trace uses is now bundled as a source dependency so you should no longer get conflicts. diff --git a/README.md b/README.md index 98a128b..410af05 100644 --- a/README.md +++ b/README.md @@ -143,6 +143,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. diff --git a/src/day8/re_frame/trace.cljs b/src/day8/re_frame/trace.cljs index 8ae82f0..fe4338a 100644 --- a/src/day8/re_frame/trace.cljs +++ b/src/day8/re_frame/trace.cljs @@ -238,3 +238,6 @@ (defn init-db! [] (trace.db/init-db)) + +(defn ^:export factory-reset! [] + (rf/dispatch [:settings/factory-reset])) From 39f038f8d59fccdfdac58eea3075f35afd60afa8 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sun, 28 Jan 2018 11:41:37 +1300 Subject: [PATCH 15/35] Add setting to drop low level traces from being stored --- CHANGELOG.md | 4 +++- src/day8/re_frame/trace/db.cljs | 2 ++ src/day8/re_frame/trace/events.cljs | 15 +++++++++++++-- src/day8/re_frame/trace/metamorphic.cljc | 12 ++++++++++++ src/day8/re_frame/trace/view/settings.cljs | 5 ++--- 5 files changed, 32 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3d6e128..69408eb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,10 +6,12 @@ All notable changes to this project will be documented in this file. This change ### Added * 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. ### Changed -* The version of Garden that re-frame-trace uses is now bundled as a source dependency so you should no longer get conflicts. +* 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. ### Fixed diff --git a/src/day8/re_frame/trace/db.cljs b/src/day8/re_frame/trace/db.cljs index 4f30b92..b625419 100644 --- a/src/day8/re_frame/trace/db.cljs +++ b/src/day8/re_frame/trace/db.cljs @@ -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,6 +26,7 @@ (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]) (when external-window? (rf/dispatch [:global/launch-external])) diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index ecc740a..18eae6b 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -185,9 +185,17 @@ (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?))) @@ -491,6 +499,7 @@ 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) @@ -502,7 +511,9 @@ all-matches (reduce conj previous-matches new-matches) retained-matches (into [] (take-last number-of-epochs-to-retain all-matches)) first-id-to-retain (:id (ffirst retained-matches)) - retained-traces (into [] (drop-while #(< (:id %) first-id-to-retain)) all-traces)] + 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] diff --git a/src/day8/re_frame/trace/metamorphic.cljc b/src/day8/re_frame/trace/metamorphic.cljc index e34a5ab..a74a994 100644 --- a/src/day8/re_frame/trace/metamorphic.cljc +++ b/src/day8/re_frame/trace/metamorphic.cljc @@ -142,6 +142,18 @@ (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))) diff --git a/src/day8/re_frame/trace/view/settings.cljs b/src/day8/re_frame/trace/view/settings.cljs index 0f90efe..48346de 100644 --- a/src/day8/re_frame/trace/view/settings.cljs +++ b/src/day8/re_frame/trace/view/settings.cljs @@ -149,9 +149,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 From b87a58458933904db43e38d1c66f411a249aae2d Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Mon, 29 Jan 2018 00:03:39 +1300 Subject: [PATCH 16/35] Change clicking on a trace to print entire trace to console This is useful for debugging with more information about the trace. --- CHANGELOG.md | 1 + src/day8/re_frame/trace/view/traces.cljs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 69408eb..059f15f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ All notable changes to this project will be documented in this file. This change * 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. ### Fixed diff --git a/src/day8/re_frame/trace/view/traces.cljs b/src/day8/re_frame/trace/view/traces.cljs index 14fe6f4..7221a90 100644 --- a/src/day8/re_frame/trace/view/traces.cljs +++ b/src/day8/re_frame/trace/view/traces.cljs @@ -71,7 +71,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) From b62ed5284798afc047e9f4e8ef3041f6ff8a0cf1 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Mon, 29 Jan 2018 00:26:56 +1300 Subject: [PATCH 17/35] Collect layer 2/3 information when subs run We can then use it for determining subscription layer level when subs are created or destroyed. --- CHANGELOG.md | 1 + .../HyperlinkedInformation/UnchangedLayer2.md | 52 ++++++++++++------- src/day8/re_frame/trace/events.cljs | 23 ++++++-- src/day8/re_frame/trace/subs.cljs | 11 +++- src/day8/re_frame/trace/view/subs.cljs | 2 +- 5 files changed, 65 insertions(+), 24 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 059f15f..3edb17d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,7 @@ All notable changes to this project will be documented in this file. This change * 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. diff --git a/docs/HyperlinkedInformation/UnchangedLayer2.md b/docs/HyperlinkedInformation/UnchangedLayer2.md index 52948fb..97485e1 100644 --- a/docs/HyperlinkedInformation/UnchangedLayer2.md +++ b/docs/HyperlinkedInformation/UnchangedLayer2.md @@ -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. diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index 18eae6b..f650d2f 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -510,10 +510,26 @@ (contains? events-to-ignore (first event)))) new-matches) all-matches (reduce conj previous-matches new-matches) retained-matches (into [] (take-last number-of-epochs-to-retain all-matches)) + app-db-id (get-in db [:app-db :reagent-id]) + subscription-info (->> new-traces + (filter metam/subscription-re-run?) + (reduce (fn [state trace] + ;; TODO: 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 any of the input signals are app-db, it is a layer 2 sub, else 3 + (assoc-in state + [(:operation trace) :layer] + (if (some #(= app-db-id %) (get-in trace [:tags :input-signals])) + 2 + 3))) + (get-in db [:epochs :subscription-info] {}))) first-id-to-retain (:id (ffirst 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)] + (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] @@ -521,7 +537,8 @@ :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))))) + :parse-state parse-state + :subscription-info subscription-info))))) ;; Else db))) diff --git a/src/day8/re_frame/trace/subs.cljs b/src/day8/re_frame/trace/subs.cljs index 7ae5375..4746e60 100644 --- a/src/day8/re_frame/trace/subs.cljs +++ b/src/day8/re_frame/trace/subs.cljs @@ -351,6 +351,12 @@ (fn [traces] (filter metam/subscription? traces))) +(rf/reg-sub + :subs/subscription-info + :<- [:epochs/epoch-root] + (fn [epoch] + (:subscription-info epoch))) + (defn sub-sort-val [sub] (case (:type sub) @@ -375,7 +381,8 @@ :subs/all-subs :<- [:subs/all-sub-traces] :<- [:app-db/reagent-id] - (fn [[traces app-db-id]] + :<- [:subs/subscription-info] + (fn [[traces app-db-id sub-info]] (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 @@ -385,7 +392,7 @@ 3)] {:id (str pod-type (get-in trace [:tags :reaction])) :type pod-type - :layer layer + :layer (get-in sub-info [(:operation trace) :layer]) :path-data path-data :path (pr-str path-data) :value (get-in trace [:tags :value]) diff --git a/src/day8/re_frame/trace/view/subs.cljs b/src/day8/re_frame/trace/view/subs.cljs index 190fb2a..0025254 100644 --- a/src/day8/re_frame/trace/view/subs.cljs +++ b/src/day8/re_frame/trace/view/subs.cljs @@ -133,7 +133,7 @@ :model path :disabled? true]]] [rc/gap-f :size common/gs-12s] - [rc/label :label (str "Layer " layer)] + [rc/label :label (str "Layer " (if (some? layer) layer "?"))] ;; TODO: capture previous sub run value and allow diffing it. #_[rc/gap-f :size common/gs-12s] From 6465a09d080c5e61b799cd5195b548b12836f5e5 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Mon, 29 Jan 2018 01:14:31 +1300 Subject: [PATCH 18/35] Create separate subs that ignore view namespaces These are only needed in the Trace panel, so we don't need to pay the cost elsewhere. This also fixes the bug where ignored view namespaces were shown when showing all traces in the Trace panel. --- CHANGELOG.md | 2 ++ src/day8/re_frame/trace/events.cljs | 7 +++-- src/day8/re_frame/trace/subs.cljs | 40 ++++++++++++++---------- src/day8/re_frame/trace/view/traces.cljs | 4 +-- 4 files changed, 33 insertions(+), 20 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3edb17d..050dc48 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,12 +13,14 @@ All notable changes to this project will be documented in this file. This change * 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. ### 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. diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index f650d2f..9941de5 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -514,13 +514,16 @@ subscription-info (->> new-traces (filter metam/subscription-re-run?) (reduce (fn [state trace] - ;; TODO: can we take any shortcuts by assuming that a sub with + ;; 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 any of the input signals are app-db, it is a layer 2 sub, else 3 + ;; 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))) diff --git a/src/day8/re_frame/trace/subs.cljs b/src/day8/re_frame/trace/subs.cljs index 4746e60..ed88f5e 100644 --- a/src/day8/re_frame/trace/subs.cljs +++ b/src/day8/re_frame/trace/subs.cljs @@ -145,29 +145,37 @@ (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))) +(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? :<- [:traces/trace-root] diff --git a/src/day8/re_frame/trace/view/traces.cljs b/src/day8/re_frame/trace/view/traces.cljs index 7221a90..b0753da 100644 --- a/src/day8/re_frame/trace/view/traces.cljs +++ b/src/day8/re_frame/trace/view/traces.cljs @@ -89,8 +89,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 %]) From 7efeb61208362d50e182d066e5085634dfde3f5b Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Mon, 29 Jan 2018 22:54:22 +1300 Subject: [PATCH 19/35] Add new event panel --- CHANGELOG.md | 3 +- src/day8/re_frame/trace/common_styles.cljs | 3 + src/day8/re_frame/trace/metamorphic.cljc | 3 +- src/day8/re_frame/trace/styles.cljs | 9 ++- src/day8/re_frame/trace/view/app_db.cljs | 2 +- src/day8/re_frame/trace/view/components.cljs | 5 +- src/day8/re_frame/trace/view/container.cljs | 6 +- src/day8/re_frame/trace/view/event.cljs | 61 +++++++++++++++----- 8 files changed, 64 insertions(+), 28 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 050dc48..aee7afc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ All notable changes to this project will be documented in this file. This change ### 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. @@ -20,7 +21,7 @@ All notable changes to this project will be documented in this file. This change * 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. +* View namespaces that are ignored are no longer shown when showing traces for all epochs. diff --git a/src/day8/re_frame/trace/common_styles.cljs b/src/day8/re_frame/trace/common_styles.cljs index 70134b9..0377319 100644 --- a/src/day8/re_frame/trace/common_styles.cljs +++ b/src/day8/re_frame/trace/common_styles.cljs @@ -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") diff --git a/src/day8/re_frame/trace/metamorphic.cljc b/src/day8/re_frame/trace/metamorphic.cljc index a74a994..1215cd3 100644 --- a/src/day8/re_frame/trace/metamorphic.cljc +++ b/src/day8/re_frame/trace/metamorphic.cljc @@ -85,8 +85,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))) (defn summarise-match [match] diff --git a/src/day8/re_frame/trace/styles.cljs b/src/day8/re_frame/trace/styles.cljs index e09a8cd..b169c63 100644 --- a/src/day8/re_frame/trace/styles.cljs +++ b/src/day8/re_frame/trace/styles.cljs @@ -9,7 +9,8 @@ [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 +409,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,6 +435,7 @@ 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")) diff --git a/src/day8/re_frame/trace/view/app_db.cljs b/src/day8/re_frame/trace/view/app_db.cljs index 308fcbb..aebb477 100644 --- a/src/day8/re_frame/trace/view/app_db.cljs +++ b/src/day8/re_frame/trace/view/app_db.cljs @@ -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 diff --git a/src/day8/re_frame/trace/view/components.cljs b/src/day8/re_frame/trace/view/components.cljs index dd2fb29..a42cc87 100644 --- a/src/day8/re_frame/trace/view/components.cljs +++ b/src/day8/re_frame/trace/view/components.cljs @@ -209,12 +209,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? "▼ " "▶ ")]] diff --git a/src/day8/re_frame/trace/view/container.cljs b/src/day8/re_frame/trace/view/container.cljs index c6f782c..f69998d 100644 --- a/src/day8/re_frame/trace/view/container.cljs +++ b/src/day8/re_frame/trace/view/container.cljs @@ -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,7 +149,7 @@ [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 } diff --git a/src/day8/re_frame/trace/view/event.cljs b/src/day8/re_frame/trace/view/event.cljs index 9f7629d..4df7072 100644 --- a/src/day8/re_frame/trace/view/event.cljs +++ b/src/day8/re_frame/trace/view/event.cljs @@ -1,19 +1,50 @@ (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.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]])) + +(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 + :class "event-section" + :children + [[rc/h-box + :class "event-section--header app-db-path--header" + :align :center + :children [[:h2 title]]] + + [components/simple-render data [title] "event-section--data app-db-path--pod-border"]]]) (defn render [] - [rc/v-box - :padding "12px 0px" - :children [[rc/label :label "Event"] - [rc/label :label "Dispatch Point"] - [rc/label :label "Coeffects"] - [rc/label :label "Effects"] - [rc/label :label "Interceptors"] - - [rc/h-box - :children [[:p "Subs Run"] [:p "Created"] [:p "Destroyed"]]] - [:p "Views Rendered"] - [rc/h-box - :children [[:p "Timing"] [:p "Animation Frames"]]] - ]]) + (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])]]])) From 02974f3f32724fb7d8eb399a9346c45b3108100b Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Mon, 29 Jan 2018 09:56:33 +1300 Subject: [PATCH 20/35] WIP step for calculating subscription match state State not being rolled over between processing, and still needs to be integrated with the existing match information we store. --- src/day8/re_frame/trace/events.cljs | 45 +++++++++++++++++++++++- src/day8/re_frame/trace/subs.cljs | 2 +- src/day8/re_frame/trace/utils/utils.cljs | 5 +++ 3 files changed, 50 insertions(+), 2 deletions(-) diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index 9941de5..6dd71af 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -508,10 +508,53 @@ new-matches (remove (fn [match] (let [event (get-in (metam/matched-event match) [:tags :event])] (contains? events-to-ignore (first event)))) new-matches) + sub-state {} + + ;; Retrieve previous state + ;; Save new states, removing unretained ones (maybe by mapping with match?) + ;; Save final state + + + subscription-match-state (rest + (reductions (fn [state match] + (let [epoch-traces (into [] + (comp + (utils/id-between-xf (:id (first match)) (:id (last match))) + (filter metam/subscription?)) + filtered-traces) + reset-state (into {} + (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 conj :sub/run)))) + :sub/dispose (-> (assoc-in state [reaction-id :disposed?] true) + (update-in [reaction-id :order] conj :sub/dispose)) + (do (js/console.warn "Unhandled sub trace" trace) + state)))) + reset-state)))) + sub-state + new-matches)) + + ;_ (js/console.log new-matches subscription-match-state) + new-matches (map (fn [match sub-match] match) new-matches subscription-match-state) all-matches (reduce conj previous-matches new-matches) retained-matches (into [] (take-last number-of-epochs-to-retain all-matches)) app-db-id (get-in db [:app-db :reagent-id]) - subscription-info (->> new-traces + subscription-info (->> filtered-traces (filter metam/subscription-re-run?) (reduce (fn [state trace] ;; Can we take any shortcuts by assuming that a sub with diff --git a/src/day8/re_frame/trace/subs.cljs b/src/day8/re_frame/trace/subs.cljs index ed88f5e..a806c46 100644 --- a/src/day8/re_frame/trace/subs.cljs +++ b/src/day8/re_frame/trace/subs.cljs @@ -151,7 +151,7 @@ :<- [: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 diff --git a/src/day8/re_frame/trace/utils/utils.cljs b/src/day8/re_frame/trace/utils/utils.cljs index 850b0fc..85153eb 100644 --- a/src/day8/re_frame/trace/utils/utils.cljs +++ b/src/day8/re_frame/trace/utils/utils.cljs @@ -16,3 +16,8 @@ "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))) From 1e55d1440a7c10508a3acd1cd6e405b7e4ceac2f Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Mon, 29 Jan 2018 10:39:07 +1300 Subject: [PATCH 21/35] Work on incrementally updating subscription state --- src/day8/re_frame/trace/events.cljs | 18 ++++++++++-------- src/day8/re_frame/trace/utils/utils.cljs | 8 ++++++++ 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index 6dd71af..c03cf01 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -488,7 +488,7 @@ (defn first-match-id [m] - (-> m first :id)) + (-> m :match-info first :id)) (rf/reg-event-db :epochs/receive-new-traces @@ -503,7 +503,7 @@ 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] []) + previous-matches (get-in db [:epochs :matches-and-subs] []) 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])] @@ -549,8 +549,8 @@ sub-state new-matches)) - ;_ (js/console.log new-matches subscription-match-state) - new-matches (map (fn [match sub-match] match) new-matches subscription-match-state) + new-matches (map (fn [match sub-match] {:match-info match + :sub-state sub-match}) new-matches subscription-match-state) all-matches (reduce conj previous-matches new-matches) retained-matches (into [] (take-last number-of-epochs-to-retain all-matches)) app-db-id (get-in db [:app-db :reagent-id]) @@ -571,7 +571,7 @@ 2 3))) (get-in db [:epochs :subscription-info] {}))) - first-id-to-retain (:id (ffirst retained-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)) @@ -580,11 +580,13 @@ (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) + :matches (into [] (map :match-info) retained-matches) + :matches-by-id (into {} (map (juxt first-match-id :match-info)) retained-matches) :match-ids (mapv first-match-id retained-matches) :parse-state parse-state - :subscription-info subscription-info))))) + :subscription-info subscription-info + :matches-and-subs retained-matches + :matches-by-id2 (into {} (map (juxt first-match-id identity)) retained-matches)))))) ;; Else db))) diff --git a/src/day8/re_frame/trace/utils/utils.cljs b/src/day8/re_frame/trace/utils/utils.cljs index 85153eb..17ad715 100644 --- a/src/day8/re_frame/trace/utils/utils.cljs +++ b/src/day8/re_frame/trace/utils/utils.cljs @@ -21,3 +21,11 @@ "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)) From b2522831c71b28c658c2dc0a7872580fd6d4f79c Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Mon, 29 Jan 2018 22:59:32 +1300 Subject: [PATCH 22/35] Add note about re-frame required version --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index aee7afc..685c862 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,8 @@ All notable changes to this project will be documented in this file. This change ## Unreleased +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. From b28f14c8cfe3e31861b38ed7fe244e630289c26d Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Mon, 29 Jan 2018 23:24:13 +1300 Subject: [PATCH 23/35] Make app-db and subscription views wrap header info responsively --- CHANGELOG.md | 1 + src/day8/re_frame/trace/view/app_db.cljs | 1 + src/day8/re_frame/trace/view/subs.cljs | 1 + 3 files changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 685c862..b00b356 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,7 @@ This version requires re-frame 0.10.4 to make use of the newly added Event panel * 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 diff --git a/src/day8/re_frame/trace/view/app_db.cljs b/src/day8/re_frame/trace/view/app_db.cljs index aebb477..8ef9c50 100644 --- a/src/day8/re_frame/trace/view/app_db.cljs +++ b/src/day8/re_frame/trace/view/app_db.cljs @@ -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 diff --git a/src/day8/re_frame/trace/view/subs.cljs b/src/day8/re_frame/trace/view/subs.cljs index 0025254..c08f861 100644 --- a/src/day8/re_frame/trace/view/subs.cljs +++ b/src/day8/re_frame/trace/view/subs.cljs @@ -61,6 +61,7 @@ [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 From 72ead3e2e62bdf62d98a3c50452f605a798bafa6 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Mon, 29 Jan 2018 23:45:46 +1300 Subject: [PATCH 24/35] Remove interceptors from debug information --- src/day8/re_frame/trace/metamorphic.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/day8/re_frame/trace/metamorphic.cljc b/src/day8/re_frame/trace/metamorphic.cljc index 1215cd3..13abeab 100644 --- a/src/day8/re_frame/trace/metamorphic.cljc +++ b/src/day8/re_frame/trace/metamorphic.cljc @@ -85,7 +85,7 @@ (defn summarise-event [ev] (-> ev (dissoc :start :duration :end :child-of) - (update :tags dissoc :app-db-before :app-db-after :effects :coeffects))) + (update :tags dissoc :app-db-before :app-db-after :effects :coeffects :interceptors))) (defn summarise-match [match] From 339d7c91470d29655a7db192385b00d578e946bc Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Tue, 30 Jan 2018 10:40:19 +1300 Subject: [PATCH 25/35] Add a docs link to layer ? subs --- src/day8/re_frame/trace/utils/re_com.cljs | 8 ++++++++ src/day8/re_frame/trace/view/subs.cljs | 16 +++++++--------- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/src/day8/re_frame/trace/utils/re_com.cljs b/src/day8/re_frame/trace/utils/re_com.cljs index e34dbda..2b71f43 100644 --- a/src/day8/re_frame/trace/utils/re_com.cljs +++ b/src/day8/re_frame/trace/utils/re_com.cljs @@ -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] diff --git a/src/day8/re_frame/trace/view/subs.cljs b/src/day8/re_frame/trace/view/subs.cljs index c08f861..a6cbcc1 100644 --- a/src/day8/re_frame/trace/view/subs.cljs +++ b/src/day8/re_frame/trace/view/subs.cljs @@ -91,14 +91,9 @@ :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"} - "?"]] + :label [:span "Ignore " [:b {:style {:font-weight "700"}} @ignore-unchanged-l2-count] #_ " unchanged" [:br] + [rc/link {:label "layer 2 subs" + :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? %])]]]]])) @@ -134,7 +129,10 @@ :model path :disabled? true]]] [rc/gap-f :size common/gs-12s] - [rc/label :label (str "Layer " (if (some? 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] From beca2881dfe0eafbd2f0ca70a999e436a3b738f6 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Tue, 30 Jan 2018 10:49:26 +1300 Subject: [PATCH 26/35] Distinguish between subscriptions returning nil and not run --- CHANGELOG.md | 1 + src/day8/re_frame/trace/subs.cljs | 35 ++++++++++++++------------ src/day8/re_frame/trace/view/subs.cljs | 10 +++++--- 3 files changed, 26 insertions(+), 20 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b00b356..19dc72b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -25,6 +25,7 @@ This version requires re-frame 0.10.4 to make use of the newly added Event panel * 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. diff --git a/src/day8/re_frame/trace/subs.cljs b/src/day8/re_frame/trace/subs.cljs index a806c46..b1607a8 100644 --- a/src/day8/re_frame/trace/subs.cljs +++ b/src/day8/re_frame/trace/subs.cljs @@ -391,22 +391,25 @@ :<- [:app-db/reagent-id] :<- [:subs/subscription-info] (fn [[traces app-db-id sub-info]] - (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 (get-in sub-info [(:operation trace) :layer]) - :path-data path-data - :path (pr-str path-data) - :value (get-in trace [:tags :value]) - - ;; TODO: Get not run subscriptions - })) + (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) + sub + (-> {:id (str pod-type (get-in trace [:tags :reaction])) + :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 + })] + (if (contains? (:tags trace) :value) + (assoc sub :value (get-in trace [:tags :value])) + sub))) traces) re-run (->> raw (filter #(= :re-run (:type %))) diff --git a/src/day8/re_frame/trace/view/subs.cljs b/src/day8/re_frame/trace/view/subs.cljs index a6cbcc1..509ca48 100644 --- a/src/day8/re_frame/trace/view/subs.cljs +++ b/src/day8/re_frame/trace/view/subs.cljs @@ -169,10 +169,12 @@ :style {:margin (css-join pod-padding pod-padding "0px" pod-padding) :overflow-x "auto" :overflow-y "hidden"} - :children [[components/simple-render - (:value pod-info) - ["sub-path" path] - ]]])] + :children [(if (contains? pod-info :value) + [components/simple-render + (:value pod-info) + ["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" From 2a644b9acf95f02e1d1e72922f4d32f153f37acd Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Tue, 30 Jan 2018 13:30:37 +1300 Subject: [PATCH 27/35] Remove pprint requires --- src/day8/re_frame/trace.cljs | 1 - src/day8/re_frame/trace/view/traces.cljs | 1 - 2 files changed, 2 deletions(-) diff --git a/src/day8/re_frame/trace.cljs b/src/day8/re_frame/trace.cljs index fe4338a..61d8f9f 100644 --- a/src/day8/re_frame/trace.cljs +++ b/src/day8/re_frame/trace.cljs @@ -9,7 +9,6 @@ [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] diff --git a/src/day8/re_frame/trace/view/traces.cljs b/src/day8/re_frame/trace/view/traces.cljs index b0753da..62164e1 100644 --- a/src/day8/re_frame/trace/view/traces.cljs +++ b/src/day8/re_frame/trace/view/traces.cljs @@ -4,7 +4,6 @@ [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.v0v7v0.reagent.core :as r] [mranderson047.re-frame.v0v10v2.re-frame.core :as rf] From 7af2532d55e6b71485552f2459520d21e7ee21f1 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Tue, 30 Jan 2018 15:41:39 +1300 Subject: [PATCH 28/35] Clean up unused namespaces --- src/day8/re_frame/trace.cljs | 11 ++--------- src/day8/re_frame/trace/metamorphic.cljc | 3 +-- src/day8/re_frame/trace/styles.cljs | 4 ---- src/day8/re_frame/trace/utils/localstorage.cljs | 4 ++-- src/day8/re_frame/trace/view/components.cljs | 1 - src/day8/re_frame/trace/view/event.cljs | 1 - src/day8/re_frame/trace/view/settings.cljs | 1 - src/day8/re_frame/trace/view/timing.cljs | 6 ++---- src/day8/re_frame/trace/view/traces.cljs | 3 --- 9 files changed, 7 insertions(+), 27 deletions(-) diff --git a/src/day8/re_frame/trace.cljs b/src/day8/re_frame/trace.cljs index 61d8f9f..f4b8571 100644 --- a/src/day8/re_frame/trace.cljs +++ b/src/day8/re_frame/trace.cljs @@ -1,17 +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] [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] @@ -19,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.v0v7v0.reagent.core :as r])) diff --git a/src/day8/re_frame/trace/metamorphic.cljc b/src/day8/re_frame/trace/metamorphic.cljc index 13abeab..e7190d6 100644 --- a/src/day8/re_frame/trace/metamorphic.cljc +++ b/src/day8/re_frame/trace/metamorphic.cljc @@ -1,5 +1,4 @@ -(ns day8.re-frame.trace.metamorphic - (:require [mranderson047.re-frame.v0v10v2.re-frame.utils :as utils])) +(ns day8.re-frame.trace.metamorphic) ;; What starts an epoch? diff --git a/src/day8/re_frame/trace/styles.cljs b/src/day8/re_frame/trace/styles.cljs index b169c63..5d54a7a 100644 --- a/src/day8/re_frame/trace/styles.cljs +++ b/src/day8/re_frame/trace/styles.cljs @@ -1,5 +1,4 @@ (ns day8.re-frame.trace.styles - (:require-macros [day8.re-frame.trace.utils.macros :as macros]) (:require [mranderson047.garden.v1v3v3.garden.core :as garden] [mranderson047.garden.v1v3v3.garden.units :refer [em px percent]] [mranderson047.garden.v1v3v3.garden.color :as color] @@ -7,7 +6,6 @@ [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.event :as event])) @@ -437,8 +435,6 @@ 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) diff --git a/src/day8/re_frame/trace/utils/localstorage.cljs b/src/day8/re_frame/trace/utils/localstorage.cljs index cd92f10..25216cf 100644 --- a/src/day8/re_frame/trace/utils/localstorage.cljs +++ b/src/day8/re_frame/trace/utils/localstorage.cljs @@ -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])) diff --git a/src/day8/re_frame/trace/view/components.cljs b/src/day8/re_frame/trace/view/components.cljs index a42cc87..5535b19 100644 --- a/src/day8/re_frame/trace/view/components.cljs +++ b/src/day8/re_frame/trace/view/components.cljs @@ -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.v0v7v0.reagent.core :as r]) diff --git a/src/day8/re_frame/trace/view/event.cljs b/src/day8/re_frame/trace/view/event.cljs index 4df7072..5e41582 100644 --- a/src/day8/re_frame/trace/view/event.cljs +++ b/src/day8/re_frame/trace/view/event.cljs @@ -1,6 +1,5 @@ (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] diff --git a/src/day8/re_frame/trace/view/settings.cljs b/src/day8/re_frame/trace/view/settings.cljs index 48346de..99adf44 100644 --- a/src/day8/re_frame/trace/view/settings.cljs +++ b/src/day8/re_frame/trace/view/settings.cljs @@ -1,6 +1,5 @@ (ns day8.re-frame.trace.view.settings (:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf] - [mranderson047.reagent.v0v7v0.reagent.core :as r] [day8.re-frame.trace.utils.re-com :as rc :refer [css-join]] [day8.re-frame.trace.common-styles :as common] [mranderson047.garden.v1v3v3.garden.units :as units] diff --git a/src/day8/re_frame/trace/view/timing.cljs b/src/day8/re_frame/trace/view/timing.cljs index d3a42fb..ce20180 100644 --- a/src/day8/re_frame/trace/view/timing.cljs +++ b/src/day8/re_frame/trace/view/timing.cljs @@ -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-- diff --git a/src/day8/re_frame/trace/view/traces.cljs b/src/day8/re_frame/trace/view/traces.cljs index 62164e1..278cef6 100644 --- a/src/day8/re_frame/trace/view/traces.cljs +++ b/src/day8/re_frame/trace/view/traces.cljs @@ -1,10 +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] - [clojure.set :as set] [mranderson047.reagent.v0v7v0.reagent.core :as r] [mranderson047.re-frame.v0v10v2.re-frame.core :as rf] [day8.re-frame.trace.utils.re-com :as rc])) From 09946268143b6dfd7f1c09d2822cadb4cf0ff570 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Tue, 30 Jan 2018 16:52:20 +1300 Subject: [PATCH 29/35] Fix event processing time --- CHANGELOG.md | 1 + src/day8/re_frame/trace/events.cljs | 18 +++++++++++++++--- src/day8/re_frame/trace/subs.cljs | 24 ++++++++++++++++++++++-- 3 files changed, 38 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 19dc72b..00e1db4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,7 @@ This version requires re-frame 0.10.4 to make use of the newly added Event panel * 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. diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index c03cf01..97fa1f4 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -2,7 +2,7 @@ (:require [mranderson047.re-frame.v0v10v2.re-frame.core :as rf] [mranderson047.reagent.v0v7v0.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] @@ -548,9 +548,21 @@ reset-state)))) sub-state new-matches)) + 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))] + ;; Note, sometimes we still end up with a nil elapsed time here, look into more + {:re-frame/event-time (metam/elapsed-time start-of-epoch finish-run)})) + new-matches) - new-matches (map (fn [match sub-match] {:match-info match - :sub-state sub-match}) new-matches subscription-match-state) + new-matches (map (fn [match sub-match t] {:match-info match + :sub-state sub-match + :timing t}) new-matches subscription-match-state timing) all-matches (reduce conj previous-matches new-matches) retained-matches (into [] (take-last number-of-epochs-to-retain all-matches)) app-db-id (get-in db [:app-db :reagent-id]) diff --git a/src/day8/re_frame/trace/subs.cljs b/src/day8/re_frame/trace/subs.cljs index b1607a8..4873c73 100644 --- a/src/day8/re_frame/trace/subs.cljs +++ b/src/day8/re_frame/trace/subs.cljs @@ -224,6 +224,21 @@ :else (get (:matches-by-id epochs) current-id))] match))) +(rf/reg-sub + :epochs/current-match-state + :<- [:epochs/epoch-root] + :<- [:epochs/match-ids] + (fn [[epochs match-ids] _] + (let [current-id (:current-epoch-id epochs) + match (cond + (nil? current-id) (last (:matches-and-subs epochs)) + (< current-id (first match-ids)) (first (:matches-and-subs epochs)) + ;; This case seems impossible, but can happen if the user filters out + ;; an event that they are 'on'. + (> current-id (last match-ids)) (last (:matches-and-subs epochs)) + :else (get (:matches-by-id2 epochs) current-id))] + match))) + (rf/reg-sub :epochs/current-event-trace :<- [:epochs/current-match] @@ -322,9 +337,14 @@ [start end] (first (drop (dec frame-number) frames))] (metam/elapsed-time start end)))) - - (rf/reg-sub + :timing/event-processing-time + :<- [:epochs/current-match-state] + (fn [match] + (utils/spy "match" match) + (get-in match [:timing :re-frame/event-time]))) + +#_(rf/reg-sub :timing/event-processing-time :<- [:traces/current-event-traces] (fn [traces] From 889bfc6a3a750dcbc03d852a3c00ddd8eef09a10 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Tue, 30 Jan 2018 17:02:18 +1300 Subject: [PATCH 30/35] Refactor match handling to return a map with multiple keys This allows us to parse and collect other information when receiving events, rather than calculating them at runtime when some information may not be available (like dropped traces). --- src/day8/re_frame/trace/events.cljs | 23 +++++++------------- src/day8/re_frame/trace/subs.cljs | 28 +++++-------------------- src/day8/re_frame/trace/view/debug.cljs | 9 ++++---- 3 files changed, 17 insertions(+), 43 deletions(-) diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index 97fa1f4..9291815 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -503,18 +503,12 @@ 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-and-subs] []) + 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) sub-state {} - - ;; Retrieve previous state - ;; Save new states, removing unretained ones (maybe by mapping with match?) - ;; Save final state - - subscription-match-state (rest (reductions (fn [state match] (let [epoch-traces (into [] @@ -540,10 +534,10 @@ sub-state) (assoc :run? true :value (:value tags)) - (update :order conj :sub/run)))) + (update :order (fnil conj []) :sub/run)))) :sub/dispose (-> (assoc-in state [reaction-id :disposed?] true) - (update-in [reaction-id :order] conj :sub/dispose)) - (do (js/console.warn "Unhandled sub trace" trace) + (update-in [reaction-id :order] (fnil conj []) :sub/dispose)) + (do (js/console.warn "Unhandled sub trace, this is a bug, report to re-frame-trace please" trace) state)))) reset-state)))) sub-state @@ -556,7 +550,6 @@ start-of-epoch (nth epoch-traces 0) finish-run (or (first (filter metam/finish-run? epoch-traces)) (utils/last-in-vec epoch-traces))] - ;; Note, sometimes we still end up with a nil elapsed time here, look into more {:re-frame/event-time (metam/elapsed-time start-of-epoch finish-run)})) new-matches) @@ -592,13 +585,11 @@ (assoc-in [:traces :all-traces] retained-traces) (update :epochs (fn [epochs] (assoc epochs - :matches (into [] (map :match-info) retained-matches) - :matches-by-id (into {} (map (juxt first-match-id :match-info)) retained-matches) + :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 - :subscription-info subscription-info - :matches-and-subs retained-matches - :matches-by-id2 (into {} (map (juxt first-match-id identity)) retained-matches)))))) + :subscription-info subscription-info))))) ;; Else db))) diff --git a/src/day8/re_frame/trace/subs.cljs b/src/day8/re_frame/trace/subs.cljs index 4873c73..3443f7c 100644 --- a/src/day8/re_frame/trace/subs.cljs +++ b/src/day8/re_frame/trace/subs.cljs @@ -210,7 +210,7 @@ (:epochs db))) (rf/reg-sub - :epochs/current-match + :epochs/current-match-state :<- [:epochs/epoch-root] :<- [:epochs/match-ids] (fn [[epochs match-ids] _] @@ -225,19 +225,10 @@ match))) (rf/reg-sub - :epochs/current-match-state - :<- [:epochs/epoch-root] - :<- [:epochs/match-ids] - (fn [[epochs match-ids] _] - (let [current-id (:current-epoch-id epochs) - match (cond - (nil? current-id) (last (:matches-and-subs epochs)) - (< current-id (first match-ids)) (first (:matches-and-subs epochs)) - ;; This case seems impossible, but can happen if the user filters out - ;; an event that they are 'on'. - (> current-id (last match-ids)) (last (:matches-and-subs epochs)) - :else (get (:matches-by-id2 epochs) current-id))] - match))) + :epochs/current-match + :<- [:epochs/current-match-state] + (fn [match-state _] + (:match-info match-state))) (rf/reg-sub :epochs/current-event-trace @@ -341,17 +332,8 @@ :timing/event-processing-time :<- [:epochs/current-match-state] (fn [match] - (utils/spy "match" match) (get-in match [:timing :re-frame/event-time]))) -#_(rf/reg-sub - :timing/event-processing-time - :<- [:traces/current-event-traces] - (fn [traces] - (let [start-of-epoch (nth traces 0) - finish-run (first (filter metam/finish-run? traces))] - (metam/elapsed-time start-of-epoch finish-run)))) - (rf/reg-sub :timing/render-time :<- [:traces/current-event-traces] diff --git a/src/day8/re_frame/trace/view/debug.cljs b/src/day8/re_frame/trace/view/debug.cljs index 231e6d7..a7ebe10 100644 --- a/src/day8/re_frame/trace/view/debug.cljs +++ b/src/day8/re_frame/trace/view/debug.cljs @@ -16,14 +16,15 @@ [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))) ])) ]] ) From e0dea398f41e0cbdab85eadef6f0da108e9f6c04 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Wed, 31 Jan 2018 00:49:18 +1300 Subject: [PATCH 31/35] Add debug? subscription --- src/day8/re_frame/trace.cljs | 2 +- src/day8/re_frame/trace/db.cljs | 3 ++- src/day8/re_frame/trace/events.cljs | 5 +++++ src/day8/re_frame/trace/subs.cljs | 6 ++++++ src/day8/re_frame/trace/utils/utils.cljs | 4 ++-- 5 files changed, 16 insertions(+), 4 deletions(-) diff --git a/src/day8/re_frame/trace.cljs b/src/day8/re_frame/trace.cljs index f4b8571..f8580f9 100644 --- a/src/day8/re_frame/trace.cljs +++ b/src/day8/re_frame/trace.cljs @@ -229,7 +229,7 @@ :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])) diff --git a/src/day8/re_frame/trace/db.cljs b/src/day8/re_frame/trace/db.cljs index b625419..c3557f8 100644 --- a/src/day8/re_frame/trace/db.cljs +++ b/src/day8/re_frame/trace/db.cljs @@ -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) @@ -28,6 +28,7 @@ (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]) diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index 9291815..d89afec 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -199,6 +199,11 @@ (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] diff --git a/src/day8/re_frame/trace/subs.cljs b/src/day8/re_frame/trace/subs.cljs index 3443f7c..6df56c0 100644 --- a/src/day8/re_frame/trace/subs.cljs +++ b/src/day8/re_frame/trace/subs.cljs @@ -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 diff --git a/src/day8/re_frame/trace/utils/utils.cljs b/src/day8/re_frame/trace/utils/utils.cljs index 17ad715..68c9f1a 100644 --- a/src/day8/re_frame/trace/utils/utils.cljs +++ b/src/day8/re_frame/trace/utils/utils.cljs @@ -24,8 +24,8 @@ (defn spy ([x] - (js/console.log x) + #?(:cljs (js/console.log x)) x) ([label x] - (js/console.log label x) + #?(:cljs (js/console.log label x)) x)) From d652ef17e3d823fba5ede73630c9cb0db949cc9b Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Wed, 31 Jan 2018 00:49:50 +1300 Subject: [PATCH 32/35] Show previous value for subscription state --- CHANGELOG.md | 1 + src/day8/re_frame/trace/events.cljs | 66 ++----- src/day8/re_frame/trace/metamorphic.cljc | 69 ++++++- src/day8/re_frame/trace/subs.cljs | 51 +++-- src/day8/re_frame/trace/utils/utils.cljs | 4 +- src/day8/re_frame/trace/view/app_db.cljs | 80 ++++---- src/day8/re_frame/trace/view/debug.cljs | 4 + src/day8/re_frame/trace/view/subs.cljs | 238 ++++++++++++----------- 8 files changed, 286 insertions(+), 227 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 00e1db4..9433d7b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ This version requires re-frame 0.10.4 to make use of the newly added Event panel * 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 diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index d89afec..266e6d0 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -513,40 +513,16 @@ new-matches (remove (fn [match] (let [event (get-in (metam/matched-event match) [:tags :event])] (contains? events-to-ignore (first event)))) new-matches) - sub-state {} - subscription-match-state (rest - (reductions (fn [state match] - (let [epoch-traces (into [] - (comp - (utils/id-between-xf (:id (first match)) (:id (last match))) - (filter metam/subscription?)) - filtered-traces) - reset-state (into {} - (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 (js/console.warn "Unhandled sub trace, this is a bug, report to re-frame-trace please" trace) - state)))) - reset-state)))) - sub-state - 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 @@ -560,27 +536,10 @@ new-matches (map (fn [match sub-match t] {:match-info match :sub-state sub-match - :timing t}) new-matches subscription-match-state timing) + :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)) - app-db-id (get-in db [:app-db :reagent-id]) - subscription-info (->> filtered-traces - (filter metam/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))) - (get-in db [:epochs :subscription-info] {}))) first-id-to-retain (first-match-id (first retained-matches)) retained-traces (into [] (comp (drop-while #(< (:id %) first-id-to-retain)) (remove (fn [trace] @@ -594,6 +553,7 @@ :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))) diff --git a/src/day8/re_frame/trace/metamorphic.cljc b/src/day8/re_frame/trace/metamorphic.cljc index e7190d6..507db89 100644 --- a/src/day8/re_frame/trace/metamorphic.cljc +++ b/src/day8/re_frame/trace/metamorphic.cljc @@ -1,5 +1,11 @@ (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? ;;; idle -> dispatch -> running @@ -68,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) @@ -245,3 +251,64 @@ (->> 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)) diff --git a/src/day8/re_frame/trace/subs.cljs b/src/day8/re_frame/trace/subs.cljs index 6df56c0..2d4e842 100644 --- a/src/day8/re_frame/trace/subs.cljs +++ b/src/day8/re_frame/trace/subs.cljs @@ -373,6 +373,18 @@ (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) @@ -398,26 +410,27 @@ :<- [:subs/all-sub-traces] :<- [:app-db/reagent-id] :<- [:subs/subscription-info] - (fn [[traces app-db-id sub-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]) - ;; 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) - sub - (-> {:id (str pod-type (get-in trace [:tags :reaction])) - :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 - })] - (if (contains? (:tags trace) :value) - (assoc sub :value (get-in trace [:tags :value])) - sub))) + (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 %))) diff --git a/src/day8/re_frame/trace/utils/utils.cljs b/src/day8/re_frame/trace/utils/utils.cljs index 68c9f1a..17ad715 100644 --- a/src/day8/re_frame/trace/utils/utils.cljs +++ b/src/day8/re_frame/trace/utils/utils.cljs @@ -24,8 +24,8 @@ (defn spy ([x] - #?(:cljs (js/console.log x)) + (js/console.log x) x) ([label x] - #?(:cljs (js/console.log label x)) + (js/console.log label x) x)) diff --git a/src/day8/re_frame/trace/view/app_db.cljs b/src/day8/re_frame/trace/view/app_db.cljs index 8ef9c50..113be3e 100644 --- a/src/day8/re_frame/trace/view/app_db.cljs +++ b/src/day8/re_frame/trace/view/app_db.cljs @@ -197,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"} @@ -242,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])]]]])) diff --git a/src/day8/re_frame/trace/view/debug.cljs b/src/day8/re_frame/trace/view/debug.cljs index a7ebe10..1fdddf6 100644 --- a/src/day8/re_frame/trace/view/debug.cljs +++ b/src/day8/re_frame/trace/view/debug.cljs @@ -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,6 +15,9 @@ [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])) diff --git a/src/day8/re_frame/trace/view/subs.cljs b/src/day8/re_frame/trace/view/subs.cljs index 509ca48..f03d2ee 100644 --- a/src/day8/re_frame/trace/view/subs.cljs +++ b/src/day8/re_frame/trace/view/subs.cljs @@ -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]]]) @@ -91,55 +91,56 @@ :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] + :label [:span "Ignore " [:b {:style {:font-weight "700"}} @ignore-unchanged-l2-count] #_" unchanged" [:br] [rc/link {:label "layer 2 subs" - :href "https://github.com/Day8/re-frame-trace/blob/master/docs/HyperlinkedInformation/UnchangedLayer2.md"}]] + :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? %])]]]]])) (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 (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"}])] + :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" @@ -147,86 +148,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 [(if (contains? pod-info :value) - [components/simple-render - (:value pod-info) - ["sub-path" path]] - [rc/label :style {:font-style "italic"} :label "Subscription not run, so no value produced."] - )]])] + (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 @@ -243,14 +257,14 @@ [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 [] @@ -266,25 +280,25 @@ ;; 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)]]]]) From d5060fc8144caf20065b469e14897064dc8b3442 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Wed, 31 Jan 2018 01:07:55 +1300 Subject: [PATCH 33/35] Change sub filter to ignore unchanged l2 subs --- CHANGELOG.md | 1 + src/day8/re_frame/trace/events.cljs | 2 +- src/day8/re_frame/trace/metamorphic.cljc | 6 +++--- src/day8/re_frame/trace/subs.cljs | 4 ++-- src/day8/re_frame/trace/utils/utils.cljs | 18 ++++++++++++++++++ src/day8/re_frame/trace/view/subs.cljs | 19 +++++++++---------- 6 files changed, 34 insertions(+), 16 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9433d7b..353e7ec 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ This version requires re-frame 0.10.4 to make use of the newly added Event panel ### 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. diff --git a/src/day8/re_frame/trace/events.cljs b/src/day8/re_frame/trace/events.cljs index 266e6d0..1aec078 100644 --- a/src/day8/re_frame/trace/events.cljs +++ b/src/day8/re_frame/trace/events.cljs @@ -593,7 +593,7 @@ ;; (rf/reg-event-db - :subs/ignore-unchanged-subs? + :subs/ignore-unchanged-l2-subs? [(rf/path [:subs :ignore-unchanged-subs?])] (fn [_ [_ ignore?]] ignore?)) diff --git a/src/day8/re_frame/trace/metamorphic.cljc b/src/day8/re_frame/trace/metamorphic.cljc index 507db89..a2cff1a 100644 --- a/src/day8/re_frame/trace/metamorphic.cljc +++ b/src/day8/re_frame/trace/metamorphic.cljc @@ -162,12 +162,12 @@ (= :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] diff --git a/src/day8/re_frame/trace/subs.cljs b/src/day8/re_frame/trace/subs.cljs index 2d4e842..322aba5 100644 --- a/src/day8/re_frame/trace/subs.cljs +++ b/src/day8/re_frame/trace/subs.cljs @@ -464,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) @@ -509,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))) diff --git a/src/day8/re_frame/trace/utils/utils.cljs b/src/day8/re_frame/trace/utils/utils.cljs index 17ad715..9c969cb 100644 --- a/src/day8/re_frame/trace/utils/utils.cljs +++ b/src/day8/re_frame/trace/utils/utils.cljs @@ -29,3 +29,21 @@ ([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")))) diff --git a/src/day8/re_frame/trace/view/subs.cljs b/src/day8/re_frame/trace/view/subs.cljs index f03d2ee..6f9d911 100644 --- a/src/day8/re_frame/trace/view/subs.cljs +++ b/src/day8/re_frame/trace/view/subs.cljs @@ -56,7 +56,7 @@ 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 @@ -89,13 +89,12 @@ :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] - [rc/link {:label "layer 2 subs" + :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 @@ -270,10 +269,10 @@ (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] From 02db12e0c18e1896860a85ab915780a43fe5d9e7 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Wed, 31 Jan 2018 01:20:38 +1300 Subject: [PATCH 34/35] Bump changelog --- CHANGELOG.md | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 353e7ec..ed478bf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,10 @@ 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 @@ -30,8 +34,6 @@ This version requires re-frame 0.10.4 to make use of the newly added Event panel * 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. From d07a9f5aadf75c6dff3328adf2c63c48b6f8abd2 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Wed, 31 Jan 2018 01:21:01 +1300 Subject: [PATCH 35/35] Version 0.1.17 --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 1d11907..02b175f 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject day8.re-frame/trace "0.1.17-SNAPSHOT" +(defproject day8.re-frame/trace "0.1.17" :description "Tracing and developer tools for re-frame apps" :url "https://github.com/Day8/re-frame-trace" :license {:name "MIT"}