From 6ea384df7066c7b8060526807b3d59b4895f8053 Mon Sep 17 00:00:00 2001 From: Aaron Craelius Date: Mon, 17 Nov 2014 23:25:39 -0500 Subject: [PATCH] Experimental state-machine support. --- src/clojure/freactive/core.cljs | 135 +++++++++++++++++++++++++++++++- test/freactive/core_test.cljs | 59 +++++++++++++- 2 files changed, 190 insertions(+), 4 deletions(-) diff --git a/src/clojure/freactive/core.cljs b/src/clojure/freactive/core.cljs index 483d5f0..abb819c 100644 --- a/src/clojure/freactive/core.cljs +++ b/src/clojure/freactive/core.cljs @@ -372,6 +372,135 @@ ([ref korks-or-getter] (cursor* ref korks-or-getter nil true )) ([ref getter setter] (cursor* ref getter setter true))) -(defn debug-rx* [the-rx capture-callback invalidation-callback] - (add-invalidation-watch the-rx capture-callback invalidation-callback) - (add-invalidation-watch the-rx capture-callback invalidation-callback)) +;(defn debug-rx* [the-rx capture-callback invalidation-callback] +; (add-invalidation-watch the-rx capture-callback invalidation-callback) +; (add-invalidation-watch the-rx capture-callback invalidation-callback)) + +(deftype StateMachine [state state-transtions allowed-states default-accept + watches] + Object + (equiv [this other] + (-equiv this other)) + + IReactive + (-raw-deref [_] state) + + cljs.core/IEquiv + (-equiv [o other] (identical? o other)) + + cljs.core/IDeref + (-deref [this] + (when-let [invalidate *invalidate-rx*] + (-add-watch this invalidate invalidate) + (when *trace-capture* (*trace-capture* this))) + state) + + IMeta + (-meta [_] meta) + + IPrintWithWriter + (-pr-writer [a writer opts] + (-write writer "#")) + + IWatchable + (-notify-watches [this oldval newval] + (doseq [[key f] watches] + (f key this oldval newval))) + (-add-watch [this key f] + (set! (.-watches this) (assoc watches key f)) + this) + (-remove-watch [this key] + (set! (.-watches this) (dissoc watches key))) + + IHash + (-hash [this] (goog/getUid this)) + + IReset + (-reset! [this new-state] + (let [old-state state] + (when-not (keyword-identical? new-state old-state) + (set! (.-state this) new-state) + (-notify-watches this old-state new-state))) + state)) + +(defn- test-transition + ([transition] + (cond (identical? transition true) true + (identical? transition false) false + :default (transition))) + ([transition arg] + (cond (identical? transition true) true + (identical? transition false) false + :default (transition arg)))) + +(defn transition-to! + "Attempts to transition the state-machine to the requested-state. Returns + the state of the machine after the request has been made." + [state-machine requested-state] + (let [cur-state (.-state state-machine)] + (if-not (keyword-identical? cur-state requested-state) + (let [transitions (.-transition-map state-machine) + allowed-states (.-allowed-states state-machine)] + (if + (and + (if allowed-states + (allowed-states requested-state) + true) + (if-let [from-to-transition (get transitions + (keyword (str ":from-" cur-state + "-to-" requested-state)))] + (test-transition from-to-transition) + (if-let [from-transition (get transitions (keyword (str ":from-" cur-state)))] + (when (test-transition from-transition requested-state) + (if-let [to-transition (get transitions (keyword (str "to-" requested-state)))] + (test-transition to-transition cur-state) + (.-default-accept state-machine))) + (if-let [to-transition (get transitions (keyword (str "to-" requested-state)))] + (test-transition to-transition cur-state) + (.-default-accept state-machine))))) + (do + (set! (.-state state-machine) requested-state) + (when-let [after (get state-machine (keyword (str "after-" + cur-state)))] + (after requested-state)) + (when-let [on (get state-machine (keyword (str "on-" cur-state)))] + (on cur-state)) + requested-state) + cur-state)) + cur-state))) + +(defn state-machine + "Takes an initial-state and a map of state-transitions. + + A state transition is named by a keyword that can be prefixed with either + :from- and to-. A convenience :from-state1-to-state2 form is + also allowed. + + :from- and :to- transitions are used as tests to check if a requested + transiton is allowed and should either be a function taking a single parameter + representing the requested state (for :from- transitions) or the current state + (for :to- transitions) - or - a boolean value representing an unconditional + accept/reject for that transition. In order for a :from- or :to- transition + to succeed it must return a truthy value. If the matching transition + function is not found the :default-accept policy will be used. Convienence + :from-state1-to-state2 will take priority over :from- and :to- transitions + and take a 0-arity function or a boolean value. + + For example, if the current state is :off and the state + requested is :on, The state machine will attempt to first to find a + transition named :from-off. If that succeeds it will look for a :to-on + transition. If that succeeds, the new state will be :on. + + A set of allowed-states can also be defined and any other states will be + rejected. + " + [initial-state state-transitions + & {:keys [default-accept allowed-states] + :or {default-accept true}}] + (assert (keyword? initial-state) "state must be keyword") + (when allowed-states + (assert (set? allowed-states) "allowed-states must be a set") + (assert (allowed-states initial-state) "initial-state must be in allowed states")) + (StateMachine. initial-state state-transitions allowed-states default-accept nil)) diff --git a/test/freactive/core_test.cljs b/test/freactive/core_test.cljs index c47df0b..95661a4 100644 --- a/test/freactive/core_test.cljs +++ b/test/freactive/core_test.cljs @@ -1,7 +1,8 @@ (ns freactive.core-test (:refer-clojure :exclude [atom]) (:require - [freactive.core :refer [atom cursor]] + [freactive.core :refer [atom cursor state-machine + transition-to!]] [cljs.reader] [cemerick.cljs.test :refer-macros [deftest is run-tests]]) (:require-macros [freactive.macros :refer [rx]])) @@ -34,3 +35,59 @@ (is (= @a {:b 1})) (reset! a {:c 2}) (is (= @l "{:c 2}")))) + +;(defn sm1 +; (state-machine +; :init +; {:from-init (fn [to] true) +; :to-init (fn [from] false) +; :to-running (fn [from] +; (if (or (= from :init) (= :from :stopped)) +; true)) +; :from-running {fn [to] +; (when (= to :) +; true)} +; :to-stopped (fn [from] +; (when (= from :running) +; true)) +; :from-stopped (fn [to] +; (when (= to :running) +; true))})) + +(defn sm1 [] + (state-machine + :init + {:from-init true + :to-init false + :from-running-to-stopped true + :from-stopped-to-running true + :to-finished true + :from-finished false} + :default-accept false + :allowed-states #{:init :running :stopped :finished})) + +(defn sm2 [] + (state-machine + :init + {:from-init #(true) + :to-init #(false) + :from-running-to-stopped #(true) + :from-stopped-to-running #(true) + :to-finished #(true) + :from-finished #(false)} + :default-accept false + :allowed-states #{:init :running :stopped :finished})) + +(defn test-sm [sm] + (is (= @sm :init)) + (is (= (transition-to! sm :running)) :running) + (is (= (transition-to! sm :stopped)) :stopped) + (is (= (transition-to! sm :running)) :running) + (is (= (transition-to! sm :finished)) :finished) + (is (= (transition-to! sm :running)) :finished) + (is (= (transition-to! sm :test1)) :finished) + ) + +(deftest state-machine-test + (test-sm (sm1)) + (test-sm (sm2)))