├── deps.edn ├── src └── statecharts │ ├── macros.cljs │ ├── macros.clj │ ├── clock.cljc │ ├── utils.cljc │ ├── sim.cljc │ ├── core.cljc │ ├── service.cljc │ ├── scheduler.cljc │ ├── store.cljc │ ├── delayed.cljc │ ├── integrations │ └── re_frame.cljc │ └── impl.cljc ├── .gitmodules ├── docs ├── archetypes │ └── default.md ├── layouts │ └── shortcodes │ │ └── loadcode.html ├── samples │ ├── project.clj │ └── src │ │ └── statecharts-samples │ │ ├── trigger_actions.clj │ │ ├── basic_immutable.clj │ │ ├── basic.clj │ │ ├── rf_integration.cljs │ │ └── rf_integration_service.cljs ├── config.toml └── content │ ├── _index.md │ ├── menu │ └── index.md │ └── docs │ ├── guards.md │ ├── stores.md │ ├── hierarchical-states.md │ ├── xstate.md │ ├── identifying-states.md │ ├── concepts.md │ ├── get-started.md │ ├── delayed.md │ ├── actions.md │ ├── transitions.md │ ├── integration │ └── re-frame.md │ └── parallel-states.md ├── .clj-kondo └── config.edn ├── .dir-locals.el ├── .gitignore ├── package.json ├── tests.edn ├── shadow-cljs.edn ├── tests.watch.edn ├── .prettierrc ├── test └── statecharts │ ├── utils_test.cljc │ ├── integrations │ └── re_frame_test.cljc │ ├── service_test.cljc │ └── impl_test.cljc ├── karma.conf.js ├── CHANGELOG.md ├── scripts └── publish_docs.sh ├── README.md ├── .github └── workflows │ └── build.yml ├── project.clj └── LICENSE.txt /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {metosin/malli {:mvn/version "0.8.9"}}} 3 | -------------------------------------------------------------------------------- /src/statecharts/macros.cljs: -------------------------------------------------------------------------------- 1 | (ns statecharts.macros 2 | (:require-macros [statecharts.macros])) 3 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "docs/themes/book"] 2 | path = docs/themes/book 3 | url = https://github.com/alex-shpak/hugo-book 4 | -------------------------------------------------------------------------------- /docs/archetypes/default.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "{{ replace .Name "-" " " | title }}" 3 | date: {{ .Date }} 4 | draft: true 5 | --- 6 | 7 | -------------------------------------------------------------------------------- /.clj-kondo/config.edn: -------------------------------------------------------------------------------- 1 | {:linters {:unresolved-symbol {:exclude [goog.DEBUG 2 | (statecharts.macros/prog1 [<>])]}}} 3 | -------------------------------------------------------------------------------- /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((nil . ((fill-column . 83) 2 | (cider-repl-display-help-banner . nil) 3 | (clojure-toplevel-inside-comment-form . t)))) 4 | -------------------------------------------------------------------------------- /src/statecharts/macros.clj: -------------------------------------------------------------------------------- 1 | (ns statecharts.macros) 2 | 3 | (defmacro prog1 [expr & body] 4 | `(let [~'<> ~expr] 5 | (do 6 | ~@body) 7 | ~'<>)) 8 | 9 | -------------------------------------------------------------------------------- /docs/layouts/shortcodes/loadcode.html: -------------------------------------------------------------------------------- 1 | {{ $samplePattern := "BEGIN SAMPLE((.|\n)*);; *END SAMPLE" }} 2 | {{ $sample := findRE $samplePattern (readFile (.Get 0)) 1}} 3 | 4 | {{ range $sample }} 5 | {{ $c := replaceRE "(BEGIN SAMPLE|;; *END SAMPLE)" "" . }} 6 | {{ $c = trim $c "\n" }} 7 | {{ $h := highlight $c "clojure" "" }} 8 | {{ $h }} 9 | {{ end }} 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.pyc 2 | *~ 3 | *# 4 | *.class 5 | *.iml 6 | *.jar 7 | *.jar 8 | *.log 9 | .DS_Store 10 | .idea 11 | .lein-* 12 | .nrepl-* 13 | .nrepl-port 14 | .shadow-cljs 15 | checkouts/ 16 | classes/ 17 | target/ 18 | node_modules/ 19 | pom.xml 20 | pom.xml.asc 21 | profiles.clj 22 | public/js 23 | src/gen 24 | 25 | /data/ 26 | /test-assets/ 27 | /.clj-kondo 28 | /docs/public 29 | _gen/ 30 | /out/ 31 | .cpcache -------------------------------------------------------------------------------- /docs/samples/project.clj: -------------------------------------------------------------------------------- 1 | (defproject cljs-statecharts-sample "0.0.1-SNAPSHOT" 2 | :description "StateCharts Sample" 3 | :url "https://statecharts.github.io/" 4 | :min-lein-version "2.5.0" 5 | 6 | :aliases {"kaocha" ["with-profile" "+dev" "run" "-m" "kaocha.runner"] 7 | "test" ["version"]} 8 | 9 | :dependencies [[org.clojure/clojure "1.10.1"] 10 | [cljs-statecharts "0.0.1"]]) 11 | -------------------------------------------------------------------------------- /docs/config.toml: -------------------------------------------------------------------------------- 1 | baseURL = "https://lucywang000.github.io/clj-statecharts" 2 | languageCode = "en-us" 3 | title = "clj-statecharts" 4 | theme = "book" 5 | 6 | [params] 7 | 8 | BookMenuBundle = "/menu" 9 | BookRepo = "https://github.com/lucywang000/clj-statecharts" 10 | BookEditPath = "blob/master/docs/content" 11 | 12 | [markup] 13 | [markup.tableOfContents] 14 | endLevel = 4 15 | ordered = false 16 | startLevel = 2 17 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "clj-statecharts", 3 | "version": "0.0.1", 4 | "scripts": { 5 | "ci-build": "shadow-cljs release :ci", 6 | "ci-test": "karma start --single-run" 7 | }, 8 | "devDependencies": { 9 | "karma": "^4.4.1", 10 | "karma-chrome-launcher": "^3.1.0", 11 | "karma-cljs-test": "^0.1.0", 12 | "puppeteer": "^17.0.0", 13 | "shadow-cljs": "^2.20.1", 14 | "source-map-support": "^0.5.19", 15 | "ws": "^7.1.2" 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 2 | {:capture-output? true, 3 | :color? true, 4 | :fail-fast? true, 5 | :plugins [:kaocha.plugin/print-invocations 6 | :noyoda.plugin/swap-actual-and-expected], 7 | :reporter kaocha.report/documentation, 8 | :tests [{:id :unit, 9 | :ns-patterns ["statecharts.*-test$"], 10 | :source-paths ["src"], 11 | :test-paths ["test"]}], 12 | :watch? false} 13 | -------------------------------------------------------------------------------- /shadow-cljs.edn: -------------------------------------------------------------------------------- 1 | {:source-paths 2 | ["src" 3 | "test"] 4 | 5 | :dependencies [[metosin/malli "0.8.9"] 6 | [re-frame "1.3.0" 7 | :exclusions [[cljsjs/react] 8 | [cljsjs/react-dom] 9 | [cljsjs/create-react-class]]] 10 | [day8.re-frame/test "0.1.5" 11 | :exclusions [[re-frame]]]] 12 | 13 | :builds {:ci 14 | {:target :karma 15 | :output-to "test-assets/karma/ci.js" 16 | :ns-regexp "-test$"}}} 17 | -------------------------------------------------------------------------------- /tests.watch.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 2 | {:capture-output? false, 3 | :color? true, 4 | :fail-fast? true, 5 | :plugins [:kaocha.plugin/print-invocations 6 | :noyoda.plugin/swap-actual-and-expected], 7 | :reporter kaocha.report/documentation, 8 | :tests [{:id :watch, 9 | :kaocha.filter/focus-meta [:focus] 10 | :kaocha.filter/skip-meta [:skip] 11 | :ns-patterns ["statecharts.*-test$"], 12 | :source-paths ["src"], 13 | :test-paths ["test"]}], 14 | :watch? true} 15 | -------------------------------------------------------------------------------- /.prettierrc: -------------------------------------------------------------------------------- 1 | { 2 | "singleQuote": true, 3 | "tabWidth": 2, 4 | "useTabs": false, 5 | "printWidth": 80, 6 | "endOfLine": "auto", 7 | "proseWrap": "always", 8 | "overrides": [ 9 | { 10 | "files": ["*.yml", "*.yaml"], 11 | "options": { 12 | "tabWidth": 2 13 | } 14 | }, 15 | { 16 | "files": ["*.js", "*.jsx"], 17 | "options": { 18 | "arrowParens": "avoid", 19 | "semi": false, 20 | "singleQuote": true, 21 | "bracketSpacing": false 22 | } 23 | } 24 | ] 25 | } 26 | -------------------------------------------------------------------------------- /docs/content/_index.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Introduction" 3 | date: 2020-08-18T20:19:52+08:00 4 | draft: true 5 | --- 6 | 7 | State Machine and StateCharts for Clojure(Script). Inspired by [XState](https://github.com/davidkpiano/xstate). 8 | 9 | ## Features 10 | 11 | Most features of statecharts are supported: 12 | 13 | * Declarative statecharts definition 14 | * Compound (hierarchical) states 15 | * Transition actions & Entry/Exit actions 16 | * Guarded transitions 17 | * Delayed transitions 18 | 19 | Also provides re-frame integration. 20 | 21 | Head to [Get Started]({{< relref "docs/get-started.md" >}}) for a quick start. 22 | 23 | ## About Statecharts 24 | 25 | - [Statecharts 101](https://statecharts.github.io/) 26 | - [XState](https://github.com/davidkpiano/xstate), which inspired this project 27 | -------------------------------------------------------------------------------- /test/statecharts/utils_test.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.utils-test 2 | (:require [statecharts.utils :as u] 3 | [clojure.test :refer [deftest is are use-fixtures testing]])) 4 | 5 | (deftest test-map-kv 6 | (is (= (u/map-kv (fn [k v] [k (inc v)]) {:a 1 :b 2}) 7 | {:a 2 :b 3}))) 8 | 9 | (deftest test-map-vals 10 | (is (= (u/map-vals inc {:a 1 :b 2}) 11 | {:a 2 :b 3}))) 12 | 13 | (deftest test-map-kv-vals 14 | (is (= (u/map-kv-vals (fn [k v] 15 | (inc v)) {:a 1 :b 2}) 16 | {:a 2 :b 3}))) 17 | 18 | (deftest test-remove-vals 19 | (is (= (u/remove-vals odd? {:a 1 :b 2}) 20 | {:b 2}))) 21 | 22 | (deftest test-find-first 23 | (is (= (u/find-first odd? [1 2 3 4]) 24 | 1)) 25 | (is (= (u/find-first even? [1 2 3 4]) 26 | 2))) 27 | -------------------------------------------------------------------------------- /karma.conf.js: -------------------------------------------------------------------------------- 1 | process.env.CHROME_BIN = require('puppeteer').executablePath(); 2 | 3 | module.exports = function (config) { 4 | config.set({ 5 | browsers: ['ChromeHeadlessNoSandbox'], 6 | customLaunchers: { 7 | ChromeHeadlessNoSandbox: { 8 | base: 'ChromeHeadless', 9 | flags: [ 10 | '--no-sandbox', 11 | ] 12 | } 13 | }, 14 | // The directory where the output file lives 15 | basePath: 'test-assets/karma/', 16 | // The file itself 17 | files: [ 18 | 'ci.js', 19 | ], 20 | frameworks: ['cljs-test'], 21 | plugins: ['karma-cljs-test', 'karma-chrome-launcher'], 22 | colors: true, 23 | logLevel: config.LOG_INFO, 24 | client: { 25 | args: ["shadow.test.karma.init"], 26 | singleRun: true 27 | } 28 | }) 29 | }; 30 | -------------------------------------------------------------------------------- /docs/content/menu/index.md: -------------------------------------------------------------------------------- 1 | +++ 2 | headless = true 3 | +++ 4 | 5 | - [Introduction]({{< relref "/" >}}) 6 | - [Get Started]({{< relref "/docs/get-started" >}}) 7 | - [Concepts: Machine, State, Service]({{< relref "/docs/concepts" >}}) 8 | - [Actions]({{< relref "/docs/actions" >}}) 9 | - [Transitions]({{< relref "/docs/transitions" >}}) 10 | - [Hierarchical States]({{< relref "/docs/hierarchical-states" >}}) 11 | - [Parallel States]({{< relref "/docs/parallel-states" >}}) 12 | - [Identifying States]({{< relref "/docs/identifying-states" >}}) 13 | - [Guarded Transitions]({{< relref "/docs/guards" >}}) 14 | - [Delayed Transitions]({{< relref "/docs/delayed" >}}) 15 | - Integration 16 | - [Re-frame integration]({{< relref "/docs/integration/re-frame" >}}) 17 | - Internals 18 | - [Difference from XState]({{< relref "/docs/xstate" >}}) 19 | - [Stores]({{< relref "/docs/stores" >}}) 20 | -------------------------------------------------------------------------------- /docs/samples/src/statecharts-samples/trigger_actions.clj: -------------------------------------------------------------------------------- 1 | ;; BEGIN SAMPLE 2 | (ns statecharts-samples.trigger-actions 3 | (:require [statecharts.core :as fsm])) 4 | 5 | (defn fire-cameras [& _] 6 | (println "Firing the traffic cameras!")) 7 | 8 | (def machine 9 | (fsm/machine 10 | {:id :lights 11 | :initial :red 12 | :states 13 | {:green {:on 14 | {:timer :yellow}} 15 | :yellow {:on 16 | {:timer {:target :red 17 | :actions fire-cameras}}} 18 | :red {:on 19 | {:timer :green}}} 20 | 21 | :on {:power-outage :red}})) 22 | 23 | (def service (fsm/service machine)) 24 | (fsm/start service) 25 | 26 | ;; :red => :green 27 | (fsm/send service :timer) 28 | ;; :green => yellow 29 | (fsm/send service :timer) 30 | ;; :yellow => :red 31 | ;; fire-cameras would be called here 32 | (fsm/send service :timer) 33 | 34 | ;; END SAMPLE 35 | -------------------------------------------------------------------------------- /docs/content/docs/guards.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Guarded Transitions" 3 | --- 4 | 5 | # Guarded Transitions 6 | 7 | ## Use Guarded Transitions 8 | 9 | Also called "conditional transitions". 10 | 11 | When an event happens, the target state may depend on some condition. 12 | 13 | To express this, add a `:guard` key in the transition map. 14 | 15 | * The first transition that has is condition met is selected. 16 | * If none is selected, the event is ignored. 17 | 18 | ```clojure 19 | (defn my-condition-fn [state event] 20 | ;; returns a boolean 21 | ) 22 | 23 | ;; Part of the machine definition 24 | {:states 25 | {:s1 {:on 26 | {:some-event [{:target :s2 27 | :guard my-condition-fn 28 | :actions some-action} 29 | {:target :s3}]}}}} 30 | ``` 31 | 32 | If `my-condition-fn` returns true, then the target is `:s2`. Otherwise the target would be `:s3`. 33 | -------------------------------------------------------------------------------- /src/statecharts/clock.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.clock) 2 | 3 | (defprotocol Clock 4 | (getTimeMillis [this] "Return the current time in milliseconds") 5 | (setTimeout [this f delay]) 6 | (clearTimeout [this id])) 7 | 8 | #?(:cljs 9 | (deftype WallClock [] 10 | Clock 11 | (getTimeMillis [this] 12 | (js/Date.now)) 13 | (setTimeout [this f delay] 14 | (js/setTimeout f delay)) 15 | (clearTimeout [this id] 16 | (js/clearTimeout id)))) 17 | 18 | ;; TODO 19 | #?(:clj 20 | (deftype WallClock [] 21 | Clock 22 | (getTimeMillis [this] 23 | (System/currentTimeMillis)) 24 | (setTimeout [this f delay]) 25 | (clearTimeout [this id]))) 26 | 27 | (defn wall-clock [] 28 | (WallClock.)) 29 | 30 | (def ^:dynamic ^Clock *clock* 31 | "The scheduler clock for the current fsm" 32 | nil) 33 | 34 | (defn now 35 | "" 36 | [] 37 | (assert *clock*) 38 | (getTimeMillis *clock*)) 39 | -------------------------------------------------------------------------------- /docs/samples/src/statecharts-samples/basic_immutable.clj: -------------------------------------------------------------------------------- 1 | ;; BEGIN SAMPLE 2 | ;; import proper ns 3 | (ns statecharts-samples.basic-immuatable 4 | (:require [statecharts.core :as fsm])) 5 | 6 | ;; define the machine 7 | (def machine 8 | (fsm/machine 9 | {:id :lights 10 | :initial :red 11 | :context nil 12 | :states 13 | {:green {:on 14 | {:timer {:target :yellow 15 | :actions (fn [& _] 16 | (println "transitioned to :yellow!")) 17 | }}} 18 | :yellow {:on 19 | {:timer :red}} 20 | :red {:on 21 | {:timer :green}}} 22 | 23 | :on {:power-outage :red} 24 | })) 25 | 26 | (def s1 (fsm/initialize machine)) ; {:_state :red} 27 | 28 | (def s2 (fsm/transition machine s1 {:type :timer})) ; {:_state :green} 29 | 30 | (def s3 (fsm/transition machine s2 {:type :timer})) ; {:_state :yellow} 31 | 32 | ;; END SAMPLE 33 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ## v0.1.7 2022/12/19 2 | 3 | - Revert 0.1.5 changes. Keep fsm schema closed is easier for catching typos early 4 | on. 5 | 6 | ## v0.1.6 2022/9/8 7 | 8 | - expose `clock/now` to actions fn to facilitate unit-testing delayed 9 | transitions. See commit [8541631](https://github.com/lucywang000/clj-statecharts/commit/8541631670dddb599091706e14849b4e6ed7377c) 10 | 11 | ## v0.1.5 2022/4/13 12 | 13 | - the fsm schemas are now open instead of closed (#11) 14 | 15 | ## v0.1.4 2022/3/31 16 | 17 | - include current state in the error message when reporting unknown event 18 | 19 | ## v0.1.3 2022/3/17 20 | 21 | - Structure scheduler to interoperate with data stores #10 (thanks to @mainej) 22 | 23 | ## v0.1.2 2022/3/1 24 | 25 | - support eventless transitions on initial states 26 | - update malli to 0.8.3 27 | 28 | ## v0.1.1 2021/10/28 29 | 30 | - update malli to 0.6.2 to fix 31 | [a compiler warning](https://github.com/metosin/malli/issues/536). 32 | 33 | ## v0.1.0 2021/6/21 34 | 35 | - first public release. 36 | -------------------------------------------------------------------------------- /src/statecharts/utils.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.utils) 2 | 3 | (defn ensure-vector [x] 4 | (cond 5 | (vector? x) 6 | x 7 | 8 | (nil? x) 9 | [] 10 | 11 | :else 12 | [x])) 13 | 14 | (defn ensure-event-map [x] 15 | (if (map? x) 16 | x 17 | {:type x})) 18 | 19 | (defn map-kv [f m] 20 | (->> m 21 | (map (fn [[k v]] 22 | (f k v))) 23 | (into (empty m)))) 24 | 25 | (defn map-vals [f m] 26 | (->> m 27 | (map (fn [[k v]] 28 | [k (f v)])) 29 | (into (empty m)))) 30 | 31 | (defn map-kv-vals [f m] 32 | (->> m 33 | (map (fn [[k v]] 34 | [k (f k v)])) 35 | (into (empty m)))) 36 | 37 | (defn remove-vals [pred m] 38 | (->> m 39 | (remove (fn [[_ v]] 40 | (pred v))) 41 | (into (empty m)))) 42 | 43 | (defn find-first [pred coll] 44 | (->> coll 45 | (filter pred) 46 | first)) 47 | 48 | (defn with-index [coll] 49 | (map vector coll (range))) 50 | 51 | (defn devectorize 52 | "Return the first element of x if x is a one-element vector." 53 | [x] 54 | (if (= 1 (count x)) 55 | (first x) 56 | x)) 57 | -------------------------------------------------------------------------------- /docs/samples/src/statecharts-samples/basic.clj: -------------------------------------------------------------------------------- 1 | ;; BEGIN SAMPLE 2 | ;; import proper ns 3 | (ns statecharts-samples.basic 4 | (:require [statecharts.core :as fsm])) 5 | 6 | ;; define the machine 7 | (def machine 8 | (fsm/machine 9 | {:id :lights 10 | :initial :red 11 | :context nil 12 | :states 13 | {:green {:on 14 | {:timer {:target :yellow 15 | :actions (fn [& _] 16 | (println "transitioned to :yellow!")) 17 | }}} 18 | :yellow {:on 19 | {:timer :red}} 20 | :red {:on 21 | {:timer :green}}} 22 | 23 | :on {:power-outage :red} 24 | })) 25 | 26 | ;; define the service 27 | (def service (fsm/service machine)) 28 | 29 | ;; start the service 30 | (fsm/start service) 31 | 32 | ;; prints :red 33 | (println (fsm/value service)) 34 | 35 | ;; send events to trigger transitions 36 | (fsm/send service :timer) 37 | 38 | ;; prints :green 39 | (println (fsm/value service)) 40 | 41 | (fsm/send service :timer) 42 | ;; prints :yellow 43 | (println (fsm/value service)) 44 | 45 | ;; END SAMPLE 46 | -------------------------------------------------------------------------------- /src/statecharts/sim.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.sim 2 | (:require [statecharts.clock :refer [Clock setTimeout clearTimeout]])) 3 | 4 | (defprotocol ISimulatedClock 5 | (now [this]) 6 | (events [this]) 7 | (advance [this ms])) 8 | 9 | (deftype SimulatedClock [events 10 | ^:volatile-mutable id 11 | ^:volatile-mutable now_] 12 | Clock 13 | (getTimeMillis [_] 14 | now_) 15 | (setTimeout [_ f delay] 16 | (set! id (inc id)) 17 | (swap! events assoc id {:f f :event-time (+ now_ delay)}) 18 | id) 19 | 20 | (clearTimeout [_ id] 21 | (swap! events dissoc id) 22 | nil) 23 | 24 | ISimulatedClock 25 | (now [this] 26 | now_) 27 | (events [this] 28 | @events) 29 | (advance [this ms] 30 | (set! now_ (+ now_ ms)) 31 | (doseq [[id {:keys [f event-time]}] @events] 32 | (if (>= now_ event-time) 33 | (do (f) 34 | (clearTimeout this id)) 35 | [:not-yet now_ event-time f])))) 36 | 37 | (defn simulated-clock [] 38 | (SimulatedClock. (atom nil) 0 0)) 39 | 40 | 41 | (comment 42 | (def simclock (simulated-clock)) 43 | (setTimeout simclock #(println :e1) 1000) 44 | (setTimeout simclock #(println :e2) 2000) 45 | (events simclock) 46 | (advance simclock 1000) 47 | (now simclock) 48 | ()) 49 | -------------------------------------------------------------------------------- /scripts/publish_docs.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | set -x 5 | 6 | HUGO_VERSION=0.74.3 7 | TMP_REPO_DIR=/tmp/clj-statecharts 8 | 9 | install_hugo() { 10 | pushd /tmp 11 | wget -q "https://github.com/gohugoio/hugo/releases/download/v${HUGO_VERSION}/hugo_extended_${HUGO_VERSION}_Linux-64bit.tar.gz" 12 | tar xf hugo_extended_${HUGO_VERSION}_Linux-64bit.tar.gz hugo 13 | chmod +x hugo 14 | popd 15 | } 16 | 17 | build_docs() { 18 | git submodule init 19 | git submodule update 20 | pushd docs/ 21 | /tmp/hugo -D 22 | popd 23 | } 24 | 25 | init_tmp_repo() { 26 | rm -rf $TMP_REPO_DIR 27 | mkdir -p $TMP_REPO_DIR 28 | pushd $TMP_REPO_DIR 29 | git init 30 | git remote add origin https://github.com/lucywang000/clj-statecharts.git 31 | # create a new clear branch 32 | git checkout --orphan "branch-$(date +%s)" 33 | popd 34 | 35 | } 36 | 37 | copy_docs() { 38 | cp -rpvfa docs/public/* $TMP_REPO_DIR 39 | } 40 | 41 | commit_and_push_pages() { 42 | cd $TMP_REPO_DIR 43 | git add -f . 44 | git config user.email "wxitb2017@gmail.com" 45 | git config user.name "Github Actions Robot" 46 | git commit -a -m 'update' 47 | git push -f origin HEAD:gh-pages 48 | } 49 | 50 | install_hugo 51 | build_docs 52 | init_tmp_repo 53 | copy_docs 54 | commit_and_push_pages 55 | -------------------------------------------------------------------------------- /src/statecharts/core.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.core 2 | (:require [statecharts.impl :as impl] 3 | [statecharts.service :as service] 4 | [statecharts.utils :refer [ensure-vector]]) 5 | (:refer-clojure :exclude [send])) 6 | 7 | (def machine impl/machine) 8 | (def initialize impl/initialize) 9 | (def transition impl/transition) 10 | (def assign impl/assign) 11 | 12 | (def service service/service) 13 | (defn start [service] 14 | (service/start service)) 15 | (defn reload [service fsm] 16 | (service/reload service fsm)) 17 | 18 | (defn send 19 | ([service event] 20 | (send service event nil)) 21 | ([service event _] 22 | (service/send service event))) 23 | 24 | (defn state [service] 25 | (service/state service)) 26 | 27 | (defn value [service] 28 | (-> service state :_state)) 29 | 30 | (defn matches [state value] 31 | (let [v1 (ensure-vector 32 | (if (map? state) 33 | (:_state state) 34 | state)) 35 | v2 (ensure-vector value)] 36 | (impl/is-prefix? v2 v1))) 37 | 38 | (defn update-state 39 | "Provide a pathway to modify the state of a state machine directly 40 | without going through any event. 41 | 42 | Return the updated context. 43 | " 44 | [^statecharts.service.Service service f & args] 45 | (let [state (.-state service)] 46 | (swap! state #(apply f % args)))) 47 | -------------------------------------------------------------------------------- /docs/samples/src/statecharts-samples/rf_integration.cljs: -------------------------------------------------------------------------------- 1 | ;; BEGIN SAMPLE 2 | 3 | (ns statecharts-samples.rf-integration 4 | (:require [re-frame.core :as rf] 5 | [statecharts.core :as fsm :refer [assign]] 6 | [statecharts.integrations.re-frame :as fsm.rf])) 7 | 8 | (def friends-path [(rf/path :friends)]) 9 | 10 | (def load-friends 11 | (fsm.rf/call-fx 12 | {:http-xhrio 13 | {:uri "/api/get-friends.json" 14 | :method :get 15 | :on-failure [:friends/fsm-event :fail-load] 16 | :on-success [:friends/fsm-event :success-load]}})) 17 | 18 | (defn on-friends-loaded [state {:keys [data]}] 19 | (assoc state :friends (:friends data))) 20 | 21 | (defn on-friends-load-failed [state {:keys [data]}] 22 | (assoc state :error (:status data))) 23 | 24 | (def friends-machine 25 | (fsm/machine 26 | {:id :friends 27 | :initial :loading 28 | :integrations {:re-frame {:path friends-path 29 | :initialize-event :friends/init 30 | :transition-event :friends/fsm-event}} 31 | :states 32 | {:loading {:entry load-friends 33 | :on {:success-load {:actions (assign on-friends-loaded) 34 | :target :loaded} 35 | :fail-load {:actions (assign on-friends-load-failed) 36 | :target :load-failed}}} 37 | :loaded {} 38 | :load-failed {}}})) 39 | 40 | ;; END SAMPLE 41 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | State Machine and StateCharts for Clojure(Script). Inspired by [XState](https://github.com/davidkpiano/xstate). 2 | 3 | [![Clojars Project](https://img.shields.io/clojars/v/clj-statecharts.svg)](https://clojars.org/clj-statecharts) 4 | ![build](https://github.com/lucywang000/clj-statecharts/actions/workflows/build.yml/badge.svg?branch=master) 5 | [![project chat](https://img.shields.io/badge/slack-join_chat-brightgreen.svg)](https://clojurians.slack.com/messages/C01C7RJA81M) 6 | 7 | ## Features 8 | 9 | Most features of statecharts are supported: 10 | 11 | * Declarative statecharts definition 12 | * Hierarchical states (a.k.a compound or nested states) 13 | * Parallel states (a.k.a concurrent states or orthogonal regions) 14 | * Transition actions & Entry/Exit actions 15 | * Guarded transitions 16 | * Delayed transitions 17 | * First-class Re-frame Integration 18 | 19 | ## Documentation 20 | 21 | Please visit https://lucywang000.github.io/clj-statecharts/ for the documentation. 22 | 23 | ## Related Projects 24 | 25 | - [Statecharts 101](https://statecharts.github.io/) 26 | - [XState](https://github.com/davidkpiano/xstate), which inspired this project 27 | 28 | ## Articles & Show Cases 29 | 30 | * [Using clj-statecharts to Manage Character Animations](https://doughamil.github.io/gamedev/2021/03/24/statecharts-for-animation.html) 31 | 32 | 33 | ## License 34 | 35 | Copyright © 2020-2021 Lucy Wang 36 | 37 | Distributed under the Eclipse Public License either version 1.0 or (at 38 | your option) any later version. 39 | -------------------------------------------------------------------------------- /docs/content/docs/stores.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: 'Stores' 3 | --- 4 | 5 | # Stores 6 | 7 | clj-statecharts is mostly stateless. But it will often be used in a state-ful 8 | environment. The state objects will need to be stored somewhere, in a 9 | [service]({{< relref "/docs/concepts#state-and-service" >}}), a [re-frame 10 | db]({{< relref "/docs/integration/re-frame" >}}), or somewhere of your choosing. 11 | 12 | Over time events will transition the state objects, which need to be updated in 13 | the storage location. Much of the time the events will come from your code 14 | calling `transition`. In these cases, it might be clear how to update the 15 | storage location. However if you use [delayed 16 | transitions]({{< relref "/docs/delayed" >}}) clj-statecharts itself needs to 17 | update the storage location in the same way that your code would. 18 | clj-statecharts does not dictate how the storage works; instead it provides an 19 | interface IStore that lets external transitioners coordinate with the internal 20 | delayed transitions to update the storage location in the same way. 21 | 22 | Most users of clj-statecharts will not need to understand IStore intimately—they 23 | can use a service or one of the existing integrations, which manage an IStore 24 | instance internally. However, integration implementors should use this project's 25 | examples of how stores are created, connected to schedulers, and used as a 26 | facade for `initialize` and `transition`. You can find such examples in the 27 | implementation of services, the re-frame integration, and in the tests. Search 28 | for `make-store-scheduler`. 29 | -------------------------------------------------------------------------------- /docs/content/docs/hierarchical-states.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Hierarchical States" 3 | --- 4 | 5 | # Hierarchical States 6 | 7 | (a.k.a compound states or nested states) 8 | 9 | ## About Hierarchical States (a.k.a Compound States) 10 | 11 | One of the greatest power of statecharts is that it could prevent the 12 | "states explosion" problem of a tradition finite state machine. The power 13 | comes from the concept of "compound states" in statecharts: 14 | 15 | * A state can define its sub-states, a.k.a child states 16 | * If a state doesn't handle an event, its parent would handle it (if it can). 17 | 18 | In this sense a statecharts is a tree, and the event is handled by 19 | searching from the current node up to the root, until whichever node 20 | is found to have specified a handler for this event. 21 | 22 | *Here is [a more in-depth concept explanation in the StateCharts 23 | 101](https://statecharts.github.io/glossary/compound-state.html).* 24 | 25 | For example a state machine for a calculator could have a "clear 26 | screen" event that is only handled by the root node. 27 | 28 | 29 | ```clojure 30 | {:id :calculator 31 | :on {:clear-screen {:target :operand1 32 | :actions (assign reset-inputs)}} 33 | {:states 34 | {:operand1 {:on {:input-digit :operand1 35 | :input-operator :operator}} 36 | 37 | :operator {:on {:input-operator :operand2}} 38 | 39 | :operand2 {:on {:input-digit :operand2 40 | :equals :result}}}}} 41 | ``` 42 | 43 | In a traditional finite state machine, all states would have to handle this event by themselves. 44 | -------------------------------------------------------------------------------- /docs/samples/src/statecharts-samples/rf_integration_service.cljs: -------------------------------------------------------------------------------- 1 | ;; BEGIN SAMPLE 2 | 3 | (ns statecharts-samples.rf-integration-service 4 | (:require [statecharts.core :as fsm :refer [assign]] 5 | [re-frame.core :as rf] 6 | [statecharts.integrations.re-frame :as fsm.rf])) 7 | 8 | (def friends-path [(rf/path :friends)]) 9 | 10 | (declare friends-service) 11 | 12 | (rf/reg-event-fx 13 | :friends/init 14 | (fn [] 15 | (fsm/start friends-service) ;; (1) 16 | nil)) 17 | 18 | (defn load-friends [] 19 | (send-http-request 20 | {:uri "/api/get-friends.json" 21 | :method :get 22 | :on-success #(fsm/send friends-service {:type :success-load :data %}) 23 | :on-failure #(fsm/send friends-service {:type :fail-load :data %})})) 24 | 25 | (defn on-friends-loaded [state {:keys [data]}] 26 | (assoc state :friends (:friends data))) 27 | 28 | (defn on-friends-load-failed [state {:keys [data]}] 29 | (assoc state :error (:status data))) 30 | 31 | (def friends-machine 32 | (fsm/machine 33 | {:id :friends 34 | :initial :loading 35 | :states 36 | {:loading {:entry load-friends 37 | :on {:success-load {:actions (assign on-friends-loaded) 38 | :target :loaded} 39 | :fail-load {:actions (assign on-friends-load-failed) 40 | :target :load-failed}}} 41 | :loaded {} 42 | :load-failed {}}})) 43 | 44 | (defonce friends-service (fsm/service friends-machine)) 45 | 46 | (fsm.rf/connect-rf-db friends-service [:friends]) ;; (2) 47 | 48 | (defn ^:dev/after-load after-reload [] 49 | (fsm/reload friends-service friends-machine)) ;; (3) 50 | 51 | ;; END SAMPLE 52 | -------------------------------------------------------------------------------- /docs/content/docs/xstate.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Difference from XState" 3 | --- 4 | # Difference from XState 5 | 6 | ## Why not use XState in CLJS? 7 | 8 | * In XState the context can only be a plain js map. One can not use 9 | cljs objects (map/vector) as context, because xstate doesn't preserve 10 | the context object's prototype, because [it uses Object.assign when 11 | updating the 12 | context](https://github.com/davidkpiano/xstate/blob/v4.7.1/packages/core/src/utils.ts#L432). 13 | * For a CLJS project, xstate may be good enough, but we still need a solution for CLJ projects. 14 | * Last but not least, xstate uses strings to represent states 15 | everywhere, but in clj/cljs we tend to use keywords instead. 16 | 17 | ## Unsupported XState/SCXML Features 18 | 19 | * invoking another machine/promise/actor 20 | * final states & done signals 21 | * history states 22 | 23 | These features may be implemented in the future. 24 | 25 | ## Different structure for the state map 26 | 27 | In xstate, the state object has two keys `value` and `context` 28 | 29 | ```js 30 | { 31 | value: "waiting", 32 | context: { 33 | user: "jack", 34 | backoff: 3000 35 | } 36 | } 37 | ``` 38 | 39 | But in clj-statecharts the state map is a flat map: 40 | 41 | ```clojure 42 | {:_state :waiting 43 | :user "jack" 44 | :backoff 3000} 45 | ``` 46 | 47 | In the state map, any underscored key (e.g. `_state`) is internal to 48 | clj-statecharts, which means your application code should not modify it (e.g. in an 49 | context function). The others are the application specific data (equivalent to the 50 | "context" of xstate). 51 | 52 | The reason behind this is that after using the xstate-like two-level map structure 53 | in some real world projects, it's obvious that the two-level map is hard to 54 | integrate into an existing project, e.g. putting the state inside a re-frame db. 55 | -------------------------------------------------------------------------------- /docs/content/docs/identifying-states.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Identifying States" 3 | --- 4 | 5 | # Identifying States 6 | 7 | ## Syntax of State Identifiers 8 | 9 | In describing a transition, we need a way to represent the target state. 10 | 11 | A state is uniquely identified by the vector of its path from the 12 | root, with the first element being a special keyword `:>`. 13 | 14 | For instance, if we have a state `:s1` and it has a child state 15 | `:s1.1`, then they could be identified by `[:> :s1]` and `[:> :s1 16 | :s1.1]` respectively. 17 | 18 | There are other ways to represent a state in transition: 19 | * If the first element of the vector of keywords is not `:>`, it represents a relative path. 20 | * A keyword `:foo` is short for `[:foo]` 21 | * If the first element of the vector of keywords is special keyword 22 | `:.`, it represents a child state of the current state. 23 | * A `nil` target represents a internal self-transition 24 | 25 | Some examples: 26 | 27 | ```clojure 28 | {:states {:s1 29 | {:on {:event1_2 :s2 ;; (1) 30 | :event_1_1.1 [:. :s1.1]} ;; (2) 31 | :states {:s1.1 32 | {:on {:event1.1_1.2 :s1.2 33 | :event1.1_2 [:> :s2] ;; (3) 34 | }}}} 35 | :s2 36 | {:on {:event_2_2 {:actions some-action}}}}} ;; (4) 37 | 38 | ``` 39 | 40 | (1) We want to represent state `:s2` in the context of `:s1`, so we 41 | can simply write `:s2`. We could of course use the absolute syntax 42 | `[:> :s2]`. 43 | 44 | (2) `:s1.1` is a child state of `:s1`, and we want to represent it in the context 45 | of `:s1`, which means we can use either the relative syntax `[:. :s1.1]` or the 46 | absolute syntax `[:> :s1 :s1.1]`. 47 | 48 | (3) We want to represent the state `:s2` in the context of `:s1.1`, 49 | which means we had to use the absolute syntax here. 50 | 51 | (4) When the `target` is not given (or `nil`), it means an internal self-transition. 52 | -------------------------------------------------------------------------------- /src/statecharts/service.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.service 2 | (:require [statecharts.clock :as clock] 3 | [statecharts.store :as store] 4 | [statecharts.scheduler :as scheduler]) 5 | (:refer-clojure :exclude [send])) 6 | 7 | (defn attach-fsm-scheduler [fsm store clock] 8 | (assoc fsm :scheduler (scheduler/make-store-scheduler store clock))) 9 | 10 | (defprotocol IService 11 | (start [this]) 12 | (send [this event]) 13 | (state [this]) 14 | (add-listener [this id listener]) 15 | (reload [this fsm])) 16 | 17 | (defn wrap-listener [f] 18 | (fn [_ _ old new] 19 | (f old new))) 20 | 21 | (deftype Service [^:volatile-mutable fsm 22 | store 23 | ^:volatile-mutable running 24 | clock 25 | transition-opts] 26 | IService 27 | (start [this] 28 | (when-not running 29 | (set! running true) 30 | (store/initialize store fsm nil))) 31 | (state [this] 32 | (store/get-state store nil)) 33 | (send [_ event] 34 | (let [old-state (store/get-state store nil)] 35 | (store/transition store fsm old-state event transition-opts)) 36 | (store/get-state store nil)) 37 | (add-listener [_ id listener] 38 | ;; Kind of gross to reach down into the store's internals. Then again, the fact 39 | ;; that the store is a single-store is an implementation detail known only to 40 | ;; this namespace. 41 | (add-watch (:state* store) id (wrap-listener listener))) 42 | (reload [this fsm_] 43 | (set! fsm (attach-fsm-scheduler fsm_ store clock)))) 44 | 45 | (defn default-opts [] 46 | {:clock (clock/wall-clock)}) 47 | 48 | (defn service 49 | ([fsm] 50 | (service fsm nil)) 51 | ([fsm opts] 52 | (let [{:keys [clock 53 | transition-opts]} (merge (default-opts) opts) 54 | store (store/single-store)] 55 | (Service. (attach-fsm-scheduler fsm store clock) 56 | ;; state store 57 | store 58 | ;; running 59 | false 60 | clock 61 | transition-opts)))) 62 | -------------------------------------------------------------------------------- /src/statecharts/scheduler.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.scheduler 2 | (:require [statecharts.store :as store] 3 | [statecharts.delayed :as delayed] 4 | [statecharts.clock :as clock])) 5 | 6 | (deftype Scheduler [dispatch timeout-ids clock] 7 | delayed/IScheduler 8 | (schedule [_ fsm state event delay] 9 | (let [timeout-id (clock/setTimeout clock #(dispatch fsm state event) delay)] 10 | (swap! timeout-ids assoc event timeout-id))) 11 | 12 | (unschedule [_ _fsm _state event] 13 | (when-let [timeout-id (get @timeout-ids event)] 14 | (clock/clearTimeout clock timeout-id) 15 | (swap! timeout-ids dissoc event)))) 16 | 17 | (defn ^{:deprecated "0.1.2"} make-scheduler 18 | "DEPRECATED: Use [[make-store-scheduler]] instead. 19 | 20 | If we are scheduling events, we must be saving them somewhere, implying that we 21 | have a store. make-store-scheduler is a neater combination of those 22 | responsibilities: transition and save." 23 | ([dispatch clock] 24 | (Scheduler. dispatch (atom {}) clock))) 25 | 26 | (deftype StoreScheduler [store timeout-ids clock] 27 | delayed/IScheduler 28 | (schedule [_ fsm state event delay] 29 | (let [state-id (store/unique-id store state) 30 | timeout-id (clock/setTimeout clock #(store/transition store fsm state event nil) delay)] 31 | (swap! timeout-ids assoc-in [state-id event] timeout-id))) 32 | (unschedule [_ _fsm state event] 33 | (let [state-id (store/unique-id store state) 34 | timeout-id (get-in @timeout-ids [state-id event])] 35 | (when timeout-id 36 | (clock/clearTimeout clock timeout-id) 37 | (swap! timeout-ids update state-id dissoc event))))) 38 | 39 | (defn make-store-scheduler 40 | "Returns a scheduler that can be used to [[statecharts.delayed/schedule]] events 41 | afer some delay. The `store`, which is a `statecharts.store/IStore` contains the 42 | current values of the states, and will be updated as those states are 43 | transitioned by the scheduled events. The `clock` is part of the delay 44 | mechanism." 45 | ([store clock] 46 | (StoreScheduler. store (atom {}) clock))) 47 | -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: build 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | test: 7 | # ubuntu 18.04 comes with lein + java8 installed 8 | runs-on: ubuntu-18.04 9 | steps: 10 | - name: Git checkout 11 | uses: actions/checkout@v2 12 | with: 13 | fetch-depth: 1 14 | 15 | - name: Install Java 11 16 | uses: actions/setup-java@v3 17 | with: 18 | java-version: '11' 19 | distribution: 'adopt' 20 | 21 | - name: Run Tests 22 | run: 23 | lein kaocha 24 | 25 | cljs-test: 26 | runs-on: ubuntu-18.04 27 | steps: 28 | - name: Git checkout 29 | uses: actions/checkout@v2 30 | with: 31 | fetch-depth: 1 32 | 33 | - name: Install Java 11 34 | uses: actions/setup-java@v3 35 | with: 36 | java-version: '11' 37 | distribution: 'adopt' 38 | 39 | - name: Run CLJS Tests 40 | run: | 41 | yarn 42 | yarn ci-build 43 | yarn ci-test 44 | 45 | docs: 46 | if: github.ref == 'refs/heads/master' 47 | runs-on: ubuntu-18.04 48 | steps: 49 | - name: Store gh token 50 | run: | 51 | cat >~/.netrc<}}) for 29 | how to represent hierarchical states). 30 | - the current state context, e.g. number of seconds to back off before next 31 | connection attempt. 32 | 33 | ## The State Map 34 | 35 | The current state is expressed as a map like this: 36 | 37 | ```clojure 38 | {:_state :waiting 39 | :user :jack 40 | :backoff 3000} 41 | ``` 42 | 43 | - All keys that starts with an underscore (e.g. `_state`) is considered internal 44 | to clj-statecharts. Application code could read them, but should not modify 45 | them. 46 | - All others keys are application-specific data, collectively called the 47 | "[context](https://en.wikipedia.org/wiki/UML_state_machine#Extended_states)" 48 | of the state machine. 49 | 50 | ## State & Service {#state-and-service} 51 | 52 | How are machine/state connected to the higher level services? 53 | 54 | A service is stateful, and we need it for two reasons: 55 | 56 | 1. We need a container of state to represent the state of system, which could 57 | transition over time. Actually it's just an atom in the state record. 58 | 2. For [delayed transitions]({{< relref "docs/delayed.md" >}}), we need someone 59 | to keep track of these scheduling information. In its essence a delayed 60 | transition is just a timer: 61 | - the timer is scheduled when entering the state 62 | - if the machine transitions out of the state before the timer is fired, the 63 | timer shall be canceled. 64 | -------------------------------------------------------------------------------- /docs/content/docs/get-started.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Get Started" 3 | --- 4 | 5 | # Get Started 6 | 7 | ## Installation 8 | 9 | Add the dep to to your project.clj/deps.edn/shadow-cljs.edn: [![Clojars Project](https://img.shields.io/clojars/v/clj-statecharts.svg)](https://clojars.org/clj-statecharts) 10 | 11 | The below document assumes you have a `require` statement like this: 12 | 13 | ```clojure 14 | (require '[statecharts.core :as fsm]) 15 | ``` 16 | 17 | ## Two layers of APIs 18 | 19 | There are two layers of APIs in clj-statecharts: 20 | 21 | * The **Immutable API** that deals with machines and states 22 | directly. This layer is purely functional. 23 | * The **Service API** are the higher level one. It is built on top of 24 | the immutable API, stateful and easier to get started. 25 | 26 | ### Part 1. The Immutable API {#the-immutable-api} 27 | 28 | Simply define a machine, which includes: 29 | 30 | * the states and transitions on each state 31 | * the initial state value 32 | * the initial context 33 | 34 | And use the `fsm/initialize` and `fsm/transition` functions. 35 | 36 | {{< loadcode "samples/src/statecharts-samples/basic_immutable.clj" >}} 37 | 38 | #### (fsm/initialize machine) 39 | 40 | Returns the initial state of the machine. It also executes all the entry actions of 41 | the initial states, if any. 42 | 43 | If you do not want these actions to be executed, use `(fsm/initialize machine 44 | {:exec false})` instead. The action functions would be collected in the `_actions` 45 | key of the new state map. For example, the test code of clj-statecharts uses this 46 | feature to make assertions to ensure correct actions are collected during 47 | transitions. 48 | 49 | #### (fsm/transition machine state event) 50 | 51 | Returns the next state based the current state & event. It also executes all the 52 | entry/exit/transition actions. 53 | 54 | If you do not want these actions to be executed, use `(fsm/transition machine state event {:exec false})` instead. 55 | 56 | 57 | ### Part 2. The Service API {#the-service-api} 58 | 59 | The immutable API provides a clean interface so you can integrate it 60 | into your own state management system like re-frame. 61 | 62 | However, sometimes it's more convenient to provide a higher level API 63 | that could manage the state out of the box. Here comes the service API. 64 | 65 | The usage pattern for the service API is very simple: 66 | 67 | * Define a machine 68 | * Define a service that runs the machine 69 | * Send events to trigger transitions on this machine. 70 | * Use functions like `fsm/state` or `fsm/value` to get the state of the service. 71 | 72 | {{< loadcode "samples/src/statecharts-samples/basic.clj" >}} 73 | -------------------------------------------------------------------------------- /docs/content/docs/delayed.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Delayed Transitions" 3 | --- 4 | # Delayed Transitions 5 | 6 | ## Basic Delayed Transitions 7 | 8 | To specify a transition that shall happen automatically after some time, use the 9 | `:after` keyword: 10 | 11 | ```clojure 12 | {:states 13 | {:s1 {:after [{:delay 1000 14 | :target :s2 15 | :guard some-condition-fn 16 | :actions some-action} 17 | {:delay 2000 18 | :target :s3 19 | :actions some-action}]}}} 20 | ``` 21 | 22 | All transition features like guards and actions could be used here, as 23 | you can see in the code snippet above. 24 | 25 | ## Dynamic Delay 26 | 27 | The amount of delay could be expressed as a context function. 28 | 29 | For example, in a state machine that manages a websocket connection, 30 | the reconnection delay could be calculated as an exponential backoff. 31 | 32 | ```clojure 33 | (defn calculate-backoff 34 | "Exponential backoff, with a upper limit of 15 seconds." 35 | [state & _] 36 | (-> (js/Math.pow 2 (:retries state)) 37 | (* 1000) 38 | (min 15000))) 39 | 40 | (defn update-retries [state & _] 41 | (update state :retries inc)) 42 | 43 | ;; Part of the machine definition 44 | {:states 45 | {:connecting {:entry try-connect 46 | :on {:success-connect :connected}} 47 | :disconnected {:entry (assign update-retries) 48 | :after [{:delay calculate-backoff :target :connecting}]} 49 | :connected {:on {:connection-closed :disconnected}}}} 50 | ``` 51 | 52 | ## Unit Testing a StateCharts That Uses Delayed Transitions 53 | 54 | When unit-testing a statecharts that uses delayed transitions, we don't want to 55 | really wait for the exact delay to timeout. 56 | 57 | To facilitate this, clj-statecharts provides a "simulated clock" to be used in 58 | unit tests. This clock could be manipulated by calling its `advance` method. 59 | 60 | If you are interested, see this 61 | [test case](https://github.com/lucywang000/clj-statecharts/blob/v0.1.5/test/statecharts/integrations/re_frame_test.cljc#L48-L60) 62 | for inspiration. 63 | 64 | `Note`: if in your actions code you need to get the current time value, you 65 | shall not use OS API (i.e. `(js/Date.now)` or `(System/currentTimeMillis)`), but 66 | use `(statecharts.clock/now)`. The latter returns the current time in 67 | milliseconds, and when the clock is a simulated one, it would return the value 68 | of the simulated time. This is the only way to make your statecharts 69 | unit-testing-friendly. 70 | 71 | ## Notes 72 | 73 | * Delayed transitions currently only works in the CLJS. CLJ support is going to be added soon. 74 | 75 | * When using the [Immutable API]({{< relref "/docs/get-started#the-immutable-api" 76 | >}}), the machine spec must have a `:scheduler` key that satisfies the 77 | [`statecharts.delayed.Scheduler`](https://github.com/lucywang000/clj-statecharts/blob/master/src/statecharts/delayed.cljc#L6-L8) protocol. 78 | -------------------------------------------------------------------------------- /src/statecharts/store.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.store 2 | "This namespace provides an interface for a mutable datastore for one or more 3 | states. 4 | 5 | It is used in places that are concerned with storing states as they change _over 6 | time_. So, [[statecharts.service]], which notifies listeners when a state 7 | changes, and [[statecharts.integrations.re-frame]], which persists state changes 8 | in a re-frame app-db, both use it. It is also used in [[statecharts.scheduler]], 9 | which is concerned with scheduling state changes that will happen at some future 10 | time." 11 | (:require [statecharts.impl :as impl])) 12 | 13 | (defprotocol IStore 14 | (unique-id [this state] 15 | "Get the id that the store uses to identify this state.") 16 | (initialize [this machine opts] 17 | "Initialize a state, and save it in the store.") 18 | (transition [this machine state event opts] 19 | "Transition a state previously saved in the store. Save and return its new value.") 20 | (get-state [this id] 21 | "Get the current value of a state, by its id.")) 22 | 23 | 24 | (defrecord SingleStore [state*] 25 | IStore 26 | (unique-id [_ _state] :context) 27 | (initialize [_ machine opts] 28 | (reset! state* (impl/initialize machine opts))) 29 | (transition [_ machine _state event opts] 30 | (swap! state* #(impl/transition machine % event opts))) 31 | (get-state [_ _] 32 | @state*)) 33 | 34 | (defn single-store 35 | "A single-store stores the current value of a single state." 36 | [] 37 | (SingleStore. (atom nil))) 38 | 39 | (defrecord ManyStore [states* id] 40 | IStore 41 | (unique-id [_ state] (get state id)) 42 | (initialize [this machine opts] 43 | (let [state (-> (impl/initialize machine opts) 44 | (update id #(or % (gensym))))] 45 | (swap! states* assoc (unique-id this state) state) 46 | state)) 47 | (transition [this machine state event opts] 48 | (let [state-id (unique-id this state)] 49 | (swap! states* update state-id #(impl/transition machine % event opts)) 50 | (get-state this state-id))) 51 | (get-state [_ id] 52 | (get @states* id))) 53 | 54 | (defn many-store 55 | "A many-store stores the current values of many states. 56 | 57 | The `opts` provided to `init` should configure the state to have a unique id. 58 | This ensures that the state can be identified and transitioned later, by both 59 | external and scheduled events. 60 | 61 | By default, a many-store expects the id to be `:id`. 62 | ```clojure 63 | (let [store (store/many-store)] 64 | (store/initialize store fsm {:context {:id 1}}) 65 | (store/get-state store 1)) 66 | ``` 67 | The id can be configured by providing an `:id` key in the many-store 68 | configuration options. 69 | ```clojure 70 | (let [store (store/many-store {:id :my-id})] 71 | (store/initialize store fsm {:context {:my-id 1}}) 72 | (store/get-state store 1)) 73 | ``` 74 | " 75 | ([] (many-store {})) 76 | ([{:keys [id] :or {id :id}}] 77 | (ManyStore. (atom {}) id))) 78 | -------------------------------------------------------------------------------- /test/statecharts/integrations/re_frame_test.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.integrations.re-frame-test 2 | (:require [re-frame.core :as rf] 3 | [statecharts.core :as fsm :refer [assign]] 4 | [day8.re-frame.test :refer [run-test-sync]] 5 | [statecharts.integrations.re-frame :as fsm.rf] 6 | [statecharts.sim :as fsm.sim] 7 | [clojure.test :refer [deftest is are use-fixtures testing]])) 8 | 9 | (def friends-data 10 | [{:name "user1"} 11 | {:name "user2"}]) 12 | 13 | (defn load-friends [state & _] 14 | (rf/dispatch [:friends/fsm-event :success-load friends-data])) 15 | 16 | (defn on-success-load [state {:keys [data]}] 17 | (is (= data friends-data)) 18 | (assoc state :friends data)) 19 | 20 | (defn on-fail-load [state event]) 21 | 22 | (rf/reg-sub 23 | :friends 24 | (fn [db & _] 25 | (:friends db))) 26 | 27 | (def machine-spec 28 | {:id :friends 29 | :initial :init 30 | :context {:user "jack"} 31 | :on {:refresh :init} 32 | :integrations {:re-frame {:path (rf/path :friends) 33 | :initialize-event :friends/init 34 | :transition-event :friends/fsm-event}} 35 | :states 36 | {:init {:after {1000 :loading}} 37 | :loading {:entry load-friends 38 | :on {:success-load {:target :loaded 39 | :actions (assign on-success-load)} 40 | :fail-load {:target :load-failed 41 | :actions on-fail-load}}} 42 | :loaded {} 43 | :load-failed {}}}) 44 | 45 | (defn get-data [k] 46 | (get @(rf/subscribe [:friends]) k)) 47 | 48 | (deftest test-rf-integration 49 | (let [clock (fsm.sim/simulated-clock) 50 | advance-clock (fn [ms] 51 | (fsm.sim/advance clock ms))] 52 | (run-test-sync 53 | (-> (fsm/machine machine-spec) 54 | (fsm.rf/integrate {:clock clock})) 55 | (rf/dispatch [:friends/init]) 56 | (is (= (get-data :_state) :init)) 57 | (is (= (get-data :user) "jack")) 58 | (advance-clock 1000) 59 | (is (= (get-data :_state) :loaded)) 60 | (is (= (get-data :friends) friends-data))))) 61 | 62 | (deftest test-rf-epoch-support 63 | (let [clock (fsm.sim/simulated-clock) 64 | advance-clock (fn [ms] 65 | (fsm.sim/advance clock ms))] 66 | (-> machine-spec 67 | (assoc-in [:integrations :re-frame :epoch?] true) 68 | (update-in [:states :loading] dissoc :entry) 69 | (fsm/machine) 70 | (fsm.rf/integrate {:clock clock})) 71 | (run-test-sync 72 | (rf/dispatch [:friends/init]) 73 | (is (= (get-data :_state) :init)) 74 | (advance-clock 1000) 75 | (is (= (get-data :_state) :loading)) 76 | 77 | (rf/dispatch [:friends/fsm-event {:type :success-load :epoch 100} friends-data]) 78 | (is (= (get-data :_state) :loading)) 79 | 80 | (rf/dispatch [:friends/fsm-event 81 | {:type :success-load :epoch (get-data :_epoch)} 82 | friends-data]) 83 | (is (= (get-data :_state) :loaded)) 84 | (is (= (get-data :friends) friends-data)) 85 | (rf/dispatch [:friends/fsm-event :refresh]) 86 | (is (= (get-data :_state) :init))))) 87 | -------------------------------------------------------------------------------- /docs/content/docs/actions.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Actions & Context" 3 | --- 4 | 5 | # Actions & Context 6 | 7 | ## Actions 8 | 9 | Actions are side-effects that are executed on state transitions. 10 | 11 | There are two kinds of actions: 12 | - Actions that are executed when a transition happens 13 | - Actions that are executed when transition in (entry) or transition out (exit) of a state 14 | 15 | ### Transition Actions 16 | 17 | Instead of define a transition target as simply a keyword, you need to use the full form: 18 | 19 | ```clojure 20 | {:on {:some-event {:target :some-state 21 | :actions some-action}}} 22 | ``` 23 | 24 | The actions value can also be a vector, and the actions would be executed one by one. 25 | ```clojure 26 | {:on {:some-event {:target :some-state 27 | :actions [action1 action2]}}} 28 | ``` 29 | 30 | ### Entry/Exit Actions 31 | 32 | Entry actions are defined on a state, and are executed whenever this state is entered. Similar for exit actions - they are executed whenever leaving the state. 33 | 34 | ```clojure 35 | {:states 36 | {:state1 {:entry some-action-on-entry 37 | :exit some-action-on-exit 38 | :on {...}}}} 39 | 40 | ;; entry/exit can also be vector of actions 41 | {:states 42 | {:state1 {:entry [action1 action2] 43 | :exit [action3 action4] 44 | :on {...}}}} 45 | ``` 46 | 47 | 48 | ### Method Signature of the Action Functions 49 | 50 | The action function is invoked with two arguments: `(state event)` 51 | 52 | * state is the current state 53 | * event is the event that triggers the transition and execution of the action 54 | 55 | 56 | ## Updating the State Context 57 | 58 | Actions can update the context of the state machine. 59 | 60 | ```clojure 61 | (require '[statecharts.core :as fsm :refer [assign]]) 62 | 63 | (defn update-counter [state event] 64 | (update state :counter inc)) 65 | 66 | 67 | {:states 68 | {:state1 {:on {:some-event {:target :state2 69 | :action (assign update-counter)}}}}} 70 | ``` 71 | 72 | Note the action is wrapped with `statecharts.core/assign`. Without this it's return value is ignored and the state context is not changed. 73 | 74 | The `event` arg of update-counter would be `{:type :some-event}`. Extra keys could be passed when calling `fsm/transition`: 75 | 76 | ```clojure 77 | (let [event {:type :some-event 78 | :k1 :v1 79 | :k1 :v2}] 80 | (fsm/transition machine current-state event)) 81 | ``` 82 | 83 | And the `event` argument passed to the `update-counter` would have these `:k1` 84 | `:k2` keys etc. 85 | 86 | ## The Special Variable `_prev-state` in Action Functions 87 | 88 | During action execution time, `_state` already points to the new 89 | state after the transition. 90 | 91 | The action functions could use the value under the `_prev-state` key of the context 92 | to access the previous state before the transition (e.g. for debugging, or 93 | archiving some information for later analysis). 94 | 95 | Please note: 96 | - Unlike `_state`, the `_prev-state` variable only exists during the transition and 97 | would not be available after that. 98 | - If the transition is called with `{:exec false}`, the actions would be returned 99 | to the caller instead of being executed. In that case it would also have no 100 | access to `_prev-state`. 101 | 102 | ## A Full Example 103 | 104 | {{< loadcode "samples/src/statecharts-samples/trigger_actions.clj" >}} 105 | -------------------------------------------------------------------------------- /test/statecharts/service_test.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.service-test 2 | (:require [statecharts.core :as fsm :refer [assign]] 3 | [statecharts.service] 4 | [statecharts.clock :as clock] 5 | [statecharts.sim :as fsm.sim] 6 | [clojure.test :refer [deftest is are use-fixtures testing]])) 7 | 8 | 9 | (deftest test-service 10 | (let [inc-x (fn [context & _] 11 | (update context :x inc)) 12 | now (atom nil) 13 | capture-now (fn [& _] 14 | (reset! now (clock/now))) 15 | fsm 16 | (fsm/machine 17 | {:id :fsm 18 | :initial :s2 19 | :context {:x 1} 20 | :after {50000 {:actions (assign inc-x)} 21 | 4000 [:. :s1]} 22 | :states 23 | {:s1 {:after [{:delay 500 24 | :actions (assign inc-x)} 25 | {:delay (fn [context & _] 26 | (if (> (:x context) 0) 27 | 1000 28 | 2000)) 29 | :actions (assign inc-x)}]} 30 | :s2 {:after [{:delay 1000 :actions capture-now :target :s3}]} 31 | :s3 {:after [{:delay 1000 :target :s4}]} 32 | :s4 {:after [{:delay 1000 33 | :target :s5 34 | :guard (fn [context _] 35 | (< (:x context) 0))} 36 | {:delay 1000 :target :s6}]} 37 | :s5 {} 38 | :s6 {}}}) 39 | clock (fsm.sim/simulated-clock) 40 | 41 | service (fsm/service fsm {:clock clock}) 42 | state* (atom nil) 43 | 44 | is-state (fn [v] 45 | (is (= v (:_state @state*))) 46 | (is (= v (fsm/value service)))) 47 | is-x (fn [x] 48 | (is (= x (:x (fsm/state service)))) 49 | (is (= x (:x @state*)))) 50 | advance-clock (fn [ms] 51 | ;; (println '--------------) 52 | (fsm.sim/advance clock ms))] 53 | 54 | (statecharts.service/add-listener 55 | service 56 | [::test] ;; listener id 57 | (fn [_ new-state] 58 | (reset! state* new-state))) 59 | 60 | (fsm/start service) 61 | (is-state :s2) 62 | 63 | (advance-clock 1000) 64 | (is (= @now 1000)) 65 | (is-state :s3) 66 | 67 | (advance-clock 1000) 68 | (is-state :s4) 69 | 70 | (testing "delay+guarded" 71 | (advance-clock 1000) 72 | (is-state :s6)) 73 | 74 | (testing "delay transition on root node" 75 | (advance-clock 1000) 76 | (is-state :s1)) 77 | 78 | (testing "delay internal self-transition on non-root node" 79 | (advance-clock 500) 80 | (is-x 2)) 81 | 82 | (testing "delay as a function" 83 | (advance-clock 500) 84 | (is-x 3)) 85 | )) 86 | 87 | (deftest test-transition-opts 88 | (let [machine (fsm/machine {:id :foo 89 | :initial :foo 90 | :states {:foo {:on {:foo-event {:target :bar}}} 91 | :bar {:on {:bar-event {:target :foo}}}}}) 92 | svc (fsm/service machine {:transition-opts {:ignore-unknown-event? true}})] 93 | (fsm/start svc) 94 | (testing "error is not thrown when ignore-unknown-event? flag is set" 95 | (is (= :foo (:_state (fsm/send svc :bar-event))))))) 96 | -------------------------------------------------------------------------------- /src/statecharts/delayed.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.delayed 2 | (:require [clojure.walk :refer [postwalk]] 3 | [statecharts.utils :as u])) 4 | 5 | (defprotocol IScheduler 6 | (schedule [this fsm state event delay]) 7 | (unschedule [this fsm state event])) 8 | 9 | (defn scheduler? [x] 10 | (satisfies? IScheduler x)) 11 | 12 | (def path-placeholder [:]) 13 | 14 | (defn delay-fn-id [d] 15 | (if (int? d) 16 | d 17 | #?(:cljs (aget d "name") 18 | :clj (str (type d))))) 19 | 20 | (defn generate-delayed-events [delay txs] 21 | (let [event [:fsm/delay 22 | path-placeholder 23 | ;; When the delay is a context function, after each 24 | ;; reload its value of change, causing the delayed 25 | ;; event can't find a match in :on keys. To cope with 26 | ;; this we extract the function name as the event 27 | ;; element instead. 28 | (delay-fn-id delay)]] 29 | ;; (def vd1 delay) 30 | {:entry {:action :fsm/schedule-event 31 | :event-delay delay 32 | :event event} 33 | :exit {:action :fsm/unschedule-event 34 | :event event} 35 | :on [event (mapv #(dissoc % :delay) txs)]})) 36 | 37 | #_(generate-delayed-events 1000 [{:delay 1000 :target :s1 :guard :g1} 38 | {:delay 1000 :target :s2}]) 39 | 40 | #_(group-by odd? [1 2 3]) 41 | 42 | ;; statecharts.impl/T_DelayedTransition 43 | ;; => 44 | #_[:map 45 | [:entry] 46 | [:exit] 47 | [:on]] 48 | (defn derived-delay-info [delayed-transitions] 49 | (doseq [dt delayed-transitions] 50 | (assert (contains? dt :delay) 51 | (str "no :delay key found in" dt))) 52 | (->> delayed-transitions 53 | (group-by :delay) 54 | ;; TODO: the transition's entry/exit shall be grouped by delay, 55 | ;; otherwise a delay with multiple targets (e.g. with guards) 56 | ;; would result in multiple entry/exit events. 57 | (map (fn [[delay txs]] 58 | (generate-delayed-events delay txs))) 59 | (reduce (fn [accu curr] 60 | (merge-with conj accu curr)) 61 | {:entry [] :exit [] :on []}))) 62 | 63 | #_(derived-delay-info [:s1] [{:delay 1000 :target :s1 :guard :g1} 64 | {:delay 2000 :target :s2}]) 65 | 66 | (defn insert-delayed-transitions 67 | "Translate delayed transitions into internal entry/exit actions and 68 | transitions." 69 | [node] 70 | ;; node 71 | (let [after (:after node)] 72 | (if-not after 73 | node 74 | (let [{:keys [entry exit on]} (derived-delay-info after) 75 | on (into {} on) 76 | vconcat (fn [xs ys] 77 | (-> (concat xs ys) vec))] 78 | (-> node 79 | (update :entry vconcat entry) 80 | (update :exit vconcat exit) 81 | (update :on merge on)))))) 82 | 83 | (defn replace-path [path form] 84 | (if (nil? form) 85 | form 86 | (postwalk (fn [x] 87 | x 88 | (if (= x path-placeholder) 89 | path 90 | x)) 91 | form))) 92 | 93 | (defn replace-delayed-place-holder 94 | ([fsm] 95 | (replace-delayed-place-holder fsm [])) 96 | ([node path] 97 | (let [replace-path (partial replace-path path)] 98 | (cond-> node 99 | (:on node) 100 | (update :on replace-path) 101 | 102 | (:entry node) 103 | (update :entry replace-path) 104 | 105 | (:exit node) 106 | (update :exit replace-path) 107 | 108 | (:states node) 109 | (update :states 110 | (fn [states] 111 | (u/map-kv (fn [id node] 112 | [id 113 | (replace-delayed-place-holder node (conj path id))]) 114 | states))))))) 115 | 116 | #_(replace-delayed-place-holder 117 | {:on {[:fsm/delay [:] 1000] :s2} 118 | :states {:s3 {:on {[:fsm/delay [:] 1000] :s2} 119 | :entry [{:fsm/type :schedule-event 120 | :fsm/delay 1000 121 | :fsm/event [:fsm/delay [:] 1000]}]}} 122 | :entry [{:fsm/type :schedule-event 123 | :fsm/delay 1000 124 | :fsm/event [:fsm/delay [:] 1000]}]} [:root]) 125 | -------------------------------------------------------------------------------- /src/statecharts/integrations/re_frame.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.integrations.re-frame 2 | "Integration with re-frame" 3 | (:require [re-frame.core :as rf] 4 | [statecharts.core :as fsm] 5 | [statecharts.clock :as clock] 6 | [statecharts.utils :as u] 7 | [statecharts.scheduler :as scheduler] 8 | [statecharts.service :as service] 9 | [statecharts.store :as store])) 10 | 11 | (rf/reg-event-db 12 | ::sync-state-update 13 | (fn [db [_ path state f]] 14 | (assoc-in db path (f state)))) 15 | 16 | (defn connect-rf-db 17 | "Update the given path of re-frame app-db whenever the state of the 18 | fsm service changes." 19 | ([service path] 20 | (connect-rf-db service path identity)) 21 | ([service path f] 22 | (service/add-listener 23 | service 24 | ;; listener id 25 | [::connect-rf-db path] 26 | (fn [_ new-state] 27 | (rf/dispatch [::sync-state-update path new-state f]))))) 28 | 29 | (rf/reg-event-fx 30 | ::call-fx 31 | (fn [_ [_ fx]] 32 | fx)) 33 | 34 | (defn call-fx 35 | "Create an action that when called would dispatch the provided 36 | effects." 37 | [effects] 38 | (rf/dispatch [::call-fx effects])) 39 | 40 | (defn fx-action 41 | "Create an action that when called would dispatch the provided 42 | effects." 43 | [effects] 44 | (fn [] 45 | (rf/dispatch [::call-fx effects]))) 46 | 47 | (defn make-rf-scheduler [{:keys [path transition-event]} clock] 48 | ;; re-frame's app-db is the true storage, so we need a store that delegates to 49 | ;; re-frame by dispatching events. This store will not be exposed externally; it 50 | ;; is used only by the scheduler, internally. Since The scheduler calls only a 51 | ;; subset of the IStore protocol, the unused methods do not need to be 52 | ;; implemented. 53 | (let [store (reify 54 | store/IStore 55 | (unique-id [_this _state] path) 56 | (transition [_this _machine _state event _opts] 57 | (rf/dispatch [transition-event event])))] 58 | (scheduler/make-store-scheduler store clock))) 59 | 60 | (defn default-opts [] 61 | {:clock (clock/wall-clock)}) 62 | 63 | (defonce epochs (volatile! {})) 64 | 65 | (def safe-inc (fnil inc 0)) 66 | 67 | (defn new-epoch [id] 68 | (get (vswap! epochs update id safe-inc) id)) 69 | 70 | (defn should-discard [event current-epoch] 71 | (if-let [event-epoch (:epoch event)] 72 | (not= event-epoch current-epoch) 73 | false)) 74 | 75 | (defn canon-event [event data] 76 | (if (keyword? event) 77 | {:event event :data data} 78 | (do 79 | (assert (map? event)) 80 | (assoc event :data data)))) 81 | 82 | (defn log-discarded-event [{:keys [type]}] 83 | (let [msg (str "event " type " ignored in new epoch")] 84 | #?(:cljs 85 | (when ^boolean goog.DEBUG 86 | (js/console.log msg))) 87 | #?(:clj 88 | (println msg)))) 89 | 90 | (defn integrate 91 | ([machine] 92 | (integrate machine default-opts)) 93 | ([{:keys [id] :as machine} {:keys [clock]}] 94 | (let [clock 95 | (or clock (clock/wall-clock)) 96 | 97 | integration-opts (get-in machine [:integrations :re-frame]) 98 | 99 | machine 100 | (assoc machine :scheduler (make-rf-scheduler integration-opts clock)) 101 | 102 | {:keys [path initialize-event transition-event epoch?]} 103 | integration-opts 104 | 105 | path 106 | (some-> path u/ensure-vector)] 107 | 108 | (when initialize-event 109 | (rf/reg-event-db 110 | initialize-event 111 | path 112 | (fn [_ [_ initialize-args]] 113 | (cond-> (fsm/initialize machine initialize-args) 114 | epoch? 115 | (assoc :_epoch (new-epoch id)))))) 116 | 117 | (when transition-event 118 | (rf/reg-event-db 119 | transition-event 120 | path 121 | (fn [db [_ fsm-event data :as args]] 122 | (let [fsm-event (u/ensure-event-map fsm-event) 123 | more-data (when (> (count args) 3) 124 | (subvec args 2))] 125 | (if (and epoch? (should-discard fsm-event (:_epoch db))) 126 | (do 127 | (log-discarded-event fsm-event) 128 | db) 129 | (fsm/transition machine db 130 | ;; For 99% of the cases the fsm-event has 0 or 1 arg. 131 | ;; The first event arg is passed in :data key of the 132 | ;; event, the remaining are passed in :full-data. 133 | (cond-> (assoc fsm-event :data data) 134 | (some? more-data) 135 | (assoc :more-data more-data)))))))) 136 | machine))) 137 | 138 | (defn with-epoch [event epoch] 139 | {:type event 140 | :epoch epoch}) 141 | -------------------------------------------------------------------------------- /docs/content/docs/transitions.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Transitions" 3 | --- 4 | 5 | # Transitions 6 | 7 | Transitions are the most important parts of a state machine, since it 8 | embodies the major logic of the application. 9 | 10 | ## Basic Transitions 11 | 12 | The basic elements of a transition is the target state and the actions 13 | to execute. 14 | 15 | ```clojure 16 | {:states {:s1 17 | {:on {:event1 {:target :s2 18 | :actions some-action-fn}}}} 19 | ``` 20 | 21 | If the current state is `:s1` and event `:event1` happens, the new 22 | state would be `:s2` and the action function `some-action-fn` would be 23 | executed. 24 | 25 | Some syntax sugars: 26 | 27 | ```clojure 28 | {:states {:s1 29 | {:on {:event1 {:target :s2 30 | :actions [action-fn1 action-fn2]} ;; (1) 31 | :event2 :s3}}}} ;; (2) 32 | ``` 33 | 34 | (1) The actions could be a vector of multiple action functions to execute. 35 | 36 | (2) If there is no actions, the transition could be simplified to be a single 37 | keyword. 38 | 39 | Please note that event names could be any keywords, with one exception: **keywords 40 | namespace "fsm" is considered reserved for clj-statecharts's internal use**, so do 41 | not use event names like `:fsm/foo` in your application code. 42 | 43 | 44 | ## Internal & External Transitions {#internal-external-transitions} 45 | 46 | *Before reading this section, make sure you have read the [Identifying 47 | States]({{< relref "/docs/identifying-states.md" >}}) about the 48 | absolute and relative syntax of representing a state.* 49 | 50 | A state could transition to one of its child states. 51 | 52 | * If the transition triggers the entry/exit actions on the parent 53 | state, it's called an **external transition**. 54 | * Otherwise, it's called an **internal transition**. 55 | 56 | Here is an example of an internal & external transition: 57 | 58 | ```clojure 59 | {:states {:s1 {:initial :s1.1 60 | :entry entry1 61 | :exit exit1 62 | :on {:event1_1.2_internal [:. :s1.2] ;; (1) 63 | :event1_1.2_external [:> :s1 :s1.2]} ;; (2) 64 | :states {:s1.1 {} 65 | :s1.2 {}}}}} 66 | ``` 67 | 68 | State `:s1` has two child states `:s1.1` and `:s1.2`. 69 | 70 | (1) When event `event1_1.2_internal` happens, the new state would be 71 | `:s1.2`, but the entry/exit actions of state `:s1` **would not be** 72 | executed. 73 | 74 | (2) When event `event1_1.2_external` happens, the new state would also 75 | be `:s1.2`, but the entry/exit actions of state `:s1` **would be** 76 | executed. 77 | 78 | 79 | ## Self Transitions {#self-transitions} 80 | 81 | A state could transition to itself, this is called a 82 | [self-transition](https://statecharts.github.io/glossary/self-transition.html). 83 | 84 | For instance, a calculator FSM could have a state `:operand1` 85 | representing the state that the user is typing the first operand. So 86 | the `:input-digit` event should keep the state machine in that state 87 | (but using actions to update the value of the operand on each input), 88 | instead of transitioning to a new state. 89 | 90 | A self-transition could also be either internal or external. To specify an internal self-transition, simply omit the `:target` key in the transition map. 91 | 92 | For instance: 93 | 94 | ```clojure 95 | {:states {:s1 {:entry entry1 96 | :exit exit1 97 | :on {:event1_1_internal {:actions some-action} ;; (1) 98 | :event1_1_external :s1 ;; (2) 99 | }}}} 100 | ``` 101 | 102 | (1) For event `:event1_1_internal`, the target state is not specified 103 | (or `nil`). In this case, the entry/exit actions of `:s1` **would not 104 | be** executed. 105 | 106 | (2) For event `:event1_1_external`, the target state is explicitly 107 | provided as itself, so the entry/exit actions of `:s1` **would be** 108 | executed. 109 | 110 | ## EventLess Transitions 111 | 112 | Quoting [XState doc](https://xstate.js.org/docs/guides/transitions.html#eventless-transitions): 113 | 114 | > An eventless transition is a transition that is always taken when the machine is 115 | in the state where it is defined, and when its guards evaluates to true. They are 116 | always checked when the state is first entered, before handling any other events. 117 | 118 | Eventless transitions are defined on the `:always` key of the state node: 119 | 120 | Given the following state machine: 121 | 122 | ```clojure 123 | {:states {:s1 {:entry entry1 124 | :exit exit1 125 | :on {:e12 :s2 126 | :actions action12}} 127 | :s2 {:entry entry2 128 | :exit exit2 129 | :always [{:guard guard23 130 | :target :s3 131 | :actions action23} 132 | {:guard guard24 133 | :target :s4 134 | :actions action23}] 135 | :on {:e23 :s3}} 136 | :s3 {:entry entry3} 137 | :s4 {}}} 138 | ``` 139 | 140 | Assume current state is `:s1`, and event `:e12` happens. 141 | - The target state is `:s2`. Because `:s2` has eventless transitions defined, it 142 | would immediately evaluates the guard function `guard23`. 143 | - If `guard23` returns a truthy value, the machine would transition to state `:s3`. 144 | In this case these actions would be executed one by one: 145 | - exit1 146 | - action12 147 | - entry2 148 | - exit2 149 | - action23 150 | - entry3 151 | - Otherwise `guard24` would be evaluated. If `guard24` returns truthy, the machine 152 | would transition to `:s4` (and similarly a list of actions would be executed). 153 | Otherwise it would stay in `:s2`. 154 | 155 | The event args that accompanies `:e12` would be passed to every action that is 156 | executed. 157 | -------------------------------------------------------------------------------- /docs/content/docs/integration/re-frame.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Re-frame Integration" 3 | --- 4 | 5 | # Re-frame Integration 6 | 7 | First, re-frame itself is much like a simple state machine: an event triggers 8 | the change of the app-db (much like the `context` in statecharts), as 9 | well as execution of other effects (much like actions in a 10 | fsm/statecharts). 11 | 12 | There are two ways to integrate clj-statecharts with re-frame: 13 | 14 | * Integrate re-frame with the immutable api 15 | * Or integrate with the service api 16 | 17 | The `statecharts.re-frame` namespace provides some goodies for 18 | both ways of integration. 19 | 20 | ## Integrate re-frame with the Immutable API 21 | 22 | It's pretty straight forward to integrate the immutable API of 23 | statecharts into re-frame's event handlers: 24 | 25 | ```clojure 26 | (ns mymodule 27 | (:require [re-frame.core :as rf] 28 | [statecharts.core :as fsm] 29 | [statecharts.integrations.re-frame :as fsm.rf])) 30 | 31 | (def mymodule-path [(rf/path :mymodule)]) 32 | 33 | (def my-machine 34 | (-> (fsm/machine 35 | {:id :mymodule 36 | :initial :init 37 | :states {...} 38 | :integrations {:re-frame {:path mymodule-path ;; (1) 39 | :initialize-event :mymodule/init 40 | :transition-event :mymodule/fsm-transition}}}) 41 | (fsm.rf/integrate) ;; (2) 42 | )) 43 | ``` 44 | 45 | The tricky part is to how to use the event system of re-frame to transition the state machine. This is done by `fsm.rf/integrate`. 46 | 47 | The call to `fsm.rf/integrate` would do the following for you: 48 | - register an re-frame event handler for `:mymodule/init` that calls 49 | `fsm/initialize` and store the resulting state in the given path (i.e. 50 | `mymodule-path` in the this example) 51 | - register an re-frame event handler `:mymodule/fsm-transition`, that when 52 | triggered, simply calls `fsm/transition` with the event args. 53 | 54 | Here is an example of loading the list of friends of current user: 55 | 56 | {{< loadcode "samples/src/statecharts-samples/rf_integration.cljs" >}} 57 | 58 | Notice the use of `statecharts.integrations.re-frame/call-fx` to dispatch an effect 59 | in a fsm action. 60 | 61 | ### Discard stale events with epoch support 62 | 63 | Under the `[:integrations :re-frame]` key, you can specify an `epoch?` boolean 64 | flag. To see why you may need it, first let's see a real world problem. 65 | 66 | Imagine there is a image viewing application which users could click one image from 67 | a list of thumbnails, and the application would download and show the original 68 | high-quality image. Also imagine the download/show is managed by a state machine, 69 | so there are states like `loading`, `loaded`, `load-failed`, and events like 70 | `:load-image`, `:success-load`, `:fail-load` etc. For instance, upon successful 71 | download the image with an ajax request, the `:success-load` event would be fired, 72 | and the machine would enter `:loaded` state. The UI would then display the image. 73 | 74 | One problem arises when the user clicks too quickly, for instance, after clicking 75 | on image A, and quickly on image B. It's possible that upon successful downloading 76 | of image A, the `:success-load` fires and the UI displays the image A, but the user 77 | wants to see image B. (Eventually image B would be displayed, but this "flaky" 78 | experience may annoy users.) 79 | 80 | One way is to always cancel the current ajax request when requesting for a new one. 81 | But sometimes it maybe not feasible to do so. So clj-statecharts provides an 82 | `epoch?` flag in this re-frame integration for such uses cases. 83 | 84 | ```clojure 85 | (-> (fsm/machine 86 | {:id :image-viewer 87 | :states {...} 88 | :integrations {:re-frame {:transition-event :viewer/fsm-event 89 | :epoch? true ;; (1) 90 | ...}}}) 91 | (fsm.rf/integrate)) 92 | ``` 93 | 94 | This `epoch?` flag would add some extra features to the state: 95 | - Upon the initialize event, the state map would have an `_epoch` key populated by 96 | default, whose value is an integer. Later if you re-initialize the machine, the 97 | `_epoch` key would be automatically incremented by 1. 98 | - When you dispatch an event to the fsm, typically in a callback function of some 99 | async operations like sending an ajax request, you can dispatch a keyword, or a 100 | map with an `:type` key (actually `:event-foo` is short for `{:type :event-foo}`. 101 | In this map you can pass an `:epoch` key, which could serve the purpose to 102 | automatically discard this event in the `:_epoch` of the state machine changes. 103 | ```clojure 104 | (ajax/send 105 | {:url "http://image.com/imageA" 106 | ;; this event is always accepted 107 | :callback #(rf/dispatch [:viewer/fsm-event :success-load %])}) 108 | 109 | (ajax/send 110 | {:url "http://image.com/imageA" 111 | ;; For this event, when the callback is called, if the provided 112 | ;; epoch is not the same as the state's current _epoch value, the 113 | ;; event would be ignored. 114 | :callback #(rf/dispatch [:viewer/fsm-event {:type :success-load :epoch 1} %])}) 115 | ``` 116 | 117 | ## Integrate with the Service API 118 | 119 | When integrating re-frame with the service api of clj-statecharts, the 120 | state is stored in the service, and is synced to re-frame app-db by 121 | calling to `statecharts.integrations.re-frame/connect-rf-db`. 122 | 123 | {{< loadcode "samples/src/statecharts-samples/rf_integration_service.cljs" >}} 124 | 125 | (1) call `fsm/start` on the service in some event handler 126 | 127 | (2) sync the state machine context to some sub key of re-frame app-db 128 | with `statecharts.integrations.re-frame/connect-rf-db` 129 | 130 | (3) Make sure the service keeps a reference to the latest machine 131 | definition after hot-reloading. 132 | 133 | Be aware that state is updated into the app-db path in a "unidirectional" sense. If 134 | you update the app-db data (for instance modify the `:friends` key in the above 135 | example), it would not affect the state machine and would be overwritten by the 136 | next state machine update. 137 | 138 | ## Immutable or Service? 139 | 140 | Integrate with the immutable API when: 141 | - The state machine states changes are mostly driven by UI/re-frame events (e.g. 142 | button clicks) 143 | - You need to modify the state directly in other re-frame events 144 | 145 | Integrate with the service API when: 146 | - The state changes are mostly driven by non UI/re-frame events (e.g. websocket 147 | states management) 148 | 149 | ## Further Reading 150 | 151 | * [Re-frame EP 003 - Finite State Machines](https://github.com/day8/re-frame/blob/v1.1.0/docs/EPs/005-StateMachines.md) 152 | -------------------------------------------------------------------------------- /docs/content/docs/parallel-states.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: 'Parallel States' 3 | --- 4 | 5 | # Why Parallel States 6 | 7 | (a.k.a concurrent states or orthogonal regions) 8 | 9 | Usually within a statecharts, all states are tightly related and mutual 10 | exclusive to each other (e.g. `uploading` and `uploaded` in a file 11 | application.). 12 | 13 | However, in lots of real world complex applications, there could be multiple 14 | "regions" of the application that are loosely related, or not related at all, 15 | but is always used/reasoned together in a module/screen/subsystem. 16 | 17 | For instance, in a files management application, there could be 18 | 19 | - a files list on the main part of the screen, and 20 | - a "properties" window that is placed on the right of the screen when a file is 21 | selected. 22 | 23 | The files list could have the following states: 24 | 25 | - `list-loading`: requesting the list of files from the server 26 | - `list-loaded`: successfully get the list of files 27 | - `list-load-failed`: error when requesting the list of files, e.g. ajax request 28 | fails because of network error 29 | 30 | The files property has the following states: 31 | 32 | - `props-idle`: no file is selected, so nothing to show 33 | - `props-loading`: file is selected, and requesting the details of the file from 34 | the server 35 | - `props-loaded` 36 | - `props-load-failed` 37 | 38 | Most people would feel comfortable to model this screen with two statecharts. 39 | But as more features are added, we'll need to create and maintain and reason 40 | about more and more disparate statecharts. For instance, each file could have a 41 | list of comments, which would pop out when a user clicks a "show comments" 42 | button. Of course we can just add one more new statecharts, but it's obvious to 43 | conclude that this doesn't look that appealing, because: 44 | 45 | 1. With the states scattered in more and more multiple places, it becomes harder 46 | and harder for us to see and reason about "the big picture" of the current 47 | screen. 48 | 2. Part of the statecharts context has to be duplicated among different 49 | statecharts, e.g. the current selected file name. 50 | 3. Lots of boilerplate. Each state machine requires an `id`, a call to 51 | `fsm/machine` and `fsm.rf/integrate` (see [re-frame 52 | integration]({{< relref "docs/integration/re-frame.md" >}}) for details.) 53 | 54 | ## What is Parallel States 55 | 56 | **Parallel states** (a.k.a **concurrent states**) is a mechanism in statecharts 57 | that could be used to use a single statecharts to model different parts of an 58 | application that doesn't depend on each other. Conceptually: 59 | 60 | - when an event comes, each child of a parallel state receives this event at the 61 | same time. They could either handle it or ignore it, since some events only 62 | makes sense to one part of the screen, e.g. "property-loaded" should be 63 | handled by the props part, but should be ignored by the other parts. 64 | - The current state of the statecharts is a combination of all parallel 65 | children. 66 | 67 | ## How to define a parallel state node 68 | 69 | ```clojure 70 | ;!zprint {:format :on :map {:justify? true} :pair {:justify? true}} 71 | {:id :file-app 72 | :type :parallel ;; (1) 73 | :context {:selected-file-name nil} 74 | :regions ;; (2) 75 | {:main {:initial :loading ;; (3) 76 | :states {:loading {:on {:success-load-files :loaded 77 | :fail-load-files :load-failed}} 78 | :loaded {} 79 | :load-failed {}}} 80 | :props {:initial :idle 81 | :states {:idle {:on {:file-selected :loading}} 82 | :loading {:on {:success-load-props :loaded 83 | :fail-load-props :load-failed}} 84 | :loaded {} 85 | :load-failed {}}}} 86 | 87 | :comments {:initial :idle 88 | :states {:idle {:on {:show-comments :loading}} 89 | :loading {:on {:success-load-comments :loaded 90 | :fail-load-comments :load-failed}} 91 | :loaded {} 92 | :load-failed {}}}} 93 | ``` 94 | 95 | (1) Use `{:type :parallel}` to define a parallel state node 96 | 97 | (2) Define the child regions in the `:regions` key. 98 | 99 | (3) Each child node of a parallel node must be a hierarchical state node. 100 | 101 | ### Hierarchical parallel state node 102 | 103 | In the example above, the root node of the statecharts is a parallel node. 104 | However you can put a parallel node anywhere in the state chart, e.g.: 105 | 106 | ```clojure 107 | {:id :hierarchical-parallel-demo 108 | :initial :p2 109 | :states ;; (1) 110 | {:p1 ;; (2) 111 | {:initial :p11 112 | :states {:p11 {:on {:e12 :p12}} 113 | :p12 {}}} 114 | 115 | ;; p2 is a hierarchical parallel node 116 | :p2 ;; (3) 117 | {:type :parallel 118 | :regions 119 | {:p2.a ;; (4) 120 | {:initial :p2.a1 121 | :states {:p2.a1 {:on {:e12 :p2.a2}} 122 | :p2.a2 {}}} 123 | 124 | :p2.b ;; (5) 125 | {:initial :p2b2 126 | :states 127 | {:p2b1 {:on {:e231 :p2b2}} 128 | ;; parallel nest level depth +1 129 | :p2b2 {:type :parallel ;; (6) 130 | :regions {:p2b2.a {:initial :p2b2.a1 131 | :states {:p2b2.a1 {}}} 132 | :p2b2.b {:initial :p2b2.b1 133 | :states {:p2b2.b1 134 | {}}}}}}}}}}} 135 | ``` 136 | 137 | (1) The root node is a hierarchical node, with two regions `:p1` and `:p2` 138 | 139 | (2) `:p1` is a hierarchical node 140 | 141 | (3) `:p2` is a parallel node with two regions `:p2.a` and `:p2.b` 142 | 143 | (4) `:p2.a` is a hierarchical node 144 | 145 | (5)(6) `:p2.b` is a hierarchical node, but one of its children `:p2b2` is a 146 | parallel node. 147 | 148 | We can build arbitrary complex statecharts this way, but it's highly discouraged 149 | because it makes the statecharts harder and harder to reason about. 150 | 151 | ## State Representation for Parallel Node 152 | 153 | - If the fsm root node is a parallel node, then the whole state is represented 154 | as a map, e.g. `{:r1 :r1-state :r2 :r2-state}` 155 | - In a typical hierarchical node, the current state is represented as 156 | `[:s1 :s1.1]`. However, if `:s1.1` is a parallel node and has two regions 157 | `:r1` and `:r2`, then it would be represented as 158 | `[:s1 {:s1.1 {:r1 :r1-state :r2 :r2-state}}]`. 159 | 160 | ## Advantages and Disadvantages of Parallel States 161 | 162 | ### Advantages 163 | 164 | - A single statecharts spec could as the blueprint of the logic of a coherent 165 | module/screen/subsystem, instead of scattered among multiple smaller 166 | statecharts. With a better big picture, we could more easily spot places where 167 | states design could be improved. 168 | - Less boilerplate code. 169 | - Avoid duplication of the same piece of information in the contexts of 170 | different statecharts. 171 | 172 | ### Disadvantages 173 | 174 | Nothing. 175 | 176 | Some may say "it's more complex". But the complexity is a result of the 177 | inheritent complexity of the application itself, not introduced by using 178 | parallel nodes in the statecharts. The alternative is to use multiple smaller 179 | statecharts. However to keep track and reason about all of these smaller 180 | statecharts introduces extra cost both in your code and in your mind. 181 | 182 | Some may worry about "there would be a performance impact", since for a parallel 183 | state, each event is dispatched to all its child states and in lots of cases 184 | some events is only handled by one child state. However, IMO this is hardly a 185 | problem given today's hardware technology, unless you're building some 186 | nano-second HFT system. For most applications, clj-statecharts takes less than 187 | 1ms to process an event. 188 | 189 | ## Useful links 190 | 191 | - [Parallel States in StateCharts 101](https://statecharts.github.io/glossary/parallel-state.html) 192 | - [XState's parallel states support](https://xstate.js.org/docs/guides/parallel.html) 193 | 194 | Note that in xstate the regions are still represented in the `states` key, which 195 | I think is not a good choice since `states` is also used to represent the 196 | children of hierarchical states. So in clj-statecharts we use the `:regions` 197 | key. 198 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | a) in the case of the initial Contributor, the initial code and 11 | documentation distributed under this Agreement, and 12 | b) in the case of each subsequent Contributor: 13 | i) changes to the Program, and 14 | ii) additions to the Program; 15 | 16 | where such changes and/or additions to the Program originate from and are 17 | distributed by that particular Contributor. A Contribution 'originates' from a 18 | Contributor if it was added to the Program by such Contributor itself or 19 | anyone acting on such Contributor's behalf. Contributions do not include 20 | additions to the Program which: (i) are separate modules of software 21 | distributed in conjunction with the Program under their own license agreement, 22 | and (ii) are not derivative works of the Program. 23 | "Contributor" means any person or entity that distributes the Program. 24 | 25 | "Licensed Patents" mean patent claims licensable by a Contributor which are 26 | necessarily infringed by the use or sale of its Contribution alone or when 27 | combined with the Program. 28 | 29 | "Program" means the Contributions distributed in accordance with this 30 | Agreement. 31 | 32 | "Recipient" means anyone who receives the Program under this Agreement, 33 | including all Contributors. 34 | 35 | 2. GRANT OF RIGHTS 36 | 37 | a) Subject to the terms of this Agreement, each Contributor hereby grants 38 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 39 | reproduce, prepare derivative works of, publicly display, publicly 40 | perform, distribute and sublicense the Contribution of such Contributor, 41 | if any, and such derivative works, in source code and object code form. 42 | 43 | b) Subject to the terms of this Agreement, each Contributor hereby grants 44 | Recipient a non-exclusive, worldwide, royalty-free patent license under 45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 46 | transfer the Contribution of such Contributor, if any, in source code and 47 | object code form. This patent license shall apply to the combination of 48 | the Contribution and the Program if, at the time the Contribution is 49 | added by the Contributor, such addition of the Contribution causes such 50 | combination to be covered by the Licensed Patents. The patent license 51 | shall not apply to any other combinations which include the Contribution. 52 | No hardware per se is licensed hereunder. 53 | 54 | c) Recipient understands that although each Contributor grants the 55 | licenses to its Contributions set forth herein, no assurances are 56 | provided by any Contributor that the Program does not infringe the patent 57 | or other intellectual property rights of any other entity. Each 58 | Contributor disclaims any liability to Recipient for claims brought by 59 | any other entity based on infringement of intellectual property rights or 60 | otherwise. As a condition to exercising the rights and licenses granted 61 | hereunder, each Recipient hereby assumes sole responsibility to secure 62 | any other intellectual property rights needed, if any. For example, if a 63 | third party patent license is required to allow Recipient to distribute 64 | the Program, it is Recipient's responsibility to acquire that license 65 | before distributing the Program. 66 | 67 | d) Each Contributor represents that to its knowledge it has sufficient 68 | copyright rights in its Contribution, if any, to grant the copyright 69 | license set forth in this Agreement. 70 | 71 | 3. REQUIREMENTS 72 | A Contributor may choose to distribute the Program in object code form under 73 | its own license agreement, provided that: 74 | 75 | a) it complies with the terms and conditions of this Agreement; and 76 | 77 | b) its license agreement: 78 | i) effectively disclaims on behalf of all Contributors all 79 | warranties and conditions, express and implied, including warranties 80 | or conditions of title and non-infringement, and implied warranties 81 | or conditions of merchantability and fitness for a particular 82 | purpose; 83 | ii) effectively excludes on behalf of all Contributors all liability 84 | for damages, including direct, indirect, special, incidental and 85 | consequential damages, such as lost profits; 86 | iii) states that any provisions which differ from this Agreement are 87 | offered by that Contributor alone and not by any other party; and 88 | iv) states that source code for the Program is available from such 89 | Contributor, and informs licensees how to obtain it in a reasonable 90 | manner on or through a medium customarily used for software 91 | exchange. 92 | 93 | When the Program is made available in source code form: 94 | 95 | a) it must be made available under this Agreement; and 96 | 97 | b) a copy of this Agreement must be included with each copy of the 98 | Program. 99 | Contributors may not remove or alter any copyright notices contained within 100 | the Program. 101 | 102 | Each Contributor must identify itself as the originator of its Contribution, 103 | if any, in a manner that reasonably allows subsequent Recipients to identify 104 | the originator of the Contribution. 105 | 106 | 4. COMMERCIAL DISTRIBUTION 107 | Commercial distributors of software may accept certain responsibilities with 108 | respect to end users, business partners and the like. While this license is 109 | intended to facilitate the commercial use of the Program, the Contributor who 110 | includes the Program in a commercial product offering should do so in a manner 111 | which does not create potential liability for other Contributors. Therefore, 112 | if a Contributor includes the Program in a commercial product offering, such 113 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify 114 | every other Contributor ("Indemnified Contributor") against any losses, 115 | damages and costs (collectively "Losses") arising from claims, lawsuits and 116 | other legal actions brought by a third party against the Indemnified 117 | Contributor to the extent caused by the acts or omissions of such Commercial 118 | Contributor in connection with its distribution of the Program in a commercial 119 | product offering. The obligations in this section do not apply to any claims 120 | or Losses relating to any actual or alleged intellectual property 121 | infringement. In order to qualify, an Indemnified Contributor must: a) 122 | promptly notify the Commercial Contributor in writing of such claim, and b) 123 | allow the Commercial Contributor to control, and cooperate with the Commercial 124 | Contributor in, the defense and any related settlement negotiations. The 125 | Indemnified Contributor may participate in any such claim at its own expense. 126 | 127 | For example, a Contributor might include the Program in a commercial product 128 | offering, Product X. That Contributor is then a Commercial Contributor. If 129 | that Commercial Contributor then makes performance claims, or offers 130 | warranties related to Product X, those performance claims and warranties are 131 | such Commercial Contributor's responsibility alone. Under this section, the 132 | Commercial Contributor would have to defend claims against the other 133 | Contributors related to those performance claims and warranties, and if a 134 | court requires any other Contributor to pay any damages as a result, the 135 | Commercial Contributor must pay those damages. 136 | 137 | 5. NO WARRANTY 138 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN 139 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 140 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, 141 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each 142 | Recipient is solely responsible for determining the appropriateness of using 143 | and distributing the Program and assumes all risks associated with its 144 | exercise of rights under this Agreement , including but not limited to the 145 | risks and costs of program errors, compliance with applicable laws, damage to 146 | or loss of data, programs or equipment, and unavailability or interruption of 147 | operations. 148 | 149 | 6. DISCLAIMER OF LIABILITY 150 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 151 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 152 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 153 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 154 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 155 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 156 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 157 | OF SUCH DAMAGES. 158 | 159 | 7. GENERAL 160 | 161 | If any provision of this Agreement is invalid or unenforceable under 162 | applicable law, it shall not affect the validity or enforceability of the 163 | remainder of the terms of this Agreement, and without further action by the 164 | parties hereto, such provision shall be reformed to the minimum extent 165 | necessary to make such provision valid and enforceable. 166 | 167 | If Recipient institutes patent litigation against any entity (including a 168 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 169 | (excluding combinations of the Program with other software or hardware) 170 | infringes such Recipient's patent(s), then such Recipient's rights granted 171 | under Section 2(b) shall terminate as of the date such litigation is filed. 172 | 173 | All Recipient's rights under this Agreement shall terminate if it fails to 174 | comply with any of the material terms or conditions of this Agreement and does 175 | not cure such failure in a reasonable period of time after becoming aware of 176 | such noncompliance. If all Recipient's rights under this Agreement terminate, 177 | Recipient agrees to cease use and distribution of the Program as soon as 178 | reasonably practicable. However, Recipient's obligations under this Agreement 179 | and any licenses granted by Recipient relating to the Program shall continue 180 | and survive. 181 | 182 | Everyone is permitted to copy and distribute copies of this Agreement, but in 183 | order to avoid inconsistency the Agreement is copyrighted and may only be 184 | modified in the following manner. The Agreement Steward reserves the right to 185 | publish new versions (including revisions) of this Agreement from time to 186 | time. No one other than the Agreement Steward has the right to modify this 187 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 188 | Eclipse Foundation may assign the responsibility to serve as the Agreement 189 | Steward to a suitable separate entity. Each new version of the Agreement will 190 | be given a distinguishing version number. The Program (including 191 | Contributions) may always be distributed subject to the version of the 192 | Agreement under which it was received. In addition, after a new version of the 193 | Agreement is published, Contributor may elect to distribute the Program 194 | (including its Contributions) under the new version. Except as expressly 195 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 196 | licenses to the intellectual property of any Contributor under this Agreement, 197 | whether expressly, by implication, estoppel or otherwise. All rights in the 198 | Program not expressly granted under this Agreement are reserved. 199 | 200 | This Agreement is governed by the laws of the State of New York and the 201 | intellectual property laws of the United States of America. No party to this 202 | Agreement will bring a legal action under this Agreement more than one year 203 | after the cause of action arose. Each party waives its rights to a jury trial 204 | in any resulting litigation. 205 | -------------------------------------------------------------------------------- /src/statecharts/impl.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.impl 2 | (:require [malli.core :as ma] 3 | [malli.transform :as mt] 4 | [clojure.set] 5 | [malli.error] 6 | [statecharts.clock :refer [*clock*]] 7 | [statecharts.delayed 8 | :as fsm.d 9 | :refer [insert-delayed-transitions 10 | replace-delayed-place-holder 11 | scheduler?]] 12 | [statecharts.utils :as u] 13 | [statecharts.macros :refer [prog1]]) 14 | (:refer-clojure :exclude [send])) 15 | 16 | (defn canon-one-transition [x] 17 | (if (map? x) 18 | x 19 | {:target x})) 20 | 21 | (defn canon-transitions [x] 22 | (cond 23 | (and (vector? x) 24 | (some map? x)) 25 | (mapv canon-one-transition x) 26 | 27 | (map? x) 28 | [x] 29 | 30 | :else 31 | [{:target x}])) 32 | 33 | (defn canon-actions [x] 34 | (if (vector? x) 35 | x 36 | [x])) 37 | 38 | (defn canon-event [x] 39 | (if (map? x) 40 | x 41 | {:type x})) 42 | 43 | (def T_Actions 44 | [:vector {:decode/fsm canon-actions} 45 | [:fn ifn?]]) 46 | 47 | (def T_Target 48 | "See `resolve-target` for the synatx of target definition." 49 | [:or 50 | keyword? 51 | [:vector keyword?]]) 52 | 53 | (def T_Transition 54 | [:vector {:decode/fsm canon-transitions} 55 | [:map {:closed true} 56 | [:target {:optional true} T_Target] 57 | [:guard {:optional true} [:fn ifn?]] 58 | [:actions {:optional true} T_Actions]]]) 59 | 60 | (def T_Entry 61 | [:entry {:optional true} T_Actions]) 62 | 63 | (def T_Exit 64 | [:exit {:optional true} T_Actions]) 65 | 66 | (def T_DelayExpression 67 | [:or 68 | int? 69 | ;; when replaced as a 70 | [:fn ifn?]]) 71 | 72 | (def T_DelayedEvent 73 | "Generated internal event for delayed transitions." 74 | [:tuple keyword? T_Target [:or int? 75 | ;; See delayed/generate-delayed-events 76 | ;; for why we use string instead of 77 | ;; delayed fn as the event key. 78 | :string]]) 79 | 80 | (def T_Event 81 | [:or keyword? T_DelayedEvent]) 82 | 83 | (def T_Transitions 84 | [:on {:optional true} 85 | [:map-of T_Event T_Transition]]) 86 | 87 | (def T_Initial 88 | [:initial {:optional true} T_Target]) 89 | 90 | (defn decode-delayed-map [m] 91 | ;; {1000 :s1 2000 :s2} 92 | ;; => 93 | ;; [{delay: 1000 :target :s1} {:delay 2000 :target :s2}] 94 | (->> m 95 | (mapcat (fn [[ms target]] 96 | (->> target 97 | canon-transitions 98 | (map #(assoc % :delay ms))))) 99 | (into []))) 100 | 101 | #_(decode-delayed-map {1000 :s1 2000 :s2}) 102 | #_(decode-delayed-map {1000 [{:target :s1 103 | :cond :c1} 104 | {:target :s2}] 105 | 2000 :s2}) 106 | 107 | (defn decode-delayed-transitions [x] 108 | (if (map? x) 109 | (decode-delayed-map x) 110 | x)) 111 | 112 | (def T_DelayedTransition 113 | [:map {:closed true} 114 | [:delay T_DelayExpression] 115 | [:target {:optional true} T_Target] 116 | [:guard {:optional true} [:fn ifn?]] 117 | [:actions {:optional true} T_Actions]]) 118 | 119 | (def T_DelayedTransitions 120 | [:vector {:decode/fsm decode-delayed-transitions} 121 | T_DelayedTransition]) 122 | 123 | (def T_After 124 | [:after {:optional true} T_DelayedTransitions]) 125 | 126 | (def T_EventlessTransitions 127 | [:always {:optional true} T_Transition]) 128 | 129 | (defn insert-eventless-transitions [node] 130 | (let [always (:always node)] 131 | (if-not always 132 | node 133 | (update node :on assoc :fsm/always always)))) 134 | 135 | (def T_Type 136 | [:type {:optional true} [:enum :parallel]]) 137 | 138 | (def T_States 139 | [:schema 140 | {:registry 141 | {::state [:map {:closed true 142 | :decode/fsm {:leave (comp 143 | insert-eventless-transitions 144 | insert-delayed-transitions)}} 145 | T_After 146 | T_Entry 147 | T_Exit 148 | T_EventlessTransitions 149 | T_Transitions 150 | T_Initial 151 | ;; TODO: dispatch on type 152 | T_Type 153 | [:states {:optional true} 154 | [:map-of keyword? [:ref ::state]]] 155 | [:regions {:optional true} 156 | [:map-of keyword? [:ref ::state]]]]}} 157 | [:map-of keyword? [:ref ::state]]]) 158 | 159 | #_(ma/validate T_States {:s1 {:on {:e1 {:target :s2}}} 160 | :s2 {:initial :s2.1 161 | :states {:s2.1 {:on {:e2.1_2.2 {:target :s2.2}}}}}}) 162 | 163 | (def T_Integrations 164 | [:integrations {:optional true} 165 | [:map {:closed true} 166 | [:re-frame {:optional true} 167 | [:map 168 | [:path any?] 169 | [:transition-event {:optional true} keyword?] 170 | [:initialize-event {:optional true} keyword?]]]]]) 171 | 172 | (def T_Machine 173 | [:map {:decode/fsm {:leave (comp 174 | replace-delayed-place-holder 175 | insert-delayed-transitions)}} 176 | T_Integrations 177 | [:id keyword?] 178 | [:context {:optional true} any?] 179 | [:scheduler {:optional true} [:fn scheduler?]] 180 | T_Transitions 181 | T_After 182 | T_Entry 183 | T_Exit 184 | T_Initial 185 | ;; TODO: dispatch on type 186 | T_Type 187 | [:states {:optional true} T_States] 188 | [:regions {:optional true} T_States]]) 189 | 190 | (declare validate-targets) 191 | 192 | (defn machine 193 | "Create a canonical presentation of the machine using malli." 194 | [orig] 195 | (let [conformed (ma/decode T_Machine orig 196 | (mt/transformer 197 | mt/default-value-transformer 198 | {:name :fsm}))] 199 | (when-not (ma/validate T_Machine conformed) 200 | ;; TODO: ensure the initial target exists 201 | (let [reason (malli.error/humanize (ma/explain T_Machine conformed)) 202 | machine-id (:id conformed) 203 | msg (cond-> "Invalid fsm machine spec:" 204 | machine-id 205 | (str " machine-id=" machine-id))] 206 | #?(:cljs 207 | (js/console.warn msg (-> reason 208 | (clj->js) 209 | (js/JSON.stringify)))) 210 | (throw (ex-info msg reason)))) 211 | (validate-targets conformed) 212 | conformed)) 213 | 214 | ;; TODO: use deftype. We use defrecord because it has a handy 215 | ;; toString. 216 | (defrecord ContextAssignment [v]) 217 | 218 | (defn assign 219 | "Wrap a function into a context assignment function." 220 | [f] 221 | (fn [& args] 222 | (ContextAssignment. (apply f args)))) 223 | 224 | (defn- internal-action? [action] 225 | (and (map? action) 226 | (= (some-> (:action action) namespace) "fsm"))) 227 | 228 | (defn- execute-internal-action 229 | [{:as fsm :keys [scheduler]} 230 | state 231 | transition-event 232 | {:as internal-action :keys [action event event-delay]}] 233 | (when-not scheduler 234 | (throw (ex-info 235 | "Delayed fsm without scheduler configured" 236 | {:action internal-action}))) 237 | (cond 238 | (= action :fsm/schedule-event) 239 | (let [event-delay (if (int? event-delay) 240 | event-delay 241 | (event-delay state transition-event))] 242 | (fsm.d/schedule scheduler fsm state event event-delay)) 243 | 244 | (= action :fsm/unschedule-event) 245 | (fsm.d/unschedule scheduler fsm state event) 246 | 247 | :else 248 | (throw (ex-info (str "Unknown internal action " action) internal-action)))) 249 | 250 | (defn- execute 251 | "Execute the actions/entry/exit functions when transitioning." 252 | ([fsm state event] 253 | (execute fsm state event nil)) 254 | ([fsm state event {:keys [debug]}] 255 | (binding [*clock* (some-> (:scheduler fsm) 256 | .-clock)] 257 | (reduce (fn [new-state action] 258 | (if (internal-action? action) 259 | (do 260 | (execute-internal-action fsm new-state event action) 261 | new-state) 262 | (let [retval (action new-state event)] 263 | (if (instance? ContextAssignment retval) 264 | (.-v retval) 265 | new-state)))) 266 | (cond-> state 267 | (not debug) 268 | (dissoc :_actions)) 269 | (:_actions state))))) 270 | 271 | (def PathElement 272 | "Schema of an element of a expanded path. We need the 273 | transitions/exit/entry information to: 274 | 1. transitions: in a compound node, decide which level handles 275 | the event 276 | 2. :id of each level to resolve the target state node. 277 | 3. entry/exit: collect the actions during a transtion transition." 278 | [:map {:closed true} 279 | [:id [:maybe keyword?]] 280 | T_Transitions 281 | T_Entry 282 | T_Exit]) 283 | 284 | (defn- parallel? [node] 285 | (some-> (:type node) 286 | (= :parallel))) 287 | 288 | (defn- compound? [node] 289 | (contains? node :initial)) 290 | 291 | (defn- atomic? [node] 292 | (and (not (parallel? node)) 293 | (not (compound? node)))) 294 | 295 | (defn path->_state 296 | "Calculate the _state value based on the node paths. 297 | 298 | In our internal code, we need to represent the current state as a series of 299 | nodes, but when presenting the current state to the user we need to extract the 300 | simplest form." 301 | [xs] 302 | (let [indexed-xs (u/with-index (rest xs)) 303 | ret (->> indexed-xs 304 | (reduce 305 | (fn [accu [node i]] 306 | (if (parallel? node) 307 | (let [para-state (u/map-vals path->_state 308 | (:regions node))] 309 | (if (zero? i) 310 | ;; If the root is a para node: {:p1 :s1 :p2 :s2} 311 | [para-state] 312 | ;; If the non-root is a para node: {:p1 {:p2 :s2 :p3 313 | ;; :s3}} 314 | (update accu 315 | (dec i) 316 | (fn [id] 317 | {id para-state})))) 318 | (conj accu (:id node)))) 319 | []))] 320 | (u/devectorize ret))) 321 | 322 | (defn check-or-throw [x k v & {:keys [] :as map}] 323 | (when (nil? x) 324 | (throw (ex-info (str "Unknown fsm " (name k) " " v) (assoc map k v))))) 325 | 326 | 327 | (defn resolve-target 328 | "Resolve the given transition target given the current state context. 329 | 330 | Rules for resolving the target: 331 | - If the target is nil, it's the same as the current state, a.k.a self-transition 332 | 333 | - If the target is a vector and the first element is :>, it's an absolute path 334 | 335 | (f :whatever [:> :s2]) => [:s2] 336 | 337 | - If the target is a vector and the first element is not :>, it's an relative path 338 | 339 | (f [:s1] [:s2]) => :s2 340 | (f [:s1 :s1.1] [:s1.2]) => [:s1 :s1.2] 341 | 342 | - If the target is a keyword, it's the same as an one-element vector 343 | 344 | (f [:s1] :s2) => :s2 345 | (f [:s1 :s1.1] :s1.2) => [:s1 :s1.2] 346 | 347 | - If the target is a vector and the first element is :., it's a 348 | child state of current node: 349 | 350 | (f [:s1] [:. :s1.1]) => [:s1 :s1.1] 351 | 352 | E.g. given current state [:s1 :s1.1] and a target of :s1.2, it 353 | should resolve to [:s1 :s1.2]" 354 | [base target] 355 | (let [base (u/ensure-vector base) 356 | parent (vec (drop-last base))] 357 | (cond 358 | (nil? target) 359 | base 360 | 361 | (keyword? target) 362 | (conj parent target) 363 | 364 | (not (sequential? target)) 365 | (throw (ex-info "Invalid fsm target" {:target target})) 366 | 367 | (= (first target) :>) 368 | (vec (next target)) 369 | 370 | (= (first target) :.) 371 | (vec (concat base (drop 1 target))) 372 | 373 | :else 374 | (vec (concat parent target))))) 375 | 376 | (defn absolute-target? [target] 377 | (and (sequential? target) 378 | (= (first target) :>))) 379 | 380 | (defn is-prefix? [short long] 381 | (let [n (count short)] 382 | (and (<= n (count long)) 383 | (= short (take n long))))) 384 | 385 | (defn external-self-transition-actions 386 | "Calculate the actions for an external self-transition. 387 | 388 | if handler is on [:s1 :s1.1] 389 | and current state is [:s1 :s1.1 :s1.1.1] 390 | then we shall exit s1.1.1 s1.1 and entry s1.1 s1.1.1 again 391 | 392 | if handler is on [:s1] 393 | and current state is [:s1 :s1.1 :s1.1.1] 394 | then we shall exit s1.1.1 s1.1 s1 and entry s1 s1.1 s1.1.1 again 395 | 396 | if handler is on [:s2] 397 | and current state is [:s2] 398 | then we shall exit s2 and entry s2 again 399 | 400 | if handler is on [] 401 | and current state is [:s2] 402 | then we shall exit s2 Machine and entry Machine s2 again 403 | " 404 | [handler nodes]) 405 | 406 | (defn has-eventless-transition? [nodes] 407 | (boolean (some #(get-in % [:on :fsm/always]) nodes))) 408 | 409 | (defn- updatev-last 410 | "Update the last element of a vector" 411 | [v f & args] 412 | (apply update v (dec (count v)) f args)) 413 | 414 | (def RT_NodePath 415 | [:vector :keyword]) 416 | 417 | (def RT_Node 418 | [:map 419 | [:path RT_NodePath] 420 | [:on {:optional true} [:map-of :keyword :any]] 421 | [:type :enum [:atomic :compound :parallel]] 422 | [:entry {:optional true} :any] 423 | [:exit {:optional true} :any]]) 424 | 425 | (def RT_TX 426 | [:map {:closed true} 427 | [:source {:optional true} RT_NodePath] 428 | [:target {:optional true} RT_NodePath] 429 | [:domain {:optional true} RT_NodePath] 430 | [:guard {:optional true} [:vector :fn]] 431 | [:actions {:optional true} [:vector :fn]]]) 432 | 433 | (def T_Configuration 434 | [:set RT_NodePath]) 435 | 436 | (defn add-node-type [node] 437 | (let [type (cond 438 | (parallel? node) 439 | :parallel 440 | 441 | (compound? node) 442 | :compound 443 | 444 | :else 445 | :atomic)] 446 | (assoc node :type type))) 447 | 448 | (defn resolve-node 449 | ([root path] 450 | (resolve-node root path false)) 451 | ([root path full?] 452 | ;; [:s1 :s1.1] 453 | (let [node (let [path (u/ensure-vector path) 454 | node (reduce 455 | (fn [current-root k] 456 | (cond 457 | (parallel? current-root) 458 | (get-in current-root [:regions k]) 459 | 460 | (compound? current-root) 461 | (get-in current-root [:states k]) 462 | 463 | :else 464 | (reduced nil))) 465 | root 466 | path)] 467 | (some-> node 468 | (add-node-type) 469 | (assoc :path path)))] 470 | (if full? 471 | node 472 | (some-> node 473 | (select-keys [:on :entry :exit :type :path])))))) 474 | 475 | (defn _state->nodes [_state] 476 | (loop [[head & more] (u/ensure-vector _state) 477 | prefix [] 478 | ret (sorted-set)] 479 | (cond 480 | (keyword? head) 481 | (let [current (conj prefix head) 482 | ret (conj ret current)] 483 | (if (seq more) 484 | (recur more current ret) 485 | ret)) 486 | 487 | (map? head) 488 | (do 489 | (assert (empty? more) 490 | "invalid _state, parallel state must be the last one") 491 | (into ret (mapcat (fn [[k v]] 492 | (let [prefix (conj prefix k)] 493 | (cons prefix 494 | (map #(into prefix %) (_state->nodes v))))) 495 | head)))))) 496 | 497 | (defn _state->configuration 498 | ;; We always resolve the `_state` in a JIT manner, so the user has the 499 | ;; flexibility to pass in a literal `_state` (and context) as data, instead of 500 | ;; forcing the user to keep track of an opaque "State" object like xstate. 501 | ;; 502 | ;; E.g. the user pass in `[:s1 :s1.1]` then we would get a set of two nodes: 503 | ;; - `[:s1]` 504 | ;; - `[:s1 :s1.1]` 505 | [fsm _state & 506 | {:keys [no-resolve?] 507 | :as _opt}] 508 | (let [_state (u/ensure-vector _state)] 509 | (let [paths (conj (_state->nodes _state) []) 510 | ;; Always reslove to ensure all nodes are resolvable in the fsm. TODO: 511 | ;; throw an exc here if resolve-node returns nil? 512 | nodes (mapv #(resolve-node fsm %) paths)] 513 | (if no-resolve? 514 | paths 515 | nodes)))) 516 | 517 | (defn backtrack-ancestors-as-paths 518 | "Return a (maybe lazy) sequence of the node path with all its ancestors, starting from the 519 | node and goes up." 520 | [fsm path] 521 | (reductions (fn [accu _] 522 | (vec (drop-last accu))) 523 | path 524 | (range (count path)))) 525 | 526 | (defn backtrack-ancestors-as-nodes 527 | "Like backtrack-ancestors-as-paths but resolves the paths into nodes." 528 | [fsm path] 529 | ;; [:s1 :s1.1 :s1.1.1] 530 | (->> (backtrack-ancestors-as-paths fsm path) 531 | (map #(resolve-node fsm %)))) 532 | 533 | (defn find-least-common-compound-ancessor [fsm path1 path2] 534 | (u/find-first (fn [anc] 535 | (is-prefix? anc path1)) 536 | (backtrack-ancestors-as-paths fsm path2))) 537 | 538 | (defn get-tx-domain 539 | [fsm {:keys [source target] :as tx}] 540 | (cond 541 | ;; internal self transition 542 | (nil? target) 543 | nil 544 | 545 | ;; external self transition 546 | (= source target) 547 | source 548 | 549 | :else 550 | (find-least-common-compound-ancessor fsm source target))) 551 | 552 | (defn select-one-tx 553 | "Given an atomic node and an event, find the first satistifed transition by 554 | walking from the node and then its ancestors, until the root. 555 | 556 | Return a two-tuple: 557 | - The first element is the a boolean indicates whether any transition is found at 558 | all (regarding it's satisfied or not) 559 | - The second element is the found transition, if any. 560 | " 561 | [fsm 562 | {:keys [path] 563 | :as node} state 564 | {:keys [type] 565 | :as event} input-event] 566 | (let [first-satisfied-tx (fn [txs] 567 | (some (fn [{:keys [guard] 568 | :as tx}] 569 | (when (or (not guard) 570 | (guard state input-event)) 571 | (dissoc tx :guard))) 572 | txs)) 573 | found (volatile! false) 574 | tx (when-let [{:keys [source target] 575 | :as tx} 576 | (some (fn [{:keys [path] 577 | :as node}] 578 | (when-let [txs (seq (get-in node [:on type]))] 579 | (vreset! found true) 580 | (when-let [tx (first-satisfied-tx txs)] 581 | (assoc tx :source path)))) 582 | (backtrack-ancestors-as-nodes fsm (:path node)))] 583 | (let [target-resolved (when target 584 | (resolve-target source target)) 585 | tx (-> tx 586 | (assoc :target target-resolved) 587 | (assoc :external? (or (absolute-target? target) 588 | (= target-resolved source))))] 589 | (assoc tx :domain (get-tx-domain fsm tx))))] 590 | [@found tx])) 591 | 592 | (defn get-initial-path [{:keys [path initial] :as _node}] 593 | (let [initial (u/ensure-vector initial) 594 | initial (if (= (first initial) :.) 595 | (next initial) 596 | initial)] 597 | (into path initial))) 598 | 599 | (defn add-ancestors-to-entry-set 600 | [fsm domain path external?] 601 | (->> (backtrack-ancestors-as-paths fsm path) 602 | (take-while (fn [path] 603 | (and (not= path []) 604 | ;; exclude the domain node when not external, 605 | (or external? 606 | (not= domain path)) 607 | (is-prefix? domain path)))))) 608 | 609 | (defn compute-entry-set 610 | [fsm txs] 611 | (let [get-tx-entry-set 612 | (fn [{:keys [target domain external?] 613 | :as _tx}] 614 | ;; target=nil means internal self-transtion, where no entry/exit would 615 | ;; happen 616 | (when target 617 | (loop [entry-set #{target} 618 | seeds entry-set] 619 | (let [exist? #(contains? entry-set %) 620 | new 621 | (->> 622 | seeds 623 | (map #(resolve-node fsm % true)) 624 | (map 625 | (fn [{:keys [type path] 626 | :as node}] 627 | (remove exist? 628 | (concat 629 | (add-ancestors-to-entry-set fsm 630 | domain 631 | path 632 | external?) 633 | (case type 634 | :parallel 635 | (let [regions 636 | (->> (:regions node) 637 | keys 638 | (map #(conj path %)))] 639 | regions) 640 | 641 | :compound 642 | ;; for compound node that has no descedents in the 643 | ;; entry set, add its initial state to the next 644 | ;; seeds of next round of iteration. 645 | (when-not (some (fn [x] 646 | (and (not= path x) 647 | (is-prefix? path x))) 648 | entry-set) 649 | [(get-initial-path node)]) 650 | 651 | ;; an atomic node, nothing to add for it. 652 | nil))))) 653 | (reduce concat)) 654 | 655 | new (clojure.set/difference (set new) entry-set)] 656 | (if-not (empty? new) 657 | (recur 658 | ;; include the new nodes 659 | (into entry-set new) 660 | ;; new the new nodes in this iteration as the new seeds 661 | new) 662 | entry-set)))))] 663 | (->> (map get-tx-entry-set txs) 664 | (reduce into (sorted-set))))) 665 | 666 | (defn get-actions [fsm path k] 667 | (let [node (resolve-node fsm path)] 668 | (k node))) 669 | 670 | (defn get-entry-actions [fsm entry-set] 671 | (->> entry-set 672 | (mapcat #(get-actions fsm % :entry)))) 673 | 674 | (defn simple-state [x] 675 | (if (and (sequential? x) 676 | (= (count x) 1)) 677 | (first x) 678 | x)) 679 | 680 | (defn configuration->_state 681 | "Represent the current configuration in a user-friendly form. It's the reverse 682 | operation of `_state->configuration`. 683 | " 684 | [fsm configuration] 685 | (-> (loop [paths configuration 686 | node fsm 687 | _state [] 688 | parent-compound? false] 689 | (let [paths (into [] (remove empty? paths))] 690 | (cond 691 | (parallel? node) 692 | (let [children (:regions node) 693 | groups (group-by first paths) 694 | parallel-state 695 | (u/map-kv-vals (fn [k region] 696 | (configuration->_state region 697 | (map 698 | ;; remove the common 699 | ;; prefix 700 | next 701 | (get groups k)))) 702 | children)] 703 | ;; If the parent node of the parallel node is a compound node (i.e. 704 | ;; the parallel node is not the root), the notation is a 705 | ;; single-valued map, e.g. [:s1 {:s1.1 {:p1 :x :p2 :y}}] 706 | (if parent-compound? 707 | (updatev-last _state 708 | (fn [k] 709 | {k parallel-state})) 710 | parallel-state)) 711 | 712 | (compound? node) 713 | (do 714 | (let [ks (set (map first paths)) 715 | k (first ks)] 716 | (assert (= (count ks) 1) (str "invalid paths: " paths)) 717 | (let [paths (remove empty? (map next paths))] 718 | (if (seq paths) 719 | (recur 720 | paths 721 | (get-in node [:states k]) 722 | (conj _state k) 723 | true) 724 | (conj _state k))))) 725 | 726 | :else 727 | ;; some atomic node 728 | (conj _state (ffirst paths))))) 729 | simple-state)) 730 | 731 | (defn -do-transition 732 | [fsm 733 | {:keys [_state] 734 | :as state} event input-event 735 | ignore-unknown-event?] 736 | (let [configuration (_state->configuration fsm _state) 737 | atomic-nodes (filter #(= (:type %) :atomic) configuration) 738 | txs (->> atomic-nodes 739 | (map #(select-one-tx fsm % state event input-event))) 740 | _ (when-not ignore-unknown-event? 741 | (when-not (->> txs 742 | (map first) 743 | (some identity)) 744 | (throw (ex-info (str "fsm " (:id fsm) " got unknown event " (:type event) " when in state " _state) 745 | {:_state _state})))) 746 | txs (->> txs 747 | (map second) 748 | (remove nil?))] 749 | (if (not (seq? txs)) 750 | [_state [] false] 751 | (let [exit-set (->> configuration 752 | ;; all active nodes that is covered by some tx domain 753 | ;; should 754 | ;; exit itself. 755 | (filter (fn [{:keys [path] 756 | :as node}] 757 | (some 758 | (fn [{:keys [target domain external?] 759 | :as tx}] 760 | (cond 761 | (= path []) 762 | ;; only exit the root when the target is 763 | ;; the root itself 764 | (and external? 765 | (= target [])) 766 | 767 | (= domain path) 768 | ;; only include the domain itself 769 | ;; when it's an external transition 770 | external? 771 | 772 | :else 773 | (is-prefix? domain path))) 774 | txs))) 775 | (map :path) 776 | (into (sorted-set))) 777 | entry-set (compute-entry-set fsm txs) 778 | exit-actions (->> exit-set 779 | reverse 780 | (mapcat #(get-actions fsm % :exit))) 781 | entry-actions (get-entry-actions fsm entry-set) 782 | tx-actions (->> txs 783 | (mapcat :actions)) 784 | actions (concat exit-actions tx-actions entry-actions) 785 | ;; _ #p exit-set 786 | ;; _ #p entry-set 787 | new-configuration (-> (->> (map :path configuration) 788 | (into #{})) 789 | (clojure.set/difference exit-set) 790 | (clojure.set/union entry-set)) 791 | new-value (configuration->_state fsm new-configuration)] 792 | [new-value actions 793 | (has-eventless-transition? (map #(resolve-node fsm %) 794 | entry-set))])))) 795 | 796 | (defn -do-init 797 | [fsm] 798 | (let [tx {:source [] 799 | :target [] 800 | :external? true 801 | :domain []} 802 | entry-set (compute-entry-set fsm [tx]) 803 | entry-actions (get-entry-actions fsm entry-set) 804 | _state (configuration->_state fsm entry-set) 805 | _pending-eventless-tx? (has-eventless-transition? 806 | (map #(resolve-node fsm %) 807 | entry-set))] 808 | [_state entry-actions _pending-eventless-tx?])) 809 | 810 | (declare transition) 811 | 812 | (defn initialize 813 | ([fsm] 814 | (initialize fsm nil)) 815 | ([{:keys [initial type] 816 | :as fsm} 817 | {:keys [exec debug context] 818 | :or {exec true 819 | context nil} 820 | :as _opts}] 821 | (let [default-context (:context fsm) 822 | context (if (some? context) 823 | (if (and (map? default-context) 824 | (map? context)) 825 | (merge default-context context) 826 | context) 827 | (:context fsm)) 828 | event {:type :fsm/init} 829 | [_state actions _pending-eventless-tx?] (-do-init fsm) 830 | state (assoc context 831 | :_state _state 832 | :_actions actions) 833 | new-state (if exec 834 | (execute fsm state event {:debug debug}) 835 | state)] 836 | (if-not _pending-eventless-tx? 837 | new-state 838 | (transition fsm new-state :fsm/always {:exec exec :debug debug}))))) 839 | 840 | (defn -transition-once 841 | "Do the transition, but would not follow new eventless transitions defined on 842 | the target state." 843 | [fsm state event 844 | {:keys [exec debug input-event ignore-unknown-event?] 845 | :or {exec true}}] 846 | (let [;; input-event is set to the original event when event is :fsm/always for 847 | ;; eventless transitions. We pass both along because even in eventless 848 | ;; transitions, the actions function may want to access the original event 849 | ;; instead of :fsm/always 850 | input-event 851 | (or input-event event) 852 | 853 | [new-value actions _pending-eventless-tx?] 854 | (-do-transition fsm 855 | state 856 | event 857 | input-event 858 | ignore-unknown-event?) 859 | 860 | new-state (assoc state 861 | :_state new-value 862 | :_pending-eventless-tx? _pending-eventless-tx? 863 | :_prev-state (:_state state) 864 | :_actions actions)] 865 | (if exec 866 | (execute 867 | fsm 868 | new-state 869 | input-event 870 | {:debug debug}) 871 | new-state))) 872 | 873 | (defn -transition-impl 874 | "Return the new state and the actions to execute." 875 | [fsm state input-event opts] 876 | ;; The loop is used to execute eventless transitions. 877 | (loop [i 0 878 | state (dissoc state :_actions) 879 | actions []] 880 | 881 | (when (> i 10) 882 | ;; Prevent bugs in application's code that two states uses eventless 883 | ;; transitions and the states jumps back and forth between them. 884 | (throw (ex-info (str "Possible dead loop on event" (:type input-event)) 885 | {:state (:_state state)}))) 886 | 887 | (let [event 888 | (if (zero? i) 889 | input-event 890 | ;; The first iteration of the loop is the real input event, while the 891 | ;; following ones are eventless transitions. 892 | {:type :fsm/always}) 893 | 894 | {:keys [_actions _pending-eventless-tx?] 895 | :as state} 896 | (-transition-once fsm state event opts) 897 | 898 | actions 899 | (if _actions 900 | (into actions _actions) 901 | actions)] 902 | (if _pending-eventless-tx? 903 | (recur (inc i) (dissoc state :_pending-eventless-tx?) actions) 904 | [state actions])))) 905 | 906 | (defn transition 907 | "Given a machine with its current state, trigger a transition to the 908 | next state based on the given event. 909 | 910 | The nature and purpose of the transition impl is to get two outputs: 911 | - the new state 912 | - the actions to execute 913 | 914 | By default it executes all actions, unless the `exec` opt is false, 915 | in which case it is a pure function." 916 | ([fsm state event] 917 | (transition fsm state event nil)) 918 | ([fsm state event 919 | {:as opts 920 | :keys [exec debug] 921 | :or {exec true}}] 922 | (let 923 | [input-event 924 | (canon-event event) 925 | 926 | opts 927 | (assoc opts :input-event input-event) 928 | 929 | [new-state actions] 930 | (-transition-impl 931 | fsm 932 | (dissoc state :_actions) 933 | input-event 934 | opts)] 935 | ;; get rid of the internal fields 936 | (cond-> (dissoc new-state :_pending-eventless-tx? :_prev-state) 937 | (or (not exec) debug) 938 | (assoc :_actions actions))))) 939 | 940 | (defn- valid-target? [node path] 941 | (try 942 | (when-not (resolve-node node path) 943 | (throw (ex-info "node not found" {:path path ::type :invalid-path}))) 944 | true 945 | (catch #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) e 946 | (if (= (::type (ex-data e)) :invalid-path) 947 | false 948 | (throw e))))) 949 | 950 | (defn validate-targets 951 | "Walk the fsm and try to resolve all transition targets. Raise an 952 | exception if any target is invalid." 953 | ([root] 954 | (validate-targets root root [])) 955 | ([root node current-path] 956 | (do 957 | (let [transitions (mapcat identity (-> node :on vals)) 958 | targets (->> transitions 959 | (map :target) 960 | ;; nil target target means self-transition, 961 | ;; which is always valid. 962 | (remove nil?))] 963 | (when (seq targets) 964 | (doseq [target targets 965 | :let [target (resolve-target current-path target)]] 966 | (when-not (valid-target? root target) 967 | (throw (ex-info (str "Invalid target " target) 968 | {:target target :state current-path})))))) 969 | (when-let [initial (:initial node)] 970 | (let [initial-node (get-in node [:states initial])] 971 | (when-not initial-node 972 | (throw (ex-info (str "Invalid initial target " initial) 973 | {:initial initial :state current-path}))))) 974 | (doseq [[name child] (:states node)] 975 | (validate-targets root child (conj current-path name))) 976 | (when (parallel? node) 977 | (doseq [[name child] (:regions node)] 978 | (validate-targets root child (conj current-path name))))))) 979 | 980 | (defn matches [state value] 981 | (let [v1 (u/ensure-vector (:value state)) 982 | v2 (u/ensure-vector value)] 983 | (is-prefix? v2 v1))) 984 | 985 | (comment 986 | (ma/validate keyword? :a) 987 | 988 | (def m1 989 | {:id :foo 990 | :initial :s1 991 | :states {:s1 {:on {:e1 :s2 992 | :e12 {:target :s3 993 | :actions :a12}}} 994 | :s2 {:on {:e2 {:target :s3 995 | :actions [:a31 :a32]}}}}}) 996 | (machine m1) 997 | (ma/validate T_Machine m1) 998 | (ma/explain T_Machine m1) 999 | (ma/validate T_Machine (machine m1)) 1000 | (ma/explain T_Machine (machine m1)) 1001 | 1002 | ()) 1003 | -------------------------------------------------------------------------------- /test/statecharts/impl_test.cljc: -------------------------------------------------------------------------------- 1 | (ns statecharts.impl-test 2 | (:require [statecharts.impl :as impl :refer [assign]] 3 | [statecharts.sim :as fsm.sim] 4 | [statecharts.scheduler :as fsm.scheduler] 5 | [statecharts.store :as fsm.store] [clojure.test :refer [deftest is are use-fixtures testing]] 6 | #?(:clj [kaocha.stacktrace]) 7 | [statecharts.core :as fsm])) 8 | 9 | #?(:clj 10 | (alter-var-root 11 | #'kaocha.stacktrace/*stacktrace-filters* 12 | (constantly ["java." "clojure." "kaocha." "orchestra."]))) 13 | 14 | (defonce actions-data (atom nil)) 15 | 16 | (def safe-inc (fnil inc 0)) 17 | 18 | (defn inc-actions-data [k] 19 | (swap! actions-data update k safe-inc)) 20 | 21 | (defn create-connection [state event] 22 | (is (= (:_state state) :connecting)) 23 | (is (#{:connect :error} (:type event)))) 24 | 25 | (defn update-connect-attempts [state event] 26 | (update state :connect-attempts (fnil inc 0))) 27 | 28 | (defn assign-inc-fn [k] 29 | (assign (fn [context & _] 30 | (update context k (fnil inc 0))))) 31 | 32 | (def inc-a (assign-inc-fn :a)) 33 | (def inc-b (assign-inc-fn :b)) 34 | (def inc-c (assign-inc-fn :c)) 35 | (def inc-d (assign-inc-fn :d)) 36 | (def inc-e (assign-inc-fn :e)) 37 | (def inc-f (assign-inc-fn :f)) 38 | 39 | 40 | (defn test-machine [] 41 | (impl/machine 42 | {:id :conn 43 | :initial :idle 44 | :context {:x 0 45 | :y 0} 46 | :entry (fn [& _] 47 | (inc-actions-data :global-entry)) 48 | :on {:logout {:target :wait-login 49 | :actions [(assign (fn [context & _] 50 | (update context :logout-times safe-inc))) 51 | (fn [& _] 52 | (inc-actions-data :global-logout))]}} 53 | :states 54 | {:wait-login {:on {:login :idle}} 55 | :idle {:on {:connect {:target :connecting 56 | :actions [(assign update-connect-attempts)]}}} 57 | :connecting {:entry create-connection 58 | :on {:connected :connected}} 59 | :connected {:on {:error :connecting} 60 | :exit [(fn [& _] 61 | (inc-actions-data :connected-exit)) 62 | (assign 63 | (fn [context & _] 64 | (update context :disconnections safe-inc)))]}}})) 65 | 66 | (deftest test-e2e 67 | (reset! actions-data nil) 68 | (let [fsm (test-machine) 69 | state (impl/initialize fsm) 70 | _ (do 71 | (is (= (:_state state) :idle)) 72 | (is (= (:global-entry @actions-data) 1))) 73 | 74 | {:keys [connect-attempts] :as state} (impl/transition fsm state :connect) 75 | 76 | _ (do 77 | (is (= (:_state state) :connecting)) 78 | (is (= (:connect-attempts state) 1))) 79 | 80 | state (impl/transition fsm state :connected) 81 | 82 | _ (is (= (:_state state) :connected)) 83 | 84 | state (impl/transition fsm state :error) 85 | 86 | _ (do 87 | (is (= (:disconnections state) 1)) 88 | (is (= (:connected-exit @actions-data) 1)) 89 | (is (= (:_state state) :connecting))) 90 | 91 | state (impl/transition fsm state :logout) 92 | 93 | _ (do 94 | (is (= (:_state state) :wait-login)) 95 | (is (= (:global-logout @actions-data) 1)) 96 | (is (= (:logout-times state) 1))) 97 | ])) 98 | 99 | (deftest test-override-context 100 | (let [fsm (test-machine) 101 | n (rand-int 100) 102 | state (impl/initialize fsm {:context {:foo n}})] 103 | (is (= (:foo state) n)))) 104 | 105 | (defn fake-action-fn [] 106 | (fn [& args])) 107 | 108 | (deftest test-transition 109 | (let [[entry0 110 | entry1 exit1 a12 a13 111 | entry2 exit2 a21 a23 112 | entry3 exit3 a31 a32 a34 a35 113 | entry4 exit4 exit5] 114 | (repeatedly 20 fake-action-fn) 115 | 116 | event-ref (atom nil) 117 | entry5 (fn [_ event] 118 | (reset! event-ref event)) 119 | 120 | guard-event-ref (atom nil) 121 | 122 | test-machine 123 | (impl/machine 124 | {:id :test 125 | :initial :s1 126 | :entry entry0 127 | :states 128 | {:s1 {:entry entry1 129 | :exit exit1 130 | :on {:e12 :s2 131 | :e13 {:target :s3 132 | :actions a13}}} 133 | :s2 {:entry entry2 134 | :exit exit2 135 | :on {:e23 {:target :s3 136 | :actions a23}}} 137 | :s3 {:entry entry3 138 | :exit exit3 139 | :always [{:guard (constantly false) 140 | :actions a34 141 | :target :s4} 142 | {:guard (fn [state event] 143 | (reset! guard-event-ref event) 144 | true) 145 | :actions a35 146 | :target :s5}] 147 | :on {:e31 :s1}} 148 | :s4 {:entry entry4 149 | :exit exit3} 150 | :s5 {:entry entry5 151 | :exit exit5}}}) 152 | 153 | init-state (impl/initialize test-machine {:debug true}) 154 | 155 | tx (fn [v event] 156 | (impl/transition test-machine {:_state v} event {:debug true})) 157 | check-tx (fn [curr event _ expected] 158 | (let [new-state (tx curr event)] 159 | (is (= (:_state new-state) expected)))) 160 | check-actions (fn [curr event _ expected] 161 | (let [new-state (tx curr event)] 162 | (is (= (:_actions new-state) expected))))] 163 | 164 | (is (= (:_state init-state) :s1)) 165 | (is (= (:_actions init-state) [entry0 entry1])) 166 | 167 | (check-tx :s1 :e12 :=> :s2) 168 | ;; (check-actions :s1 :e12 :=> [exit1]) 169 | ;; (check-tx :s1 :e13 :=> :s3) 170 | ;; (check-actions :s1 :e13 :=> [exit1 a13 entry3]) 171 | 172 | (check-tx :s2 :e23 :=> :s5) 173 | (check-actions :s2 :e23 :=> [exit2 a23 entry3 exit3 a35 entry5]) 174 | 175 | (testing "eventless transitions should pass the event along" 176 | (tx :s2 {:type :e23 177 | :k1 :v1 178 | :k2 :v2}) 179 | (is (= (:k1 @event-ref) :v1)) 180 | (is (= (:k2 @event-ref) :v2)) 181 | (is (= (:k1 @guard-event-ref) :v1))))) 182 | 183 | (defn guard-fn [state _] 184 | (> (:y state) 1)) 185 | 186 | (defn root-a01 [& _]) 187 | 188 | (defn nested-machine [] 189 | (impl/machine 190 | {:id :fsm 191 | :context {:x 1 :y 2} 192 | :entry :entry0 193 | :exit :exit0 194 | :after {100 [:. :s6]} 195 | :on {:e01 {:target [:. :s1] 196 | :actions root-a01} 197 | :e02 [:. :s2] 198 | :e0_0_internal {:actions :a_0_0_internal} 199 | :e0_0_external {:target [] :actions :a_0_0_external}} 200 | :initial :s1 201 | :states {:s1 202 | {:initial :s1.1 203 | :entry :entry1 204 | :exit :exit1 205 | :on {:e12 :s2 206 | :e14 :s4} 207 | :states {:s1.1 {:entry :entry1.1 208 | :exit :exit1.1 209 | :initial :s1.1.1 210 | :on {:e1.1_1.2 {:target :s1.2 211 | :actions :a1.1_1.2} 212 | :e1.1_or_1.1.1 [:> :s4]} 213 | :states {:s1.1.1 {:entry :entry1.1.1 214 | :exit :exit1.1.1 215 | :on {:e1.1.1_1.2 [:> :s1 :s1.2] 216 | :e1.1_or_1.1.1 [:> :s3] 217 | :e1.1.1_3 [:> :s3]}}}} 218 | 219 | :s1.2 220 | {:entry :entry1.2 221 | :exit :exit1.2 222 | :on {:e1.2_1.2_internal {:actions :a1.2_1.2_internal} 223 | :e1.2_1.3 {:target :s1.3 224 | :actions :a1.2_1.3} 225 | :e1.2_1.2_external {:target :s1.2 226 | :actions :a1.2_1.2_external}}} 227 | :s1.3 228 | {:entry :entry1.3 229 | :exit :exit1.3 230 | :always [{:target [:> :s2] 231 | :actions :a1.3_2 232 | :guard (constantly false)} 233 | {:target [:> :s9] 234 | :actions :a1.3_9}]}}} 235 | :s2 {:entry :entry2 236 | :exit :exit2 237 | :on {:e2_3 :s3 238 | :e2_2_internal {:actions :a2_2_internal} 239 | :e2_2_external {:target :s2 240 | :actions :a2_2_external}}} 241 | :s3 {:entry :entry3 242 | :exit :exit3} 243 | :s4 {:initial :s4.1 244 | :entry :entry4 245 | :exit :exit4 246 | :on {:e4_4.2_internal {:target [:. :s4.2] 247 | :actions :a4_4.2_internal} 248 | :e4_4.2_external {:target [:> :s4 :s4.2] 249 | :actions :a4_4.2_external}} 250 | :states {:s4.1 {:entry :entry4.1 251 | :exit :exit4.1} 252 | :s4.2 {:entry :entry4.2 253 | :exit :exit4.2}}} 254 | :s5 {:on {:e5x [{:target :s3 255 | :guard (fn [context _] 256 | (> (:x context) 1))} 257 | {:target :s4}] 258 | 259 | :e5y [{:target :s3 260 | :guard (fn [context _] 261 | (> (:y context) 1))} 262 | {:target :s4}] 263 | 264 | :e5z [{:target :s3 265 | :guard (fn [context _] 266 | (= (:y context) 1))}] 267 | }} 268 | :s6 {:after [{:delay 1000 269 | :target :s7}]} 270 | :s7 {:after {2000 [{:target :s6 271 | :guard guard-fn} 272 | {:target :s8}]}} 273 | :s8 {} 274 | :s9 {:entry :entry9 275 | :exit :exit9 276 | :always {:target :s8 277 | :actions :a98}}}})) 278 | 279 | (defn prepare-nested-test [] 280 | (let [fsm (nested-machine) 281 | init-state (impl/initialize fsm {:exec false}) 282 | 283 | tx (fn [v event] 284 | (impl/transition fsm 285 | (assoc (:context fsm) 286 | :_state v) 287 | event {:exec false})) 288 | check-tx (fn [curr event _ expected] 289 | (let [new-state (tx curr event)] 290 | (is (= (:_state new-state) expected)))) 291 | check-actions (fn [curr event _ expected] 292 | (let [new-state (tx curr event)] 293 | (is (= (:_actions new-state) expected))))] 294 | {:fsm fsm 295 | :init-state init-state 296 | :check-tx check-tx 297 | :check-actions check-actions})) 298 | 299 | (deftest test-nested-transition 300 | (let [{:keys [init-state check-tx check-actions]} (prepare-nested-test)] 301 | 302 | (testing "initialize shall handle nested state" 303 | (is (= (:_state init-state) [:s1 :s1.1 :s1.1.1])) 304 | (is (= (:_actions init-state) [:entry0 305 | {:action :fsm/schedule-event, 306 | :event [:fsm/delay [] 100], 307 | :event-delay 100} 308 | :entry1 :entry1.1 :entry1.1.1]))) 309 | 310 | (testing "from inner nested state to another top level state" 311 | (check-tx [:s1 :s1.1 :s1.1.1] :e1.1_1.2 :=> [:s1 :s1.2]) 312 | (check-actions [:s1 :s1.1 :s1.1.1] :e1.1_1.2 313 | :=> [:exit1.1.1 :exit1.1 :a1.1_1.2 :entry1.2])) 314 | 315 | (testing "transition to inner nested state in another top level parent" 316 | (check-tx [:s1 :s1.1 :s1.1.1] :e14 :=> [:s4 :s4.1]) 317 | (check-actions [:s1 :s1.1 :s1.1.1] :e14 :=> 318 | [:exit1.1.1 :exit1.1 :exit1 :entry4 :entry4.1])) 319 | 320 | (testing "event unhandled by child state is handled by parent" 321 | (check-tx [:s1 :s1.1 :s1.1.1] :e12 :=> :s2)) 322 | 323 | (testing "child has higher priority than parent when both handles an event" 324 | (check-tx [:s1 :s1.1 :s1.1.1] :e1.1_or_1.1.1 :=> :s3)) 325 | 326 | (testing "in inner state, event handled by top level event" 327 | (check-tx [:s1 :s1.1 :s1.1.1] :e1.1.1_1.2 328 | :=> [:s1 :s1.2]) 329 | (check-actions [:s1 :s1.1 :s1.1.1] :e1.1.1_1.2 330 | :=> [:exit1.1.1 :exit1.1 :exit1 :entry1 :entry1.2]) 331 | (check-actions [:s1 :s1.1 :s1.1.1] :e1.1.1_3 332 | :=> [:exit1.1.1 :exit1.1 :exit1 :entry3])) 333 | 334 | (testing "event handled by root" 335 | (check-tx :s3 :e01 :=> [:s1 :s1.1 :s1.1.1])) 336 | (check-actions [:s3] :e01 :=> [:exit3 root-a01 :entry1 :entry1.1 :entry1.1.1]) 337 | 338 | )) 339 | 340 | (deftest test-self-transitions 341 | (let [{:keys [init-state check-tx check-actions]} (prepare-nested-test)] 342 | 343 | (testing "internal self-transition" 344 | (check-tx :s2 :e2_2_internal :=> :s2) 345 | (check-actions :s2 :e2_2_internal 346 | :=> [:a2_2_internal])) 347 | 348 | (testing "external self-transition" 349 | (check-tx :s2 :e2_2_external :=> :s2) 350 | (check-actions :s2 :e2_2_external 351 | :=> [:exit2 :a2_2_external :entry2])) 352 | 353 | (testing "internal self-transition on root" 354 | (check-tx [:s1 :s1.1 :s1.1.1] :e0_0_internal :=> [:s1 :s1.1 :s1.1.1]) 355 | (check-actions [:s1 :s1.1 :s1.1.1] :e0_0_internal 356 | :=> [:a_0_0_internal])) 357 | 358 | (testing "external self-transition on root" 359 | (check-tx [:s1 :s1.1 :s1.1.1] :e0_0_external :=> [:s1 :s1.1 :s1.1.1]) 360 | (check-actions [:s1 :s1.1 :s1.1.1] :e0_0_external 361 | :=> [:exit1.1.1 :exit1.1 :exit1 362 | :exit0 363 | {:action :fsm/unschedule-event 364 | :event [:fsm/delay [] 100]} 365 | :a_0_0_external 366 | :entry0 367 | {:action :fsm/schedule-event, 368 | :event [:fsm/delay [] 100], 369 | :event-delay 100} 370 | :entry1 :entry1.1 :entry1.1.1 371 | ])) 372 | 373 | (testing "internal self-transition in an inner state" 374 | (check-tx [:s1 :s1.2] :e1.2_1.2_internal :=> [:s1 :s1.2]) 375 | (check-actions [:s1 :s1.2] :e1.2_1.2_internal 376 | :=> [:a1.2_1.2_internal])) 377 | 378 | (testing "external self-transition in an inner state" 379 | (check-tx [:s1 :s1.2] :e1.2_1.2_external :=> [:s1 :s1.2]) 380 | (check-actions [:s1 :s1.2] :e1.2_1.2_external 381 | :=> [:exit1.2 :a1.2_1.2_external :entry1.2])) 382 | 383 | )) 384 | 385 | (deftest test-internal-external-transition 386 | (let [{:keys [init-state check-tx check-actions]} (prepare-nested-test)] 387 | 388 | (testing "internal parent->child" 389 | (check-tx [:s4 :s4.1] :e4_4.2_internal :=> [:s4 :s4.2]) 390 | (check-actions [:s4 :s4.1] :e4_4.2_internal 391 | :=> [:exit4.1 :a4_4.2_internal :entry4.2])) 392 | 393 | (testing "external parent->child" 394 | (check-tx [:s4 :s4.1] :e4_4.2_external :=> [:s4 :s4.2]) 395 | (check-actions [:s4 :s4.1] :e4_4.2_external 396 | :=> [:exit4.1 :exit4 :a4_4.2_external :entry4 :entry4.2])))) 397 | 398 | (deftest test-guarded-transition 399 | (let [{:keys [init-state check-tx check-actions]} (prepare-nested-test)] 400 | 401 | (check-tx [:s5] :e5x :=> [:s4 :s4.1]) 402 | (check-tx [:s5] :e5y :=> :s3) 403 | (check-tx [:s5] :e5z :=> :s5))) 404 | 405 | (deftest test-resolve-target 406 | (are [current target _ resolved] (= (impl/resolve-target current target) 407 | resolved) 408 | ;; nil 409 | :s1 nil :=> [:s1] 410 | [:s1 :s1.1] nil :=> [:s1 :s1.1] 411 | 412 | ;; absolute 413 | :s1 [:> :s2] :=> [:s2] 414 | 415 | ;; relative 416 | :s1 [:s2] :=> [:s2] 417 | [:s1 :s1.1] [:s1.2] :=> [:s1 :s1.2] 418 | 419 | ;; keyword 420 | :s1 :s2 :=> [:s2] 421 | [:s1 :s1.1] :s1.2 :=> [:s1 :s1.2] 422 | 423 | ;; child 424 | [:s1] [:. :s1.1] :=> [:s1 :s1.1] 425 | [:s1 :s1.1] [:. :s1.1.1] :=> [:s1 :s1.1 :s1.1.1] 426 | )) 427 | 428 | (defn make-node [id] 429 | (let [kw #(-> % 430 | name 431 | (str id) 432 | keyword)] 433 | {:id (kw :s) :entry [(kw :entry)] :exit [(kw :exit)]})) 434 | 435 | (deftest test-verify-targets-when-creating-machine 436 | (are [fsm re] (thrown-with-msg? #?(:clj Exception 437 | :cljs js/Error) re (impl/machine fsm)) 438 | {:id :fsm 439 | :initial :s1 440 | :states {:s2 {}}} 441 | #"target.*s1" 442 | 443 | {:id :fsm 444 | :initial :s1 445 | :states {:s1 {:on {:e1 :s2}}}} 446 | #"target.*s2" 447 | 448 | {:id :fsm 449 | :initial :s1 450 | :states {:s1 {:initial :s1.1 451 | :states {:s1.1 {:on {:s1.1_s1.2 :s2}}}} 452 | :s2 {}}} 453 | #"target.*s2" 454 | 455 | {:id :fsm 456 | :initial :s1 457 | :states {:s1 {:after {1000 :s2}}}} 458 | #"target.*s2" 459 | 460 | {:id :fsm 461 | :initial :s1 462 | :states {:s1 {:always {:guard :g12 463 | :target :s2}}}} 464 | #"target.*s2" 465 | 466 | {:id :fsm 467 | :type :parallel 468 | :regions {:p1 {:initial :p12 469 | :states {:p11 {}}}}} 470 | #"target.*p12" 471 | 472 | {:id :fsm 473 | :type :parallel 474 | :regions {:p1 {:initial :p11 475 | :states {:p11 {:on {:e1 :p12}}}}}} 476 | #"target.*p12" 477 | 478 | )) 479 | 480 | (deftest test-delayed-transition-unit 481 | (let [{:keys [fsm init-state check-tx check-actions]} (prepare-nested-test)] 482 | 483 | (let [{:keys [entry exit on] :as s6} (get-in fsm [:states :s6])] 484 | (is (= entry [{:action :fsm/schedule-event 485 | :event-delay 1000 486 | :event [:fsm/delay [:s6] 1000]}])) 487 | (is (= exit [{:action :fsm/unschedule-event 488 | :event [:fsm/delay [:s6] 1000]}])) 489 | (is (= on {[:fsm/delay [:s6] 1000] [{:target :s7}]}))) 490 | 491 | (let [{:keys [entry exit on] :as s7} (get-in fsm [:states :s7])] 492 | (is (= entry [{:action :fsm/schedule-event 493 | :event-delay 2000 494 | :event [:fsm/delay [:s7] 2000]}])) 495 | 496 | (is (= exit [{:action :fsm/unschedule-event 497 | :event [:fsm/delay [:s7] 2000]}])) 498 | 499 | (is (= (get on [:fsm/delay [:s7] 2000]) 500 | [{:guard guard-fn 501 | :target :s6} 502 | {:target :s8}]))))) 503 | 504 | (deftest test-nested-eventless-transition 505 | (let [{:keys [init-state check-tx check-actions]} (prepare-nested-test)] 506 | (check-tx [:s1 :s1.2] :e1.2_1.3 :=> :s8) 507 | (check-actions [:s1 :s1.2] :e1.2_1.3 508 | :=> [:exit1.2 :a1.2_1.3 :entry1.3 509 | :exit1.3 :exit1 510 | :a1.3_9 :entry9 :exit9 :a98]))) 511 | 512 | (deftest test-eventless-transtions-iterations 513 | (let [test-machine 514 | (impl/machine 515 | {:id :test 516 | :initial :s1 517 | :context {:x 100} 518 | :states 519 | {:s1 {:on {:e12 {:target :s2 520 | :actions (assign (fn [state _] 521 | (assoc state :x 200)))}}} 522 | :s2 {:always {:target :s3 523 | :guard (fn [{:keys [x]} _] 524 | (= x 200))}} 525 | :s3 {}}})] 526 | (is (= (:_state (impl/transition test-machine {:_state :s1} :e12)) 527 | :s3)))) 528 | 529 | (deftest test-prev-state 530 | (let [test-machine 531 | (impl/machine 532 | {:id :test 533 | :initial :s1 534 | :states 535 | {:s1 {:on {:e12 {:target :s2 536 | :actions (assign 537 | (fn [state _] 538 | (assoc state :a1 (:_prev-state state))))}}} 539 | :s2 {:always {:target :s3 540 | :actions (assign 541 | (fn [state _] 542 | (assoc state :a2 (:_prev-state state))))}} 543 | :s3 {}}})] 544 | (is (= (impl/transition test-machine {:_state :s1} :e12) 545 | {:_state :s3 546 | :a1 :s1 547 | :a2 :s2})))) 548 | 549 | (defn parallel-machine 550 | [] 551 | (impl/machine 552 | {:id :test 553 | :type :parallel 554 | :context {:a 0 555 | :b 0} 556 | :regions 557 | {:p1 {:initial :p11 558 | :on {:e21 [:p1 :p11]} 559 | :states {:p11 {:on {:e12 {:target :p12 560 | :actions inc-a}}} 561 | :p12 {}}} 562 | :p2 {:initial :p21 563 | :states {:p21 {:on {:e12 {:target :p22 564 | :actions inc-b}}} 565 | :p22 {:always {:target :p23 566 | :actions inc-b}} 567 | :p23 {}}} 568 | ;; p3 is a nested parallel node 569 | :p3 {:type :parallel 570 | :regions 571 | {:p3.a {:initial :p3.a1 572 | :states {:p3.a1 {:on {:e12 {:target :p3.a2 573 | :actions inc-c}}} 574 | :p3.a2 {}}} 575 | :p3.b {:initial :p3.b1 576 | :states {:p3.b1 {:on {:e12 {:target :p3.b2 577 | :actions inc-d}}} 578 | :p3.b2 {:always {:target :p3.b3 579 | :actions inc-d}} 580 | :p3.b3 {}}} 581 | :p3.c {:initial :p3c1 582 | :states {:p3c1 {:on {:e331 :p3c2}} 583 | ;; parallel nest level depth +1 584 | :p3c2 {:type :parallel 585 | :regions {:p3c2.a {:initial :p3c2.a1 586 | :states {:p3c2.a1 {}}} 587 | :p3c2.b {:initial :p3c2.b1 588 | :states {:p3c2.b1 589 | {}}}}}}}}}}})) 590 | 591 | (deftest test-parallel-states 592 | (let [test-machine (parallel-machine) 593 | 594 | state (impl/initialize test-machine) 595 | 596 | _ (is (= (:_state state) 597 | {:p1 :p11 598 | :p2 :p21 599 | :p3 {:p3.a :p3.a1 600 | :p3.b :p3.b1 601 | :p3.c :p3c1}})) 602 | 603 | new-state (impl/transition test-machine state :e12) 604 | new-state2 (impl/transition test-machine new-state :e331) 605 | new-state3 (impl/transition test-machine new-state2 :e21)] 606 | (is (= new-state 607 | {:_state {:p1 :p12 608 | :p2 :p23 609 | :p3 {:p3.a :p3.a2 610 | :p3.b :p3.b3 611 | :p3.c :p3c1}} 612 | :a 1 613 | :b 2 614 | :c 1 615 | :d 2})) 616 | (is (= new-state2 617 | {:_state {:p1 :p12 618 | :p2 :p23 619 | :p3 {:p3.a :p3.a2 620 | :p3.b :p3.b3 621 | :p3.c {:p3c2 {:p3c2.a :p3c2.a1 622 | :p3c2.b :p3c2.b1}}}} 623 | :a 1 624 | :b 2 625 | :c 1 626 | :d 2})) 627 | (is (= new-state3 (assoc-in new-state2 [:_state :p1] :p11))) 628 | )) 629 | 630 | (defn alt-parallel-machine 631 | [] 632 | (impl/machine 633 | {:id :test 634 | :context {:a 0 635 | :b 0 636 | :c 0 637 | :d 0 638 | :e 0} 639 | :initial :p3 640 | :states 641 | {:p1 {:initial :p11 642 | :states {:p11 {:on {:e12 {:target :p12 643 | :actions inc-a}}} 644 | :p12 {}}} 645 | :p2 {:initial :p21 646 | :states {:p21 {:on {:e12 {:target :p22 647 | :actions inc-b}}} 648 | :p22 {:always {:target :p23 649 | :actions inc-b}} 650 | :p23 {:entry inc-e}}} 651 | ;; p3 is a nested parallel node 652 | :p3 {:type :parallel 653 | :regions 654 | {:p3.a {:initial :p3.a1 655 | :states {:p3.a1 {:on {:e12 {:target :p3.a2 656 | :actions inc-c}}} 657 | :p3.a2 {}}} 658 | :p3.b {:initial :p3.b1 659 | :states {:p3.b1 {:on {:e12 {:target :p3.b2 660 | :actions inc-d}}} 661 | :p3.b2 {:always {:target :p3.b3 662 | :actions inc-d}} 663 | :p3.b3 {}}} 664 | :p3.c {:initial :p3c2 665 | :exit inc-f 666 | :states {:p3c1 {:on {:e331 :p3c2}} 667 | ;; parallel nest level depth +1 668 | :p3c2 {:type :parallel 669 | :exit inc-f 670 | :regions {:p3c2.a {:initial :p3c2.a1 671 | :states {:p3c2.a1 672 | {:on {:e-331out [:> :p2 :p23]}}}} 673 | :p3c2.b {:initial :p3c2.b1 674 | :states {:p3c2.b1 675 | {}}}}}}}}}}})) 676 | 677 | (deftest test-alt-parallel-states 678 | (let [test-machine (alt-parallel-machine) 679 | 680 | state (impl/initialize test-machine) 681 | 682 | _ (is (= (:_state state) 683 | {:p3 {:p3.a :p3.a1 684 | :p3.b :p3.b1 685 | :p3.c {:p3c2 {:p3c2.a :p3c2.a1 686 | :p3c2.b :p3c2.b1}}}})) 687 | new-state (impl/transition test-machine state :e12) 688 | new-state3 (impl/transition test-machine state :e-331out)] 689 | (is (= new-state 690 | {:_state {:p3 {:p3.a :p3.a2 691 | :p3.b :p3.b3 692 | :p3.c {:p3c2 {:p3c2.a :p3c2.a1 693 | :p3c2.b :p3c2.b1}}}} 694 | :a 0 695 | :b 0 696 | :c 1 697 | :d 2 698 | :e 0})) 699 | (is (thrown-with-msg? #?(:clj Exception 700 | :cljs js/Error) 701 | #"unknown event" 702 | (impl/transition test-machine state :e331))) 703 | (is (= new-state3 704 | {:_state [:p2 :p23] 705 | :a 0 706 | :b 0 707 | :c 0 708 | :d 0 709 | :e 1 710 | :f 2})))) 711 | 712 | (deftest test-simple-parallel-states 713 | (let [test-machine 714 | (impl/machine 715 | {:id :simple-parallel 716 | :type :parallel 717 | :regions 718 | {:pa {:initial :pa1 719 | :states {:pa1 {:on {:e12 :pa2}} 720 | :pa2 {}}} 721 | :pb {:initial :pb1 722 | :states {:pb1 {:on {:e12 :pb2}} 723 | :pb2 {}}}}}) 724 | 725 | state (impl/initialize test-machine) 726 | 727 | _ (is (= (:_state state) 728 | {:pa :pa1 729 | :pb :pb1})) 730 | 731 | new-state (impl/transition test-machine state :e12)] 732 | (is (= (:_state new-state) 733 | {:pa :pa2 734 | :pb :pb2})))) 735 | 736 | (def non-root-parallel-states 737 | (impl/machine 738 | {:id :simple-parallel 739 | :initial :s1 740 | :states 741 | {:s1 {:initial :s1.1 742 | :on {:e0 :s2} 743 | :states 744 | {:s1.1 {:type :parallel 745 | :regions {:pa {:initial :pa1 746 | :states {:pa1 {:on {:e12 :pa2 747 | :e13 :pa3 748 | :e2 [:> :s2]}} 749 | :pa2 {} 750 | :pa3 {:always {:target :pa4}} 751 | :pa4 {}}} 752 | :pb {:initial :pb1 753 | :states {:pb1 {:on {:e12 :pb2}} 754 | :pb2 {}}}}} 755 | :s1.2 {}}} 756 | :s2 {:on {:e21 :s1}}}})) 757 | 758 | (deftest test-_state->configuration 759 | (let [fsm non-root-parallel-states 760 | format-node (fn [get-path path type] 761 | (-> fsm 762 | (get-in get-path) 763 | (select-keys [:on :exit :entry]) 764 | (assoc :path path 765 | :type type)))] 766 | (are [_state _ configuration] 767 | (= (set (impl/_state->configuration fsm _state)) 768 | (set configuration)) 769 | 770 | [] 771 | :=> 772 | [(format-node [] [] :compound)] 773 | [:s1] 774 | :=> 775 | [(format-node [] [] :compound) 776 | (format-node [:states :s1] [:s1] :compound)] 777 | [:s1 :s1.1] 778 | :=> 779 | [(format-node [] [] :compound) 780 | (format-node [:states :s1] [:s1] :compound) 781 | (format-node [:states :s1 :states :s1.1] [:s1 :s1.1] :parallel)]) 782 | 783 | (is (= (sort (impl/_state->configuration fsm 784 | {:p1 :p11 785 | :p2 :p21 786 | :p3 {:p3.a :p3.a1 787 | :p3.b :p3.b1 788 | :p3.c :p3c1}} 789 | :no-resolve? 790 | true)) 791 | [[] 792 | [:p1] 793 | [:p2] 794 | [:p3] 795 | [:p1 :p11] 796 | [:p2 :p21] 797 | [:p3 :p3.a] 798 | [:p3 :p3.b] 799 | [:p3 :p3.c] 800 | [:p3 :p3.a :p3.a1] 801 | [:p3 :p3.b :p3.b1] 802 | [:p3 :p3.c :p3c1]])))) 803 | 804 | (deftest ^:focus1 test-non-root-parallel-states 805 | (let [test-machine non-root-parallel-states 806 | state (impl/initialize test-machine) 807 | _ (is (= (:_state state) 808 | [:s1 {:s1.1 {:pa :pa1 809 | :pb :pb1}}])) 810 | 811 | new-state (impl/transition test-machine state :e12) 812 | new-state2 (impl/transition test-machine state :e13) 813 | new-state3 (impl/transition test-machine state :e2) 814 | new-state4 (impl/transition test-machine state :e0)] 815 | (is (= (:_state new-state) 816 | [:s1 {:s1.1 {:pa :pa2 817 | :pb :pb2}}])) 818 | (is (= (:_state new-state2) 819 | [:s1 {:s1.1 {:pa :pa4 820 | :pb :pb1}}])) 821 | (is (= (:_state new-state3) :s2)) 822 | (is (= (:_state new-state4) :s2)) 823 | (is (thrown-with-msg? #?(:clj Exception 824 | :cljs js/Error) 825 | #"unknown event" 826 | (impl/transition test-machine state :e-unknown))) 827 | )) 828 | 829 | (deftest test-non-root-parallel-states-tx-into 830 | (let [test-machine non-root-parallel-states 831 | state (impl/initialize (assoc test-machine :initial :s2)) 832 | state1 (impl/transition test-machine state :e21)] 833 | (is (= (:_state state) :s2)) 834 | (is (= (:_state state1) [:s1 {:s1.1 {:pa :pa1 835 | :pb :pb1}}])))) 836 | 837 | ;!zprint {:format :next :set {:respect-nl? true :sort? false}} 838 | (deftest test-configuration->_state 839 | (are [configuration _ _state] 840 | (= (impl/configuration->_state non-root-parallel-states configuration) 841 | _state) 842 | 843 | [[:s1] [:s1 :s1.2]] 844 | :=> 845 | [:s1 :s1.2] 846 | ) 847 | 848 | (are [configuration _ _state] 849 | (= (impl/configuration->_state (parallel-machine) configuration) 850 | _state) 851 | #{[] 852 | [:p1] 853 | [:p1 :p12] 854 | [:p2] 855 | [:p2 :p23] 856 | [:p3] 857 | [:p3 :p3.a] 858 | [:p3 :p3.a :p3.a2] 859 | [:p3 :p3.b] 860 | [:p3 :p3.b :p3.b3] 861 | [:p3 :p3.c] 862 | [:p3 :p3.c :p3c2] 863 | [:p3 :p3.c :p3c2 :p3c2.a] 864 | [:p3 :p3.c :p3c2 :p3c2.a :p3c2.a1] 865 | [:p3 :p3.c :p3c2 :p3c2.b] 866 | [:p3 :p3.c :p3c2 :p3c2.b :p3c2.b1]} 867 | :=> 868 | {:p1 :p12 869 | :p2 :p23 870 | :p3 {:p3.a :p3.a2 871 | :p3.b :p3.b3 872 | :p3.c {:p3c2 {:p3c2.a :p3c2.a1 873 | :p3c2.b :p3c2.b1}}}})) 874 | 875 | ;; Skipped because this is not a common used feature 876 | ;; https://github.com/davidkpiano/xstate/blob/xstate@4.17.0/packages/core/test/parallel.test.ts#L829 877 | #_(deftest ^:skip test-tx-to-parallel-sibling 878 | (let [fsm 879 | (impl/machine 880 | {:id :app 881 | :type :parallel 882 | :regions {:pages {:initial :about 883 | :states {:about {:on {:e-dashboard :dashboard}} 884 | :dashboard {:on {:e-about :about}}}} 885 | :menu {:initial :closed 886 | :states {:closed {:on {:toggle :opened}} 887 | :opened {:on {:toggle :closed 888 | :go-to-dashboard 889 | [:> :pages :dashboard]}}}}}}) 890 | 891 | state (impl/initialize fsm) 892 | menu-opened-state (impl/transition fsm state :toggle) 893 | dashboard-state (impl/transition fsm menu-opened-state :go-to-dashboard)] 894 | (is (= (:_state state) 895 | {:pages :about 896 | :menu :closed})) 897 | (is (= (:_state menu-opened-state) 898 | {:pages :about 899 | :menu :opened})) 900 | (is (= (:_state dashboard-state) 901 | {:pages :dashboard 902 | :menu :opened})))) 903 | 904 | (defn word-machine 905 | [] 906 | (impl/machine 907 | {:id :word 908 | :type :parallel 909 | :on {:reset []} 910 | :regions {:bold {:initial :off 911 | :states {:on {:on {:toggle-bold :off}} 912 | :off {:on {:toggle-bold :on}}}} 913 | :underline {:initial :off 914 | :states {:on {:on {:toggle-underline :off}} 915 | :off {:on {:toggle-underline :on}}}} 916 | :italics {:initial :off 917 | :states {:on {:on {:toggle-italics :off}} 918 | :off {:on {:toggle-italics :on}}}} 919 | 920 | :list {:initial :none 921 | :states {:none {:on {:bullets :bullets 922 | :numbers :numbers}} 923 | :bullets {:on {:none :none 924 | :numbers :numbers}} 925 | :numbers {:on {:bullets :bullets 926 | :none :none}}}} 927 | }})) 928 | 929 | ;; https://github.com/davidkpiano/xstate/blob/xstate@4.17.0/packages/core/test/parallel.test.ts#L496 930 | (deftest test-word-machine 931 | (let [fsm (word-machine) 932 | state (impl/initialize fsm) 933 | init-state {:bold :off 934 | :italics :off 935 | :underline :off 936 | :list :none} 937 | _ (is (= (:_state state) init-state))] 938 | (are [event _ _state] 939 | (= (:_state (impl/transition fsm state event)) 940 | _state) 941 | :toggle-bold :=> (assoc init-state :bold :on) 942 | :toggle-underline :=> (assoc init-state :underline :on) 943 | :toggle-italics :=> (assoc init-state :italics :on) 944 | :reset :=> init-state 945 | 946 | ))) 947 | 948 | (deftest test-ignore-unknown-event 949 | (let [fsm (impl/machine {:id :foo 950 | :initial :foo 951 | :states {:foo {:on {:foo-event {:target :bar}}} 952 | :bar {:on {:bar-event {:target :foo}}}}}) 953 | state (impl/initialize fsm)] 954 | (testing "error is thrown when flag is unset" 955 | (is (thrown? #?(:clj Exception 956 | :cljs js/Error) 957 | (impl/transition fsm state :bar-event)))) 958 | (testing "error is thrown when flag is false" 959 | (is (thrown? #?(:clj Exception 960 | :cljs js/Error) 961 | (impl/transition fsm state :bar-event {:ignore-unknown-event? false})))) 962 | (testing "error is not thrown when flag is true" 963 | (is (= :foo (:_state (impl/transition fsm state :bar-event {:ignore-unknown-event? true}))))))) 964 | 965 | (deftest test-parallel-regions-without-state 966 | (let [fsm (impl/machine {:id :foo 967 | :type :parallel 968 | :regions {:foo {} 969 | :bar {} 970 | :baz {:initial :one 971 | :states {:one {:on {:e :two}} 972 | :two {}}}}}) 973 | state (impl/initialize fsm) 974 | _ (is (= (:_state state) {:foo nil :bar nil :baz :one})) 975 | new-state (impl/transition fsm state :e)] 976 | (is (= (:_state new-state) {:foo nil :bar nil :baz :two})))) 977 | 978 | 979 | (comment 980 | #?(:cljs (let [fsm (parallel-machine) 981 | state (impl/initialize fsm)] 982 | (simple-benchmark [] 983 | (impl/transition fsm 984 | state 985 | :e12) 986 | 1000))) 987 | ()) 988 | 989 | (deftest test-unscheduling-delayed-transitions 990 | (let [clock (fsm.sim/simulated-clock) 991 | advance-clock (fn [ms] 992 | (fsm.sim/advance clock ms)) 993 | ;; a store that manages a single state 994 | state-store (fsm.store/single-store) 995 | machine (impl/machine 996 | {:id :process 997 | :scheduler (fsm.scheduler/make-store-scheduler state-store clock) 998 | :initial :running 999 | :states {:running {:after [{:delay 1000 1000 | :target :done}] 1001 | :on {:cancel :canceled}} 1002 | :canceled {} 1003 | :done {}}})] 1004 | ;; start 1005 | (fsm.store/initialize state-store machine nil) 1006 | ;; cancel it before it finishes 1007 | (advance-clock 500) 1008 | (fsm.store/transition state-store machine nil :cancel {}) 1009 | ;; wait until it would have finished 1010 | (advance-clock 500) 1011 | ;; it stays in canceled state, instead of moving to :done 1012 | (is (= (:_state (fsm.store/get-state state-store nil)) :canceled)))) 1013 | 1014 | (deftest test-simultaneous-delays 1015 | (let [clock (fsm.sim/simulated-clock) 1016 | advance-clock (fn [ms] 1017 | (fsm.sim/advance clock ms)) 1018 | ;; a store that manages several states at once 1019 | state-store (fsm.store/many-store) 1020 | machine (impl/machine 1021 | {:id :process 1022 | :scheduler (fsm.scheduler/make-store-scheduler state-store clock) 1023 | :initial :running 1024 | :states {:running {:after [{:delay 1000 1025 | :target :done}]} 1026 | :done {}}}) 1027 | get-state (fn [id] (:_state (fsm.store/get-state state-store id)))] 1028 | ;; start one state 1029 | (fsm.store/initialize state-store machine {:context {:id :a}}) 1030 | (is (= (get-state :a) :running)) 1031 | (advance-clock 500) 1032 | ;; a moment later start another 1033 | (fsm.store/initialize state-store machine {:context {:id :b}}) 1034 | (advance-clock 500) 1035 | ;; enough time has passed for the first to be done 1036 | (is (= (get-state :a) :done)) 1037 | ;; but the second is still pending 1038 | (is (= (get-state :b) :running)) 1039 | ;; until it finishes too 1040 | (advance-clock 500) 1041 | (is (= (get-state :b) :done)))) 1042 | 1043 | (deftest test-root-entry-and-action 1044 | (let [root-entries (atom 0) 1045 | root-entry (fn [& _] (swap! root-entries inc)) 1046 | root-actions (atom 0) 1047 | root-action (fn [& _] (swap! root-actions inc)) 1048 | machine (impl/machine {:id :test 1049 | :initial :s1 1050 | :entry root-entry 1051 | :on {:e1 {:actions root-action}} 1052 | :states 1053 | {:s1 {:on {:e1_2 :s2}} 1054 | :s2 {:on {:e1 :s1}}}}) 1055 | state (impl/initialize machine)] 1056 | (is (= (:_state state) :s1)) 1057 | (is (= @root-entries 1)) 1058 | (let [state1 (impl/transition machine state :e1_2)] 1059 | (is (= (:_state state1) :s2))) 1060 | (let [state2 (impl/transition machine state :e1)] 1061 | (is (= (:_state state2) :s1)) 1062 | (is (= @root-entries 1)) 1063 | (is (= @root-actions 1))))) 1064 | 1065 | (deftest test-eventless-transtions-on-init-state 1066 | (let [machine (impl/machine {:id :test 1067 | :initial :s1 1068 | :states 1069 | {:s1 {:always [{:guard (constantly true) 1070 | :target :s2}] 1071 | :on {:e1_3 :s3}} 1072 | :s2 {:on {:e2_3 :s3}} 1073 | :s3 {:always [{:guard (constantly true) 1074 | :target :s1}]}}}) 1075 | tx (fn [state event] 1076 | (impl/transition machine state event)) 1077 | state (impl/initialize machine)] 1078 | (is (= :s2 (:_state state))) 1079 | ;; s2--(e2_3)-->s3--(always)-->s1--(always)-->s2 1080 | (is (= :s2 (:_state (tx state :e2_3)))))) 1081 | 1082 | (deftest test-eventless-transtions-on-init-state-nested 1083 | (let [machine 1084 | (impl/machine {:id :test 1085 | :initial :s1 1086 | :states 1087 | {:s1 {:initial :s1.1 1088 | :states {:s1.1 {:always [{:guard (constantly true) 1089 | :target [:> :s2]}]}}} 1090 | :s2 {}}}) 1091 | 1092 | state (impl/initialize machine)] 1093 | (is (= :s2 (:_state state))))) 1094 | 1095 | #_(deftest test-allow-extra-keys 1096 | (let [error (volatile! nil) 1097 | machine (try 1098 | (impl/machine 1099 | {:id :lights 1100 | :my-custom-id :lights-v0 1101 | :initial :red 1102 | :context nil 1103 | :states {:green {:description "Green Light" 1104 | :on {:timer {:target :yellow}}} 1105 | :yellow {:on {:timer {:target :red 1106 | :description "Don't rush!"}}} 1107 | :red {:on {:timer :green}}} 1108 | :on {:power-outage :red}}) 1109 | (catch #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) e 1110 | (vreset! error e) 1111 | nil))] 1112 | (is (some? machine) (ex-data @error)))) 1113 | 1114 | (deftest test-merge-context-with-default-context 1115 | (let [machine (impl/machine 1116 | {:id :test 1117 | :initial :s0 1118 | :context {:foo 1 1119 | :bar 2} 1120 | :states {:s0 {}}})] 1121 | (let [{:keys [foo bar baz]} 1122 | (fsm/initialize machine {:context {:bar 3 1123 | :baz 4}})] 1124 | (is (= foo 1)) 1125 | (is (= bar 3)) 1126 | (is (= baz 4))))) 1127 | --------------------------------------------------------------------------------