Saturday, May 19, 2018

Improving legacy Om code (II): Using effects and coeffects to isolate effectful code from pure code

Introduction.

In the previous post, we applied the humble object pattern idea to avoid having to write end-to-end tests for the interesting logic of a hard to test legacy Om view, and managed to write cheaper unit tests instead. Then, we saw how those unit tests were far from ideal because they were highly coupled to implementation details, and how these problems were caused by a lack of separation of concerns in the code design.

In this post we’ll show a solution to those design problems using effects and coeffects that will make the interesting logic pure and, as such, really easy to test and reason about.

Refactoring to isolate side-effects and side-causes using effects and coeffects.

We refactored the code to isolate side-effects and side-causes from pure logic. This way, not only testing the logic got much easier (the logic would be in pure functions), but also, it made tests less coupled to implementation details. To achieve this we introduced the concepts of coeffects and effects.

The basic idea of the new design was:

  1. Extracting all the needed data from globals (using coeffects for getting application state, getting component state, getting DOM state, etc).
  2. Using pure functions to compute the description of the side effects to be performed (returning effects for updating application state, sending messages, etc) given what was extracted in the previous step (the coeffects).
  3. Performing the side effects described by the effects returned by the called pure functions.

The main difference that the code of horizon.controls.widgets.tree.hierarchy presented after this refactoring was that the event handler functions were moved back into it again, and that they were using the process-all! and extract-all! functions that were used to perform the side-effects described by effects, and extract the values of the side-causes tracked by coeffects, respectively. The event handler functions are shown in the next snippet (to see the whole code click here):

(ns horizon.controls.widgets.tree.hierarchy
(:require
;; a buch of requires...
[sablono.core :refer-macros [html]])
(:require-macros
[horizon.common.macros :refer [defhandler]]))
(defhandler expand-node [e channel expanded-nodes-ids node-id expanded?]
(effects.processing/process-all!
(tree.hierarchy-helpers/expand-nodes-effects
channel expanded? expanded-nodes-ids node-id)))
(defhandler select-node [e channel value]
(effects.processing/process-all!
(tree.hierarchy-helpers/select-node-effects channel value)))
(defhandler select-alert [e channel value]
(effects.processing/process-all!
(tree.hierarchy-helpers/select-alert-effects channel value)))
(defn handle-branch-channel-messages [tree-channel msg]
(effects.processing/process-all!
(tree.hierarchy-helpers/branch-channel-messages-effects
tree-channel msg)))
(defn- get-expanded-nodes-from-dom []
(let [expanded-html-nodes (vec (array-seq (js->clj (.getElementsByClassName js/document "device-name"))))]
(mapv #(hash-map :id (.-id (.-dataset %)) :name (.-name (.-dataset %))) expanded-html-nodes)))
(defn- extracting-data [owner]
(coeffects.extraction/extract-all!
[(coeffects/om-state owner [:shift-selection :selected :pressed-keys])
(coeffects/arbitrary-fn :expanded-nodes get-expanded-nodes-from-dom)]))
(defn- handle-tree-channel-messages [owner channel msg]
(effects.processing/process-all!
(tree.hierarchy-helpers/tree-channel-messages-effects
owner channel msg #(extracting-data owner))))
;; view code

Now all the logic in the companion namespace was comprised of pure functions, with neither asynchronous nor mutating code:

(ns horizon.controls.widgets.tree.hierarchy-helpers
(:require
[clojure.string :as string]
[horizon.common.utils.collections :as utils.collections]
[horizon.common.utils.effects.factories :as effects]
[horizon.common.utils.keys-pressed :as kp]))
(defn expand-node-message [expanded-nodes]
{:type :expand-node :value expanded-nodes})
(defn select-nodes-message [selected]
{:type :select-nodes :value selected})
(defn select-alert-message [value]
{:type :select-alert :value value})
(defn expand-nodes-effects [channel expanded? expanded-nodes-ids clicked-node-id]
(if expanded?
[(effects/propagation-up channel [(expand-node-message (disj expanded-nodes-ids clicked-node-id))])]
[(effects/propagation-up channel [(expand-node-message (conj expanded-nodes-ids clicked-node-id))])]))
(defn select-node-effects [channel selected]
[(effects/propagation-up channel [(select-nodes-message selected)])])
(defn select-alert-effects [channel selected]
[(effects/propagation-up channel [(select-alert-message selected)])])
(defn- selected-node? [selected node-id]
(contains? (set (map :id selected)) node-id))
(defn select-node-classes [selected node-id level num-children]
(->> ["tree-node"
(when (selected-node? selected node-id) "selected")
(str "level-" level)
(when (zero? num-children) "clickable")]
(remove nil?)
(string/join " ")))
(defn branch-channel-messages-effects [tree-channel msg]
(if (contains? #{:select-alert :expand-node :select-nodes} (:type msg))
[(effects/propagation-up tree-channel [msg])]
[(effects/logging-unknown-message-type msg)]))
(defn- control-selection-new-selected [selected node to-select]
(if (contains? selected node)
(disj to-select node)
(conj to-select node)))
(defn- control-selection-shift-selection [additive selected node]
(if (contains? selected node)
nil
(if additive nil node)))
(defn- control-selection-effects [channel owner node additive data]
(let [selected (get data :selected)
to-select (if additive selected #{node})
shift-selection (control-selection-shift-selection additive selected node)
selected (control-selection-new-selected selected node to-select)]
[(effects/om-state owner :shift-selection shift-selection)
(effects/om-state owner :selected selected)
(effects/propagation-up channel [(select-nodes-message selected)])]))
(defn- get-shift-selected-nodes [first-selected-node last-selected-node data]
(let [expanded-nodes (get data :expanded-nodes)
first-index (utils.collections/position-of first-selected-node expanded-nodes)
last-index (utils.collections/position-of last-selected-node expanded-nodes)]
(if (and first-index last-index)
(set (subvec expanded-nodes (min first-index last-index) (inc (max first-index last-index))))
#{})))
(defn- shift-selection-effects [channel owner node additive data]
(let [shift-selection (get data :shift-selection)]
(if shift-selection
(let [shift-selected-nodes (get-shift-selected-nodes shift-selection node data)
current-selected (get data :selected)
to-select (if additive (conj shift-selected-nodes current-selected) shift-selected-nodes)]
[(effects/om-state owner :shift-selection shift-selection)
(effects/om-state owner :selected to-select)
(effects/propagation-up channel [(select-nodes-message to-select)])])
[(effects/om-state owner :shift-selection node)])))
(defn select-tree-node-effects [channel owner node data]
(let [pressed-keys (get data :pressed-keys)]
(cond
(kp/is-control-pressed? pressed-keys)
(control-selection-effects channel owner node true data)
(kp/is-shift-pressed? pressed-keys)
(shift-selection-effects channel owner node false data)
:else
(control-selection-effects channel owner node false data))))
(defn tree-channel-messages-effects [owner channel {:keys [value] :as msg} cofx-fn]
(case (:type msg)
:select-alert [(effects/propagation-up channel [msg])]
:expand-node [(effects/propagation-up channel [msg])]
:select-nodes (select-tree-node-effects channel owner value (cofx-fn))
[(effects/logging-unknown-message-type msg)]))

Thus, its tests became much simpler:

(ns horizon.controls.widgets.tree.hierarchy-helpers-test
(:require
[cljs.test :refer-macros [deftest testing is]]
[greenpowermonitor.test-doubles :as td]
[horizon.common.utils.effects.factories :as effects]
[horizon.controls.widgets.tree.hierarchy-helpers :as sut]
[horizon.test-helpers.equality :as equality]))
(deftest selecting-node-classes
(is (= "tree-node level-0" (sut/select-node-classes #{} 1 0 3)))
(is (= "tree-node level-1" (sut/select-node-classes #{} 1 1 3)))
(is (= "tree-node selected level-0" (sut/select-node-classes #{{:id 1}} 1 0 3)))
(is (= "tree-node level-0" (sut/select-node-classes #{{:id 1}} 5 0 3)))
(is (= "tree-node level-1 clickable" (sut/select-node-classes #{{:id 1}} 5 1 0))))
(deftest branch-channel-effects
(testing "on receiving expanding nodes message"
(let [msg (sut/expand-node-message :some-value)
channel :some-channel]
(is (= [(effects/propagation-up channel [msg])]
(sut/branch-channel-messages-effects channel msg)))))
(testing "on receiving selecting alerts message"
(let [msg (sut/select-alert-message :some-value)
channel :some-channel]
(is (= [(effects/propagation-up channel [msg])]
(sut/branch-channel-messages-effects channel msg)))))
(testing "on receiving selecting nodes message"
(let [msg (sut/select-nodes-message :some-value)
channel :some-channel]
(is (= [(effects/propagation-up channel [msg])]
(sut/branch-channel-messages-effects channel msg)))))
(testing "on receiving an unknown type of message"
(let [msg {:type :an-unknown-type}
channel :some-channel
effects (sut/branch-channel-messages-effects channel msg)]
(is (= 1 (count effects)))
(is (equality/equal-msg-in-logging-unknown-message-type?
msg
(first effects))))))
(def ^:private cofx-fn #())
(deftest tree-channel-messages-effects
(let [owner :some-owner
channel :some-channel]
(testing "when selecting alert"
(let [msg (sut/select-alert-message :whatever)]
(is (= [(effects/propagation-up channel [msg])]
(sut/tree-channel-messages-effects owner channel msg cofx-fn)))))
(testing "when expanding node"
(let [msg (sut/expand-node-message :whatever)]
(is (= [(effects/propagation-up channel [msg])]
(sut/tree-channel-messages-effects owner channel msg cofx-fn)))))
(testing "when selecting nodes"
(let [msg (sut/select-nodes-message :some-nodes)
data :some-important-data]
(td/with-doubles
:stubbing [cofx-fn :returns [data]]
:spying [sut/select-tree-node-effects]
(sut/tree-channel-messages-effects owner channel msg cofx-fn)
(is (= [[channel owner :some-nodes data]]
(td/calls-to sut/select-tree-node-effects))))))
(testing "when receiving an unknown message"
(let [msg {:type :unknown :value :dont-care}
effects (sut/tree-channel-messages-effects owner channel msg cofx-fn)]
(is (= 1 (count effects)))
(is (equality/equal-msg-in-logging-unknown-message-type?
msg
(first effects)))))))
(deftest selecting-tree-node-effects
(testing "when control is pressed"
(let [pressed-keys #{:control :shift}
owner :some-owner
channel :some-channel
clicked-node {:id 1 :name "koko"}
a-selected-node {:id 2 :name "moko"}]
(testing "when clicked node is already in selected nodes"
(let [data {:pressed-keys #{:control}
:selected #{clicked-node a-selected-node}}
expected-nodes-to-select #{a-selected-node}]
(is (= [(effects/om-state owner :shift-selection nil)
(effects/om-state owner :selected expected-nodes-to-select)
(effects/propagation-up channel [(sut/select-nodes-message expected-nodes-to-select)])]
(sut/select-tree-node-effects channel owner clicked-node data)))))
(testing "when clicked node is not in selected nodes"
(let [expected-nodes-to-select #{clicked-node a-selected-node}
data {:pressed-keys #{:control :shift}
:selected #{a-selected-node}}]
(is (= [(effects/om-state owner :shift-selection nil)
(effects/om-state owner :selected expected-nodes-to-select)
(effects/propagation-up channel [(sut/select-nodes-message expected-nodes-to-select)])]
(sut/select-tree-node-effects channel owner clicked-node data)))))))
(testing "when shift but not control is pressed"
(let [owner :some-owner
channel :some-channel
pressed-keys #{:shift}]
(testing "when there're no shift selected node"
(let [shift-selected-node nil
clicked-node {:id 1 :name "k"}
data {:shift-selection shift-selected-node
:pressed-keys pressed-keys}]
(is (= [(effects/om-state owner :shift-selection clicked-node)]
(sut/select-tree-node-effects channel owner clicked-node data)))))
(testing "when there are a shift selected node"
(let [shift-selected-node {:id 3 :name "k"}
currently-selected-node :any-node
expanded-nodes-from-dom [{:id 1 :name "k"} {:id 2 :name "o"} {:id 3 :name "k"} {:id 4 :name "o"}]
nodes-from-shift-selected-one-to-clicked-one #{{:id 1 :name "k"} {:id 2 :name "o"} {:id 3 :name "k"}}
clicked-node {:id 1 :name "k"}
data {:expanded-nodes expanded-nodes-from-dom
:shift-selection shift-selected-node
:pressed-keys pressed-keys
:selected currently-selected-node}
expected-nodes-to-select nodes-from-shift-selected-one-to-clicked-one]
(is (= [(effects/om-state owner :shift-selection shift-selected-node)
(effects/om-state owner :selected expected-nodes-to-select)
(effects/propagation-up channel [(sut/select-nodes-message expected-nodes-to-select)])]
(sut/select-tree-node-effects channel owner clicked-node data)))))))
(testing "if any other keys are pressed"
(let [pressed-keys #{}
owner :some-owner
channel :some-channel
clicked-node {:id 1 :name "koko"}
a-selected-node {:id 2 :name "moko"}]
(testing "when clicked node is already in selected nodes"
(let [data {:pressed-keys #{:control}
:selected #{clicked-node a-selected-node}}
expected-nodes-to-select #{a-selected-node}]
(is (= [(effects/om-state owner :shift-selection nil)
(effects/om-state owner :selected expected-nodes-to-select)
(effects/propagation-up channel [(sut/select-nodes-message expected-nodes-to-select)])]
(sut/select-tree-node-effects channel owner clicked-node data)))))
(testing "when clicked node is not in selected nodes"
(let [expected-nodes-to-select #{clicked-node a-selected-node}
data {:pressed-keys #{:control :shift}
:selected #{a-selected-node}}]
(is (= [(effects/om-state owner :shift-selection nil)
(effects/om-state owner :selected expected-nodes-to-select)
(effects/propagation-up channel [(sut/select-nodes-message expected-nodes-to-select)])]
(sut/select-tree-node-effects channel owner clicked-node data))))))))
(deftest effects-for-expanding-nodes
(let [channel :some-channel
clicked-node-id "moko"
expanded? true
expanded-nodes-ids #{"koko" clicked-node-id}]
(is (= (sut/expand-nodes-effects channel expanded? expanded-nodes-ids clicked-node-id)
[(effects/propagation-up channel [(sut/expand-node-message #{"koko"})])])))
(let [channel :some-channel
clicked-node-id "moko"
expanded? false
expanded-nodes-ids #{"koko"}]
(is (= (sut/expand-nodes-effects channel expanded? expanded-nodes-ids clicked-node-id)
[(effects/propagation-up channel [(sut/expand-node-message #{"koko" clicked-node-id})])]))))
(deftest select-node-effects
(let [channel :some-channel
value :some-value]
(is (= (sut/select-node-effects channel value)
[(effects/propagation-up channel [(sut/select-nodes-message value)])]))))
(deftest select-alert-effects
(let [channel :some-channel
value :some-value]
(is (= (sut/select-alert-effects channel value)
[(effects/propagation-up channel [(sut/select-alert-message value)])]))))

Notice how the pure functions receive a map of coeffects already containing all the extracted values they need from the “world” and they return a map with descriptions of the effects. This makes testing really much easier than before, and remove the need to use test doubles.

Notice also how the test code is now around 100 lines shorter. The main reason for this is that the new tests know much less about how the production code is implemented than the previous one. This made possible to remove some tests that, in the previous version of the code, were testing some branches that we were considering reachable when testing implementation details, but when considering the whole behaviour are actually unreachable.

Now let’s see the code that is extracting the values tracked by the coeffects:

(ns horizon.common.utils.coeffects.extraction
(:require
[horizon.common.logging :as log]
[horizon.common.utils.coeffects.core :as coeffects]))
(defn extract-cofx! [cofx]
(try
(coeffects/extract! cofx)
(catch js/Error e
(log/log-unknown-message-type ::extract-cofx! cofx))))
(defn extract-all! [cofxs]
(reduce merge {} (map extract-cofx! cofxs)))

which is using several implementations of the Coeffect protocol:

(ns horizon.common.utils.coeffects.core
(:require
[horizon.common.state.lens :as l]
[horizon.common.utils.collections :as utils.collections]
[om.core :as om]))
(defprotocol Coeffect
(extract! [this]))
(defrecord OmState [owner kws]
Coeffect
(extract! [this]
(utils.collections/mapm #(vector % (om/get-state owner %)) kws)))
(defrecord ArbitraryFunction [kw func]
Coeffect
(extract! [this]
{kw (func)}))

All the coeffects were created using factories to localize in only one place the “shape” of each type of coeffect. This indirection proved very useful when we decided to refactor the code that extracts the value of each coeffect to substitute its initial implementation as a conditional to its current implementation using polymorphism with a protocol.

These are the coeffects factories:

(ns horizon.common.utils.coeffects.factories
(:require
[horizon.common.utils.coeffects.core :as coeffects]))
(defn om-state [owner kws]
(coeffects/->OmState owner kws))
(defn arbitrary-fn [kw func]
(coeffects/->ArbitraryFunction kw func))
(defn app-state [lenses]
(coeffects/->AppState lenses))

Now there was only one place where we needed to test side causes (using test doubles for some of them). These are the tests for extracting the coeffects values:

(ns horizon.common.utils.coeffects.extraction-test
(:require
[cljs.test :refer-macros [deftest testing is use-fixtures async]]
[greenpowermonitor.test-doubles :as td]
[horizon.common.utils.coeffects.extraction :as sut]
[horizon.common.utils.coeffects.factories :as coeffects]
[om.core :as om]))
(deftest extracting-state-from-an-om-component
(let [owner-1 :some-owner
cofx (coeffects/om-state owner-1 [:x :y :z])]
(td/with-doubles
:stubbing [om/get-state :maps {[owner-1 :x] :value-for-x
[owner-1 :y] :value-for-y
[owner-1 :z] :value-for-z}]
(is (= {:x :value-for-x :y :value-for-y :z :value-for-z}
(sut/extract-all! [cofx]))))))
(deftest extracting-state-from-several-om-components
(let [owner-1 :some-owner
owner-2 :another-owner
cofxs [(coeffects/om-state owner-1 [:x])
(coeffects/om-state owner-2 [:a])]]
(td/with-doubles
:stubbing [om/get-state :maps {[owner-1 :x] :value-for-x
[owner-2 :a] :value-for-a}]
(is (= {:x :value-for-x :a :value-for-a}
(sut/extract-all! cofxs))))))
(deftest extracting-value-from-arbitrary-function
(let [cofxs [(coeffects/arbitrary-fn :koko (constantly :koko-value))
(coeffects/arbitrary-fn :moko (constantly :moko-value))]]
(is (= {:koko :koko-value :moko :moko-value}
(sut/extract-all! cofxs)))))

A very similar code is processing the side-effects described by effects:

(ns horizon.common.utils.effects.processing
(:require
[horizon.common.logging :as log]
[horizon.common.utils.effects.core :as effects]))
(defn- process! [effect]
(try
(effects/process! effect)
(catch js/Error e
(log/log-unknown-message-type ::process! effect))))
(defn process-all! [effects]
(doseq [effect effects]
(process! effect)))

which uses different effects implementing the Effect protocol:

(ns horizon.common.utils.effects.core
(:require
[cljs.core.async :as core.async]
[horizon.common.logging :as log]
[om.core :as om]))
(defprotocol Effect
(process! [this]))
(defrecord PropagationUp [channel messages]
Effect
(process! [this]
(doseq [msg messages]
(core.async/put! channel msg))))
(defrecord LoggingUnknownMessageType [where msg]
Effect
(process! [this]
(log/log-unknown-message-type where msg)))
(defrecord SettingOmState [owner kw value]
Effect
(process! [this]
(om/set-state! owner kw value)))

that are created with the following factories:

(ns horizon.common.utils.effects.factories
(:require
[horizon.common.utils.effects.core :as effects])
(:require-macros
[horizon.common.utils.effects.factories]))
(defn propagation-up [channel messages]
{:pre [(vector? messages)]}
(effects/->PropagationUp channel messages))
(defn logging-unknown-message-type* [where msg]
(effects/->LoggingUnknownMessageType where msg))
(defn om-state [owner kw value]
(effects/->SettingOmState owner kw value))

Finally, these are the tests for processing the effects:

(ns horizon.common.utils.effects.processing-test
(:require
[cljs.core.async :as core.async]
[cljs.test :refer-macros [deftest testing is use-fixtures async]]
[greenpowermonitor.test-doubles :as td]
[horizon.common.logging :as log]
[horizon.common.utils.effects.factories :as effects]
[horizon.common.utils.effects.processing :as sut]
[horizon.test-helpers.async-test-tools :as async-test-tools]
[om.core :as om]))
(deftest processing-a-propagation-up-effect
(let [msgs [{:type :expand-node :value :some-value} {:type :expand-node :value :some-value}]
channel (core.async/chan)
effect (effects/propagation-up channel msgs)]
(async done
(async-test-tools/expect-n-async-messages
channel
:expected-messages msgs
:done-fn done)
(sut/process-all! [effect]))))
(deftest processing-a-logging-unknown-message-type-effect
(let [msg "some-message"
effect (effects/logging-unknown-message-type msg)]
(td/with-doubles
:spying [log/log-unknown-message-type]
(sut/process-all! [effect])
(is (equality/equal-msg-in-logged-line?
msg
(-> log/log-unknown-message-type td/calls-to first))))))
(deftest processing-an-unknown-message-type-effect
(let [effect {:fx-type :unknown :value :dont-care}]
(td/with-doubles
:spying [log/log-unknown-message-type]
(sut/process-all! [effect])
(is (= [[::sut/process! effect]]
(td/calls-to log/log-unknown-message-type))))))
(deftest om-state-effect
(let [owner :some-owner
kw :some-kw
value :some-value
effect (effects/om-state owner kw value)]
(td/with-doubles
:spying [om/set-state!]
(sut/process-all! [effect])
(is (= [[owner kw value]]
(td/calls-to om/set-state!))))))

Summary.

We have seen how by using the concept of effects and coeffects, we were able to refactor our code to get a new design that isolates the effectful code from the pure code. This made testing our most interesting logic really easy because it became comprised of only pure functions.

The basic idea of the new design was:

  1. Extracting all the needed data from globals (using coeffects for getting application state, getting component state, getting DOM state, etc).
  2. Computing in pure functions the description of the side effects to be performed (returning effects for updating application state, sending messages, etc) given what it was extracted in the previous step (the coeffects).
  3. Performing the side effects described by the effects returned by the called pure functions.

Since the time we did this refactoring, we have decided to go deeper in this way of designing code and we’re implementing a full effects & coeffects system inspired by re-frame.

Acknowledgements.

Many thanks to Francesc Guillén, Daniel Ojeda, André Stylianos Ramos, Ricard Osorio, Ángel Rojo, Antonio de la Torre, Fran Reyes, Miguel Ángel Viera and Manuel Tordesillas for giving me great feedback to improve this post and for all the interesting conversations.

Improving legacy Om code (I): Adding a test harness

Introduction.

I’m working at GreenPowerMonitor as part of a team developing a challenging SPA to monitor and manage renewable energy portfolios using ClojureScript. It’s a two years old Om application which contains a lot of legacy code. When I say legacy, I’m using Michael Feathers’ definition of legacy code as code without tests. This definition views legacy code from the perspective of code being difficult to evolve because of a lack of automated regression tests.

The legacy (untested) Om code.

Recently I had to face one of these legacy parts when I had to fix some bugs in the user interface that was presenting all the devices of a given energy facility in a hierarchy tree (devices might be comprised of other devices). This is the original legacy view code:

(ns horizon.controls.widgets.tree.hierarchy
(:require
[cljs.core.async :refer [>!]]
[clojure.string :as string]
[horizon.common.logging :as log]
[horizon.common.utils.keys-pressed :as kp]
[horizon.controls.utils.css-transitions-group :as css-transitions-group :include-macros true]
[horizon.controls.utils.icons :as icons]
[horizon.controls.utils.reactive :as utils.reactive]
[om.core :as om :include-macros true]
[om.dom :include-macros true]
[sablono.core :refer-macros [html]])
(:require-macros
[cljs.core.async.macros :refer [go]]
[horizon.common.macros :refer [defhandler]]))
(defhandler expand-node [e channel expanded node-id expanded?]
(if expanded?
(go (>! channel {:type :expand-node :value (disj expanded node-id)}))
(go (>! channel {:type :expand-node :value (conj expanded node-id)}))))
(defhandler select-node [e channel value]
(go (>! channel {:type :select-nodes :value value})))
(defhandler select-alert [e channel value]
(go (>! channel {:type :select-alert :value value})))
(defn- selected-node? [selected node-id]
(contains? (set (map :id selected)) node-id))
(defn- get-node-class [selected node-id level num-children]
(->> ["tree-node"
(when (selected-node? selected node-id) "selected")
(str "level-" level)
(when (zero? num-children) "clickable")]
(remove nil?)
(string/join " ")))
(defn- info-view [{:keys [level expanded info-data num-children selected]} owner branch-channel]
(reify
om/IRender
(render [_]
(let [{node-id :NodeId icon-type :IconType severity :Severity node-name :NodeName title :Title node-alerts :Alerts} info-data
expanded? (contains? expanded node-id)
icon (icons/build-icon-class icon-type)
icon-color (icons/build-icon-color severity)
node-class (get-node-class selected node-id level num-children)]
(html
[:div
(if (zero? num-children)
{:class node-class
:on-click #(select-node % branch-channel {:id node-id
:name node-name})}
{:class node-class})
(if (pos? num-children)
[:div.expander
{:on-click #(expand-node % branch-channel expanded node-id expanded?)}
[:button.mdl-button.mdl-js-button.mdl-js-ripple-effect.mdl-button--icon
(if expanded?
[:i.fa.fa-minus]
[:i.fa.fa-plus])]]
[:div.dummy-expander])
[:div.alert-icon
(when (some? icon-type)
[:button.mdl-button.mdl-js-button.mdl-js-ripple-effect.mdl-button--icon
{:title title
:on-click #(select-alert % branch-channel node-alerts)}
[:i {:class icon :style {:color icon-color}}]])]
[:div.device-name
{:data-id node-id}
node-name]])))))
(defn- handle-branch-channel-messages [tree-channel {:keys [value] :as msg}]
(case (:type msg)
:select-alert (go (>! tree-channel msg))
:expand-node (go (>! tree-channel {:type :expand-node :value value}))
:select-nodes (go (>! tree-channel {:type :select-nodes :value value}))
(log/log-unknown-message-type ::handle-branch-channel-messages msg)))
(defn- branch-view
[{node-id :NodeId nodes :Nodes :as data} owner {:keys [level tree-channel]}]
(reify
om/IInitState
(init-state [_]
{:expanded false
:selected false
:branch-channel (utils.reactive/build-channel-loop
#(handle-branch-channel-messages tree-channel %))})
om/IRenderState
(render-state [_ {:keys [expanded branch-channel selected]}]
(html
[:div.branch-container
(let [num-branches (count nodes)]
(list
(om/build info-view
{:expanded expanded
:level level
:info-data data
:selected selected
:num-children num-branches}
{:opts branch-channel})
(css-transitions-group/with-transition
:rim-list
(when (and (pos? num-branches)
(contains? expanded node-id))
(om/build-all branch-view
nodes
{:opts {:level (inc level)
:tree-channel tree-channel}
:state {:selected selected
:expanded expanded}})))))]))))
(defn- update-state-global-and-local [selected channel owner node]
(om/set-state! owner :shift-selection node)
(om/set-state! owner :selected selected)
(go (>! channel {:type :select-nodes :value selected})))
(defn- handle-control-selection [channel owner node additive]
(let [selected (om/get-state owner :selected)
to-select (if additive selected #{node})]
(if (contains? selected node)
(update-state-global-and-local (disj to-select node) channel owner nil)
(update-state-global-and-local (conj to-select node) channel owner (if additive nil node)))))
(defn- get-nodes-shift [first last]
(let [expanded-html-nodes (vec (array-seq (js->clj (.getElementsByClassName js/document "device-name"))))
expanded-nodes (mapv #(.-id (.-dataset %)) expanded-html-nodes)
first-index (.indexOf (to-array expanded-nodes) first)
last-index (.indexOf (to-array expanded-nodes) last)]
(subvec expanded-nodes (min first-index last-index) (inc (max first-index last-index)))))
(defn- handle-shift-selection [selected channel owner additive]
(let [shift-selection (om/get-state owner :shift-selection)]
(if shift-selection
(let [selected-range (set (get-nodes-shift shift-selection selected))
current-selected (om/get-state owner :selected)
to-select (if additive (conj selected-range current-selected) selected-range)]
(update-state-global-and-local to-select channel owner shift-selection))
(om/set-state! owner :shift-selection selected))))
(defn- select-node-handler [owner node channel]
(let [pressed-keys (om/get-state owner :pressed-keys)]
(cond
(kp/is-control-pressed? pressed-keys)
(handle-control-selection channel owner node true)
(kp/is-shift-pressed? pressed-keys)
(handle-shift-selection node channel owner false)
:else
(handle-control-selection channel owner node false))))
(defn set-state-pressed-keys [owner keys]
(om/set-state! owner :pressed-keys (set keys)))
(defn- tree-channel-handler [owner channel {:keys [value] :as msg}]
(case (:type msg)
:select-alert (go (>! channel msg))
:expand-node (go (>! channel {:type :expand-node :value value}))
:select-nodes (select-node-handler owner value channel)
(log/log-unknown-message-type ::tree-channel-handler msg)))
(defn main-view [{:keys [values expanded selected view]} owner channel]
(reify
om/IInitState
(init-state [_]
{:shift-selection nil
:pressed-keys #{}
:selected selected
:tree-channel (utils.reactive/build-channel-loop
#(tree-channel-handler owner channel %))})
om/IDidMount
(did-mount [_]
(kp/listen-to-pressed-keys
#{:control :shift}
#(set-state-pressed-keys owner %)
:tree-view-listen-pressed-keys))
om/IWillUnmount
(will-unmount [_]
(kp/unlisten-to-pressed-keys :tree-view-listen-pressed-keys))
om/IRenderState
(render-state [_ {:keys [tree-channel selected]}]
(html
[:div.tree-hierarchy-container
(om/build branch-view
values
{:opts {:level 0
:tree-channel tree-channel
:view view}
:state {:selected selected
:expanded expanded}})]))))

This code contains not only the layout of several components but also the logic to both conditionally render some parts of them and to respond to user interactions. This interesting logic is full of asynchronous and effectful code that is reading and updating the state of the components, extracting information from the DOM itself and reading and updating the global application state. All this makes this code very hard to test.

Humble Object pattern.

It’s very difficult to make component tests for non-component code like the one in this namespace, which makes writing end-to-end tests look like the only option.

However, following the idea of the humble object pattern, we might reduce the untested code to just the layout of the view. The humble object can be used when a code is too closely coupled to its environment to make it testable. To apply it, the interesting logic is extracted into a separate easy-to-test component that is decoupled from its environment.

In this case we extracted the interesting logic to a separate namespace, where we thoroughly tested it. With this we avoided writing the slower and more fragile end-to-end tests.

We wrote the tests using the test-doubles library (I’ve talked about it in a recent post) and some home-made tools that help testing asynchronous code based on core.async.

This is the logic we extracted:

(ns horizon.controls.widgets.tree.hierarchy-helpers
(:require
[clojure.string :as string]
[horizon.common.logging :as log]
[cljs.core.async :refer [>!]]
[om.core :as om :include-macros true]
[horizon.common.utils.keys-pressed :as kp]
[horizon.common.utils.collections :as utils.collections])
(:require-macros
[cljs.core.async.macros :refer [go]]))
(defn- selected-node? [selected node-id]
(contains? (set (map :id selected)) node-id))
(defn select-node-classes [selected node-id level num-children]
(->> ["tree-node"
(when (selected-node? selected node-id) "selected")
(str "level-" level)
(when (zero? num-children) "clickable")]
(remove nil?)
(string/join " ")))
(defn handle-branch-channel-messages [tree-channel {:keys [value] :as msg}]
(case (:type msg)
:select-alert (go (>! tree-channel msg))
:expand-node (go (>! tree-channel {:type :expand-node :value value}))
:select-nodes (go (>! tree-channel {:type :select-nodes :value value}))
(log/log-unknown-message-type ::handle-branch-channel-messages msg)))
(defn- notify-selected-nodes! [channel selected]
(go (>! channel {:type :select-nodes :value selected})))
(defn- update-state-global-and-local! [selected channel owner node]
(om/set-state! owner :shift-selection node)
(om/set-state! owner :selected selected)
(notify-selected-nodes! channel selected))
(defn- get-expanded-nodes-from-dom []
(let [expanded-html-nodes (vec (array-seq (js->clj (.getElementsByClassName js/document "device-name"))))]
(mapv #(hash-map :id (.-id (.-dataset %)) :name (.-name (.-dataset %))) expanded-html-nodes)))
(defn- get-shift-selected-nodes [first-selected-node last-selected-node]
(let [expanded-nodes (get-expanded-nodes-from-dom)
first-index (utils.collections/position-of first-selected-node expanded-nodes)
last-index (utils.collections/position-of last-selected-node expanded-nodes)]
(if (and first-index last-index)
(set (subvec expanded-nodes (min first-index last-index) (inc (max first-index last-index))))
#{})))
(defn- handle-shift-selection [node channel owner additive]
(let [shift-selection (om/get-state owner :shift-selection)]
(if shift-selection
(let [shift-selected-nodes (get-shift-selected-nodes shift-selection node)
current-selected (om/get-state owner :selected)
to-select (if additive (conj shift-selected-nodes current-selected) shift-selected-nodes)]
(update-state-global-and-local! to-select channel owner shift-selection))
(om/set-state! owner :shift-selection node))))
(defn- handle-control-selection [channel owner node additive]
(let [selected (om/get-state owner :selected)
to-select (if additive selected #{node})]
(if (contains? selected node)
(update-state-global-and-local! (disj to-select node) channel owner nil)
(update-state-global-and-local! (conj to-select node) channel owner (if additive nil node)))))
(defn- select-node-handler [owner node channel]
(let [pressed-keys (om/get-state owner :pressed-keys)]
(cond
(kp/is-control-pressed? pressed-keys)
(handle-control-selection channel owner node true)
(kp/is-shift-pressed? pressed-keys)
(handle-shift-selection node channel owner false)
:else
(handle-control-selection channel owner node false))))
(defn handle-tree-channel-messages [owner channel {:keys [value] :as msg}]
(case (:type msg)
:select-alert (go (>! channel msg))
:expand-node (go (>! channel {:type :expand-node :value value}))
:select-nodes (select-node-handler owner value channel)
(log/log-unknown-message-type ::handle-tree-channel-messages msg)))

and these are the tests we wrote for it:

(ns horizon.controls.widgets.tree.hierarchy-helpers-test
(:require
[cljs.test :refer-macros [deftest testing is use-fixtures async]]
[horizon.controls.widgets.tree.hierarchy-helpers :as sut]
[horizon.test-helpers.async-test-tools :as async-test-tools]
[greenpowermonitor.test-doubles :as td]
[cljs.core.async :as core.async]
[horizon.common.logging :as log]
[om.core :as om]))
(deftest selecting-node-classes
(is (= "tree-node level-0" (sut/select-node-classes #{} 1 0 3)))
(is (= "tree-node level-1" (sut/select-node-classes #{} 1 1 3)))
(is (= "tree-node selected level-0" (sut/select-node-classes #{{:id 1}} 1 0 3)))
(is (= "tree-node level-0" (sut/select-node-classes #{{:id 1}} 5 0 3)))
(is (= "tree-node level-1 clickable" (sut/select-node-classes #{{:id 1}} 5 1 0))))
;: Handling branch-channel messages
;;----------------------------------
(deftest branch-channel-expanding-nodes-message
(let [msg {:type :expand-node :value :some-value}
channel (core.async/chan)]
(async done
(async-test-tools/expect-async-message
channel
:expected-message msg
:done-fn done)
(sut/handle-branch-channel-messages channel msg))))
(deftest branch-channel-selecting-alerts-message
(let [msg {:type :select-alert}
channel (core.async/chan)]
(async done
(async-test-tools/expect-async-message
channel
:expected-message msg
:done-fn done)
(sut/handle-branch-channel-messages channel msg))))
(deftest branch-channel-selecting-nodes-message
(let [msg {:type :select-nodes :value :some-value}
channel (core.async/chan)]
(async done
(async-test-tools/expect-async-message
channel
:expected-message msg
:done-fn done)
(sut/handle-branch-channel-messages channel msg))))
(deftest branch-channel-any-other-type-of-message-logs-an-error
(td/with-doubles
:spying [log/log-unknown-message-type]
(let [msg {:type :any-other-type}
channel :not-used-channel]
(sut/handle-branch-channel-messages channel msg)
(is (= [[::sut/handle-branch-channel-messages msg]]
(td/calls-to log/log-unknown-message-type))))))
(deftest branch-channel-any-other-type-of-message-produces-no-messages-in-the-channel
(let [msg {:type :any-other-type}
channel (core.async/chan)]
(async done
(async-test-tools/expect-no-messages
channel
:done-fn done)
(sut/handle-branch-channel-messages channel msg))))
;: Handling tree-channel-handler messages
;;----------------------------------
(deftest tree-channel-expanding-nodes-message
(let [owner :some-owner
msg {:type :expand-node :value :some-value}
channel (core.async/chan)]
(async done
(async-test-tools/expect-async-message
channel
:expected-message msg
:done-fn done)
(sut/handle-tree-channel-messages owner channel msg))))
(deftest tree-channel-selecting-alerts-message
(let [owner :some-owner
msg {:type :select-alert}
channel (core.async/chan)]
(async done
(async-test-tools/expect-async-message
channel
:expected-message msg
:done-fn done)
(sut/handle-tree-channel-messages owner channel msg))))
(deftest tree-channel-selecting-nodes-message
(let [owner :some-owner
msg {:type :select-nodes :value :some-value}
channel :not-used-channel]
(td/with-doubles
:spying [sut/select-node-handler]
(sut/handle-tree-channel-messages owner channel msg)
(is (= [[owner :some-value channel]] (td/calls-to sut/select-node-handler))))))
(deftest tree-channel-any-other-type-of-message-logs-an-error
(td/with-doubles
:spying [log/log-unknown-message-type]
(let [msg {:type :any-other-type}
owner :some-owner
channel :not-used-channel]
(sut/handle-tree-channel-messages owner channel msg)
(is (= [[::sut/handle-tree-channel-messages msg]]
(td/calls-to log/log-unknown-message-type))))))
(deftest tree-channel-any-other-type-of-message-produces-no-messages-in-the-channel
(let [msg {:type :any-other-type}
owner :some-owner
channel (core.async/chan)]
(async done
(async-test-tools/expect-no-messages
channel
:done-fn done)
(sut/handle-tree-channel-messages owner channel msg))))
(deftest selecting-a-node-handler
(let [owner :some-owner
channel :a-channel
node :a-node]
(testing "when shift is pressed"
(let [pressed-keys #{:control :shift}]
(td/with-doubles
:stubbing [om/get-state :maps {[owner :pressed-keys] pressed-keys}]
:spying [sut/handle-control-selection]
(sut/select-node-handler owner node channel)
(is (= [[channel owner node true]] (td/calls-to sut/handle-control-selection))))))
(testing "when control but not shift is pressed"
(let [pressed-keys #{:shift}]
(td/with-doubles
:stubbing [om/get-state :maps {[owner :pressed-keys] pressed-keys}]
:spying [sut/handle-shift-selection]
(sut/select-node-handler owner node channel)
(is (= [[node channel owner false]] (td/calls-to sut/handle-shift-selection))))))
(testing "if any other keys are pressed"
(let [pressed-keys #{}]
(td/with-doubles
:stubbing [om/get-state :maps {[owner :pressed-keys] pressed-keys}]
:spying [sut/handle-control-selection]
(sut/select-node-handler owner node channel)
(is (= [[channel owner node false]] (td/calls-to sut/handle-control-selection))))))))
(deftest handling-control-selection
(let [owner :some-owner
channel :some-channel
clicked-node {:id 1 :name "koko"}
a-selected-node {:id 2 :name "moko"}]
(testing "when selection is additive and clicked node is already in selected nodes"
(let [additive true
selected-nodes #{clicked-node a-selected-node}
expected-nodes-to-select #{a-selected-node}]
(td/with-doubles
:stubbing [om/get-state :maps {[owner :selected] selected-nodes}]
:spying [sut/update-state-global-and-local!]
(sut/handle-control-selection channel owner clicked-node additive)
(is (= [[expected-nodes-to-select channel owner nil]]
(td/calls-to sut/update-state-global-and-local!))))))
(testing "when selection is additive and clicked node is not in selected nodes"
(let [additive true
selected-nodes #{a-selected-node}
expected-nodes-to-select #{clicked-node a-selected-node}]
(td/with-doubles
:stubbing [om/get-state :maps {[owner :selected] selected-nodes}]
:spying [sut/update-state-global-and-local!]
(sut/handle-control-selection channel owner clicked-node additive)
(is (= [[expected-nodes-to-select channel owner nil]]
(td/calls-to sut/update-state-global-and-local!))))))
(testing "when selection is not additive and clicked node is not in selected nodes"
(let [additive false
selected-nodes #{a-selected-node}
expected-nodes-to-select #{clicked-node}]
(td/with-doubles
:stubbing [om/get-state :maps {[owner :selected] selected-nodes}]
:spying [sut/update-state-global-and-local!]
(sut/handle-control-selection channel owner clicked-node additive)
(is (= [[expected-nodes-to-select channel owner clicked-node]]
(td/calls-to sut/update-state-global-and-local!))))))
(testing "when selection is not additive and clicked node is already in selected nodes"
(let [additive false
selected-nodes #{clicked-node a-selected-node}
expected-nodes-to-select #{}]
(td/with-doubles
:stubbing [om/get-state :maps {[owner :selected] selected-nodes}]
:spying [sut/update-state-global-and-local!]
(sut/handle-control-selection channel owner clicked-node additive)
(is (= [[expected-nodes-to-select channel owner nil]]
(td/calls-to sut/update-state-global-and-local!))))))))
(deftest handling-shift-selection
(let [owner :some-owner
channel :some-channel]
(testing "when there're no shift selected node"
(let [shift-selected-node nil
additive :any-boolean
clicked-node {:id 1 :name "k"}]
(td/with-doubles
:stubbing [om/get-state :maps {[owner :shift-selection] shift-selected-node}]
:spying [om/set-state!]
(sut/handle-shift-selection clicked-node channel owner additive)
(is (= [[:some-owner :shift-selection clicked-node]]
(td/calls-to om/set-state!))))))
(testing "when there are a shift selected node"
(let [shift-selected-node {:id 3 :name "k"}
currently-selected-node :any-node
expanded-nodes-from-dom [{:id 1 :name "k"} {:id 2 :name "o"} {:id 3 :name "k"} {:id 4 :name "o"}]
nodes-from-shift-selected-one-to-clicked-one #{{:id 1 :name "k"} {:id 2 :name "o"} {:id 3 :name "k"}}
clicked-node {:id 1 :name "k"}]
(testing "when selection is additive"
(let [additive true
expected-nodes-to-select (conj nodes-from-shift-selected-one-to-clicked-one currently-selected-node)]
(td/with-doubles
:stubbing [om/get-state :maps {[owner :shift-selection] shift-selected-node
[owner :selected] currently-selected-node}
sut/get-expanded-nodes-from-dom :returns [expanded-nodes-from-dom]]
:spying [sut/update-state-global-and-local!]
(sut/handle-shift-selection clicked-node channel owner additive)
(is (= [[expected-nodes-to-select :some-channel :some-owner shift-selected-node]]
(td/calls-to sut/update-state-global-and-local!))))))
(testing "when selection is not additive"
(let [additive false
expected-nodes-to-select nodes-from-shift-selected-one-to-clicked-one]
(td/with-doubles
:stubbing [om/get-state :maps {[owner :shift-selection] shift-selected-node
[owner :selected] currently-selected-node}
sut/get-expanded-nodes-from-dom :returns [expanded-nodes-from-dom]]
:spying [sut/update-state-global-and-local!]
(sut/handle-shift-selection clicked-node channel owner additive)
(is (= [[expected-nodes-to-select :some-channel :some-owner shift-selected-node]]
(td/calls-to sut/update-state-global-and-local!))))))))))
(deftest updating-global-and-local-state
(let [selected :some-selected-nodes
channel :some-channel
owner :some-owner
node :some-node]
(td/with-doubles
:spying [om/set-state!
sut/notify-selected-nodes!]
(sut/update-state-global-and-local! selected channel owner node)
(is (= [[owner :shift-selection node] [owner :selected selected]] (td/calls-to om/set-state!)))
(is (= [[channel selected]] (td/calls-to sut/notify-selected-nodes!))))))
(deftest notifying-selected-nodes
(let [selected :some-nodes
channel (core.async/chan)]
(async done
(async-test-tools/expect-async-message
channel
:expected-message {:type :select-nodes :value selected}
:done-fn done)
(sut/notify-selected-nodes! channel selected))))

See here how the view looks after this extraction. Using the humble object pattern, we managed to test the most important bits of logic with fast unit tests instead of end-to-end tests.

The real problem was the design.

We could have left the code as it was (in fact we did for a while) but its tests were highly coupled to implementation details and hard to write because its design was far from ideal.

Even though, applying the humble object pattern idea, we had separated the important logic from the view, which allowed us to focus on writing tests with more ROI avoiding end-to-end tests, the extracted logic still contained many concerns. It was not only deciding how to interact with the user and what to render, but also mutating and reading state, getting data from global variables and from the DOM and making asynchronous calls. Its effectful parts were not isolated from its pure parts.

This lack of separation of concerns made the code hard to test and hard to reason about, forcing us to use heavy tools: the test-doubles library and our async-test-tools assertion functions to be able to test the code.

Summary.

First, we applied the humble object pattern idea to manage to write unit tests for the interesting logic of a hard to test legacy Om view, instead of having to write more expensive end-to-end tests.

Then, we saw how those unit tests were far from ideal because they were highly coupled to implementation details, and how these problems were caused by a lack of separation of concerns in the code design.

Next.

In the next post we’ll solve the lack of separation of concerns by using effects and coeffects to isolate the logic that decides how to interact with the user from all the effectful code. This new design will make the interesting logic pure and, as such, really easy to test and reason about.