diff --git a/.github/workflows/commit_validation.yml b/.github/workflows/commit_validation.yml
index 4b8830e..2ef708e 100644
--- a/.github/workflows/commit_validation.yml
+++ b/.github/workflows/commit_validation.yml
@@ -1,3 +1,4 @@
+# V1 - For all projects
name: Commit validation
on:
push:
@@ -15,48 +16,52 @@ jobs:
runs-on: ${{ matrix.os }}
steps:
- name: Checkout
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
fetch-depth: 0
- - name: Cache clojure dependencies
- uses: actions/cache@v4
- with:
- path: /home/runner/.m2/repository
- key: cljdeps-${{ hashFiles('deps.edn', 'bb.edn') }}
- restore-keys: cljdeps-
- name: Install java
- uses: actions/setup-java@v4
+ uses: actions/setup-java@v5
with:
- distribution: 'zulu'
- java-version: '22'
+ distribution: 'temurin'
+ java-version: '21'
+ check-latest: true
- name: Install clojure tools
# See https://github.com/DeLaGuardo/setup-clojure/commits/main/
- uses: DeLaGuardo/setup-clojure@cc67f8308550d0f18b0ba445c2476f84626a5d6a #v13.0
+ uses: DeLaGuardo/setup-clojure@3fe9b3ae632c6758d0b7757b0838606ef4287b08 #v13.2
with:
- cli: 1.12.0.1479 # Clojure CLI based on tools.deps
- bb: 1.12.195 # Babashka
- clj-kondo: 2024.11.14 # Clj-kondo
- zprint: 1.2.9 # zprint
+ cli: 1.12.3.1577
+ bb: 1.12.209
+ clj-kondo: 2025.10.23
+ zprint: 1.3.0
- name: Lint
run: bb lint -v
- name: Setup zprint
run: echo "{:search-config? true}" >> ~/.zprintrc
- - name: Install fdfind
- run: sudo rm /var/lib/man-db/auto-update && sudo apt-get install -y fd-find && mkdir -p ~/.local/bin/ && PATH=$PATH:~/.local/bin/ && ln -s $(which fdfind) ~/.local/bin/fd
+ - name: Install fd-find
+ run: |
+ sudo apt-get update
+ sudo apt-get install -y fd-find
+ mkdir -p ~/.local/bin
+ ln -s "$(which fdfind)" ~/.local/bin/fd
+ echo "$HOME/.local/bin" >> $GITHUB_PATH
+ - name: Cache clojure dependencies
+ uses: actions/cache@v4
+ with:
+ path: /home/runner/.m2/repository
+ key: cljdeps-${{ hashFiles('deps.edn', 'bb.edn', '.github/workflows/commit_validation.yml') }}
+ restore-keys: cljdeps-
- name: format again to check the code pushed was uptodate
run: bb format -v
- name: Write git diff - show what has been changed by zprint
run: git diff
- name: Pushed code should already be formatted
# See https://github.com/CatChen/check-git-status-action
- uses: CatChen/check-git-status-action@bde80484b437cece974f79da735a5cd1dfdc9b0b #v1
+ uses: CatChen/check-git-status-action@d75bdbea704869e2a3b01111b4a82c49e9bd348d #v1.4.4
with:
fail-if-not-clean: true
request-changes-if-not-clean: false
push-if-not-clean: false
- - name: test code in clojure
- run: bb clj-test test-clj -v
- - name: test code in clojurescript
- run: bb cljs-node-test all -v
+ - name: test
+ run: bb gha
- name: print infos just for debugging, and the logs
run: bb heph-info
diff --git a/.github/workflows/deploy_clojar.yml b/.github/workflows/deploy_clojar.yml
index 0e0a75d..0e3ae66 100644
--- a/.github/workflows/deploy_clojar.yml
+++ b/.github/workflows/deploy_clojar.yml
@@ -14,7 +14,7 @@ jobs:
steps:
# This step checks out a copy of your repository.
- - uses: actions/checkout@v4
+ - uses: actions/checkout@v5
- uses: jlesquembre/clojars-publish-action@89a4eb7bdbe1270621e6643250afce152701699e # v0.3
env:
diff --git a/.zprintrc b/.zprintrc
index ebbd6af..54f0e93 100644
--- a/.zprintrc
+++ b/.zprintrc
@@ -1,4 +1,5 @@
-;;See [doc](https://github.com/kkinnear/zprint/blob/d0bb27e51ac97b1cdae5ea32b9b953f66cd650b2/doc/reference.md#introduction-to-configuration) for more details
+;; V1 - For all projects
+;; See [doc](https://github.com/kkinnear/zprint/blob/d0bb27e51ac97b1cdae5ea32b9b953f66cd650b2/doc/reference.md#introduction-to-configuration) for more details
{:style [:community
:how-to-ns
:sort-require
diff --git a/bb.edn b/bb.edn
index e67fd35..6b17a2e 100644
--- a/bb.edn
+++ b/bb.edn
@@ -1,10 +1,7 @@
-{:deps {io.github.hephaistox/auto-build {:git/sha "e907e29f65049a805c5a33e2f60bbe838c268a1a"}}
- :paths ["src"]
+{:deps {com.github.hephaistox/auto-build {:git/sha "cd0854aaba46d240ac4852b97d1f4f708ed626dc"}}
+ :paths []
:tasks
- {:init (do (def ^:dynamic exit System/exit))
- :requires [;;NOTE Should be as small as possible to ensure `lconnect`
- ;;can start whatever the state of the code is.
- [auto-build.os.exit-codes]]
+ {:requires [[auto-build.os.exit-codes] [auto-build.os.exiting :refer [exit]]]
bp {:doc "Before push"
:task (binding [exit (fn [exit-code & _] (when-not (zero? exit-code) exit-code))]
(-> (or (run 'format)
@@ -18,15 +15,21 @@
clean {:doc "Clean temporary files"
:requires [[auto-build.tasks.clean :as task-clean]
[auto-build.echo :refer [level1-header]]]
- :task (-> (task-clean/clean level1-header "." [".DS_Store"] [".cpcache"] (current-task))
+ :task (-> (task-clean/clean level1-header
+ "."
+ [".DS_Store"]
+ ["node_modules" ".cpcache" "target"]
+ (current-task))
exit)}
- clj-test
- {:doc "Test with clj"
- :requires [[auto-build.tasks.clj-test :as build-clj-test]
- [auto-build.echo :refer [level1-header]]]
- :task (->
- (build-clj-test/clj-test level1-header "." "clj-test-runner" (current-task) ["test-clj"])
- exit)}
+ clj-test {:doc "Test with clj"
+ :requires [[auto-build.tasks.clj-test :as build-clj-test]
+ [auto-build.echo :refer [level1-header]]]
+ :task (-> (build-clj-test/clj-test level1-header
+ "."
+ "clj-test-runner"
+ (current-task)
+ ["test-clj" "test-demo"])
+ exit)}
cljs-browser-test
{:doc "Test with cljs in browser"
:requires [[auto-build.tasks.cljs-browser-test :as build-cljs-browser]
@@ -40,6 +43,9 @@
[auto-build.echo :refer [level1-header]]]
:task (-> (build-cljs-node-test/cljs-node-test level1-header "." (current-task) ["ltest"])
exit)}
+ copy {:doc "Copy files from source projects (as defined in ext_src.edn)"
+ :requires [[auto-build.tasks.copy :as tc] [auto-build.echo :refer [level1-header]]]
+ :task (tc/run level1-header "ext_src.edn")}
deploy {:doc "Deploy"
:requires [[auto-build.tasks.deploy :as task-deploy]
[auto-build.echo :refer [level1-header]]]
@@ -56,6 +62,8 @@
[auto-build.echo :refer [level1-header]]]
:task (-> (task-format/format level1-header "." (current-task))
exit)}
+ gha {:doc "For github action tests"
+ :task (do (shell "bb clj-test test-clj -v") (shell "bb cljs-node-test all -v"))}
heph-info {:doc "Hephaistox project info"
:extra-paths ["env/dev/resources"]
:requires [[auto-build.tasks.heph-info :as heph-info]
@@ -69,11 +77,5 @@
repl {:doc "Clojure repl"
:override-builtin true
:requires [[auto-build.tasks.repl :as build-repl] [auto-build.echo :refer [level1-header]]]
- :task (-> (build-repl/repl level1-header "." (current-task))
- exit)}
- uberjar {:doc "Uberjar"
- :override-builtin true
- :requires [[auto-build.tasks.uberjar :as build-uberjar]
- [auto-build.echo :refer [level1-header]]]
- :task (-> (build-uberjar/uberjar level1-header "." "target/uberjar" "")
- exit)}}}
+ :task (-> (build-repl/repl level1-header "." (current-task) [:cljs-deps] 7008)
+ exit)}}}
diff --git a/build/compile.clj b/build/compile.clj
deleted file mode 100644
index 590c3e0..0000000
--- a/build/compile.clj
+++ /dev/null
@@ -1,22 +0,0 @@
-(ns compile
- (:require
- [clojure.tools.build.api :refer [compile-clj create-basis jar]]))
-
-(defn compile-jar
- [{:keys [target-dir]
- :as _pars}]
- (let [class-dir (str target-dir "/classes")
- jar-file (str target-dir "/production/auto_sim.jar")
- basis (create-basis)]
- (try (let [compile (compile-clj {:basis basis
- :bindings {#'clojure.core/*assert* false
- #'clojure.core/*warn-on-reflection* true}
- :out :capture
- :err :capture
- :class-dir class-dir})]
- (jar {:class-dir class-dir
- :jar-file jar-file})
- {:compile-jar compile})
- (catch Exception e
- {:compile-jar {:exception e}
- :status :compilation-failed}))))
diff --git a/deps.edn b/deps.edn
index f70ec16..1799fbe 100644
--- a/deps.edn
+++ b/deps.edn
@@ -1,49 +1,40 @@
{:aliases
- {:antq {:deps {com.github.liquidz/antq {:mvn/version "2.10.1241"}}
+ {:antq {:deps {com.github.liquidz/antq {:mvn/version "2.11.1276"}}
:main-opts ["-m" "antq.core"]}
- :build {:deps {io.github.clojure/tools.build {:git/sha "52cf7d6"
- :git/tag "v0.10.6"}}
- :extra-paths ["build"]}
:clj-test-runner {:exec-fn cognitect.test-runner.api/test
:extra-deps {com.cognitect/test-runner
{:git/url "https://github.com/cognitect-labs/test-runner"
:sha "3f288f1f16d167723ad87cc35b1dfee3c1681e10"}}}
- :cljs-deps {:extra-deps {metosin/malli #:mvn{:version "0.16.1"}
- thheller/shadow-cljs {:mvn/version "2.28.19"}}
- :extra-paths
- ["src/cljc" "src/cljs" "env/dev/resources" "test/cljc" "test/cljs" "test/resources"]}
+ :cljs-deps {:extra-deps {binaryage/devtools {:mvn/version "1.0.7"}
+ com.github.hephaistox/auto-web
+ {:git/sha "e7446ec83262c36baecf3af11c7530b0d2e97eb8"}
+ com.github.hephaistox/auto_web {:local/root "../auto_web"}
+ devcards/devcards {:mvn/version "0.2.7"}
+ re-frame/re-frame {:mvn/version "1.4.3"}
+ re-frisk/re-frisk {:mvn/version "1.7.1"}
+ thheller/shadow-cljs {:mvn/version "3.2.1"}}
+ :extra-paths ["src/cljc"
+ "src/cljs"
+ "test/unit/cljc"
+ "../auto_web/src/cljs"
+ "../auto_web/src/cljs"
+ "test/demo/cljc"
+ "env/devcards/src/cljs"]}
:codox {:exec-args
- {:description
- "`auto-sim` is about all core technical functionalities we may need to start a project."
+ {:description "`auto-sim` provide simulation features (activity and event based)"
:doc-paths ["docs/codox"]
:metadata {:doc/format :markdown}
:name "auto-sim"
:source-uri "https://github.com/hephaistox/auto-sim/blob/{version}/{filepath}#L{line}"}
:exec-fn codox.main/generate-docs
:extra-deps {codox/codox {:mvn/version "0.10.8"}}}
- :repl {:exec-args {:port 7001}
+ :repl {:exec-args {:port 7007}
:exec-fn auto-build.repl.entry-point/start
- :extra-deps {cider/cider-nrepl {:mvn/version "0.50.2"}
- io.github.hephaistox/auto-build {:git/sha
- "e907e29f65049a805c5a33e2f60bbe838c268a1a"}
- refactor-nrepl/refactor-nrepl {:mvn/version "3.10.0"}}
- :extra-paths
- ["env/dev/resources" "test/clj" "test/cljc" "test/resources" "test/src" "test/resources"]}
- :test-clj {:extra-paths ["test/clj" "test/cljc" "test/resources"]
- :main-opts
- ["-m" "cognitect.test-runner" "-r" ".*-test.*" "-d" "test/clj" "test/cljc"]}}
- :deps {babashka/fs #:mvn{:version "0.5.22"}
- babashka/process #:mvn{:version "0.5.22"}
- com.taoensso/tempura #:mvn{:version "1.5.4"}
- com.yetanalytics/colossal-squuid {:mvn/version "0.1.5"}
- danlentz/clj-uuid #:mvn{:version "0.2.0"}
- http-kit/http-kit #:mvn{:version "2.8.0"}
- lambdaisland/uri #:mvn{:version "1.19.155"}
- metosin/malli #:mvn{:version "0.16.1"}
- mount/mount #:mvn{:version "0.1.20"}
- org.apache.logging.log4j/log4j-api #:mvn{:version "2.24.1"}
- org.apache.logging.log4j/log4j-core #:mvn{:version "2.24.1"}
- org.apache.logging.log4j/log4j-slf4j2-impl #:mvn{:version "2.24.1"}
- org.clojure/tools.cli {:mvn/version "1.1.230"}
- org.clojure/tools.logging #:mvn{:version "1.3.0"}}
- :paths ["src/cljc" "src/clj"]}
+ :extra-paths ["test/unit/cljc" "test/demo/cljc"]
+ :jvm-opts ["-Djdk.attach.allowAttachSelf=true"]}
+ :test-clj {:extra-paths ["test/unit/cljc"]
+ :main-opts ["-m" "cognitect.test-runner" "-r" ".*-test.*" "-d" "test/unit/cljc"]}
+ :test-demo {:extra-paths ["test/demo/cljc"]
+ :main-opts ["-m" "cognitect.test-runner" "-r" ".*" "-d" "test/demo/cljc"]}}
+ :deps {com.github.hephaistox/auto-opti {:git/sha "fbcce94ddf956794c27c90387b2a9f975560eb25"}}
+ :paths ["src/cljc" "src/clj" "resources"]}
diff --git a/docs/img/automaton_duck.png b/docs/img/automaton_duck.png
new file mode 100644
index 0000000..03661bc
Binary files /dev/null and b/docs/img/automaton_duck.png differ
diff --git a/env/devcards/resources/index.html b/env/devcards/resources/index.html
new file mode 100644
index 0000000..dccf114
--- /dev/null
+++ b/env/devcards/resources/index.html
@@ -0,0 +1,20 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/env/devcards/src/cljs/auto_sim/animation_cards.cljs b/env/devcards/src/cljs/auto_sim/animation_cards.cljs
new file mode 100644
index 0000000..6a4f99f
--- /dev/null
+++ b/env/devcards/src/cljs/auto_sim/animation_cards.cljs
@@ -0,0 +1,65 @@
+(ns auto-sim.animation-cards
+ (:require
+ [auto-sim :as-alias sim]
+ [auto-sim.animation :refer [trajectory]]
+ [auto-sim.component.time-picker :refer [time-picker]]
+ [devcards.core :refer [defcard-rg]]
+ [devcards.util.edn-renderer :refer [html-edn]]
+ [re-frame.core :refer [dispatch dispatch-sync subscribe]]
+ [re-frame.db :refer [app-db]]))
+
+;; (defn- box-example
+;; [pos class-color]
+;; [:div {:style {:left (str (:x pos) "px")
+;; :top (str (:y pos) "px")
+;; :height "10px"
+;; :width "10px"
+;; :position "absolute"}
+;; :class class-color}])
+
+;; (dispatch-sync [::sim/time-picker-init
+;; :animation
+;; {:min 10
+;; :max 96
+;; :default 35
+;; :step 2
+;; :fast-step 11}])
+
+;; (defcard-rg trajectory-card
+;; "## Two black boxes animated with a time-picker"
+;; (fn [_ _]
+;; (let [time @(subscribe [::sim/time-picker :animation])
+;; src-pos {:x 5
+;; :y 5
+;; :t 13}
+;; dst-pos {:x 95
+;; :y 55
+;; :t 30}
+;; src-pos2 {:x 5
+;; :y 5
+;; :t 30}
+;; dst-pos2 {:x 5
+;; :y 35
+;; :t 90}]
+;; [:div
+;; [:div.w3-row
+;; [time-picker {:class "w3-half"}
+;; :animation]
+;; [:input.w3-half {:value @(subscribe [::sim/time-picker :animation])
+;; :readOnly true}]]
+;; [:button {:on-click #(dispatch [::sim/start :trajectory-test 20])}
+;; "Start"]
+;; [:button {:on-click #(dispatch [::sim/stop :trajectory-test])}
+;; "Stop"]
+;; [:div {:style {:width "100px "
+;; :height "100px"
+;; :position "relative"}}
+;; (box-example src-pos "w3-grey")
+;; (box-example (trajectory time src-pos dst-pos) "w3-black")
+;; (box-example (trajectory time src-pos2 dst-pos2) "w3-black")
+;; (box-example dst-pos "w3-grey")]
+;; [:div
+;; [html-edn
+;; (-> @app-db
+;; (select-keys [::sim/time-picker])
+;; (update ::sim/time-picker #(select-keys % [:animation])))]]])))
diff --git a/env/devcards/src/cljs/auto_sim/canvas_cards.cljs b/env/devcards/src/cljs/auto_sim/canvas_cards.cljs
new file mode 100644
index 0000000..212a653
--- /dev/null
+++ b/env/devcards/src/cljs/auto_sim/canvas_cards.cljs
@@ -0,0 +1,94 @@
+(ns auto-sim.canvas-cards
+ (:require
+ [auto-sim :as-alias sim]
+ [auto-sim.canvas :as sut]
+ [auto-sim.control-bar :as-alias cb]
+ [auto-sim.links :refer [links]]
+ [devcards.core :refer [defcard-rg]]
+ [devcards.util.edn-renderer :refer [html-edn]]
+ [re-frame.core :refer [dispatch]]
+ [re-frame.db :refer [app-db]]
+ [reagent.core :as reagent]))
+
+(defn- focus-on
+ [m path]
+ (let [[a b] path]
+ (-> m
+ (select-keys [a])
+ (update a select-keys [b]))))
+
+(def sprites
+ (->> {:source {:size-x 2
+ :size-y 2
+ :img ::sim/source}
+ :sink {:size-x 2
+ :size-y 2
+ :img ::sim/sink}
+ :machine {:size-x 4
+ :size-y 4
+ :img ::sim/machine}
+ :product {:size-x 2
+ :size-y 2
+ :img ::sim/product}}
+ (map (fn [[k v]] [k (assoc v :sprite-id k)]))
+ (into {})))
+
+(def rendering-data
+ (->> [{:render-id :exemple-a
+ :sprite :machine
+ :x 0
+ :y 0}
+ {:render-id :exemple-c
+ :sprite :product
+ :x 50
+ :y 10}
+ {:render-id :exemple-d
+ :sprite :product
+ :x 10
+ :y 20}
+ {:render-id :exemple-b
+ :sprite :product
+ :x 10
+ :y 10}]
+ (mapv (fn [{:keys [sprite render-id x y]}]
+ (let [{:keys [size-x size-y img]} (get sprites sprite)]
+ [render-id {:render-id render-id
+ :img (:url (get links img))
+ :render-items-basis {:width size-x
+ :height size-y
+ :x x
+ :y y}}])))
+ (into {})))
+
+(dispatch [::sut/set-render-items :canvas-1 rendering-data])
+
+(defcard-rg
+ simulation-control-panel-multi-select
+ "### Simulation control panel with multi select mode"
+ (fn [_ _]
+ (-> [:div
+ [:div.w3-center
+ [:div.w3-bar.w3-padding-16 [sut/bn-autofit :canvas-1] [sut/bn-drag-move :canvas-1]]]
+ [sut/layout* {:style {:width "100%"
+ :height "500px"}}
+ :canvas-1
+ {:multi-select-mode? true}]
+ (html-edn (focus-on @app-db [::sut/canvas :canvas-1]))]
+ reagent/as-element)))
+
+#_(defcard-rg
+ simulation-control-panel-mono-select
+ "### Simulation control panel with mono select mode"
+ (fn [_ _]
+ (-> [:div
+ [:button {:on-click (fn [_]
+ (dispatch-sync [::sut/set-render-items :canvas-2 rendering-data]))}
+ "Set data"]
+ [:div.w3-center [:div.bar [sut/bn-autofit :canvas-1] [sut/bn-arrows :canvas-1]]]
+ [sut/layout {:style {:width "1000px"
+ :height "500px"}}
+ :canvas-2
+ {:multi-select-mode? false}
+ rendering-data]
+ (html-edn (focus-on @app-db [::sut/canvas :canvas-2]))]
+ reagent/as-element)))
diff --git a/env/devcards/src/cljs/auto_sim/chartjs_cards.cljs b/env/devcards/src/cljs/auto_sim/chartjs_cards.cljs
new file mode 100644
index 0000000..de2772b
--- /dev/null
+++ b/env/devcards/src/cljs/auto_sim/chartjs_cards.cljs
@@ -0,0 +1,80 @@
+(ns auto-sim.chartjs-cards
+ (:require
+ [auto-sim.charts :refer [bar-chart bubble-chart doughnut-chart line-chart polar-chart]]
+ [devcards.core :refer [defcard-rg]]
+ [re-frame.db :refer [app-db]]
+ [reagent.core :as reagent]))
+
+(defcard-rg bar-chart-card
+ "### Bar chart"
+ (fn [_ _]
+ (reagent/as-element [bar-chart
+ {:type "bar"
+ :data {:labels ["Red" "Blue" "Yellow" "Green" "Purple" "Orange"]
+ :datasets [{:label "# of Votes"
+ :data [12 19 3 5 2 3]
+ :borderWidth 1}]}
+ :options {:scales {:y {:beginAtZero true}}
+ :onClick (fn [e] (js/console.log e))
+ :interaction {:mode "point"}
+ :events ["click"]}}]))
+ app-db)
+
+(defcard-rg bubble-chart-card
+ "### Bubble chart"
+ (fn [_ _]
+ (reagent/as-element [bubble-chart {:type "bubble"
+ :data {:datasets [{:label "First dataset"
+ :data [{:x 20
+ :y 30
+ :r 15}
+ {:x 40
+ :y 10
+ :r 10}]
+ :backgroundColor
+ "rgb(255, 99, 132)"}]}
+ :options {}}]))
+ app-db)
+
+(defcard-rg doughnut-card
+ "### Doughnut chart"
+ (fn [_ _]
+ (reagent/as-element [doughnut-chart {:type "doughnut"
+ :labels ["Red" "Blue" "Yellow"]
+ :data {:datasets [{:label "My first dataset"
+ :data [300 50 100]
+ :backgroundColor
+ ["rgb(255, 99, 132)"
+ "rgb(54, 162, 235)"
+ "rgb(255, 205, 86)"]
+ :hoverOffset 4}]}
+ :options {}}]))
+ app-db)
+
+(defcard-rg line-card
+ "### Line chart"
+ (fn [_ _]
+ (reagent/as-element [line-chart {:type "line"
+ :data {:datasets [{:label "My first dataset"
+ :data [65 59 80 81 56 55 40]
+ :fill true
+ :backgroundColor
+ ["rgb(255, 99, 132)"
+ "rgb(54, 162, 235)"
+ "rgb(255, 205, 86)"]
+ :borderColor "rgb(75, 192, 192)"
+ :tension 0.1}]
+ :labels ["janvier" "fevrier"]}}]))
+ app-db)
+
+(defcard-rg polar-card
+ "### Polar chart"
+ (fn [_ _]
+ (reagent/as-element [polar-chart {:type "polarArea"
+ :data {:datasets [{:label "My first dataset"
+ :data [65 59 80 81 56 55 40]
+ :backgroundColor
+ ["rgb(255, 99, 132)"
+ "rgb(54, 162, 235)"
+ "rgb(255, 205, 86)"]}]}}]))
+ app-db)
diff --git a/env/devcards/src/cljs/auto_sim/component/speed_cards.cljs b/env/devcards/src/cljs/auto_sim/component/speed_cards.cljs
new file mode 100644
index 0000000..ef4549f
--- /dev/null
+++ b/env/devcards/src/cljs/auto_sim/component/speed_cards.cljs
@@ -0,0 +1,63 @@
+(ns auto-sim.component.speed-cards
+ (:require
+ [auto-sim.component.speed :refer [time-speed]]
+ [devcards.core :refer [defcard-rg]]
+ [devcards.util.edn-renderer :refer [html-edn]]
+ [re-frame.core :refer [dispatch reg-event-db reg-sub subscribe]]
+ [re-frame.db :refer [app-db]]
+ [reagent.core :as reagent]))
+
+(reg-event-db ::set-speed (fn [db [_ k val]] (assoc-in db [:speed k] val)))
+
+(reg-sub ::speed (fn [db [_ k]] (get-in db [:speed k])))
+
+(defn- focus-on
+ [m ks]
+ (-> m
+ (select-keys [:speed])
+ (update :speed select-keys [ks])))
+
+(defcard-rg time-speed-card
+ "### Time speed
+The default is 4"
+ (fn [_ _]
+ (reagent/as-element [:div
+ [time-speed {}
+ [0.5 1 4]
+ @(subscribe [::speed :first-card])
+ #(dispatch [::set-speed :first-card %])
+ 4]
+ [:br]
+ @(subscribe [::speed :first-card])
+ (html-edn (focus-on @app-db :first-card))])))
+
+(defcard-rg time-speed2-card
+ "If value doesn't exist, it is defaulted to the first value."
+ (fn [_ _]
+ (reagent/as-element [:div
+ [time-speed {}
+ [0.5 1 4]
+ @(subscribe [::speed :second-card])
+ #(dispatch [::set-speed :second-card %])
+ 10]
+ [:br]
+ @(subscribe [::speed :second-card])
+ (html-edn (focus-on @app-db :second-card))])))
+
+(defcard-rg time-speed3-card
+ "Share value but has no opts"
+ (fn [_ _]
+ (reagent/as-element [:div
+ [time-speed
+ [0.5 1 8]
+ @(subscribe [::speed :third-card])
+ #(dispatch [::set-speed :third-card %])]
+ (html-edn (focus-on @app-db :third-card))])))
+
+(defcard-rg time-speed3-card
+ "Share value but has opts"
+ (fn [_ _]
+ (reagent/as-element [time-speed {:class "w3-card"}
+ [0.5 1 8]
+ @(subscribe [::speed :third-card])
+ #(dispatch [::set-speed :third-card %])])))
diff --git a/env/devcards/src/cljs/auto_sim/component/time_picker_cards.cljs b/env/devcards/src/cljs/auto_sim/component/time_picker_cards.cljs
new file mode 100644
index 0000000..714146f
--- /dev/null
+++ b/env/devcards/src/cljs/auto_sim/component/time_picker_cards.cljs
@@ -0,0 +1,100 @@
+(ns auto-sim.component.time-picker-cards
+ (:require
+ [auto-sim.component.time-picker :refer [get-time time-picker update-time]]
+ [devcards.core :refer [defcard-rg]]
+ [devcards.util.edn-renderer :refer [html-edn]]
+ [re-frame.core :refer [dispatch reg-event-db reg-sub subscribe]]
+ [re-frame.db :refer [app-db]]
+ [reagent.core :as reagent]))
+
+(reg-event-db ::set-time (fn [db [_ k time _ _]] (update-in db [::time-picker k] update-time time)))
+
+(reg-sub ::tp-vals (fn [db [_ k]] (get-in db [::time-picker k])))
+
+(defn- focus-on
+ [m path]
+ (let [[a b] path]
+ (-> m
+ (select-keys [a])
+ (update a select-keys [b]))))
+
+(defcard-rg
+ time-picker-card
+ "### A time picker
+Starts with default 35, step is 2, fast-step is 11. Min and max are known in advance: 30, 90"
+ (fn [_ _]
+ (let [tp-data {:min 30
+ :max 90
+ :time 35
+ :step 2
+ :fast-step 11}
+ tp-vals @(subscribe [::tp-vals :std tp-data])]
+ (reagent/as-element [:div
+ [time-picker {}
+ tp-data
+ tp-vals
+ #(dispatch [::set-time :std % tp-data tp-vals])]
+ [:input {:value (get-time tp-data @(subscribe [::tp-vals :std tp-data]))
+ :read-only true}]
+ (html-edn (focus-on @app-db [::time-picker :std tp-data]))]))))
+
+(defcard-rg time-picker-init-below-min
+ "When default value is 25, it is below the minimum, it is defaulted to the minimum 30"
+ (fn [_ _]
+ (let [tp-data {:min 30
+ :max 90
+ :step 2
+ :time 25
+ :fast-step 11}]
+ (reagent/as-element
+ [:div
+ [time-picker {}
+ tp-data
+ @(subscribe [::tp-vals :below-min tp-data])
+ #(dispatch [::set-time :below-min % tp-data])]
+ [:input {:value (get-time tp-data @(subscribe [::tp-vals :below-min tp-data]))
+ :read-only true}]
+ (html-edn (focus-on @app-db [::time-picker :below-min tp-data]))]))))
+
+(defcard-rg time-picker-not-initialized
+ "Time picker not initialized is suppose to start at 0, has no maximum"
+ (fn [_ _]
+ (let [tp-data {}]
+ (reagent/as-element
+ [:div
+ [time-picker {}
+ tp-data
+ @(subscribe [::tp-vals :not-initialized tp-data])
+ #(dispatch [::set-time :not-initialized % tp-data])]
+ [:input {:value (get-time tp-data
+ @(subscribe [::tp-vals :not-initialized tp-data]))
+ :read-only true}]
+ (html-edn (focus-on @app-db [::time-picker :not-initialized]))]))))
+
+(defcard-rg time-picker-with-no-max
+ "Time picker with no maximum"
+ (fn [_ _]
+ (let [tp-data {:min 30
+ :step 2
+ :fast-step 11}]
+ (reagent/as-element [:div
+ [time-picker {}
+ tp-data
+ @(subscribe [::tp-vals :no-max tp-data])
+ #(dispatch [::set-time :no-max % tp-data])]
+ (html-edn (focus-on @app-db [::time-picker :no-max]))]))))
+
+(defcard-rg time-picker-with-dynamic-max
+ "Time picker with dynamic maximum"
+ (fn [_ _]
+ (let [tp-data {:min 30
+ :time 25
+ :step 2
+ :fast-step 11}]
+ (reagent/as-element [:div
+ [time-picker {}
+ tp-data
+ @(subscribe [::tp-vals :dynamic-max tp-data])
+ #(dispatch [::set-time :dynamic-max % tp-data])
+ (fn [{:keys [time]}] (when (>= time 200) 200))]
+ (html-edn (focus-on @app-db [::time-picker :dynamic-max]))]))))
diff --git a/env/devcards/src/cljs/auto_sim/control_bars_cards.cljs b/env/devcards/src/cljs/auto_sim/control_bars_cards.cljs
new file mode 100644
index 0000000..12c494f
--- /dev/null
+++ b/env/devcards/src/cljs/auto_sim/control_bars_cards.cljs
@@ -0,0 +1,28 @@
+(ns auto-sim.control-bars-cards
+ (:require
+ [auto-sim :as-alias sim]
+ [auto-sim.control-bar :refer [iteration-input simulation-control-bar]]
+ [devcards.core :refer [defcard-rg]]
+ [devcards.util.edn-renderer :refer [html-edn]]
+ [re-frame.db :refer [app-db]]
+ [reagent.core :as reagent]))
+
+(defcard-rg simulation-control-bar-card
+ "### Simulation control bar"
+ (fn [_ _]
+ (reagent/as-element [:div
+ (html-edn (-> @app-db
+ (select-keys [::sim/control-bar])
+ (update ::sim/control-bar
+ #(select-keys % [:iteration]))))
+ [simulation-control-bar {}
+ :en
+ 100]])))
+
+(defcard-rg simulation-control-bar-with-no-opt
+ "### Simulation control bar with no option"
+ (fn [_ _] (reagent/as-element [:div [simulation-control-bar :en 100]])))
+
+(defcard-rg linked-iteration-input
+ "### Simulation control bar with no option"
+ (reagent/as-element [iteration-input]))
diff --git a/env/devcards/src/cljs/auto_sim/devcards.cljs b/env/devcards/src/cljs/auto_sim/devcards.cljs
new file mode 100644
index 0000000..6231624
--- /dev/null
+++ b/env/devcards/src/cljs/auto_sim/devcards.cljs
@@ -0,0 +1,12 @@
+(ns auto-sim.devcards
+ "Entry point for devcard app"
+ (:require
+ ["highlight.js" :as hljs]
+ ["marked" :as marked]
+ [devcards.core :as dc
+ :include-macros true]))
+
+(js/goog.exportSymbol "DevcardsSyntaxHighlighter" hljs)
+(js/goog.exportSymbol "DevcardsMarked" marked)
+
+(defn ^:export init [] (dc/start-devcard-ui!))
diff --git a/env/devcards/src/cljs/auto_sim/modal_cards.cljs b/env/devcards/src/cljs/auto_sim/modal_cards.cljs
new file mode 100644
index 0000000..fcede82
--- /dev/null
+++ b/env/devcards/src/cljs/auto_sim/modal_cards.cljs
@@ -0,0 +1,24 @@
+(ns auto-sim.modal-cards
+ (:require
+ [auto-sim :as-alias sim]
+ [auto-sim.modal :refer [simulation-control-panel]]
+ [devcards.core :refer [defcard-rg]]
+ [devcards.util.edn-renderer :refer [html-edn]]
+ [re-frame.core :refer [dispatch]]
+ [re-frame.db :refer [app-db]]
+ [reagent.core :as reagent]))
+
+(defcard-rg simulation-control-panel-card
+ "### Simulation control panel"
+ (fn [_ _]
+ (reagent/as-element [:div
+ [:button {:on-click #(dispatch [::sim/unselect])}
+ "Remove selection"]
+ [:button {:on-click #(dispatch [::sim/select
+ {:id 12
+ :input ["p3" "p4" "p5"]
+ :output ["p1" "p2"]}])}
+ "Select an entity"]
+ [simulation-control-panel]
+ (html-edn (-> @app-db
+ (select-keys [::sim/modal])))])))
diff --git a/ext_src.edn b/ext_src.edn
new file mode 100644
index 0000000..6e2e530
--- /dev/null
+++ b/ext_src.edn
@@ -0,0 +1,5 @@
+{com.github.hephaistox/auto-build {:files [".zprintrc"
+ "LICENSE.md"
+ "docs/img/automaton_duck.png"
+ ".github/workflows/deploy_clojar.yml"
+ ".github/workflows/commit_validation.yml"]}}
diff --git a/package-lock.json b/package-lock.json
index 97390a7..a8603f2 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -8,11 +8,25 @@
"name": "auto-sim",
"version": "0.0.1",
"license": "MIT",
+ "dependencies": {
+ "create-react-class": "15.6.3",
+ "react": "16.13.1",
+ "react-dom": "16.13.1"
+ },
"devDependencies": {
+ "highlight.js": "^10.6.0",
+ "marked": "^2.0.1",
+ "react-highlight.js": "^1.0.7",
"shadow-cljs": "^2.28.20",
"source-map-support": "^0.5.21"
}
},
+ "node_modules/asap": {
+ "version": "2.0.6",
+ "resolved": "https://registry.npmjs.org/asap/-/asap-2.0.6.tgz",
+ "integrity": "sha512-BSHWgDSAiKs50o2Re8ppvp3seVHXSRM44cdSsT9FfNEUUZLOGWVCsiWaRPWM1Znn+mqZ1OfVZ3z3DWEzSp7hRA==",
+ "license": "MIT"
+ },
"node_modules/asn1.js": {
"version": "4.10.1",
"resolved": "https://registry.npmjs.org/asn1.js/-/asn1.js-4.10.1.tgz",
@@ -26,9 +40,9 @@
}
},
"node_modules/asn1.js/node_modules/bn.js": {
- "version": "4.12.1",
- "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.1.tgz",
- "integrity": "sha512-k8TVBiPkPJT9uHLdOKfFpqcfprwBFOAAXXozRubr7R7PfIuKvQlzcI4M0pALeqXN09vdaMbUdUj+pass+uULAg==",
+ "version": "4.12.2",
+ "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.2.tgz",
+ "integrity": "sha512-n4DSx829VRTRByMRGdjQ9iqsN0Bh4OolPsFnaZBLcbi8iXcB+kJ9s7EnRt4wILZNV3kPLHkRVfOc/HvhC3ovDw==",
"dev": true,
"license": "MIT"
},
@@ -60,6 +74,22 @@
"inherits": "2.0.3"
}
},
+ "node_modules/available-typed-arrays": {
+ "version": "1.0.7",
+ "resolved": "https://registry.npmjs.org/available-typed-arrays/-/available-typed-arrays-1.0.7.tgz",
+ "integrity": "sha512-wvUjBtSGN7+7SjNpq/9M2Tg350UZD3q62IFZLbRAR1bSMlCo1ZaeW+BJ+D090e4hIIZLBcTDWe4Mh4jvUDajzQ==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "possible-typed-array-names": "^1.0.0"
+ },
+ "engines": {
+ "node": ">= 0.4"
+ },
+ "funding": {
+ "url": "https://github.com/sponsors/ljharb"
+ }
+ },
"node_modules/base64-js": {
"version": "1.5.1",
"resolved": "https://registry.npmjs.org/base64-js/-/base64-js-1.5.1.tgz",
@@ -82,9 +112,9 @@
"license": "MIT"
},
"node_modules/bn.js": {
- "version": "5.2.1",
- "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-5.2.1.tgz",
- "integrity": "sha512-eXRvHzWyYPBuB4NBy0cmYQjGitUrtqwbvlzP3G6VFnNRbsZQIxQ10PbKKHt8gZ/HW/D/747aDl+QkDqg3KQLMQ==",
+ "version": "5.2.2",
+ "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-5.2.2.tgz",
+ "integrity": "sha512-v2YAxEmKaBLahNwE1mjp4WON6huMNeuDvagFZW+ASCuA/ku0bXR9hSMw0XpiqMoA3+rmnyck/tPRSFQkoC9Cuw==",
"dev": true,
"license": "MIT"
},
@@ -151,25 +181,24 @@
}
},
"node_modules/browserify-sign": {
- "version": "4.2.3",
- "resolved": "https://registry.npmjs.org/browserify-sign/-/browserify-sign-4.2.3.tgz",
- "integrity": "sha512-JWCZW6SKhfhjJxO8Tyiiy+XYB7cqd2S5/+WeYHsKdNKFlCBhKbblba1A/HN/90YwtxKc8tCErjffZl++UNmGiw==",
+ "version": "4.2.5",
+ "resolved": "https://registry.npmjs.org/browserify-sign/-/browserify-sign-4.2.5.tgz",
+ "integrity": "sha512-C2AUdAJg6rlM2W5QMp2Q4KGQMVBwR1lIimTsUnutJ8bMpW5B52pGpR2gEnNBNwijumDo5FojQ0L9JrXA8m4YEw==",
"dev": true,
"license": "ISC",
"dependencies": {
- "bn.js": "^5.2.1",
- "browserify-rsa": "^4.1.0",
+ "bn.js": "^5.2.2",
+ "browserify-rsa": "^4.1.1",
"create-hash": "^1.2.0",
"create-hmac": "^1.1.7",
- "elliptic": "^6.5.5",
- "hash-base": "~3.0",
+ "elliptic": "^6.6.1",
"inherits": "^2.0.4",
- "parse-asn1": "^5.1.7",
+ "parse-asn1": "^5.1.9",
"readable-stream": "^2.3.8",
"safe-buffer": "^5.2.1"
},
"engines": {
- "node": ">= 0.12"
+ "node": ">= 0.10"
}
},
"node_modules/browserify-zlib": {
@@ -235,9 +264,9 @@
}
},
"node_modules/call-bind-apply-helpers": {
- "version": "1.0.1",
- "resolved": "https://registry.npmjs.org/call-bind-apply-helpers/-/call-bind-apply-helpers-1.0.1.tgz",
- "integrity": "sha512-BhYE+WDaywFg2TBWYNXAE+8B1ATnThNBqXHP5nQu0jWJdVvY2hvkpyB3qOmtmDePiS5/BDQ8wASEWGMWRG148g==",
+ "version": "1.0.2",
+ "resolved": "https://registry.npmjs.org/call-bind-apply-helpers/-/call-bind-apply-helpers-1.0.2.tgz",
+ "integrity": "sha512-Sp1ablJ0ivDkSzjcaJdxEunN5/XvksFJ2sMBFfq6x0ryhQV/2b/KwFe21cMpmHtPOSij8K99/wSfoEuTObmuMQ==",
"dev": true,
"license": "MIT",
"dependencies": {
@@ -249,14 +278,14 @@
}
},
"node_modules/call-bound": {
- "version": "1.0.3",
- "resolved": "https://registry.npmjs.org/call-bound/-/call-bound-1.0.3.tgz",
- "integrity": "sha512-YTd+6wGlNlPxSuri7Y6X8tY2dmm12UMH66RpKMhiX6rsk5wXXnYgbUcOt8kiS31/AjfoTOvCsE+w8nZQLQnzHA==",
+ "version": "1.0.4",
+ "resolved": "https://registry.npmjs.org/call-bound/-/call-bound-1.0.4.tgz",
+ "integrity": "sha512-+ys997U96po4Kx/ABpBCqhA9EuxJaQWDQg7295H4hBphv3IZg0boBKuwYpt4YXp6MZ5AmZQnU/tyMTlRpaSejg==",
"dev": true,
"license": "MIT",
"dependencies": {
- "call-bind-apply-helpers": "^1.0.1",
- "get-intrinsic": "^1.2.6"
+ "call-bind-apply-helpers": "^1.0.2",
+ "get-intrinsic": "^1.3.0"
},
"engines": {
"node": ">= 0.4"
@@ -266,14 +295,15 @@
}
},
"node_modules/cipher-base": {
- "version": "1.0.6",
- "resolved": "https://registry.npmjs.org/cipher-base/-/cipher-base-1.0.6.tgz",
- "integrity": "sha512-3Ek9H3X6pj5TgenXYtNWdaBon1tgYCaebd+XPg0keyjEbEfkD4KkmAxkQ/i1vYvxdcT5nscLBfq9VJRmCBcFSw==",
+ "version": "1.0.7",
+ "resolved": "https://registry.npmjs.org/cipher-base/-/cipher-base-1.0.7.tgz",
+ "integrity": "sha512-Mz9QMT5fJe7bKI7MH31UilT5cEK5EHHRCccw/YRFsRY47AuNgaV6HY3rscp0/I4Q+tTW/5zoqpSeRRI54TkDWA==",
"dev": true,
"license": "MIT",
"dependencies": {
"inherits": "^2.0.4",
- "safe-buffer": "^5.2.1"
+ "safe-buffer": "^5.2.1",
+ "to-buffer": "^1.2.2"
},
"engines": {
"node": ">= 0.10"
@@ -292,6 +322,13 @@
"dev": true,
"license": "MIT"
},
+ "node_modules/core-js": {
+ "version": "1.2.7",
+ "resolved": "https://registry.npmjs.org/core-js/-/core-js-1.2.7.tgz",
+ "integrity": "sha512-ZiPp9pZlgxpWRu0M+YWbm6+aQ84XEfH1JRXvfOc/fILWI0VKhLC2LX13X1NYq4fULzLMq7Hfh43CSo2/aIaUPA==",
+ "deprecated": "core-js@<3.23.3 is no longer maintained and not recommended for usage due to the number of issues. Because of the V8 engine whims, feature detection in old core-js versions could cause a slowdown up to 100x even if nothing is polyfilled. Some versions have web compatibility issues. Please, upgrade your dependencies to the actual version of core-js.",
+ "license": "MIT"
+ },
"node_modules/core-util-is": {
"version": "1.0.3",
"resolved": "https://registry.npmjs.org/core-util-is/-/core-util-is-1.0.3.tgz",
@@ -311,9 +348,9 @@
}
},
"node_modules/create-ecdh/node_modules/bn.js": {
- "version": "4.12.1",
- "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.1.tgz",
- "integrity": "sha512-k8TVBiPkPJT9uHLdOKfFpqcfprwBFOAAXXozRubr7R7PfIuKvQlzcI4M0pALeqXN09vdaMbUdUj+pass+uULAg==",
+ "version": "4.12.2",
+ "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.2.tgz",
+ "integrity": "sha512-n4DSx829VRTRByMRGdjQ9iqsN0Bh4OolPsFnaZBLcbi8iXcB+kJ9s7EnRt4wILZNV3kPLHkRVfOc/HvhC3ovDw==",
"dev": true,
"license": "MIT"
},
@@ -346,6 +383,17 @@
"sha.js": "^2.4.8"
}
},
+ "node_modules/create-react-class": {
+ "version": "15.6.3",
+ "resolved": "https://registry.npmjs.org/create-react-class/-/create-react-class-15.6.3.tgz",
+ "integrity": "sha512-M+/3Q6E6DLO6Yx3OwrWjwHBnvfXXYA7W+dFjt/ZDBemHO1DDZhsalX/NUtnTYclN6GfnBDRh4qRHjcDHmlJBJg==",
+ "license": "MIT",
+ "dependencies": {
+ "fbjs": "^0.8.9",
+ "loose-envify": "^1.3.1",
+ "object-assign": "^4.1.1"
+ }
+ },
"node_modules/crypto-browserify": {
"version": "3.12.1",
"resolved": "https://registry.npmjs.org/crypto-browserify/-/crypto-browserify-3.12.1.tgz",
@@ -433,9 +481,9 @@
}
},
"node_modules/diffie-hellman/node_modules/bn.js": {
- "version": "4.12.1",
- "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.1.tgz",
- "integrity": "sha512-k8TVBiPkPJT9uHLdOKfFpqcfprwBFOAAXXozRubr7R7PfIuKvQlzcI4M0pALeqXN09vdaMbUdUj+pass+uULAg==",
+ "version": "4.12.2",
+ "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.2.tgz",
+ "integrity": "sha512-n4DSx829VRTRByMRGdjQ9iqsN0Bh4OolPsFnaZBLcbi8iXcB+kJ9s7EnRt4wILZNV3kPLHkRVfOc/HvhC3ovDw==",
"dev": true,
"license": "MIT"
},
@@ -482,12 +530,21 @@
}
},
"node_modules/elliptic/node_modules/bn.js": {
- "version": "4.12.1",
- "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.1.tgz",
- "integrity": "sha512-k8TVBiPkPJT9uHLdOKfFpqcfprwBFOAAXXozRubr7R7PfIuKvQlzcI4M0pALeqXN09vdaMbUdUj+pass+uULAg==",
+ "version": "4.12.2",
+ "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.2.tgz",
+ "integrity": "sha512-n4DSx829VRTRByMRGdjQ9iqsN0Bh4OolPsFnaZBLcbi8iXcB+kJ9s7EnRt4wILZNV3kPLHkRVfOc/HvhC3ovDw==",
"dev": true,
"license": "MIT"
},
+ "node_modules/encoding": {
+ "version": "0.1.13",
+ "resolved": "https://registry.npmjs.org/encoding/-/encoding-0.1.13.tgz",
+ "integrity": "sha512-ETBauow1T35Y/WZMkio9jiM0Z5xjHHmJ4XmjZOq1l/dXz3lr2sRn87nJy20RupqSh1F2m3HHPSp8ShIPQJrJ3A==",
+ "license": "MIT",
+ "dependencies": {
+ "iconv-lite": "^0.6.2"
+ }
+ },
"node_modules/es-define-property": {
"version": "1.0.1",
"resolved": "https://registry.npmjs.org/es-define-property/-/es-define-property-1.0.1.tgz",
@@ -542,6 +599,37 @@
"safe-buffer": "^5.1.1"
}
},
+ "node_modules/fbjs": {
+ "version": "0.8.18",
+ "resolved": "https://registry.npmjs.org/fbjs/-/fbjs-0.8.18.tgz",
+ "integrity": "sha512-EQaWFK+fEPSoibjNy8IxUtaFOMXcWsY0JaVrQoZR9zC8N2Ygf9iDITPWjUTVIax95b6I742JFLqASHfsag/vKA==",
+ "license": "MIT",
+ "dependencies": {
+ "core-js": "^1.0.0",
+ "isomorphic-fetch": "^2.1.1",
+ "loose-envify": "^1.0.0",
+ "object-assign": "^4.1.0",
+ "promise": "^7.1.1",
+ "setimmediate": "^1.0.5",
+ "ua-parser-js": "^0.7.30"
+ }
+ },
+ "node_modules/for-each": {
+ "version": "0.3.5",
+ "resolved": "https://registry.npmjs.org/for-each/-/for-each-0.3.5.tgz",
+ "integrity": "sha512-dKx12eRCVIzqCxFGplyFKJMPvLEWgmNtUrpTiJIR5u97zEhRG8ySrtboPHZXx7daLxQVrl643cTzbab2tkQjxg==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "is-callable": "^1.2.7"
+ },
+ "engines": {
+ "node": ">= 0.4"
+ },
+ "funding": {
+ "url": "https://github.com/sponsors/ljharb"
+ }
+ },
"node_modules/function-bind": {
"version": "1.1.2",
"resolved": "https://registry.npmjs.org/function-bind/-/function-bind-1.1.2.tgz",
@@ -553,18 +641,18 @@
}
},
"node_modules/get-intrinsic": {
- "version": "1.2.7",
- "resolved": "https://registry.npmjs.org/get-intrinsic/-/get-intrinsic-1.2.7.tgz",
- "integrity": "sha512-VW6Pxhsrk0KAOqs3WEd0klDiF/+V7gQOpAvY1jVU/LHmaD/kQO4523aiJuikX/QAKYiW6x8Jh+RJej1almdtCA==",
+ "version": "1.3.0",
+ "resolved": "https://registry.npmjs.org/get-intrinsic/-/get-intrinsic-1.3.0.tgz",
+ "integrity": "sha512-9fSjSaos/fRIVIp+xSJlE6lfwhES7LNtKaCBIamHsjr2na1BiABJPo0mOjjz8GJDURarmCPGqaiVg5mfjb98CQ==",
"dev": true,
"license": "MIT",
"dependencies": {
- "call-bind-apply-helpers": "^1.0.1",
+ "call-bind-apply-helpers": "^1.0.2",
"es-define-property": "^1.0.1",
"es-errors": "^1.3.0",
- "es-object-atoms": "^1.0.0",
+ "es-object-atoms": "^1.1.1",
"function-bind": "^1.1.2",
- "get-proto": "^1.0.0",
+ "get-proto": "^1.0.1",
"gopd": "^1.2.0",
"has-symbols": "^1.1.0",
"hasown": "^2.0.2",
@@ -630,6 +718,22 @@
"url": "https://github.com/sponsors/ljharb"
}
},
+ "node_modules/has-tostringtag": {
+ "version": "1.0.2",
+ "resolved": "https://registry.npmjs.org/has-tostringtag/-/has-tostringtag-1.0.2.tgz",
+ "integrity": "sha512-NqADB8VjPFLM2V0VvHUewwwsw0ZWBaIdgo+ieHtK3hasLz4qeCRjYcqfB6AQrBggRKppKF8L52/VqdVsO47Dlw==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "has-symbols": "^1.0.3"
+ },
+ "engines": {
+ "node": ">= 0.4"
+ },
+ "funding": {
+ "url": "https://github.com/sponsors/ljharb"
+ }
+ },
"node_modules/hash-base": {
"version": "3.0.5",
"resolved": "https://registry.npmjs.org/hash-base/-/hash-base-3.0.5.tgz",
@@ -668,6 +772,16 @@
"node": ">= 0.4"
}
},
+ "node_modules/highlight.js": {
+ "version": "10.7.3",
+ "resolved": "https://registry.npmjs.org/highlight.js/-/highlight.js-10.7.3.tgz",
+ "integrity": "sha512-tzcUFauisWKNHaRkN4Wjl/ZA07gENAjFl3J/c480dprkGTg5EQstgaNFqBfUqCq54kZRIEcreTsAgF/m2quD7A==",
+ "dev": true,
+ "license": "BSD-3-Clause",
+ "engines": {
+ "node": "*"
+ }
+ },
"node_modules/hmac-drbg": {
"version": "1.0.1",
"resolved": "https://registry.npmjs.org/hmac-drbg/-/hmac-drbg-1.0.1.tgz",
@@ -687,6 +801,18 @@
"dev": true,
"license": "MIT"
},
+ "node_modules/iconv-lite": {
+ "version": "0.6.3",
+ "resolved": "https://registry.npmjs.org/iconv-lite/-/iconv-lite-0.6.3.tgz",
+ "integrity": "sha512-4fCk79wshMdzMp2rH06qWrJE4iolqLhCUH+OiuIgU++RB0+94NlDL81atO7GX55uUKueo0txHNtvEyI6D7WdMw==",
+ "license": "MIT",
+ "dependencies": {
+ "safer-buffer": ">= 2.1.2 < 3.0.0"
+ },
+ "engines": {
+ "node": ">=0.10.0"
+ }
+ },
"node_modules/ieee754": {
"version": "1.2.1",
"resolved": "https://registry.npmjs.org/ieee754/-/ieee754-1.2.1.tgz",
@@ -715,6 +841,44 @@
"dev": true,
"license": "ISC"
},
+ "node_modules/is-callable": {
+ "version": "1.2.7",
+ "resolved": "https://registry.npmjs.org/is-callable/-/is-callable-1.2.7.tgz",
+ "integrity": "sha512-1BC0BVFhS/p0qtw6enp8e+8OD0UrK0oFLztSjNzhcKA3WDuJxxAPXzPuPtKkjEY9UUoEWlX/8fgKeu2S8i9JTA==",
+ "dev": true,
+ "license": "MIT",
+ "engines": {
+ "node": ">= 0.4"
+ },
+ "funding": {
+ "url": "https://github.com/sponsors/ljharb"
+ }
+ },
+ "node_modules/is-stream": {
+ "version": "1.1.0",
+ "resolved": "https://registry.npmjs.org/is-stream/-/is-stream-1.1.0.tgz",
+ "integrity": "sha512-uQPm8kcs47jx38atAcWTVxyltQYoPT68y9aWYdV6yWXSyW8mzSat0TL6CiWdZeCdF3KrAvpVtnHbTv4RN+rqdQ==",
+ "license": "MIT",
+ "engines": {
+ "node": ">=0.10.0"
+ }
+ },
+ "node_modules/is-typed-array": {
+ "version": "1.1.15",
+ "resolved": "https://registry.npmjs.org/is-typed-array/-/is-typed-array-1.1.15.tgz",
+ "integrity": "sha512-p3EcsicXjit7SaskXHs1hA91QxgTw46Fv6EFKKGS5DRFLD8yKnohjF3hxoju94b/OcMZoQukzpPpBE9uLVKzgQ==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "which-typed-array": "^1.1.16"
+ },
+ "engines": {
+ "node": ">= 0.4"
+ },
+ "funding": {
+ "url": "https://github.com/sponsors/ljharb"
+ }
+ },
"node_modules/isarray": {
"version": "1.0.0",
"resolved": "https://registry.npmjs.org/isarray/-/isarray-1.0.0.tgz",
@@ -729,6 +893,47 @@
"dev": true,
"license": "ISC"
},
+ "node_modules/isomorphic-fetch": {
+ "version": "2.2.1",
+ "resolved": "https://registry.npmjs.org/isomorphic-fetch/-/isomorphic-fetch-2.2.1.tgz",
+ "integrity": "sha512-9c4TNAKYXM5PRyVcwUZrF3W09nQ+sO7+jydgs4ZGW9dhsLG2VOlISJABombdQqQRXCwuYG3sYV/puGf5rp0qmA==",
+ "license": "MIT",
+ "dependencies": {
+ "node-fetch": "^1.0.1",
+ "whatwg-fetch": ">=0.10.0"
+ }
+ },
+ "node_modules/js-tokens": {
+ "version": "4.0.0",
+ "resolved": "https://registry.npmjs.org/js-tokens/-/js-tokens-4.0.0.tgz",
+ "integrity": "sha512-RdJUflcE3cUzKiMqQgsCu06FPu9UdIJO0beYbPhHN4k6apgJtifcoCtT9bcxOpYBtpD2kCM6Sbzg4CausW/PKQ==",
+ "license": "MIT"
+ },
+ "node_modules/loose-envify": {
+ "version": "1.4.0",
+ "resolved": "https://registry.npmjs.org/loose-envify/-/loose-envify-1.4.0.tgz",
+ "integrity": "sha512-lyuxPGr/Wfhrlem2CL/UcnUc1zcqKAImBDzukY7Y5F/yQiNdko6+fRLevlw1HgMySw7f611UIY408EtxRSoK3Q==",
+ "license": "MIT",
+ "dependencies": {
+ "js-tokens": "^3.0.0 || ^4.0.0"
+ },
+ "bin": {
+ "loose-envify": "cli.js"
+ }
+ },
+ "node_modules/marked": {
+ "version": "2.1.3",
+ "resolved": "https://registry.npmjs.org/marked/-/marked-2.1.3.tgz",
+ "integrity": "sha512-/Q+7MGzaETqifOMWYEA7HVMaZb4XbcRfaOzcSsHZEith83KGlvaSG33u0SKu89Mj5h+T8V2hM+8O45Qc5XTgwA==",
+ "dev": true,
+ "license": "MIT",
+ "bin": {
+ "marked": "bin/marked"
+ },
+ "engines": {
+ "node": ">= 10"
+ }
+ },
"node_modules/math-intrinsics": {
"version": "1.1.0",
"resolved": "https://registry.npmjs.org/math-intrinsics/-/math-intrinsics-1.1.0.tgz",
@@ -766,9 +971,9 @@
}
},
"node_modules/miller-rabin/node_modules/bn.js": {
- "version": "4.12.1",
- "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.1.tgz",
- "integrity": "sha512-k8TVBiPkPJT9uHLdOKfFpqcfprwBFOAAXXozRubr7R7PfIuKvQlzcI4M0pALeqXN09vdaMbUdUj+pass+uULAg==",
+ "version": "4.12.2",
+ "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.2.tgz",
+ "integrity": "sha512-n4DSx829VRTRByMRGdjQ9iqsN0Bh4OolPsFnaZBLcbi8iXcB+kJ9s7EnRt4wILZNV3kPLHkRVfOc/HvhC3ovDw==",
"dev": true,
"license": "MIT"
},
@@ -786,6 +991,16 @@
"dev": true,
"license": "MIT"
},
+ "node_modules/node-fetch": {
+ "version": "1.7.3",
+ "resolved": "https://registry.npmjs.org/node-fetch/-/node-fetch-1.7.3.tgz",
+ "integrity": "sha512-NhZ4CsKx7cYm2vSrBAr2PvFOe6sWDf0UYLRqA6svUYg7+/TSfVAu49jYC4BvQ4Sms9SZgdqGBgroqfDhJdTyKQ==",
+ "license": "MIT",
+ "dependencies": {
+ "encoding": "^0.1.11",
+ "is-stream": "^1.0.1"
+ }
+ },
"node_modules/node-libs-browser": {
"version": "2.2.1",
"resolved": "https://registry.npmjs.org/node-libs-browser/-/node-libs-browser-2.2.1.tgz",
@@ -818,10 +1033,19 @@
"vm-browserify": "^1.0.1"
}
},
+ "node_modules/object-assign": {
+ "version": "4.1.1",
+ "resolved": "https://registry.npmjs.org/object-assign/-/object-assign-4.1.1.tgz",
+ "integrity": "sha512-rJgTQnkUnH1sFw8yT6VSU3zD3sWmu6sZhIseY8VX+GRu3P6F7Fu+JNDoXfklElbLJSnc3FUQHVe4cU5hj+BcUg==",
+ "license": "MIT",
+ "engines": {
+ "node": ">=0.10.0"
+ }
+ },
"node_modules/object-inspect": {
- "version": "1.13.3",
- "resolved": "https://registry.npmjs.org/object-inspect/-/object-inspect-1.13.3.tgz",
- "integrity": "sha512-kDCGIbxkDSXE3euJZZXzc6to7fCrKHNI/hSRQnRuQ+BWjFNzZwiFF8fj/6o2t2G9/jTj8PSIYTfCLelLZEeRpA==",
+ "version": "1.13.4",
+ "resolved": "https://registry.npmjs.org/object-inspect/-/object-inspect-1.13.4.tgz",
+ "integrity": "sha512-W67iLl4J2EXEGTbfeHCffrjDfitvLANg0UlX3wFUUSTx92KXRFegMHUVgSqE+wvhAbi4WqjGg9czysTV2Epbew==",
"dev": true,
"license": "MIT",
"engines": {
@@ -877,17 +1101,16 @@
"license": "(MIT AND Zlib)"
},
"node_modules/parse-asn1": {
- "version": "5.1.7",
- "resolved": "https://registry.npmjs.org/parse-asn1/-/parse-asn1-5.1.7.tgz",
- "integrity": "sha512-CTM5kuWR3sx9IFamcl5ErfPl6ea/N8IYwiJ+vpeB2g+1iknv7zBl5uPwbMbRVznRVbrNY6lGuDoE5b30grmbqg==",
+ "version": "5.1.9",
+ "resolved": "https://registry.npmjs.org/parse-asn1/-/parse-asn1-5.1.9.tgz",
+ "integrity": "sha512-fIYNuZ/HastSb80baGOuPRo1O9cf4baWw5WsAp7dBuUzeTD/BoaG8sVTdlPFksBE2lF21dN+A1AnrpIjSWqHHg==",
"dev": true,
"license": "ISC",
"dependencies": {
"asn1.js": "^4.10.1",
"browserify-aes": "^1.2.0",
"evp_bytestokey": "^1.0.3",
- "hash-base": "~3.0",
- "pbkdf2": "^3.1.2",
+ "pbkdf2": "^3.1.5",
"safe-buffer": "^5.2.1"
},
"engines": {
@@ -902,20 +1125,31 @@
"license": "MIT"
},
"node_modules/pbkdf2": {
- "version": "3.1.2",
- "resolved": "https://registry.npmjs.org/pbkdf2/-/pbkdf2-3.1.2.tgz",
- "integrity": "sha512-iuh7L6jA7JEGu2WxDwtQP1ddOpaJNC4KlDEFfdQajSGgGPNi4OyDc2R7QnbY2bR9QjBVGwgvTdNJZoE7RaxUMA==",
+ "version": "3.1.5",
+ "resolved": "https://registry.npmjs.org/pbkdf2/-/pbkdf2-3.1.5.tgz",
+ "integrity": "sha512-Q3CG/cYvCO1ye4QKkuH7EXxs3VC/rI1/trd+qX2+PolbaKG0H+bgcZzrTt96mMyRtejk+JMCiLUn3y29W8qmFQ==",
"dev": true,
"license": "MIT",
"dependencies": {
- "create-hash": "^1.1.2",
- "create-hmac": "^1.1.4",
- "ripemd160": "^2.0.1",
- "safe-buffer": "^5.0.1",
- "sha.js": "^2.4.8"
+ "create-hash": "^1.2.0",
+ "create-hmac": "^1.1.7",
+ "ripemd160": "^2.0.3",
+ "safe-buffer": "^5.2.1",
+ "sha.js": "^2.4.12",
+ "to-buffer": "^1.2.1"
},
"engines": {
- "node": ">=0.12"
+ "node": ">= 0.10"
+ }
+ },
+ "node_modules/possible-typed-array-names": {
+ "version": "1.1.0",
+ "resolved": "https://registry.npmjs.org/possible-typed-array-names/-/possible-typed-array-names-1.1.0.tgz",
+ "integrity": "sha512-/+5VFTchJDoVj3bhoqi6UeymcD00DAwb1nJwamzPvHEszJ4FpF6SNNbUbOS8yI56qHzdV8eK0qEfOSiodkTdxg==",
+ "dev": true,
+ "license": "MIT",
+ "engines": {
+ "node": ">= 0.4"
}
},
"node_modules/process": {
@@ -935,6 +1169,26 @@
"dev": true,
"license": "MIT"
},
+ "node_modules/promise": {
+ "version": "7.3.1",
+ "resolved": "https://registry.npmjs.org/promise/-/promise-7.3.1.tgz",
+ "integrity": "sha512-nolQXZ/4L+bP/UGlkfaIujX9BKxGwmQ9OT4mOt5yvy8iK1h3wqTEJCijzGANTCCl9nWjY41juyAn2K3Q1hLLTg==",
+ "license": "MIT",
+ "dependencies": {
+ "asap": "~2.0.3"
+ }
+ },
+ "node_modules/prop-types": {
+ "version": "15.8.1",
+ "resolved": "https://registry.npmjs.org/prop-types/-/prop-types-15.8.1.tgz",
+ "integrity": "sha512-oj87CgZICdulUohogVAR7AjlC0327U4el4L6eAvOqCeudMDVU0NThNaV+b9Df4dXgSP1gXMTnPdhfe/2qDH5cg==",
+ "license": "MIT",
+ "dependencies": {
+ "loose-envify": "^1.4.0",
+ "object-assign": "^4.1.1",
+ "react-is": "^16.13.1"
+ }
+ },
"node_modules/public-encrypt": {
"version": "4.0.3",
"resolved": "https://registry.npmjs.org/public-encrypt/-/public-encrypt-4.0.3.tgz",
@@ -951,9 +1205,9 @@
}
},
"node_modules/public-encrypt/node_modules/bn.js": {
- "version": "4.12.1",
- "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.1.tgz",
- "integrity": "sha512-k8TVBiPkPJT9uHLdOKfFpqcfprwBFOAAXXozRubr7R7PfIuKvQlzcI4M0pALeqXN09vdaMbUdUj+pass+uULAg==",
+ "version": "4.12.2",
+ "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.2.tgz",
+ "integrity": "sha512-n4DSx829VRTRByMRGdjQ9iqsN0Bh4OolPsFnaZBLcbi8iXcB+kJ9s7EnRt4wILZNV3kPLHkRVfOc/HvhC3ovDw==",
"dev": true,
"license": "MIT"
},
@@ -1010,6 +1264,68 @@
"safe-buffer": "^5.1.0"
}
},
+ "node_modules/react": {
+ "version": "16.13.1",
+ "resolved": "https://registry.npmjs.org/react/-/react-16.13.1.tgz",
+ "integrity": "sha512-YMZQQq32xHLX0bz5Mnibv1/LHb3Sqzngu7xstSM+vrkE5Kzr9xE0yMByK5kMoTK30YVJE61WfbxIFFvfeDKT1w==",
+ "license": "MIT",
+ "dependencies": {
+ "loose-envify": "^1.1.0",
+ "object-assign": "^4.1.1",
+ "prop-types": "^15.6.2"
+ },
+ "engines": {
+ "node": ">=0.10.0"
+ }
+ },
+ "node_modules/react-dom": {
+ "version": "16.13.1",
+ "resolved": "https://registry.npmjs.org/react-dom/-/react-dom-16.13.1.tgz",
+ "integrity": "sha512-81PIMmVLnCNLO/fFOQxdQkvEq/+Hfpv24XNJfpyZhTRfO0QcmQIF/PgCa1zCOj2w1hrn12MFLyaJ/G0+Mxtfag==",
+ "license": "MIT",
+ "dependencies": {
+ "loose-envify": "^1.1.0",
+ "object-assign": "^4.1.1",
+ "prop-types": "^15.6.2",
+ "scheduler": "^0.19.1"
+ },
+ "peerDependencies": {
+ "react": "^16.13.1"
+ }
+ },
+ "node_modules/react-highlight.js": {
+ "version": "1.0.7",
+ "resolved": "https://registry.npmjs.org/react-highlight.js/-/react-highlight.js-1.0.7.tgz",
+ "integrity": "sha512-OVPKnV0ZvU+V//HExwbV8M9CWy49Eo/9y9pBN2OsNWUFPN6dE4YZBLmJW/5sM2DxI5v/QQLyxOnTnSSfGCP+9Q==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "highlight.js": "^9.3.0",
+ "prop-types": "^15.6.0"
+ },
+ "peerDependencies": {
+ "react": "^0.14.0 || ^15.0.0 || ^16.0.0",
+ "react-dom": "^0.14.0 || ^15.0.0 || ^16.0.0"
+ }
+ },
+ "node_modules/react-highlight.js/node_modules/highlight.js": {
+ "version": "9.18.5",
+ "resolved": "https://registry.npmjs.org/highlight.js/-/highlight.js-9.18.5.tgz",
+ "integrity": "sha512-a5bFyofd/BHCX52/8i8uJkjr9DYwXIPnM/plwI6W7ezItLGqzt7X2G2nXuYSfsIJdkwwj/g9DG1LkcGJI/dDoA==",
+ "deprecated": "Support has ended for 9.x series. Upgrade to @latest",
+ "dev": true,
+ "hasInstallScript": true,
+ "license": "BSD-3-Clause",
+ "engines": {
+ "node": "*"
+ }
+ },
+ "node_modules/react-is": {
+ "version": "16.13.1",
+ "resolved": "https://registry.npmjs.org/react-is/-/react-is-16.13.1.tgz",
+ "integrity": "sha512-24e6ynE2H+OKt4kqsOvNd8kBpV65zoxbA4BVsEOB3ARVWQki/DHzaUoC5KuON/BiccDaCCTZBuOcfZs70kR8bQ==",
+ "license": "MIT"
+ },
"node_modules/readable-stream": {
"version": "2.3.8",
"resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.8.tgz",
@@ -1054,14 +1370,33 @@
}
},
"node_modules/ripemd160": {
- "version": "2.0.2",
- "resolved": "https://registry.npmjs.org/ripemd160/-/ripemd160-2.0.2.tgz",
- "integrity": "sha512-ii4iagi25WusVoiC4B4lq7pbXfAp3D9v5CwfkY33vffw2+pkDjY1D8GaN7spsxvCSx8dkPqOZCEZyfxcmJG2IA==",
+ "version": "2.0.3",
+ "resolved": "https://registry.npmjs.org/ripemd160/-/ripemd160-2.0.3.tgz",
+ "integrity": "sha512-5Di9UC0+8h1L6ZD2d7awM7E/T4uA1fJRlx6zk/NvdCCVEoAnFqvHmCuNeIKoCeIixBX/q8uM+6ycDvF8woqosA==",
"dev": true,
"license": "MIT",
"dependencies": {
- "hash-base": "^3.0.0",
- "inherits": "^2.0.1"
+ "hash-base": "^3.1.2",
+ "inherits": "^2.0.4"
+ },
+ "engines": {
+ "node": ">= 0.8"
+ }
+ },
+ "node_modules/ripemd160/node_modules/hash-base": {
+ "version": "3.1.2",
+ "resolved": "https://registry.npmjs.org/hash-base/-/hash-base-3.1.2.tgz",
+ "integrity": "sha512-Bb33KbowVTIj5s7Ked1OsqHUeCpz//tPwR+E2zJgJKo9Z5XolZ9b6bdUgjmYlwnWhoOQKoTd1TYToZGn5mAYOg==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "inherits": "^2.0.4",
+ "readable-stream": "^2.3.8",
+ "safe-buffer": "^5.2.1",
+ "to-buffer": "^1.2.1"
+ },
+ "engines": {
+ "node": ">= 0.8"
}
},
"node_modules/safe-buffer": {
@@ -1085,6 +1420,22 @@
],
"license": "MIT"
},
+ "node_modules/safer-buffer": {
+ "version": "2.1.2",
+ "resolved": "https://registry.npmjs.org/safer-buffer/-/safer-buffer-2.1.2.tgz",
+ "integrity": "sha512-YZo3K82SD7Riyi0E1EQPojLz7kpepnSQI9IyPbHHg1XXXevb5dJI7tpyN2ADxGcQbHG7vcyRHk0cbwqcQriUtg==",
+ "license": "MIT"
+ },
+ "node_modules/scheduler": {
+ "version": "0.19.1",
+ "resolved": "https://registry.npmjs.org/scheduler/-/scheduler-0.19.1.tgz",
+ "integrity": "sha512-n/zwRWRYSUj0/3g/otKDRPMh6qv2SYMWNq85IEa8iZyAv8od9zDYpGSnpBEjNgcMNq6Scbu5KfIPxNF72R/2EA==",
+ "license": "MIT",
+ "dependencies": {
+ "loose-envify": "^1.1.0",
+ "object-assign": "^4.1.1"
+ }
+ },
"node_modules/set-function-length": {
"version": "1.2.2",
"resolved": "https://registry.npmjs.org/set-function-length/-/set-function-length-1.2.2.tgz",
@@ -1107,27 +1458,33 @@
"version": "1.0.5",
"resolved": "https://registry.npmjs.org/setimmediate/-/setimmediate-1.0.5.tgz",
"integrity": "sha512-MATJdZp8sLqDl/68LfQmbP8zKPLQNV6BIZoIgrscFDQ+RsvK/BxeDQOgyxKKoh0y/8h3BqVFnCqQ/gd+reiIXA==",
- "dev": true,
"license": "MIT"
},
"node_modules/sha.js": {
- "version": "2.4.11",
- "resolved": "https://registry.npmjs.org/sha.js/-/sha.js-2.4.11.tgz",
- "integrity": "sha512-QMEp5B7cftE7APOjk5Y6xgrbWu+WkLVQwk8JNjZ8nKRciZaByEW6MubieAiToS7+dwvrjGhH8jRXz3MVd0AYqQ==",
+ "version": "2.4.12",
+ "resolved": "https://registry.npmjs.org/sha.js/-/sha.js-2.4.12.tgz",
+ "integrity": "sha512-8LzC5+bvI45BjpfXU8V5fdU2mfeKiQe1D1gIMn7XUlF3OTUrpdJpPPH4EMAnF0DsHHdSZqCdSss5qCmJKuiO3w==",
"dev": true,
"license": "(MIT AND BSD-3-Clause)",
"dependencies": {
- "inherits": "^2.0.1",
- "safe-buffer": "^5.0.1"
+ "inherits": "^2.0.4",
+ "safe-buffer": "^5.2.1",
+ "to-buffer": "^1.2.0"
},
"bin": {
"sha.js": "bin.js"
+ },
+ "engines": {
+ "node": ">= 0.10"
+ },
+ "funding": {
+ "url": "https://github.com/sponsors/ljharb"
}
},
"node_modules/shadow-cljs": {
- "version": "2.28.20",
- "resolved": "https://registry.npmjs.org/shadow-cljs/-/shadow-cljs-2.28.20.tgz",
- "integrity": "sha512-Q9N+aw2suSUZ6vmWhZupl0rkyjoYrnpU1WbMrNrbuUiKE6XjvT1vcBkTUrqkMJEPraV7u+H9b5d/RcKnj8nbhg==",
+ "version": "2.28.23",
+ "resolved": "https://registry.npmjs.org/shadow-cljs/-/shadow-cljs-2.28.23.tgz",
+ "integrity": "sha512-SM7LeLctZLLCm6Y3NxWOH4GvHqHDZ6Jz9bUgfpJrk1jMADqIp3rliD6Rrd12gLX2b9/oEh6UyD7X+yw6O1++sw==",
"dev": true,
"license": "ISC",
"dependencies": {
@@ -1324,6 +1681,28 @@
"dev": true,
"license": "MIT"
},
+ "node_modules/to-buffer": {
+ "version": "1.2.2",
+ "resolved": "https://registry.npmjs.org/to-buffer/-/to-buffer-1.2.2.tgz",
+ "integrity": "sha512-db0E3UJjcFhpDhAF4tLo03oli3pwl3dbnzXOUIlRKrp+ldk/VUxzpWYZENsw2SZiuBjHAk7DfB0VU7NKdpb6sw==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "isarray": "^2.0.5",
+ "safe-buffer": "^5.2.1",
+ "typed-array-buffer": "^1.0.3"
+ },
+ "engines": {
+ "node": ">= 0.4"
+ }
+ },
+ "node_modules/to-buffer/node_modules/isarray": {
+ "version": "2.0.5",
+ "resolved": "https://registry.npmjs.org/isarray/-/isarray-2.0.5.tgz",
+ "integrity": "sha512-xHjhDr3cNBK0BzdUJSPXZntQUx/mwMS5Rw4A7lPJ90XGAO6ISP/ePDNuo0vhqOZU+UD5JoodwCAAoZQd3FeAKw==",
+ "dev": true,
+ "license": "MIT"
+ },
"node_modules/tty-browserify": {
"version": "0.0.0",
"resolved": "https://registry.npmjs.org/tty-browserify/-/tty-browserify-0.0.0.tgz",
@@ -1331,6 +1710,47 @@
"dev": true,
"license": "MIT"
},
+ "node_modules/typed-array-buffer": {
+ "version": "1.0.3",
+ "resolved": "https://registry.npmjs.org/typed-array-buffer/-/typed-array-buffer-1.0.3.tgz",
+ "integrity": "sha512-nAYYwfY3qnzX30IkA6AQZjVbtK6duGontcQm1WSG1MD94YLqK0515GNApXkoxKOWMusVssAHWLh9SeaoefYFGw==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "call-bound": "^1.0.3",
+ "es-errors": "^1.3.0",
+ "is-typed-array": "^1.1.14"
+ },
+ "engines": {
+ "node": ">= 0.4"
+ }
+ },
+ "node_modules/ua-parser-js": {
+ "version": "0.7.41",
+ "resolved": "https://registry.npmjs.org/ua-parser-js/-/ua-parser-js-0.7.41.tgz",
+ "integrity": "sha512-O3oYyCMPYgNNHuO7Jjk3uacJWZF8loBgwrfd/5LE/HyZ3lUIOdniQ7DNXJcIgZbwioZxk0fLfI4EVnetdiX5jg==",
+ "funding": [
+ {
+ "type": "opencollective",
+ "url": "https://opencollective.com/ua-parser-js"
+ },
+ {
+ "type": "paypal",
+ "url": "https://paypal.me/faisalman"
+ },
+ {
+ "type": "github",
+ "url": "https://github.com/sponsors/faisalman"
+ }
+ ],
+ "license": "MIT",
+ "bin": {
+ "ua-parser-js": "script/cli.js"
+ },
+ "engines": {
+ "node": "*"
+ }
+ },
"node_modules/url": {
"version": "0.11.4",
"resolved": "https://registry.npmjs.org/url/-/url-0.11.4.tgz",
@@ -1376,6 +1796,12 @@
"dev": true,
"license": "MIT"
},
+ "node_modules/whatwg-fetch": {
+ "version": "3.6.20",
+ "resolved": "https://registry.npmjs.org/whatwg-fetch/-/whatwg-fetch-3.6.20.tgz",
+ "integrity": "sha512-EqhiFU6daOA8kpjOWTL0olhVOF3i7OrFzSYiGsEMB8GcXS+RrzauAERX65xMeNWVqxA6HXH2m69Z9LaKKdisfg==",
+ "license": "MIT"
+ },
"node_modules/which": {
"version": "1.3.1",
"resolved": "https://registry.npmjs.org/which/-/which-1.3.1.tgz",
@@ -1389,6 +1815,28 @@
"which": "bin/which"
}
},
+ "node_modules/which-typed-array": {
+ "version": "1.1.19",
+ "resolved": "https://registry.npmjs.org/which-typed-array/-/which-typed-array-1.1.19.tgz",
+ "integrity": "sha512-rEvr90Bck4WZt9HHFC4DJMsjvu7x+r6bImz0/BrbWb7A2djJ8hnZMrWnHo9F8ssv0OMErasDhftrfROTyqSDrw==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "available-typed-arrays": "^1.0.7",
+ "call-bind": "^1.0.8",
+ "call-bound": "^1.0.4",
+ "for-each": "^0.3.5",
+ "get-proto": "^1.0.1",
+ "gopd": "^1.2.0",
+ "has-tostringtag": "^1.0.2"
+ },
+ "engines": {
+ "node": ">= 0.4"
+ },
+ "funding": {
+ "url": "https://github.com/sponsors/ljharb"
+ }
+ },
"node_modules/ws": {
"version": "7.5.10",
"resolved": "https://registry.npmjs.org/ws/-/ws-7.5.10.tgz",
diff --git a/package.json b/package.json
index 8fa9ebc..4567b44 100644
--- a/package.json
+++ b/package.json
@@ -4,12 +4,20 @@
"license": "MIT",
"scripts": {},
"private": true,
- "description": "Core functions for Hephaistox project",
+ "description": "Simulation functions for Hephaistox project",
"version": "0.0.1",
"author": "Hephaistox ",
"workspaces": [],
"devDependencies": {
+ "highlight.js": "^10.6.0",
+ "marked": "^2.0.1",
+ "react-highlight.js": "^1.0.7",
"shadow-cljs": "^2.28.20",
"source-map-support": "^0.5.21"
+ },
+ "dependencies": {
+ "create-react-class": "15.6.3",
+ "react": "16.13.1",
+ "react-dom": "16.13.1"
}
}
diff --git a/resources/public/simulation/machine.svg b/resources/public/simulation/machine.svg
new file mode 100644
index 0000000..ffcf7a0
--- /dev/null
+++ b/resources/public/simulation/machine.svg
@@ -0,0 +1,121 @@
+
+
+
+
\ No newline at end of file
diff --git a/resources/public/simulation/product.svg b/resources/public/simulation/product.svg
new file mode 100644
index 0000000..7665e56
--- /dev/null
+++ b/resources/public/simulation/product.svg
@@ -0,0 +1,17 @@
+
+
+
\ No newline at end of file
diff --git a/resources/public/simulation/sink.svg b/resources/public/simulation/sink.svg
new file mode 100644
index 0000000..57a70a8
--- /dev/null
+++ b/resources/public/simulation/sink.svg
@@ -0,0 +1,2 @@
+
+
\ No newline at end of file
diff --git a/resources/public/simulation/source.svg b/resources/public/simulation/source.svg
new file mode 100644
index 0000000..8c84b34
--- /dev/null
+++ b/resources/public/simulation/source.svg
@@ -0,0 +1,2 @@
+
+
\ No newline at end of file
diff --git a/resources/public/simulation/workshop.css b/resources/public/simulation/workshop.css
new file mode 100644
index 0000000..fd37b65
--- /dev/null
+++ b/resources/public/simulation/workshop.css
@@ -0,0 +1,4 @@
+@keyframes example {
+ from {left: 10em; top: 0px;}
+ to {left: 40em; top: 0px;}
+}
diff --git a/shadow-cljs.edn b/shadow-cljs.edn
index d602572..b5165b0 100644
--- a/shadow-cljs.edn
+++ b/shadow-cljs.edn
@@ -1,11 +1,29 @@
-{:builds {:browser-test {:ns-regexp "-test$"
- :runner-ns shadow.test.browser
- :target :browser-test
- :test-dir "tmp/browser-test"}
- :ltest {:autorun true
- :ns-regexp "-test$"
- :output-to "tmp/ltest.js"
- :target :node-test}}
+{:builds
+ {:browser-test {:ns-regexp "-test$"
+ :runner-ns shadow.test.browser
+ :target :browser-test
+ :test-dir "target/browser-test"}
+ :devcards {:target :browser-test
+ :ns-regexp "-cards$"
+ :test-dir "target/devcards"
+ :runner-ns auto-sim.devcards ; must have init fn to run
+ :devtools {:http-root "env/devcards/resources"
+ :index-page "cards.html"
+ :preloads [re-frisk.preload]}
+ :compiler-options {:devcards true
+ :infer-externs true
+ :output-feature-set :es8}
+ :js-options {:resolve {"devcards-marked" {:require "marked"
+ :target :npm}
+ "devcards-syntax-highlighter" {:require "highlight.js"
+ :target :npm}}}}
+ :ltest {:autorun true
+ :ns-regexp "-test$"
+ :output-to "target/ltest.js"
+ :target :node-test}}
:deps {:aliases [:cljs-deps]}
- :dev-http {8290 ["tmp/browser-test"]}
+ :dev-http
+ {3002
+ ["env/devcards/resources" "target/devcards" "resources/public" "../auto_web/resources/public"]
+ 8290 ["target/browser-test"]}
:nrepl {:port 7002}}
diff --git a/src/cljc/auto_sim/component/speed.cljc b/src/cljc/auto_sim/component/speed.cljc
new file mode 100644
index 0000000..ce81cfe
--- /dev/null
+++ b/src/cljc/auto_sim/component/speed.cljc
@@ -0,0 +1,42 @@
+(ns auto-sim.component.speed
+ "Speed controls the animation time"
+ (:require
+ [auto-sim :as-alias sim]
+ [auto-web.page.builder :refer [merge-opts]]))
+
+(defn- index-of
+ [v target*]
+ (some (fn [[idx val]] (when (= val target*) idx)) (map-indexed vector v)))
+
+(defn- clamp-idx
+ [idx n]
+ (some-> idx
+ (min (dec n))
+ (max 0)))
+
+(defn time-speed
+ [opts vals val on-change-fn default-value]
+ (let [opts* (if (map? opts) opts {})
+ vals* (if (map? opts) vals opts)
+ val* (if (map? opts) val vals)
+ on-change-fn* (if (map? opts) on-change-fn val)
+ default-value* (if (map? opts) default-value on-change-fn)]
+ [:input
+ (merge-opts {:style {:height "2em"
+ :cursor "grab"}
+ :min 0
+ :max (dec (count vals*))
+ :value (or (index-of vals* val*)
+ (index-of vals* default-value*)
+ (index-of vals* (first vals*)))
+ :class "w3-light-grey w3-round-xlarge"
+ :type "range"
+ :on-change (fn [e]
+ (when (fn? on-change-fn*)
+ (let [target* (clamp-idx (-> e
+ .-target
+ .-value
+ int)
+ (count vals*))]
+ (on-change-fn* (get vals* target*)))))}
+ opts*)]))
diff --git a/src/cljc/auto_sim/component/time_picker.cljc b/src/cljc/auto_sim/component/time_picker.cljc
new file mode 100644
index 0000000..677b083
--- /dev/null
+++ b/src/cljc/auto_sim/component/time_picker.cljc
@@ -0,0 +1,99 @@
+(ns auto-sim.component.time-picker
+ "A time picker allows the user to manually select the time in a predefined range.
+
+ The range could be:
+ - completly predefined with `min` and `max`.
+ - with a `max` to be discoverd when you advance in time. In that case `last`"
+ (:require
+ [auto-opti.maths :refer [ceil]]
+ [auto-sim :as-alias sim]))
+
+(def after-last "When the last element is not reached, this extends the range" 1.2)
+
+(defn- clamp-time
+ "Time picker is defaulted to minimum, clamped between min and max."
+ [t min max]
+ (cond-> (or t min)
+ max (clojure.core/min max)
+ min (clojure.core/max min)))
+
+(defn get-time
+ "Returns `t` time which is defaulted and clamped."
+ [{:keys [min max]
+ :as tp-data}
+ tp-vals]
+ (-> (or (:time tp-vals) (:time tp-data) min 0)
+ (clamp-time min max)))
+
+(defn update-time
+ "Update `tp-vals` so time is set to new-time:
+ - The value is clamped if needed."
+ [tp-vals new-time]
+ (assoc tp-vals :time new-time))
+
+(defn time-picker
+ "A time picker is selecting one of date in a process between `min` and `max`.
+
+ Two modes exist:
+ - If `max` is non `nil`, the range is between `min` and `max`
+ - Otherwise, the range is between `min` and `max` augmented with `after-last`"
+ [opts tp-data tp-vals change-value-fn dynamic-max-fn]
+ (let [[opts* tp-data* tp-vals* change-value-fn* dynamic-max-fn*]
+ (if (fn? tp-vals)
+ [{} opts tp-data tp-vals change-value-fn dynamic-max-fn]
+ [opts tp-data tp-vals change-value-fn dynamic-max-fn])
+ {:keys [fast-step step min]
+ :or {fast-step 10
+ step 1
+ min 0}}
+ tp-data*
+ max (:max tp-data*)
+ time (or (:time tp-vals*) (:time tp-data*) min 0)
+ max (if max
+ max
+ (when (fn? dynamic-max-fn*)
+ (when-let [new-max (dynamic-max-fn* tp-vals*)]
+ (change-value-fn* new-max)
+ new-max)))
+ time (clamp-time time min max)
+ max-not-defined (and (nil? max) (not (fn? dynamic-max-fn)))]
+ [:div.w3-bar
+ opts*
+ [:div.fa.fa-fast-backward.w3-bar-item {:class (if max-not-defined "w3-text-grey" "w3-button")
+ :on-click #(when (and (not max-not-defined)
+ (fn? change-value-fn*))
+ (-> (- time fast-step)
+ (clamp-time min max)
+ change-value-fn*))}]
+ [:div.fa.fa-step-backward.w3-bar-item {:class (if max-not-defined "w3-text-grey" "w3-button")
+ :on-click #(when (and (not max-not-defined)
+ (fn? change-value-fn*))
+ (-> (- time step)
+ (clamp-time min max)
+ change-value-fn*))}]
+ [:div.w3-bar-item
+ [:input {:type "range"
+ :min min
+ :disabled max-not-defined
+ :value time
+ :max (if max max (ceil (* after-last time)))
+ :style (when-not max-not-defined {:cursor "grab"})
+ :on-change #(when (and (not max-not-defined) (fn? change-value-fn*))
+ (-> %
+ .-target
+ .-value
+ int
+ (clamp-time min max)
+ change-value-fn*))}]]
+ [:div.fa.fa-step-forward.w3-bar-item {:class (if max-not-defined "w3-text-grey" "w3-button")
+ :on-click #(when (and (not max-not-defined)
+ (fn? change-value-fn*))
+ (-> (+ time step)
+ (clamp-time min max)
+ change-value-fn*))}]
+ [:div.fa.fa-fast-forward.w3-bar-item {:class (if max-not-defined "w3-text-grey" "w3-button")
+ :on-click #(when (and (not max-not-defined)
+ (fn? change-value-fn*))
+ (-> (+ time fast-step)
+ (clamp-time min max)
+ change-value-fn*))}]]))
diff --git a/src/cljc/auto_sim/control.cljc b/src/cljc/auto_sim/control.cljc
deleted file mode 100644
index e0ed205..0000000
--- a/src/cljc/auto_sim/control.cljc
+++ /dev/null
@@ -1,151 +0,0 @@
-(ns auto-sim.control
- "Control is a higher level API for simulation scheduler. With a control state you have a pointer to one iteration that you can control with play!, next!, move-x ...
-
- Its design documents are in docs/archi/control/...
-
- Design decision:
- Control state as an atom containing all information about rendering
-
- Pros:
- - With atom state can be managed during long-lasting operations
- e.g. during play! we can modify the speed of it, modify pause easily
- - We can reuse atom state to modify the flow from multiple places
- - Atom handles well multithreading
- - Atom can be used both on clj and cljs
- Cons:
- - Not known
-
- Design decision:
- Split between control and computation
-
- Pros:
- - Split allows to easier manage responsibility between controling what's current response to render and how to move between them
- - Computation being separated allows for flexibility in how to manage execution of scheduler. This allows for adding later on optimisation, split between backend/frontend rendering, offline/online usag...
- Cons:
- - User of rendering needs to have more knowledge about how rendering is working
-
- Design decision:
- Control based on computation (vs e.g. control based on state and separated from computation)
- Pros:
- - Code is easier to manage and understand (decrease complexity)
- - We are in rendering context so it allows for better solutions for rendering
- Cons:
- - Control knows about computation so code is more entangled"
- (:require
- [auto-sim.control.computation :as sim-de-computation]
- [auto-sim.control.computation.registry :as
- sim-de-computation-registry]
- [auto-sim.control.state :as sim-de-rendering-state]
- [auto-sim.simulation-engine :as sim-engine]
- [auto-sim.simulation-engine.impl.stopping-definition.state-contains :as sim-de-sc-state-contains]
- #?(:clj [clojure.core.async :refer [ (sim-de-rendering-state/get state)
- :computation
- (sim-de-computation/iteration-n 0))]
- (when (= :success (::status iteration))
- (sim-de-rendering-state/set state :current-iteration (::response iteration)))
- iteration)))
diff --git a/src/cljc/auto_sim/control/computation.cljc b/src/cljc/auto_sim/control/computation.cljc
deleted file mode 100644
index 578544d..0000000
--- a/src/cljc/auto_sim/control/computation.cljc
+++ /dev/null
@@ -1,49 +0,0 @@
-(ns auto-sim.control.computation
- "Computation is responsible for execution/storage of scheduler so that it can respond to questions about simulation.
- This namespace consists of protocol that defines core questions to answer and use-case functions of that protocol
-
- For diagram see "
- (:require
- [auto-sim.control :as-alias sim-de-control]
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defprotocol Computation
- "Returns information about specific simulation that are useful for rendering"
- (scheduler-response [this]
- [this stopping-criterias]
- [this stopping-criterias iteration]
- "Return scheduler response when any of stopping-criteria is matched from `stopping-criterias` collection.
- Empty `stopping-criterias` means that it will stop at first found.
- `iteration` is additional information to tell from which snapshot iteration to start looking for stopping-criterias")
- (stopping-criterias [this]
- "Returns all stopping-criteria that may occur in this simulation"))
-
-(defn iteration-n
- "Returns `computation-scheduler-response` containing snapshot with iteration `n`"
- [computation n]
- (scheduler-response computation
- [[::sim-engine/iteration-nth {::sim-engine/n n}]]
- n))
-
-(defn not-next?
- "Is next iteration possible?"
- [stopping-causes]
- (some #(or (false? (get-in %
- [::sim-engine/stopping-criteria
- ::sim-engine/stopping-definition
- ::sim-engine/next-possible?]))
- (true? (get-in % [::sim-engine/stopping-criteria ::sim-engine/model-end?])))
- stopping-causes))
-
-(defn stopping-criteria-model-end?
- "Returns true if simulation has model-end criterias defined"
- [computation]
- (let [registry (stopping-criterias computation)] (some ::sim-engine/model-end? registry)))
-
-(defn model-end-iteration
- "Returns scheduler response when model-end? stopping-criteria is reached"
- ([computation]
- (let [criterias (stopping-criterias computation)
- model-end-stopping-criterias (vec (filter #(::sim-engine/model-end? %) criterias))
- iteration (scheduler-response computation model-end-stopping-criterias 0)]
- iteration)))
diff --git a/src/cljc/auto_sim/control/computation/impl/chunk.cljc b/src/cljc/auto_sim/control/computation/impl/chunk.cljc
deleted file mode 100644
index 3e85e7b..0000000
--- a/src/cljc/auto_sim/control/computation/impl/chunk.cljc
+++ /dev/null
@@ -1,167 +0,0 @@
-(ns auto-sim.control.computation.impl.chunk
- "Loads chunk of scheduler responses upfront"
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.control :as-alias sim-de-control]
- [auto-sim.control.computation :as sim-de-computation]
- [auto-sim.control.computation.response :as sim-de-comp-response]
- [auto-sim.simulation-engine :as sim-engine]
- [auto-sim.simulation-engine.impl.stopping.criteria :as sim-de-criteria]))
-
-(defn create-storage
- ([model]
- (create-storage model
- {1 #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- (::sim-engine/initial-snapshot
- model)}}))
- ([model iterations]
- (atom {:model model
- :no-next false
- :iterations (into (sorted-map) iterations)})))
-
-(defn- last-resp [buffer] (last (:iterations @buffer)))
-
-(defn- highest-it [buffer] (or (first (last-resp buffer)) 0))
-
-(defn- iteration-stp-crit
- [n]
- [::sim-engine/iteration-nth {::sim-engine/n n
- :chunk? true}])
-
-(defn- mdw-save-it
- [storage handler]
- (fn [request]
- (let [response (handler request)
- it-nb (get-in response [::sim-engine/snapshot ::sim-engine/iteration])]
- (swap! storage assoc-in
- [:iterations it-nb]
- (-> response
- (update ::sim-engine/stopping-causes
- (fn [causes]
- (remove (fn [cause]
- (true? (:chunk? (::sim-engine/params (::sim-engine/stopping-criteria
- cause)))))
- causes)))))
- response)))
-
-(defn- go-to-stop!
- [buffer stp-criterias]
- (let [model (:model @buffer)
- endless-catch (iteration-stp-crit (+ (highest-it buffer) 10000))
- stp-criterias (conj stp-criterias endless-catch)]
- (->> buffer
- last-resp
- second
- ::sim-engine/snapshot
- (sim-engine/scheduler model [(partial mdw-save-it buffer)] stp-criterias))))
-
-(defn- load-chunk!
- [storage chunk-size]
- (when (false? (:no-next @storage))
- (let [iteration-stop (iteration-stp-crit (+ (highest-it storage) chunk-size))
- last-snapshot (-> storage
- last-resp
- second
- ::sim-engine/snapshot)]
- (sim-engine/scheduler (:model @storage)
- [(partial mdw-save-it storage)]
- [iteration-stop]
- last-snapshot)
- (swap! storage assoc
- :no-next
- (-> storage
- last-resp
- second
- ::sim-engine/stopping-causes
- sim-de-computation/not-next?)))))
-
-(defn check-predicates
- [stopping-criterias {::sim-engine/keys [snapshot stopping-causes]}]
- (let [user-stopping-causes (->> stopping-criterias
- (map (fn [stopping-criteria]
- (sim-de-criteria/evaluates stopping-criteria snapshot)))
- (remove nil?))]
- (cond
- (and (empty? stopping-criterias) (not-empty stopping-causes)) stopping-causes
- (not-empty user-stopping-causes) (concat stopping-causes user-stopping-causes)
- :else false)))
-
-(defn- add-user-stopping-causes
- [stopping-criterias response]
- (assoc response ::sim-engine/stopping-causes (check-predicates stopping-criterias response)))
-
-(defn- remove-user-stopping-causes
- [it]
- (update it
- ::sim-engine/stopping-causes
- (fn [causes]
- (filter #(nil?
- (get-in % [::sim-engine/stopping-criteria ::sim-engine/params :chunk-user?]))
- causes))))
-
-(defrecord ChunkComputation [storage chunk-size]
- sim-de-computation/Computation
- (scheduler-response [this] (sim-de-computation/scheduler-response this [] 1))
- (scheduler-response [this stopping-criterias]
- (sim-de-computation/scheduler-response this stopping-criterias 1))
- (scheduler-response [_ stopping-criterias it]
- (let [it (or it 1)
- max-it (highest-it storage)
- stopping-registry (::sim-engine/stopping (::sim-engine/registry (:model @storage)))
- stopping-criterias
- (->> stopping-criterias
- (map (partial sim-de-criteria/api-data-to-entity stopping-registry))
- (filter some?)
- (mapv sim-de-criteria/out-of-model)
- (mapv (fn [stp-criteria]
- (assoc-in stp-criteria [::sim-engine/params :chunk-user?] true))))
- stopping-criterias-valid? (->> stopping-criterias
- (map #(core-schema/validate-data sim-de-criteria/schema
- %))
- (every? true?))]
- (if (not stopping-criterias-valid?)
- (sim-de-comp-response/build
- :internal-error
- #:auto-sim.simulation-engine{:stopping-criterias stopping-criterias})
- (do
- (when (>= (+ it chunk-size) max-it) (load-chunk! storage (+ chunk-size (- it max-it))))
- (if-let [response (-> (fn [[k v]]
- (and (>= k it) (check-predicates stopping-criterias v)))
- (filter (:iterations @storage))
- first
- second)]
- (sim-de-comp-response/build :success
- (add-user-stopping-causes stopping-criterias response))
- (let [loop-start-iteration (second (last-resp storage))]
- (loop [{::sim-engine/keys [stopping-causes snapshot]
- :as it}
- loop-start-iteration
- endless-catch-internal-counter 0]
- (cond
- (check-predicates stopping-criterias it)
- (do (swap! storage assoc-in
- [:iterations (get-in it [::sim-engine/snapshot ::sim-engine/iteration])]
- (remove-user-stopping-causes it))
- (load-chunk! storage (+ chunk-size (get snapshot ::sim-engine/iteration 0)))
- (sim-de-comp-response/build :success
- (add-user-stopping-causes stopping-criterias
- it)))
- (sim-de-computation/not-next? stopping-causes)
- (sim-de-comp-response/build :no-next it)
- (or (= endless-catch-internal-counter 10000)
- (>= (- (get snapshot ::sim-engine/iteration 0)
- (get-in loop-start-iteration
- [::sim-engine/snapshot ::sim-engine/iteration]
- 0))
- 10000))
- (sim-de-comp-response/build :timeout it)
- :else (do (go-to-stop! storage stopping-criterias)
- (recur (second (last-resp storage))
- (inc endless-catch-internal-counter)))))))))))
- (stopping-criterias [_] (::sim-engine/stopping-criterias (:model @storage))))
-
-(defn make-chunk-computation
- "`chunk-size` defines how many responses upfront to load"
- [model chunk-size]
- (->ChunkComputation (create-storage model) chunk-size))
diff --git a/src/cljc/auto_sim/control/computation/impl/direct.cljc b/src/cljc/auto_sim/control/computation/impl/direct.cljc
deleted file mode 100644
index c777656..0000000
--- a/src/cljc/auto_sim/control/computation/impl/direct.cljc
+++ /dev/null
@@ -1,71 +0,0 @@
-(ns auto-sim.control.computation.impl.direct
- "Naive implementation of computation.
- It directly executes scheduler each time it's asked for an answer"
- (:require
- [auto-sim.control.computation :as sim-de-computation]
- [auto-sim.control.computation.response :as sim-de-comp-response]
- [auto-sim.simulation-engine :as sim-engine]))
-
-(defn- endless-sim?
- [stopping-causes]
- (some #(= :endless-sim (get-in % [::sim-engine/stopping-criteria ::sim-engine/params :reason]))
- stopping-causes))
-
-(defn- stopping-criteria-match-cause?
- [stopping-criterias stop-causes]
- (if (empty? stopping-criterias)
- true
- (some (fn [stop-cause]
- (some #(and (= (get-in stop-cause [::sim-engine/stopping-criteria ::sim-engine/params])
- (second %))
- (= (get-in stop-cause
- [::sim-engine/stopping-criteria
- ::sim-engine/stopping-definition
- ::sim-engine/id])
- (first %)))
- stopping-criterias))
- stop-causes)))
-
-(defrecord DirectComputation [model max-it]
- sim-de-computation/Computation
- (scheduler-response [_ stopping-criterias it]
- (let [it (or it 1)
- endless-sim-catch (+ it max-it)
- endless-stopping-criteria [::sim-engine/iteration-nth {::sim-engine/n endless-sim-catch
- :reason :endless-sim}]
- it-snapshot (if (<= it 1)
- (::sim-engine/initial-snapshot model)
- (-> model
- (sim-engine/scheduler
- []
- [[::sim-engine/iteration-nth
- #:auto-sim.simulation-engine{:n (dec it)}]])
- ::sim-engine/snapshot))]
- (loop [snapshot it-snapshot
- endless-catch-internal-counter 0]
- (let [{::sim-engine/keys [snapshot stopping-causes]
- :as resp}
- (sim-engine/scheduler model
- []
- (conj stopping-criterias endless-stopping-criteria)
- snapshot)]
- (cond
- (endless-sim? stopping-causes) (sim-de-comp-response/build :timeout resp)
- (stopping-criteria-match-cause? stopping-criterias stopping-causes)
- (sim-de-comp-response/build :success resp)
- (= endless-catch-internal-counter max-it) (sim-de-comp-response/build :internal-error
- resp)
- (sim-de-computation/not-next? stopping-causes) (sim-de-comp-response/build :no-next
- resp)
- :else (recur snapshot (inc endless-catch-internal-counter)))))))
- (scheduler-response [this] (sim-de-computation/scheduler-response this [] 1))
- (scheduler-response [this stopping-criterias]
- (sim-de-computation/scheduler-response this stopping-criterias 1))
- (stopping-criterias [_] (::sim-engine/stopping-criterias model)))
-
-(defn make-direct-computation
- "Params:
- `model` simulation model
- `max-it` maximum number of iteration to go to"
- ([model max-it] (->DirectComputation model max-it))
- ([model] (make-direct-computation model 100)))
diff --git a/src/cljc/auto_sim/control/computation/registry.cljc b/src/cljc/auto_sim/control/computation/registry.cljc
deleted file mode 100644
index 030841e..0000000
--- a/src/cljc/auto_sim/control/computation/registry.cljc
+++ /dev/null
@@ -1,12 +0,0 @@
-(ns auto-sim.control.computation.registry
- "Contains all the default possible computation implementation to choose from
- For diagram see "
- (:require
- [auto-sim.control :as-alias sim-de-control]
- [auto-sim.control.computation.impl.chunk :as sim-de-comp-chunk]
- [auto-sim.control.computation.impl.direct :as sim-de-comp-direct]))
-
-(defn computation-registry
- []
- {:direct sim-de-comp-direct/make-direct-computation
- :chunk sim-de-comp-chunk/make-chunk-computation})
diff --git a/src/cljc/auto_sim/control/computation/response.cljc b/src/cljc/auto_sim/control/computation/response.cljc
deleted file mode 100644
index da9a598..0000000
--- a/src/cljc/auto_sim/control/computation/response.cljc
+++ /dev/null
@@ -1,22 +0,0 @@
-(ns auto-sim.control.computation.response
- "Computation response is consisting of status and scheduler response.
- Status informs about how the response is related to the query asked to computation.
- :success <- it is as expected
- :no-next <- it is not what was asked, but it is impossible to continue further in simulation (e.g. model-end, no future events...)
- :timeout <- it is not what was asked and it can be continued to search, but it hit a limit of time as it may be endless simulation or question could never be answered
- :internal-error <- The response may be corrupted as there was some problem with execution itself
-
- For diagram see "
- (:require
- [auto-sim.control :as-alias sim-de-control]
- [auto-sim.simulation-engine.response :as sim-de-response]))
-
-(def schema
- [:map {:closed true}
- [::sim-de-control/status [:enum :success :no-next :timeout :internal-error]]
- [::sim-de-control/response sim-de-response/schema]])
-
-(defn build
- [status response]
- {::sim-de-control/status status
- ::sim-de-control/response response})
diff --git a/src/cljc/auto_sim/control/state.cljc b/src/cljc/auto_sim/control/state.cljc
deleted file mode 100644
index d820804..0000000
--- a/src/cljc/auto_sim/control/state.cljc
+++ /dev/null
@@ -1,31 +0,0 @@
-(ns auto-sim.control.state
- "State containing information about and for control (control settings, current-iteration, computation-implementation to use...)
- For diagram see "
- (:refer-clojure :exclude [get set])
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.control :as-alias sim-de-control]
- [auto-sim.simulation-engine.response :as sim-de-response]))
-
-(defn rendering-state-schema
- "Schema of rendering state, `:computation` should be an object implementing computation defprotocol"
- []
- [:map {:closed true}
- [:pause? {:default true}
- :boolean]
- [:play-delay {:default 1000}
- number?]
- [:current-iteration {:optional true}
- sim-de-response/schema]
- [:computation :any]])
-
-(defn build
- "Returns state in form of an atom, if `initial-state` is valid or nil otherwise"
- [initial-state]
- (let [schema (rendering-state-schema)
- initial-state (core-schema/add-default schema initial-state)]
- (when (core-schema/validate-data schema initial-state) (atom initial-state))))
-
-(defn get [state] @state)
-
-(defn set [state k v] (swap! state assoc k v))
diff --git a/src/cljc/auto_sim/demo/control.cljc b/src/cljc/auto_sim/demo/control.cljc
deleted file mode 100644
index cab85f6..0000000
--- a/src/cljc/auto_sim/demo/control.cljc
+++ /dev/null
@@ -1,48 +0,0 @@
-#_{:heph-ignore {:forbidden-words ["tap>"]}}
-(ns auto-sim.demo.control
- "Demo usefull for control toy example"
- (:require
- [auto-sim.control :as sim-de-control]
- [auto-sim.demo.data :as sim-demo-data]
- [auto-sim.demo.simulation-engine :as sim-demo-engine]
- [auto-sim.simulation-engine :as sim-engine]
- [auto-sim.simulation-engine.event-return :as sim-de-event-return]))
-
-(defn infinite-part-terminate
- [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product _machine]}
- state
- future-events]
- (-> #::sim-engine{:state state
- :future-events future-events}
- (sim-de-event-return/add-event {::sim-engine/type :MA
- ::sim-engine/date date
- ::sim-demo-data/product product
- ::sim-demo-data/machine :m1})))
-
-(defn registries
- ([] (registries false))
- ([infinite?]
- (let [events (cond-> sim-demo-engine/events
- infinite? (assoc :PT infinite-part-terminate))]
- (-> (sim-engine/registries)
- (update ::sim-engine/event merge events)
- sim-de-control/wrap-registry))))
-
-(defn model [] (sim-demo-engine/model sim-demo-data/model-data (registries)))
-
-(defn model-infinite [] (sim-engine/build-model sim-demo-data/model-data (registries true)))
-
-(defn model-early-end
- []
- (sim-engine/build-model (update sim-demo-data/model-data
- ::sim-engine/stopping-criterias
- conj
- [::sim-engine/iteration-nth {::sim-engine/n 20}])
- (registries)))
-
-
-(defn control-state
- []
- (sim-de-control/build-rendering-state {:computation (sim-de-control/make-computation (model)
- :direct)}))
diff --git a/src/cljc/auto_sim/demo/data.cljc b/src/cljc/auto_sim/demo/data.cljc
deleted file mode 100644
index 46baf8d..0000000
--- a/src/cljc/auto_sim/demo/data.cljc
+++ /dev/null
@@ -1,38 +0,0 @@
-(ns auto-sim.demo.data
- (:require
- [automaton-optimization.prng :as opt-prng]
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-;; Problem data
-(def routing
- {:m1 [:m2 :m3]
- :m2 [:m4]
- :m3 [:m4]})
-
-(def process-time
- {:m1 1
- :m2 3
- :m3 3
- :m4 1})
-
-(def model-data
- (let [date 0]
- #::sim-engine{:ordering [[::sim-engine/field ::sim-engine/date]
- [::sim-engine/type [:MA :MP :MT :PT]]
- [::sim-engine/field ::machine]
- [::sim-engine/field ::product]]
- :future-events [{::sim-engine/type :MA
- ::sim-engine/date date
- ::product :p1
- ::machine :m1}
- {::sim-engine/type :MA
- ::sim-engine/date date
- ::product :p2
- ::machine :m1}
- {::sim-engine/type :MA
- ::sim-engine/date date
- ::product :p3
- ::machine :m1}]
- :stopping-criterias []}))
-
-(defn prng [seed] (opt-prng/xoroshiro128 seed))
diff --git a/src/cljc/auto_sim/demo/entity.cljc b/src/cljc/auto_sim/demo/entity.cljc
deleted file mode 100644
index 78402fc..0000000
--- a/src/cljc/auto_sim/demo/entity.cljc
+++ /dev/null
@@ -1,177 +0,0 @@
-#_{:heph-ignore {:forbidden-words ["tap>"]}}
-(ns auto-sim.demo.entity
- (:require
- [automaton-optimization.distribution :as opt-distribution]
- [automaton-optimization.maths :as opt-maths]
- [auto-sim.demo.data :as sim-demo-data]
- [auto-sim.entity :as sim-entity]
- [auto-sim.rc :as sim-rc]
- [auto-sim.simulation-engine :as sim-engine]
- [auto-sim.simulation-engine.event-return :as sim-de-event-return]))
-
-(defn events
- [prng]
- (let [uniform-distribution (opt-distribution/distribution {:prng prng
- :dst-name :uniform-int})]
- {:CE (fn [{::sim-engine/keys [date]
- ::keys [entity-current entity-max]
- :or {entity-current 1}}
- state
- future-events]
- (let [product-id (keyword (str "p-" entity-current))
- colors [:blue :purple]
- random-numb (opt-distribution/draw uniform-distribution)
- color-idx (opt-maths/mod random-numb (count colors))
- entity-color (nth colors color-idx)
- route (case entity-color
- :blue [{:resource-id :m4
- :transportation-time 2
- :processing-time (:m4 sim-demo-data/process-time)}
- {:resource-id :m2
- :transportation-time 2
- :processing-time (:m2 sim-demo-data/process-time)}
- {:resource-id :m1
- :transportation-time 0
- :processing-time (:m1 sim-demo-data/process-time)}]
- :purple [{:resource-id :m4
- :transportation-time 2
- :processing-time (:m4 sim-demo-data/process-time)}
- {:resource-id :m3
- :transportation-time 2
- :processing-time (:m3 sim-demo-data/process-time)}
- {:resource-id :m1
- :transportation-time 0
- :processing-time (:m1 sim-demo-data/process-time)}]
- {})
- entity-state (sim-entity/create state
- date
- product-id
- {:color entity-color
- :next-machines (pop route)})]
- (cond-> #::sim-engine{:state entity-state
- :future-events future-events}
- (< entity-current entity-max) (sim-de-event-return/add-event
- {::sim-engine/type :CE
- ::sim-engine/date date
- ::sim-demo-data/operation (-> route
- peek)
- ::entity-max entity-max
- ::entity-current (inc entity-current)})
- true (sim-de-event-return/add-event {::sim-engine/type :MA
- ::sim-engine/date (+ date
- (-> route
- peek
- (:transportation-time
- 0)))
- ::sim-demo-data/product product-id
- ::sim-demo-data/operation (-> route
- peek)}))))
- :MA (fn [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product operation]}
- state
- future-events]
- (let [entity-state (sim-entity/update state
- date
- product
- update
- :operations
- conj
- (-> operation
- (assoc :arrival date)))]
- (-> #::sim-engine{:state entity-state
- :future-events future-events}
- (sim-rc/seize (:resource-id operation)
- 1
- date
- {::sim-engine/type :MP
- ::sim-demo-data/product product
- ::sim-demo-data/operation operation}))))
- :MP (fn [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product operation]
- ::sim-rc/keys [resource]}
- state
- future-events]
- (-> #::sim-engine{:state state
- :future-events future-events}
- (sim-de-event-return/add-event {::sim-engine/type :MT
- ::sim-engine/date (+ date
- (:processing-time operation 0))
- ::sim-rc/resource resource
- ::sim-demo-data/product product
- ::sim-demo-data/operation operation})))
- :MT (fn [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product operation]
- :as current-event}
- state
- future-events]
- (let [next-machines (:next-machines (sim-entity/state state product))
- next-operation (peek next-machines)
- r (when (not-empty next-machines) (pop next-machines))
- transportation-end-time (+ date (:transportation-time next-operation 0))
- entity-state (-> state
- (sim-entity/update date product assoc :next-machines r)
- (sim-entity/update date
- product
- update
- :operations
- (fn [ops]
- (conj (pop ops)
- (-> ops
- peek
- (assoc :departure date))))))]
- (-> #::sim-engine{:state entity-state
- :future-events future-events}
- (sim-rc/dispose (:resource-id operation) current-event)
- (sim-de-event-return/if-return
- (empty? next-machines)
- #(sim-de-event-return/add-event %
- {::sim-engine/type :PT
- ::sim-demo-data/product product}
- transportation-end-time)
- #(sim-de-event-return/add-event %
- {::sim-engine/type :MA
- ::sim-demo-data/product product
- ::sim-demo-data/operation next-operation}
- transportation-end-time)))))
- :PT (fn [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product]
- :as _current-event}
- state
- future-events]
- (let [entity-state (-> state
- (sim-entity/dispose date product))]
- #::sim-engine{:state entity-state
- :future-events future-events}))}))
-
-(defn registries
- [prng]
- (-> (sim-engine/registries)
- (update ::sim-engine/event merge (events prng))))
-
-(def model-data
- (-> {::sim-engine/stopping-criterias []}
- (assoc ::sim-rc/rc
- {:m1 {}
- :m2 {}
- :m3 {}
- :m4 {}})
- (assoc ::seed #uuid "e85427c1-ed25-4ed4-9b11-52238d268265")
- (assoc ::sim-engine/ordering
- [[::sim-engine/field ::sim-engine/date]
- [::sim-engine/type [:CE :MA :MP :MT :PT]]
- [::sim-engine/field ::sim-demo-data/product]])
- (assoc ::sim-engine/future-events
- [{::sim-engine/type :CE
- ::sim-engine/date 0
- ::entity-max 3}])))
-
-(defn model
- ([model-data registries]
- (-> model-data
- (update ::sim-engine/stopping-criterias
- conj
- [::sim-engine/iteration-nth #::sim-engine{:n 100}])
- (sim-engine/build-model registries)
- (sim-rc/wrap-model (sim-rc/unblocking-policy-registry) (sim-rc/preemption-policy-registry))
- sim-entity/wrap-model))
- ([] (model model-data (registries (sim-demo-data/prng (::seed model-data))))))
diff --git a/src/cljc/auto_sim/demo/rc.cljc b/src/cljc/auto_sim/demo/rc.cljc
deleted file mode 100644
index 61a3f90..0000000
--- a/src/cljc/auto_sim/demo/rc.cljc
+++ /dev/null
@@ -1,108 +0,0 @@
-#_{:heph-ignore {:forbidden-words ["tap>"]}}
-(ns auto-sim.demo.rc
- "Testing the scheduler with no other lib."
- (:require
- [automaton-optimization.distribution :as opt-distribution]
- [automaton-optimization.maths :as opt-maths]
- [auto-sim.demo.data :as sim-demo-data]
- [auto-sim.event-library.common :as sim-de-common]
- [auto-sim.rc :as sim-rc]
- [auto-sim.simulation-engine :as sim-engine]
- [auto-sim.simulation-engine.event-return :as sim-de-event-return]))
-
-(defn state-rendering
- [state]
- (let [resources (vals (get-in state [::sim-rc/resource]))]
- (apply concat
- (for [{::sim-rc/keys [name currently-consuming queue]} resources]
- (concat (mapv (fn [consumption]
- (clojure.core/name (get-in consumption
- [::sim-rc/seizing-event
- ::sim-demo-data/product])))
- queue)
- ["->" (clojure.core/name name) "("]
- (map (fn [consumption]
- (clojure.core/name
- (get-in consumption [::sim-rc/seizing-event ::sim-demo-data/product])))
- (vals currently-consuming))
- [")"])))))
-
-(defn events
- [prng]
- (let [unif-distribution (opt-distribution/distribution {:prng prng
- :distribution-name :uniform-int
- :params {}})]
- {:MA (fn [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product machine]}
- state
- future-events]
- (-> #::sim-engine{:state state
- :future-events future-events}
- (sim-rc/seize machine
- 1
- date
- {::sim-engine/type :MP
- ::sim-demo-data/product product
- ::sim-demo-data/machine machine})))
- :MP (fn [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product machine]
- ::sim-rc/keys [resource]}
- state
- future-events]
- (-> #::sim-engine{:state state
- :future-events future-events}
- (sim-de-event-return/add-event {::sim-engine/type :MT
- ::sim-engine/date
- (+ date (get sim-demo-data/process-time machine))
- ::sim-rc/resource resource
- ::sim-demo-data/product product
- ::sim-demo-data/machine machine})))
- :MT (fn [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product machine]
- :as current-event}
- state
- future-events]
- (let [transportation-end-time (+ date 2)
- next-machines (get sim-demo-data/routing machine)]
- (-> #::sim-engine{:state state
- :future-events future-events}
- (sim-rc/dispose machine current-event)
- (sim-de-event-return/if-return
- (empty? next-machines)
- #(sim-de-event-return/add-event %
- {::sim-engine/type :PT
- ::sim-demo-data/product product}
- transportation-end-time)
- #(let [next-machine-idx (opt-maths/mod (opt-distribution/draw unif-distribution)
- (count next-machines))
- next-machine (nth next-machines next-machine-idx)]
- (sim-de-event-return/add-event %
- {::sim-engine/type :MA
- ::sim-demo-data/product product
- ::sim-demo-data/machine next-machine}
- transportation-end-time))))))
- :PT sim-de-common/sink}))
-
-(defn registries
- [prng]
- (-> (sim-engine/registries)
- (update ::sim-engine/event merge (events prng))))
-
-(def model-data
- (-> sim-demo-data/model-data
- (assoc ::seed #uuid "e85427c1-ed25-4ed4-9b11-52238d268265")
- (assoc ::sim-rc/rc
- {:m1 {}
- :m2 {}
- :m3 {}
- :m4 {}})))
-
-(defn model
- ([model-data registries]
- (-> model-data
- (update ::sim-engine/stopping-criterias
- conj
- [::sim-engine/iteration-nth #::sim-engine{:n 100}])
- (sim-engine/build-model registries)
- (sim-rc/wrap-model (sim-rc/unblocking-policy-registry) (sim-rc/preemption-policy-registry))))
- ([] (model model-data (registries (sim-demo-data/prng (::seed model-data))))))
diff --git a/src/cljc/auto_sim/demo/simulation_engine.cljc b/src/cljc/auto_sim/demo/simulation_engine.cljc
deleted file mode 100644
index 56f2695..0000000
--- a/src/cljc/auto_sim/demo/simulation_engine.cljc
+++ /dev/null
@@ -1,99 +0,0 @@
-#_{:heph-ignore {:forbidden-words ["tap>"]}}
-(ns auto-sim.demo.simulation-engine
- "Simulation domain, that can be tested from console
- Used to help during development of simulation de concepts"
- (:require
- [auto-sim.demo.data :as sim-demo-data]
- [auto-sim.event-library.common :as sim-de-common]
- [auto-sim.simulation-engine :as sim-engine]
- [auto-sim.simulation-engine.event :as sim-de-event]
- [auto-sim.simulation-engine.event-return :as sim-de-event-return]
- [clojure.string :as str]))
-
-;; print
-(defn state-rendering
- [state]
- (apply println
- (for [mk (keys sim-demo-data/process-time)]
- (str (or (str/join " " (map name (get-in state [mk :input]))) "_")
- " -> "
- (name mk)
- "("
- (or (some-> (get-in state [mk :process])
- name)
- "_")
- ")"))))
-
-;; Events
-(def events
- {:MA (fn [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product machine]}
- state
- future-events]
- (-> #::sim-engine{:state (-> state
- (update-in [machine :input]
- (fn [list-products]
- (vec (conj list-products product)))))
- :future-events future-events}
- (sim-de-event-return/add-event {::sim-engine/type :MP
- ::sim-engine/date date
- ::sim-demo-data/product product
- ::sim-demo-data/machine machine})))
- :MP (fn [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product machine]}
- state
- future-events]
- (let [new-date (+ date (sim-demo-data/process-time machine))]
- (-> #::sim-engine{:state (-> state
- (update-in [machine :input]
- (fn [list-products]
- (vec (remove #{product} list-products))))
- (assoc-in [machine :process] product))
- :future-events future-events}
- (sim-de-event-return/add-event {::sim-engine/type :MT
- ::sim-engine/date new-date
- ::sim-demo-data/product product
- ::sim-demo-data/machine machine})
- (update ::sim-engine/future-events
- #(sim-de-event/postpone-events
- %
- (fn [{::sim-engine/keys [type]
- :as evt}]
- (and (= (::sim-demo-data/machine evt) machine) (= type :MP)))
- new-date)))))
- :MT (fn [{::sim-engine/keys [date]
- ::sim-demo-data/keys [product machine]}
- state
- future-events]
- (let [transportation-end-time (+ date 2)
- next-machines (get sim-demo-data/routing machine)]
- (-> #::sim-engine{:state (assoc-in state [machine :process] nil)
- :future-events future-events}
- (sim-de-event-return/if-return
- (empty? next-machines)
- #(sim-de-event-return/add-event %
- {::sim-engine/type :PT
- ::sim-demo-data/product product}
- transportation-end-time)
- #(sim-de-event-return/nth %
- (map (fn [next-machine]
- {::sim-engine/type :MA
- ::sim-demo-data/product product
- ::sim-demo-data/machine next-machine})
- next-machines)
- transportation-end-time)))))
- :PT sim-de-common/sink})
-
-(defn registries
- []
- (-> (sim-engine/registries)
- (update ::sim-engine/event merge events)))
-
-(defn model
- ([model-data registries]
- (-> model-data
- (update ::sim-engine/stopping-criterias
- conj
- [::sim-engine/iteration-nth #::sim-engine{:n 100}])
- (sim-engine/build-model registries)))
- ([] (model sim-demo-data/model-data (registries))))
diff --git a/src/cljc/auto_sim/engine.cljc b/src/cljc/auto_sim/engine.cljc
new file mode 100644
index 0000000..37d9404
--- /dev/null
+++ b/src/cljc/auto_sim/engine.cljc
@@ -0,0 +1,200 @@
+(ns auto-sim.engine
+ "The simulation engine is a `scheduler` working with a `model` describing the problem to solve.
+
+ The `initial-snapshot` function updates the model with a snapshot to start with.
+ Then, `continue` allows to execute this `model`. It is starting with a snapshot that can be coming from an `initial-snapshot` or another `continue` execution.
+
+ An event execution has three parameters `(event-execution current-event event-bucket state new-future-events)`:
+ * `current-event` which is the current event to execute
+ * `state` which is the state value before the event execution
+ * `new-future-events` which is the list of future events without the current event
+
+ The returned value is a map with `state` and `future-events` keys."
+ (:require
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.stopping-criteria :as sim-sc]))
+
+;; ********************************************************************************
+;; Helpers
+;; ********************************************************************************
+
+(defn run-snapshot
+ [model sorter stopping-definition event-registry]
+ (let [{::sim-engine/keys [bucket future-events id iteration state past-events]} model]
+ (loop [future-events (sorter future-events)
+ bucket bucket
+ iteration-offset 0
+ state state
+ past-events past-events]
+ (let [[current-event & rfuture-events] future-events
+ on-previous-model (fn [stopping-criteria]
+ (->
+ model
+ (assoc ::sim-engine/bucket bucket
+ ::sim-engine/state state
+ ::sim-engine/iteration (+ iteration-offset iteration)
+ ::sim-engine/id (+ id iteration-offset)
+ ::sim-engine/past-events past-events
+ ::sim-engine/future-events future-events)
+ (update ::sim-engine/stopping-criteria concat stopping-criteria)))
+ on-next-event (fn [stopping-criteria]
+ (assoc (on-previous-model stopping-criteria)
+ ::sim-engine/past-events (conj past-events current-event)
+ ::sim-engine/future-events rfuture-events))
+ stopping-criteria (and stopping-definition
+ (sim-sc/eval stopping-definition (on-previous-model nil)))]
+ (cond
+ (empty? future-events) (-> [#::sim-engine{:id ::sim-engine/no-future-events
+ :doc ["No more future events to execute"]}]
+ on-previous-model)
+ (seq stopping-criteria) (on-previous-model stopping-criteria)
+ :else
+ (let [{event-bucket ::sim-engine/bucket
+ event-type ::sim-engine/type}
+ current-event
+ event-execution (get event-registry event-type)]
+ (cond
+ (not (fn? event-execution))
+ (on-next-event
+ [#::sim-engine{:id ::sim-engine/execution-not-found
+ :doc
+ ["Event has an unknown event type `%s` (event is `%s`, possible values are `%s`)"
+ event-type
+ current-event
+ (vec (keys event-registry))]
+ :event current-event
+ :possible-types (vec (keys event-registry))
+ :not-found-type (::sim-engine/type current-event)}])
+ (< event-bucket bucket)
+ (on-next-event
+ [#::sim-engine{:id ::sim-engine/causality-broken
+ :doc
+ ["Internal error - causality-broken: bucket is %d, next-event bucket is %d (event is `%s`)"
+ bucket
+ event-bucket
+ current-event]
+ :current-bucket bucket
+ :event-bucket event-bucket}])
+ :else
+ (let [iteration-offset (inc iteration-offset)
+ event-return
+ (try (event-execution {::state state
+ ::future-events rfuture-events}
+ current-event
+ event-bucket)
+ (catch #?(:clj Exception
+ :cljs :default)
+ e
+ (on-next-event
+ [#::sim-engine{:id ::sim-engine/failed-event-execution
+ :doc ["Internal error - failed execution of event"]
+ :current-event current-event
+ :exception e}])))
+ {new-future-events ::sim-engine/future-events
+ new-state ::sim-engine/state
+ new-stopping-criteria ::sim-engine/stopping-criteria
+ new-errors ::sim-engine/errors}
+ event-return
+ new-model-fn (fn [errors]
+ (-> (on-next-event (cond-> new-stopping-criteria
+ errors (concat errors)))
+ (assoc ::sim-engine/state new-state
+ ::sim-engine/iteration (+ iteration-offset iteration)
+ ::sim-engine/id (+ id iteration-offset)
+ ::sim-engine/future-events new-future-events)))]
+ (cond
+ new-stopping-criteria (new-model-fn nil)
+ new-errors
+ (-> [#::sim-engine{:id ::sim-engine/error-happens
+ :doc ["Errors has been documented during event execution: %s"
+ new-errors]
+ :current-event current-event
+ :errors new-errors}]
+ new-model-fn)
+ :else (recur (sorter new-future-events)
+ event-bucket
+ iteration-offset
+ new-state
+ (conj past-events current-event)))))))))))
+
+(defn- continue*
+ [model]
+ (let [{::sim-engine/keys [event-registry sorter stopping-definition]} model
+ model (-> model
+ (update ::sim-engine/iteration (fnil identity 0))
+ (update ::sim-engine/id (fnil identity 0)))]
+ (cond
+ (not (fn? sorter)) (-> model
+ (update ::sim-engine/stopping-criteria
+ conj
+ #::sim-engine{:id ::sim-engine/missing-sorter
+ :doc ["Event sorter is not defined"]}))
+ :else (run-snapshot model sorter stopping-definition event-registry))))
+
+;; ********************************************************************************
+;; API
+;; ********************************************************************************
+
+(defn initial-snapshot
+ "Returns the initial snapshot for a scheduler.
+
+ It is initialiazed with `future-events` (will be turned into a vec to maintain proper order) and `state`.
+
+ Starts at `iteration` and `id` `1`, `bucket` 0, with no `past-events`."
+ [model bucket state future-events]
+ (assoc model
+ ::sim-engine/bucket bucket
+ ::sim-engine/future-events (vec future-events)
+ ::sim-engine/id 1
+ ::sim-engine/iteration 1
+ ::sim-engine/state (if (empty? state) {} state)
+ ::sim-engine/past-events []))
+
+(defn continue
+ "Continue execution of model, starts with `snapshot`.
+
+ The scheduler executes the `model` until a `stopping-criteria` is met.
+
+ Model should contain:
+ * `#::sim-engine/sorter` the result of an execution of function `auto-sim.ordering/sorter`
+ * `#::sim-engine/event-registry` a map associating the `::sim-engine/type` to a function: `(f current-event state future-events)`
+
+ Note that users can enrich its execution by:
+ * enriching the `model` with augmented registries.
+ * supplementary middlewares and stopping criteria that don't affect the model
+
+ Note that particular attention has been paid to leverage model's preparation, e.g. stopping-criteria and middlewares aren't translated again, just their `scheduler` version is.
+
+ Returns last snapshot and the `stopping-criteria`."
+ [model]
+ (-> model
+ continue*
+ (update ::sim-engine/future-events vec)
+ (update ::sim-engine/past-events vec)
+ (update ::sim-engine/stopping-criteria vec)))
+
+(defn reinit-sc
+ [model]
+ (assoc model ::sim-engine/stopping-definition (::sim-engine/cust-stopping-definition model)))
+
+(defn run [model] (continue model))
+
+(defn run-to
+ "Run until time bucket `bucket`"
+ [model bucket]
+ (-> model
+ reinit-sc
+ (sim-sc/stop-bucket bucket)
+ continue))
+
+(defn run-iteration
+ "Run until iteration `iteration`"
+ [model iteration]
+ (-> model
+ reinit-sc
+ (sim-sc/stop-iteration iteration)
+ continue
+ (update ::sim-engine/stopping-criteria
+ (partial remove #(= ::sim-sc/iteration-stopping (::sim-engine/id %))))))
+
+(defn clean-stop-criteria [model] (dissoc model ::sim-engine/stopping-criteria))
diff --git a/src/cljc/auto_sim/entity.cljc b/src/cljc/auto_sim/entity.cljc
index e2b51f2..7a182cc 100644
--- a/src/cljc/auto_sim/entity.cljc
+++ b/src/cljc/auto_sim/entity.cljc
@@ -1,172 +1,281 @@
(ns auto-sim.entity
"An entity is a part of the model living in the `state` with its lifecycle managed.
- * 
- * 
- * "
+ Entities are identified with `uuid` automatically generated."
(:refer-clojure :exclude [update])
(:require
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.stopping-definition.registry
- :as sim-de-stopping-registry]))
+ [auto-core.uuid :as uuid-gen]
+ [auto-sim.engine :as-alias sim-engine]))
+
+;; ********************************************************************************
+;; Internal API
+;; ********************************************************************************
+
+(defn- create-id [] (uuid-gen/time-based-uuid))
(defn create
- "Creates an entity called `:entity-name` with `entity-data`. The lifecycle of this entity starts at `date`.
+ "Creates an entity called `entity-id` with `entity-data`. The lifecycle of this entity starts at `bucket`.
- An error is documented if the entity is created already."
- [state date entity-name entity-data]
+ An error is documented if the entity is created already.
+
+ Returns `state` updated."
+ [state bucket entity-name entity-id entity-data]
(-> state
- (update-in [::entities entity-name]
+ (update-in [::sim-engine/entity entity-id]
(fn [entity]
- (let [created-already? (some? (get entity ::created))]
- (cond-> entity
- created-already? (clojure.core/update ::errors
- concat
- [#::{:why ::already-created
- :entity-name entity-name
- :state state
- :entity-state entity-data
- :date date}])
- (not created-already?) (assoc ::created {::date date})
- :else (assoc ::living {::date date})
- :else (clojure.core/update ::entity-state merge entity-data)))))))
+ (if (some? (::sim-engine/created entity))
+ (clojure.core/update entity
+ ::sim-engine/errors
+ (fnil conj [])
+ #::sim-engine{:why ::sim-engine/already-created
+ :entity-id entity-id
+ :entity-name entity-name
+ :entity-state entity-data
+ :bucket bucket})
+ #::sim-engine{:created bucket
+ :living bucket
+ :entity-state entity-data})))))
+
+(defn assign-event
+ "Assign `entity-id` to `event`."
+ [entity-id event]
+ (assoc event ::sim-engine/entity-id entity-id))
+
+(defn copy-entity-id
+ [source-event event]
+ (assoc event ::sim-engine/entity-id (::sim-engine/entity-id source-event)))
(defn errors
- "Returns entity errors if exists with a map associating a collection of errors to an `entity-name`"
- ([state]
- (->> (get state ::entities)
- (mapv (fn [[entity-name entity]]
- (when-let [errors (get entity ::errors)] [entity-name errors])))
- (filter (comp not empty? second))
- (into {})))
- ([state entity-name] (get-in state [::entities entity-name ::errors])))
-
-(defn error?
- "Detects an eror in the entities."
- [{::keys [entities]
+ "Return `entity` with at least one error."
+ [{::sim-engine/keys [entity]
:as _state}]
- (->> entities
- vals
- (filter ::errors)
- first
- some?))
+ (->> entity
+ (mapv (fn [[entity-id entity]]
+ (when-let [errors (get entity ::sim-engine/errors)] [entity-id errors])))
+ (filter (comp not empty? second))
+ (into {})))
+
+(defn entity-errors
+ "Return `errors` from current entity in `event`.
+ Returns `nil` otherwise."
+ [state
+ {::sim-engine/keys [entity-id]
+ :as _event}]
+ (get-in state [::sim-engine/entity entity-id ::sim-engine/errors]))
(defn update
- "Update the entity called `:entity-name` with `f` applied to the existing value together with arguments `args`.
- The update of the entity is mark in the `living` lifecycle field."
- [state date entity-name f & args]
- (try
- (-> state
- (update-in
- [::entities entity-name]
- (fn [entity]
- (cond-> entity
- (some? (::disposed entity)) (clojure.core/update ::errors
- conj
- #::{:why ::updating-a-disposed-entity
- :state state
- :date date
- :entity-name entity-name
- :function f
- :args args})
- (nil? (::created entity)) (assoc ::created #::{:date date})
- (nil? (::created entity)) (clojure.core/update ::errors
- conj
- #::{:why ::updating-a-not-created-entity
- :state state
- :date date
- :entity-name entity-name
- :function f
- :args args})
- :else (assoc-in [::living ::date] date)
- :else (clojure.core/update ::entity-state (partial apply f) args)))))
- (catch #?(:clj Exception
- :cljs :default)
- e
- (-> state
- (update-in [::entities entity-name ::errors]
- concat
- [#::{:why ::exception-during-update
- :entity-name entity-name
- :state state
- :date date
- :exception e}])))))
+ "Returns `state` updated with `f` applied to entity `entity-id`.
+ `f` is applied with `args`: `(apply f entity-state args)`
+
+ `bucket` is used to tag when errors occur and mark when the last updated has been done"
+ [state event bucket f & args]
+ (let [{::sim-engine/keys [entity-id]} event]
+ (try
+ (update-in
+ state
+ [::sim-engine/entity entity-id]
+ (fn [old-entity]
+ (let [updated-entity
+ (-> old-entity
+ (assoc ::sim-engine/living bucket)
+ (clojure.core/update ::sim-engine/entity-state (partial apply f) args))]
+ (cond
+ (::sim-engine/disposed old-entity)
+ (clojure.core/update updated-entity
+ ::sim-engine/errors
+ (fnil conj [])
+ #::sim-engine{:args args
+ :bucket bucket
+ :entity-id entity-id
+ :function f
+ :old-entity old-entity
+ :why ::sim-engine/updating-a-disposed-entity})
+ (not (::sim-engine/created old-entity))
+ (-> updated-entity
+ (assoc ::sim-engine/created bucket)
+ (clojure.core/update ::sim-engine/errors
+ (fnil conj [])
+ #::sim-engine{:args args
+ :bucket bucket
+ :entity-id entity-id
+ :function f
+ :old-entity old-entity
+ :why
+ ::sim-engine/updating-a-not-created-entity}))
+ :else updated-entity))))
+ (catch #?(:clj Exception
+ :cljs :default)
+ e
+ (-> state
+ (update-in [::sim-engine/entity entity-id ::sim-engine/errors]
+ (fnil conj [])
+ #::sim-engine{:args args
+ :bucket bucket
+ :entity-id entity-id
+ :exception e
+ :function f
+ :old-entity (get-in state [::sim-engine/entity entity-id])
+ :why ::sim-engine/exception-during-update}))))))
(defn state
- "Returns the state value of the entity called `entity-name`."
- [state entity-name]
- (get-in state [::entities entity-name ::entity-state]))
+ "Returns the `state` value of the entity called `entity-id`."
+ [state
+ {::sim-engine/keys [entity-id]
+ :as _event}]
+ (get-in state [::sim-engine/entity entity-id ::sim-engine/entity-state]))
+
+(defn- dispose*
+ [state bucket event dissoc-state?]
+ (let [{::sim-engine/keys [entity-id]} event]
+ (-> state
+ (update-in [::sim-engine/entity entity-id]
+ (fn [old-entity]
+ (let [updated-entity (cond-> old-entity
+ true (assoc ::sim-engine/disposed bucket)
+ dissoc-state? (dissoc ::sim-engine/entity-state))]
+ (cond
+ (nil? (::sim-engine/created old-entity))
+ (-> updated-entity
+ (assoc ::sim-engine/created bucket)
+ (assoc ::sim-engine/living bucket)
+ (clojure.core/update
+ ::sim-engine/errors
+ (fnil conj [])
+ #::sim-engine{:bucket bucket
+ :entity-id entity-id
+ :old-entity old-entity
+ :why ::sim-engine/disposing-a-not-created-entity}))
+ (some? (::sim-engine/disposed old-entity))
+ (-> updated-entity
+ (clojure.core/update ::sim-engine/errors
+ (fnil conj [])
+ #::sim-engine{:bucket bucket
+ :entity-id entity-id
+ :old-entity old-entity
+ :why
+ ::sim-engine/already-disposed}))
+ :else updated-entity)))))))
(defn dispose
- "Disposing an entity by its `entity-name` is removing its data, its lifecycle will mark `::disposed` at the current `date`."
- [state date entity-name]
- (-> state
- (update-in [::entities entity-name]
- (fn [entity]
- (cond-> entity
- (nil? (::created entity)) (assoc-in [::created ::date] date)
- (nil? (::created entity)) (assoc-in [::living ::date] date)
- (some? (::disposed entity)) (clojure.core/update ::errors
- conj
- #::{:why ::already-disposed
- :state state
- :date date
- :entity-name entity-name})
- (nil? (::created entity)) (clojure.core/update
- ::errors
- conj
- #::{:why ::disposing-a-not-created-entity
- :state state
- :date date
- :entity-name entity-name})
- :else (assoc-in [::disposed ::date] date)
- :else (dissoc ::entity-state))))))
+ "Disposing an entity by its `entity-id` is removing its data, its lifecycle will mark `::sim-engine/disposed` at the current `bucket`."
+ [state event bucket]
+ (dispose* state bucket event true))
+
+(defn dispose-with-history
+ "Disposing an entity by its `entity-id` is removing its data, its lifecycle will mark `::sim-engine/disposed` at the current `bucket`."
+ [state event bucket]
+ (dispose* state bucket event false))
(defn lifecycle-status
- "The lifecycle has three possible fields `::created`, `::living` or `:disposed` depending on the position of the entity in its lifecycle."
- [state entity-name]
+ "The lifecycle has three possible fields `::sim-engine/created`, `::sim-engine/living` or `::sim-engine/disposed` depending on the position of the entity in its lifecycle."
+ [state
+ {::sim-engine/keys [entity-id]
+ :as _event}]
(-> state
- (get-in [::entities entity-name])
- (select-keys [::created ::living ::disposed])))
+ (get-in [::sim-engine/entity entity-id])
+ (select-keys [::sim-engine/created ::sim-engine/living ::sim-engine/disposed])))
(defn is-created?
- "Is the entity called `:entity-name` living?"
- [state entity-name]
- (let [{::keys [created]} (get-in state [::entities entity-name])] created))
+ "Is the entity called `:entity-id` living?"
+ [state
+ {::sim-engine/keys [entity-id]
+ :as _event}]
+ (let [{::sim-engine/keys [created]} (get-in state [::sim-engine/entity entity-id])] created))
(defn is-living?
- "Is the entity called `:entity-name` living?"
- [state entity-name]
- (let [{::keys [living disposed]} (get-in state [::entities entity-name])]
+ "Is the entity called `:entity-id` living?"
+ [state
+ {::sim-engine/keys [entity-id]
+ :as _event}]
+ (let [{::sim-engine/keys [living disposed]} (get-in state [::sim-engine/entity entity-id])]
(when (and living (not disposed)) living)))
(defn is-disposed?
- "Is the entity called `:entity-name` disposed?"
- [state entity-name]
- (let [{::keys [disposed]} (get-in state [::entities entity-name])] disposed))
-
-(defn lifecycle-corrupted
- "Detects if one entity has a lifecycle error."
- [{::sim-engine/keys [state]
- :as _snapshot}
- _params]
- (when (error? state)
- {:stop? true
- :context (errors state)}))
-
-(defn stopping-definition
- []
- #:auto-sim.simulation-engine{:doc
- "Stops when an error occured in an entity lifecycle."
- :id ::entity-lifecycle-corrupted
- :next-possible? true
- :stopping-evaluation lifecycle-corrupted})
-
-(defn wrap-model
- "Wraps a model to add necessary behavior to model an entity."
- [model]
- (-> model
- (update-in [::sim-engine/registry ::sim-engine/stopping]
- sim-de-stopping-registry/add-stopping-definition
- (stopping-definition))))
+ "Is the entity called `:entity-id` disposed?"
+ [state
+ {::sim-engine/keys [entity-id]
+ :as _event}]
+ (let [{::sim-engine/keys [disposed]} (get-in state [::sim-engine/entity entity-id])] disposed))
+
+(defn n-entities-event
+ "Event to create `n` entities separated with `waiting-time` buckets"
+ [bucket n waiting-time type]
+ {::sim-engine/type type
+ ::sim-engine/bucket bucket
+ ::waiting-time waiting-time
+ ::nb-entity 0
+ ::max-nb-entity n})
+
+;; ********************************************************************************
+;; Internal API
+;; ********************************************************************************
+
+(defn schedule-entity-every
+ "Schedule an entity creation every `waiting-time` buckets.
+
+ The event is created only `max-nb-entity` times
+
+ Returns an event-return with:
+ * `::sim-engine/state` with a new entity created named `entity-name`
+ * `::sim-engine/future-events` with events to create next entities in `waiting-time` buckets"
+ [event-return event bucket entity-name entity-data]
+ (let [{::sim-engine/keys [state future-events]} event-return
+ entity-id (create-id)
+ {::keys [nb-entity max-nb-entity waiting-time]} event]
+ (if (< nb-entity max-nb-entity)
+ (let [nb-entity (inc nb-entity)]
+ (assoc event-return
+ ::sim-engine/entity-id entity-id
+ ::sim-engine/state (create state bucket entity-name entity-id entity-data)
+ ::sim-engine/future-events (cond-> future-events
+ (< nb-entity max-nb-entity)
+ (conj (assoc event
+ ::sim-engine/bucket (+ bucket waiting-time)
+ ::nb-entity nb-entity)))))
+ event-return)))
+
+(defn schedule*
+ [event-return _event _bucket new-event entity-id bucket]
+ (if (nil? entity-id)
+ (clojure.core/update event-return
+ ::sim-engine/errors
+ (fnil conj [])
+ #::sim-engine{:why :no-entity-id-to-pick
+ :entity-id entity-id
+ :event-return event-return})
+ (let [scheduled-event (-> new-event
+ (assoc ::sim-engine/entity-id entity-id ::sim-engine/bucket bucket))]
+ (-> event-return
+ (clojure.core/update ::sim-engine/future-events (fnil conj []) scheduled-event)))))
+
+(defn schedule-new-entity
+ "Schedules the execution of `new-event` at `bucket` for the entity stored in `event-return ` by `schedule-entity-every` will be used.
+
+ If none exist, an error is raised.
+
+ Returns `event-return` with `future-events` updated."
+ [event-return event bucket new-event]
+ (let [event-id (::sim-engine/entity-id event-return)]
+ (schedule* event-return event bucket new-event event-id bucket)))
+
+(defn schedule
+ "Schedules the execution of `new-event` at `bucket` for the same entity than `event`
+
+ Returns `event-return` with `future-events` updated."
+ [event-return event bucket new-event]
+ (schedule* event-return event bucket new-event (::sim-engine/entity-id event) bucket))
+
+(defn schedule-events
+ "Schedules the execution of `new-event` at `bucket` for the same entity than `event`
+
+ Returns `event-return` with `future-events` updated."
+ [event-return event bucket new-events]
+ (reduce #(schedule* %1 event bucket %2 (::sim-engine/entity-id event) bucket)
+ event-return
+ new-events))
+
+(defn sink
+ "End of life of an entity"
+ [event-return event bucket]
+ (-> event-return
+ (clojure.core/update ::sim-engine/state dispose* bucket event false)))
diff --git a/src/cljc/auto_sim/event_library/common.cljc b/src/cljc/auto_sim/event_library/common.cljc
deleted file mode 100644
index 8055f27..0000000
--- a/src/cljc/auto_sim/event_library/common.cljc
+++ /dev/null
@@ -1,31 +0,0 @@
-(ns auto-sim.event-library.common
- "Event library helpers."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.event-return :as sim-de-event-return]))
-
-(defn sink
- "A sink is a noop event creating no other events."
- [_event state future-events]
- #:auto-sim.simulation-engine{:state state
- :future-events future-events})
-
-(defn init-events
- "Add events from `events-to-add` to the future-events, set the `initial-date` to them."
- [events-to-add initial-date]
- (fn [_event state future-events]
- #:auto-sim.simulation-engine{:state state
- :future-events
- (-> future-events
- (concat
- (map #(assoc % ::sim-engine/date initial-date)
- events-to-add)))}))
-
-(defn delay-event
- "Play the event in the future, with a fix delay."
- [event-to-postpone delay]
- (fn [{::sim-engine/keys [date]} state future-events]
- (let [new-date (+ date delay)]
- (-> #:auto-sim.simulation-engine{:state state
- :future-events future-events}
- (sim-de-event-return/add-event event-to-postpone new-date)))))
diff --git a/src/cljc/auto_sim/links.cljc b/src/cljc/auto_sim/links.cljc
new file mode 100644
index 0000000..a32cbd6
--- /dev/null
+++ b/src/cljc/auto_sim/links.cljc
@@ -0,0 +1,15 @@
+(ns auto-sim.links
+ (:require
+ [auto-sim :as-alias sim]))
+
+(def links
+ (->> [{:url "simulation/machine.svg"
+ :id ::sim/machine}
+ {:url "simulation/product.svg"
+ :id ::sim/product}
+ {:url "simulation/source.svg"
+ :id ::sim/source}
+ {:url "simulation/sink.svg"
+ :id ::sim/sink}]
+ (mapv (fn [link] [(:id link) link]))
+ (into {})))
diff --git a/src/cljc/auto_sim/machine.cljc b/src/cljc/auto_sim/machine.cljc
new file mode 100644
index 0000000..5c973a2
--- /dev/null
+++ b/src/cljc/auto_sim/machine.cljc
@@ -0,0 +1,31 @@
+(ns auto-sim.machine
+ "Model machine.
+
+ Machine expects `::sim-engine/current-operation` field to be set."
+ (:require
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.route :as sim-route]))
+
+(defn infinite-capacity
+ "Models a machine processing during.
+
+ The duration of the processing is taken in the entity state [`::sim-engine/current-operation` `kw`].
+
+ Returns `event-return` updated with `postponed-event`, at `(+ pt bucket)`"
+ [event-return event bucket postponed-event kw]
+ (let [current-operation (sim-route/current-operation event-return event bucket)]
+ (if (nil? current-operation)
+ (update event-return
+ ::sim-engine/errors
+ (fnil conj [])
+ #::sim-engine{:why :current-operation-is-nil})
+ (let [pt (get current-operation kw)]
+ (if (and (number? bucket) (number? pt) (pos? pt))
+ (sim-route/schedule event-return event (+ bucket pt) postponed-event)
+ (update event-return
+ ::sim-engine/errors
+ (fnil conj [])
+ {::sim-engine/why :buckets-cant-be-calculated
+ :machine-proceessing pt
+ :kind kw
+ :bucket bucket}))))))
diff --git a/src/cljc/auto_sim/middleware.cljc b/src/cljc/auto_sim/middleware.cljc
new file mode 100644
index 0000000..1030a74
--- /dev/null
+++ b/src/cljc/auto_sim/middleware.cljc
@@ -0,0 +1,39 @@
+(ns auto-sim.middleware
+ "Middlewares for simulaion handler"
+ (:require
+ [auto-sim.engine :as-alias sim-engine]))
+
+(defn wrap-tap-request
+ "Wrap an handler to tap the request"
+ [handler]
+ (fn [current-event state future-events]
+ (tap> {:current-event current-event
+ :state state
+ :future-events future-events})
+ (handler current-event state future-events)))
+
+(defn wrap-tap-response
+ "Wrap an handler to tap the response"
+ [handler]
+ (fn [current-event state future-events]
+ (let [response (handler current-event state future-events)]
+ (tap> {:current-event current-event
+ :state state
+ :response response
+ :future-events future-events})
+ response)))
+
+(defn wrap-rendering
+ "Wrap the `handler` to apply the rendering function `rendering-fn` to the state and then executes the handler."
+ [rendering-fn handler]
+ (fn [current-event state future-events]
+ (let [res (handler current-event state future-events)]
+ (rendering-fn (:state res))
+ res)))
+
+(defn wrap
+ "Wrap the `handler` with the middlewares.
+
+ Returns the handler value wrapped in all the middlewares."
+ [middlewares handler]
+ (reduce (fn [handler middleware] (middleware handler)) handler middlewares))
diff --git a/src/cljc/auto_sim/simulation_engine/ordering.cljc b/src/cljc/auto_sim/ordering.cljc
similarity index 53%
rename from src/cljc/auto_sim/simulation_engine/ordering.cljc
rename to src/cljc/auto_sim/ordering.cljc
index c52a916..2fa51f5 100644
--- a/src/cljc/auto_sim/simulation_engine/ordering.cljc
+++ b/src/cljc/auto_sim/ordering.cljc
@@ -1,9 +1,9 @@
-(ns auto-sim.simulation-engine.ordering
- "Event ordering is a part of the event registry meant to sort the future events.
+(ns auto-sim.ordering
+ "Event ordering is used to have a reliable and repeatable sorting of events in the scheduler.
- It is especially important to manage simultaneous events. These events does not exists in the real life, but the.
-
- * [See entity](docs/archi/ordering_entity.png)
+ An event ordering should be:
+ * a total order
+ * disambiguating simultaneous events
## Date ordering
Date ordering is sorting events by date
@@ -16,12 +16,10 @@
## Simultaneous events
Two or more events are simultaneous if they happen at the same date in the scheduler."
(:require
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(def schema [:function [:=> [:cat :any :any] :boolean]])
+ [auto-sim.engine :as-alias sim-engine]))
-(defn compare-field
- "Returns a function to compare `e1` and `e2` based on values of field `field`. `nil` values are accepted."
+(defn fields
+ "Returns a function to compare `e1` and `e2` based on values of field `field`. `nil` values are considered like `infinity`."
[field]
(fn [e1 e2]
(let [d1 (field e1)
@@ -31,7 +29,7 @@
(nil? d2) -666
:else (compare d1 d2)))))
-(defn compare-types
+(defn types
"Compares two events `e1` and `e2` with their types, based on their ordering in `evt-type-priorities`, list of event priorities, ordered with higher priority first in the list.
Returns the difference of their position in the `evt-type-priorities`, which is `0` in case of equality, negative if `e1` is before `e2`."
[evt-type-priorities]
@@ -44,26 +42,20 @@
(not= te1 te2) (- (.indexOf evt-type-priorities te1) (.indexOf evt-type-priorities te2))
:else 0))))
+(defn hashes
+ "Compares two events with their hash value"
+ []
+ (fn [e1 e2] (compare (hash e1) (hash e2))))
+
(defn- orders
- "Orders events by date.
- Applies caller defined decision on which event should be executed first."
- [orderings e1 e2]
- (loop [orderings orderings]
- (let [ordering (first orderings)
- res (if (some? ordering) (ordering e1 e2) 0)]
- (cond
- (nil? ordering) 0
- (zero? res) (recur (rest orderings))
- :else res))))
+ "Orders events by date."
+ [order-fns e1 e2]
+ (loop [[order-fn & rorder-fns] order-fns]
+ (if (nil? order-fn) 0 (let [res (order-fn e1 e2)] (if (zero? res) (recur rorder-fns) res)))))
(defn sorter
- "Returns a function with two events as parameters and returning the comparison of them, according to event-orderings."
- [orderings]
- (fn [events] (sort (fn [e1 e2] (orders orderings e1 e2)) events)))
+ "A `sorter` returns a function to sort events. The comparison is done in the order of elements in `order-fns`.
-(defn data-to-fn
- [[kind data :as _ordering-data]]
- (case kind
- ::sim-engine/field (compare-field data)
- ::sim-engine/type (compare-types data)
- nil))
+ Returns a function with two events as parameters and returning the comparison of them, according to event-orderings."
+ [& order-fns]
+ (fn [events] (sort (fn [e1 e2] (orders order-fns e1 e2)) events)))
diff --git a/src/cljc/auto_sim/predicates.cljc b/src/cljc/auto_sim/predicates.cljc
deleted file mode 100644
index ae3ae52..0000000
--- a/src/cljc/auto_sim/predicates.cljc
+++ /dev/null
@@ -1,124 +0,0 @@
-(ns auto-sim.predicates
- "Predicates are functions that takes as a param a value and return true if the value matches predicate, false otherwise and nil if comparison can't be done.
- Predicate functions can be expressed via a query language represented with vector.
- This namespace is about managing that language"
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.predicates.composed-predicates :as sim-pred-composed]
- [auto-sim.predicates.equality-predicates :as sim-pred-equality]
- [clojure.walk :as walk]))
-
-(def pred-lang-schema
- "Predicate vector language consists of :keyword represnting the name of predicate and zero or more parameters for that predicate
- [See predicate language](docs/archi/transformation/predicate_query.png)"
- [:cat :keyword [:* :any]])
-
-(def registry-value
- [:map
- [:pred-fn fn?]
- [:validation-fn {:optional true}
- fn?]
- [:doc {:optional true}
- :string]])
-
-(def pred-registry-schema
- "Predicate registry consists of keyword keys representing predicate name with map as a value, containing an implementation of the predicate under :pred-fn and metadata for the predicate"
- [:map-of :keyword registry-value])
-
-(def predicates-registry
- "Default predicates language registry.
- [See more](docs/archi/transformation/predicate_registry.png)"
- (merge sim-pred-equality/equality-predicates-lang-reg
- sim-pred-composed/composed-predicates-lang-reg))
-
-(defn is-predicate?
- [reg pred]
- (true? (and (core-schema/validate-data pred-lang-schema pred)
- (fn? (get-in reg [(first pred) :pred-fn])))))
-
-(defn- predicate-valid?
- [reg pred]
- (let [validation-fn (get-in reg [(first pred) :validation-fn])]
- (if (fn? validation-fn) (true? (validation-fn pred)) true)))
-
-(defn predicate-validation
- [reg pred]
- (try (clojure.walk/prewalk (fn [el]
- (cond
- (and (is-predicate? reg el) (not (predicate-valid? reg pred)))
- (throw (ex-info "Predicate is not valid"
- {:pred el
- :reg reg}))
- :else el)
- el)
- pred)
- nil
- (catch #?(:clj Exception
- :cljs :default)
- e
- {:error e}))
- nil)
-
-(defn predicate-lang->predicate-fn
- "Translates `pred` vector language into a function. Expects `reg` map containing predicate name as keys with values containing a function under :pred-fn"
- ([pred] (predicate-lang->predicate-fn predicates-registry pred))
- ([reg pred]
- (clojure.walk/postwalk (fn [el]
- (cond
- (keyword? el) (if-let [pred-fn (get-in reg [el :pred-fn])]
- pred-fn
- el)
- (and (vector? el) (fn? (first el))) (apply (first el) (rest el))
- :else el))
- pred)))
-
-(defn predicate-lang->pred-fn-detailed
- "Turns predicate query language into a function"
- ([pred] (predicate-lang->pred-fn-detailed predicates-registry pred))
- ([reg pred]
- (if-let [invalid-pred-schema (core-schema/validate-data-humanize pred-lang-schema pred)]
- {:msg "Predicate is not matching a schema"
- :error invalid-pred-schema}
- (if-let [invalid-pred-query (predicate-validation reg pred)]
- {:msg "Predicate is not valid"
- :error invalid-pred-query}
- (try (predicate-lang->predicate-fn reg pred)
- (catch #?(:clj Exception
- :cljs :default)
- e
- {:msg "Error during transformation from language to function"
- :error e}))))))
-
-(defn apply-query-detailed
- "Same as `apply-query`, but in case of an error it returns a map with more detailed information"
- ([pred d] (apply-query-detailed predicates-registry pred d))
- ([reg pred d]
- (let [pred-fn (predicate-lang->pred-fn-detailed reg pred)]
- (if (fn? pred-fn)
- (try (pred-fn d)
- (catch #?(:clj Exception
- :cljs :default)
- e
- {:msg "predicate failed during execution"
- :reg reg
- :invalid? true
- :pred pred
- :data d
- :error e}))
- {:reg reg
- :msg "predicate does not evaluated to function"
- :invalid? true
- :pred pred
- :data d
- :error pred-fn}))))
-
-(defn apply-query
- "Accepts `pred` query vector, translates it with `reg` and applies it to `d`
- Returns response from predicate or nil if application couldn't be done"
- ([pred d] (apply-query predicates-registry pred d))
- ([reg pred d]
- (try ((predicate-lang->predicate-fn reg pred) d)
- (catch #?(:clj Exception
- :cljs :default)
- _
- nil))))
diff --git a/src/cljc/auto_sim/predicates/composed_predicates.cljc b/src/cljc/auto_sim/predicates/composed_predicates.cljc
deleted file mode 100644
index 4345d50..0000000
--- a/src/cljc/auto_sim/predicates/composed_predicates.cljc
+++ /dev/null
@@ -1,47 +0,0 @@
-(ns auto-sim.predicates.composed-predicates
- "Composed predicates accept other predicates and return value based on their value"
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.predicates :as-alias sim-pred]))
-
-(defn not-fn
- "Returns true if `pred-fn` evaluates to false. Otherwise returns false."
- [pred-fn]
- #(not (pred-fn %)))
-
-(defn and-fn
- "Returns true if ALL of `pred-fns` evaluate to true"
- [& pred-fn]
- #(every? (fn [pred-fn] (true? (pred-fn %))) pred-fn))
-
-(defn or-fn
- "Returns true if ANY of `pred-fns` evaluates to true"
- [& pred-fn]
- #(boolean (some (fn [pred-fn] (true? (pred-fn %))) pred-fn)))
-
-(def pred-name :keyword)
-
-(defn- composed-pred-schema
- "Utility function for creating composed predicate schema"
- ([] (composed-pred-schema false))
- ([one-param?]
- [:schema {:registry
- {::composed-pred-schema
- [:cat
- pred-name
- (if one-param?
- [:or [:cat :keyword [:* :any]] [:schema [:ref ::composed-pred-schema]]]
- [:+ [:or [:cat :keyword [:* :any]] [:schema [:ref ::composed-pred-schema]]]])]}}
- [:ref ::composed-pred-schema]]))
-
-(def composed-predicates-lang-reg
- "All predicates in composed predicates lang registry expects other predicates as params"
- {::sim-pred/not {:doc "Returns true if predicate evaluates to false, false otherwise"
- :pred-fn not-fn
- :validation-fn #(core-schema/validate-data (composed-pred-schema true) %)}
- ::sim-pred/and {:doc "Returns true if ALL of them evaluate to true"
- :pred-fn and-fn
- :validation-fn #(core-schema/validate-data (composed-pred-schema) %)}
- ::sim-pred/or {:doc "Returns true if ANY of them evaluates to true"
- :pred-fn or-fn
- :validation-fn #(core-schema/validate-data (composed-pred-schema) %)}})
diff --git a/src/cljc/auto_sim/predicates/equality_predicates.cljc b/src/cljc/auto_sim/predicates/equality_predicates.cljc
deleted file mode 100644
index 9c4bdda..0000000
--- a/src/cljc/auto_sim/predicates/equality_predicates.cljc
+++ /dev/null
@@ -1,163 +0,0 @@
-(ns auto-sim.predicates.equality-predicates
- "Equality predicates compare values and return boolean based on the result"
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.predicates :as-alias sim-pred]
- [auto-sim.predicates.impl.utils :as sim-trans-utils]))
-
-(defn- in?
- "Return true if `value` is equal to one of values in `vs`, false otherwise"
- [value vs]
- (boolean (some (fn [v] (= v value)) vs)))
-
-(defn- str-includes? [str text] (some? (re-find (re-pattern text) str)))
-
-(defn- get-path
- "Return value under path, if path is nil return value itself"
- [path v]
- (cond
- (keyword? path) (get v path)
- (sequential? path) (get-in v path)
- (nil? path) v
- ;;:else added so cond don't throw error, but there is no real use-case for it except making this function total
- :else v))
-
-(defn is?-fn
- "Returns predicate function that sa a param accepts value
- which will be compared with `v` and return true if it's equal, false if it's not.
- If `path` is supplied it will consider value under path for comparison"
- ([path v] #(= v (get-path path %)))
- ([v] (is?-fn nil v)))
-
-(defn one-of?-fn
- "Returns predicate function that as a param accepts value which is compared with values in `vs`. If any of them are equal, predicate will return true.
- If `path` is supplied it will consider value under path for comparison"
- ([vs] (one-of?-fn nil vs))
- ([path vs] #(if (sequential? vs) (in? (get-path path %) vs) nil)))
-
-(defn is-empty?-fn
- "Returns predicate fn that as a param accepts value which if nil or empty collection will return true.
- If `path` is supplied it will consider value under path for comparison"
- ([path]
- #(if-let [v (get-path path %)]
- (if (coll? v) (empty? v) false)
- true))
- ([] (is-empty?-fn nil)))
-
-(defn true?-fn
- "Returns predicate fn that as a param accepts a value that if equals to true will return true.
- If `path` is supplied it will consider value under path for comparison"
- ([path] (is?-fn path true))
- ([] (is?-fn true)))
-
-(defn false?-fn
- "Returns predicate fn that as a param accepts a value that if equals to false will return true.
- If `path` is supplied it will consider value under path for comparison"
- ([path] (is?-fn path false))
- ([] (is?-fn false)))
-
-(defn contains?-fn
- "Returns pred fn that accepts any type data.
- Pred will return true if `value` exists in that data.
- If `path` is supplied it will consider value under path for comparison"
- ([path value]
- #(let [v (get-path path %)]
- (cond
- (string? v) (str-includes? v value)
- (map? v) (->> (sim-trans-utils/keypaths v)
- (some (fn [path] ((is?-fn path v) value)))
- boolean)
- (sequential? v) ((one-of?-fn v) value)
- :else ((is?-fn v) value))))
- ([text] (contains?-fn nil text)))
-
-(defn starts-with?-fn
- "Returns pred fn that accepts string.
- Pred will return true if that string starts with `text`.
- If `path` is supplied it will consider value under path for comparison"
- ([path text]
- #(let [v (get-path path %)]
- (when (and (string? v) (string? text)) (str-includes? v (str "^" text)))))
- ([text] (starts-with?-fn nil text)))
-
-(defn ends-with?-fn
- "Returns pred fn that accepts string.
- Pred will return true if that string ends with `text`.
- If `path` is supplied it will consider value under path for comparison"
- ([path text] #(let [v (get-path path %)] (when (string? v) (str-includes? v (str text "$")))))
- ([text] (ends-with?-fn nil text)))
-
-(defn >-fn
- ([path v] #(let [ov (if (keyword? path) (get % path) (get-in % path))] (clojure.core/> ov v)))
- ([v] #(clojure.core/> % v)))
-
-(defn >=-fn
- ([path v] #(let [ov (if (keyword? path) (get % path) (get-in % path))] (clojure.core/>= ov v)))
- ([v] #(clojure.core/>= % v)))
-
-(defn <-fn
- ([path v] #(let [ov (if (keyword? path) (get % path) (get-in % path))] (clojure.core/< ov v)))
- ([v] #(clojure.core/< % v)))
-
-(defn <=-fn
- ([path v] #(let [ov (if (keyword? path) (get % path) (get-in % path))] (clojure.core/<= ov v)))
- ([v] #(clojure.core/<= % v)))
-
-(def pred-name :keyword)
-
-(def path [:or :keyword :string [:vector [:or :keyword :string]]])
-
-(defn- lang-schema
- "Utility function for creating schema for equality predicates"
- ([] (lang-schema true))
- ([strict?] (lang-schema strict? :any))
- ([strict? val-type]
- (if (not strict?) [:cat pred-name [:? path]] [:cat pred-name [:? path] val-type])))
-
-(defn- lang-valid?
- "Returns true if predicate lang vector for equality predicate is valid"
- ([schema pred] (core-schema/validate-data schema pred))
- ([pred] (lang-valid? (lang-schema) pred)))
-
-(def equality-predicates-lang-reg
- "Each predicate return boolean if comparison with pred-fn input can be done"
- {::sim-pred/always-true {:doc "Returns always true"
- :pred-fn #(constantly true)}
- ::sim-pred/equal? {:doc "Compares if values are equal"
- :pred-fn is?-fn
- :validation-fn lang-valid?}
- ::sim-pred/one-of? {:doc "compares if one of values is equal to input"
- :pred-fn one-of?-fn
- :validation-fn (partial lang-valid?
- (conj (lang-schema false) [:sequential :any]))}
- ::sim-pred/is-empty? {:doc "compares if value nil or empty collection"
- :pred-fn is-empty?-fn
- :validation-fn (partial lang-valid? (lang-schema false))}
- ::sim-pred/contains? {:doc "Returns true if pred-fn input contains value, works for string"
- :pred-fn contains?-fn
- :validation-fn lang-valid?}
- ::sim-pred/starts-with? {:doc
- "True if pred input starts with text, expects input to be a strings"
- :pred-fn starts-with?-fn
- :validation-fn (partial lang-valid? (lang-schema true :string))}
- ::sim-pred/ends-with? {:doc "True if pred input ends with text expects input to be a string"
- :pred-fn ends-with?-fn
- :validation-fn (partial lang-valid? (lang-schema true :string))}
- ::sim-pred/true? {:doc "Is true?"
- :pred-fn true?-fn
- :validation-fn (partial lang-valid? (lang-schema false))}
- ::sim-pred/false? {:doc "Is false?"
- :pred-fn false?-fn
- :validation-fn (partial lang-valid? (lang-schema false))}
- ::sim-pred/> {:doc "Is value greater than.."
- :pred-fn >-fn
- :validation-fn (partial lang-valid? (lang-schema true :number))}
- ::sim-pred/< {:doc "Is value lesser than.."
- :pred-fn <-fn
- :validation-fn (partial lang-valid? (lang-schema true :number))}
- ::sim-pred/>= {:doc "Is value greater or equal"
- :pred-fn >=-fn
- :validation-fn (partial lang-valid? (lang-schema true :number))}
- ::sim-pred/<= {:doc "Is value lesser or equal"
- :pred-fn <=-fn
- :validation-fn (partial lang-valid? (lang-schema true :number))}})
diff --git a/src/cljc/auto_sim/predicates/impl/utils.cljc b/src/cljc/auto_sim/predicates/impl/utils.cljc
deleted file mode 100644
index 4b1cabb..0000000
--- a/src/cljc/auto_sim/predicates/impl/utils.cljc
+++ /dev/null
@@ -1,35 +0,0 @@
-(ns auto-sim.predicates.impl.utils
- (:require
- [clojure.walk :as walk]))
-
-(defn remove-nils
- "remove pairs of key-value that has nil value from a (possibly nested) map. also transform map to nil if all of its value are nil"
- [nm]
- (walk/postwalk (fn [el]
- (cond
- (map? el) (not-empty (into {} (remove (comp nil? second)) el))
- (vector? el) (into [] (remove nil? el))
- (list? el) (remove nil? el)
- :else el))
- nm))
-
-(defn nilify-vals
- "It nilify whole keyword value if all values in map are nil"
- ([m] (nilify-vals [] m {}))
- ([base-path m result]
- (reduce-kv (fn [acc k v]
- (if (and (map? v) (not (every? nil? (vals v))))
- (nilify-vals (conj base-path k) v acc)
- (assoc-in acc (conj base-path k) nil)))
- result
- m)))
-
-(defn keypaths
- ([m] (keypaths [] m []))
- ([base-path m result]
- (reduce-kv (fn [acc k v]
- (cond
- (map? v) (keypaths (conj base-path k) v acc)
- :else (conj acc (conj base-path k))))
- result
- m)))
diff --git a/src/cljc/auto_sim/rc.cljc b/src/cljc/auto_sim/rc.cljc
index 3f68ab8..361f644 100644
--- a/src/cljc/auto_sim/rc.cljc
+++ b/src/cljc/auto_sim/rc.cljc
@@ -1,111 +1,124 @@
(ns auto-sim.rc
- "Models resource consumers interaction.
+ "Models the resource consumers interaction.
- Resource definition:
- * A limited quantity of items that are used (e.g. seized and disposed) by entities as they proceed through the system. A resource has a capacity that governs the total quantity of items that may be available. All the items in the resource are homogeneous, meaning that they are indistinguishable. If an entity attempts to seize a resource that does not have any units available it must wait in a queue. It is often representing real world items that availability is limited (e.g. machine, wrench).
+ Definitions:
+ * Resource definition: A limited quantity of items that are seized and disposed by entities as they proceed through the system. A resource has a capacity that governs the total quantity of items that may be available. All the items in the resource are homogeneous, meaning that they are indistinguishable. If an entity attempts to seize a resource that does not have any units available it must wait in a queue. It is often representing real world items that availability is limited (e.g. machine, wrench).
+ * Consumer definition: A consumer is responsible for seizing and disposing the resource.
- Consumer definition:
- * A consumer is responsible for seizing and disposing the resource.
-
- Note:
- * All namespaced keywords of the rc bounded context are from this namespace, so rc users need only to refer this one."
+ A resource defines:
+ * `capacity` (default 1) total number of available resources, note that this number may evolve over time.
+ * `consumption` (default []) list of events currently consumption this resource, is useful to track them and enabling preemption and failures. The postponable-event contains the information on the waiting entity.
+ * `queue` (default []) list of blocked entities.
+ * `renewable?` (default true) when true, the disposing is not giving back the values."
(:require
- [auto-sim.rc.impl.preemption-policy.registry :as
- sim-de-rc-preemption-policy-registry]
- [auto-sim.rc.impl.state :as sim-de-rc-state]
- [auto-sim.rc.impl.unblocking-policy.registry :as
- sim-de-rc-unblocking-policy-registry]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.event-return :as sim-de-event-return]))
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.entity :as sim-entity]
+ [auto-sim.rc.resource :as sim-rc-resource]))
-(defn seize
- "Seize a resource,
+(defn nb-consumed-resources
+ "Returned how much resources `resource-name` are currently consumed"
+ [model _event _bucket resource-name]
+ (let [resource (get-in model [::sim-engine/state ::sim-engine/resource resource-name])]
+ (sim-rc-resource/nb-consumed-resources resource)))
- Depending on the capacity found in the state for that `resource-name`,
- * If capacity is not defined for that resource, the whole consumption is skipped, including the `postponed-event` execution.
- * If some resource are available, the `postponed-event` is executed now, (i.e. added at the current date in the scheduler)
- * Otherwise block that consumer and store it in the queue
- * Blocked consumer: A blocked consumer is a consumer waiting for a resource being available.
- * Queue: Stores blocked consumers.
+(defn nb-available-resources
+ "Returned how much resources `resource-name` are available"
+ [model _event _bucket resource-name]
+ (let [resource (get-in model [::sim-engine/state ::sim-engine/resource resource-name])]
+ (sim-rc-resource/nb-available-resources resource)))
- Returns an event-return."
- [{::sim-engine/keys [state]
- :as event-return}
- resource-name
- consumed-quantity
- seizing-date
- postponed-event]
- (let [[consumption-uuid state] (sim-de-rc-state/seize
- state
- resource-name
- consumed-quantity
- (when postponed-event
- (assoc postponed-event ::sim-engine/date seizing-date)))]
- (cond-> event-return
- consumption-uuid (sim-de-event-return/add-event
- (assoc-in postponed-event [::resource resource-name] consumption-uuid)
- seizing-date)
- (some? state) (assoc ::sim-engine/state state))))
+(defn define-resource
+ "Update `state` to define `resource-name` with `resource`.
-(defn dispose
- "Returns the `event-return` with the resource disposed, so it is available again.
+ Note that `resource` is defaulted if necessary."
+ [model _event _bucket resource-name resource]
+ (update model
+ ::sim-engine/state
+ assoc-in
+ [::sim-engine/resource resource-name]
+ (sim-rc-resource/defaulting-values resource)))
- A consumer is unblocked, the capacity of `resource-name` is freed."
- [event-return
- resource-name
- {::keys [resource]
- ::sim-engine/keys [date]
- :as _current-event}]
- (let [{::sim-engine/keys [state]} event-return
- [unblockings state]
- (sim-de-rc-state/dispose state resource-name (get resource resource-name))]
- (reduce (fn [event-return
- {::keys [consumed-quantity seizing-event]
- :as _blocking}]
- (seize event-return resource-name consumed-quantity date seizing-event))
- (assoc event-return ::sim-engine/state state)
- unblockings)))
+(defn seize
+ "The `postponable-event` is executed when the resource called `resource-name` has `quantity` items available.
-(defn resource-update
- "Update the resource capacity."
- [{::sim-engine/keys [state]
- :as event-return}
- resource-name
- new-capacity]
- (let [[unblocked-events state]
- (sim-de-rc-state/update-resource-capacity state resource-name new-capacity)]
- (-> event-return
- (assoc ::sim-engine/state state)
- (sim-de-event-return/add-events unblocked-events))))
+ There are two cases:
+ * If resources are lacking, the consumption is postponed, and the `postponable-event` stored in the `queue` of the `resource`. It may be triggered latter on, when freeing or capacity updating.
+ * If resources are sufficient, a consumption is added in the `resource`, the `postponable-event` is planned to be executed now by adding it in the `future-events`.
-(defn unblocking-policy-registry
- "Returns the default registry for event `unblocking-policy`.
- Note that you can enrich it with your own policies."
- []
- (sim-de-rc-unblocking-policy-registry/registry))
+ The `priority` defines.
-(defn preemption-policy-registry
- "Returns the default registry for event `preemption-policy`.
- Note that you can enrich it with your own policies."
- []
- (sim-de-rc-preemption-policy-registry/registry))
+ Returns a map:
+ * `state`
+ * `future-events`"
+ [model event bucket resource-name quantity postponable-event priority]
+ (if-let [resource (get-in model [::sim-engine/state ::sim-engine/resource resource-name])]
+ (let [{:keys [consumption-uuid resource errors]}
+ (sim-rc-resource/seize resource event quantity priority postponable-event)]
+ (cond-> (-> model
+ (assoc-in [::sim-engine/state ::sim-engine/resource resource-name] resource))
+ consumption-uuid (sim-entity/schedule event bucket postponable-event)
+ (seq errors) (update ::sim-engine/errors #(reduce (fnil conj []) % errors))))
+ ;;NOTE seizing is noop
+ (update model
+ ::sim-engine/errors
+ (fnil conj [])
+ #::sim-engine{:why :resource-not-found
+ :resource-name resource-name
+ :quantity quantity
+ :possible-resources (-> model
+ ::sim-engine/state
+ ::sim-engine/resource
+ keys
+ vec)})))
-(defn wrap-model
- "Wraps a model to add necessary behavior to model a resource/consumer.
+(defn schedule-now
+ [model events bucket]
+ (-> model
+ (update ::sim-engine/future-events
+ concat
+ (mapv #(-> %
+ ::sim-engine/event
+ (assoc ::sim-engine/bucket bucket))
+ events))))
- Resource/Consumer modeling is a way to model state and events for simulation, by using concepts of resource being used by consumer
+(defn dispose
+ "Dispose a resource called `resource-name` for entity of `postponable-event`.
+
+ The new available resources can be used by some other entities. `unqueueing-policy-fn` is used to select events to unqueue.
- The `resources` is a map defining the resource available:
- * `policy` In a queue, the policy selects the next consumer that will be unblocked. (Each queue has its own policy)
- * `renewable?` When disposed, a renewable resource model is available again. Typically the toolings like wrenches, hammers, machines are most often renewable resources."
- [{{::keys [rc]} ::sim-engine/model-data
- :as model}
- unblocking-policy-registry
- preemption-policy-registry]
- (cond-> model
- (seq rc) (update-in [::sim-engine/initial-snapshot ::sim-engine/state]
- (fn [state]
- (sim-de-rc-state/define-resources state
- rc
- unblocking-policy-registry
- preemption-policy-registry)))))
+ Returns a pair:
+ * `state`
+ * `future-events`"
+ [model _event bucket resource-name quantity unqueueing-policy-fn priority-comp]
+ (if-let [resource (get-in model [::sim-engine/state ::sim-engine/resource resource-name])]
+ (let [{:keys [events resource errors]}
+ (sim-rc-resource/dispose resource priority-comp unqueueing-policy-fn quantity)]
+ (cond-> model
+ resource (assoc-in [::sim-engine/state ::sim-engine/resource resource-name] resource)
+ (seq events) (schedule-now events bucket)
+ ;;TODO This adding miss the bucket starting date should be replaced with a function. Where to define this function. Start here and think where to move it?
+ (seq errors) (update ::sim-engine/errors #(reduce (fnil conj []) % errors))))
+ (update model
+ ::sim-engine/errors
+ (fnil conj [])
+ #::sim-engine{:why :resource-not-found
+ :resource-name resource-name
+ :quantity quantity})))
+
+(defn update-capacity
+ "Update the resource capacity."
+ [model event bucket resource-name new-capacity preemption-policy-fn unqueueing-policy-fn]
+ (if-let [resource (get-in model [::sim-engine/state ::sim-engine/resource resource-name])]
+ (let [{:keys [events _preempt resource]} (sim-rc-resource/update-capacity resource
+ preemption-policy-fn
+ unqueueing-policy-fn
+ new-capacity)]
+ (cond-> model
+ resource (assoc-in [::sim-engine/state ::sim-engine/resource resource-name] resource)
+ events (sim-entity/schedule-events event bucket events)))
+ (update model
+ ::sim-engine/errors
+ (fnil conj [])
+ #::sim-engine{:why :resource-not-found
+ :resource-name resource-name
+ :new-capacity new-capacity})))
diff --git a/src/cljc/auto_sim/rc/impl/preemption_policy/base.cljc b/src/cljc/auto_sim/rc/impl/preemption_policy/base.cljc
deleted file mode 100644
index b98b262..0000000
--- a/src/cljc/auto_sim/rc/impl/preemption_policy/base.cljc
+++ /dev/null
@@ -1,6 +0,0 @@
-(ns auto-sim.rc.impl.preemption-policy.base "Basic preemption policies.")
-
-(defn no-preemption
- "Do nothing when a preemption occurs. In other words ,the failure or capacity decreases will have no effect before the next event on that resource."
- [resource]
- [[] resource])
diff --git a/src/cljc/auto_sim/rc/impl/preemption_policy/factory.cljc b/src/cljc/auto_sim/rc/impl/preemption_policy/factory.cljc
deleted file mode 100644
index ac4bae1..0000000
--- a/src/cljc/auto_sim/rc/impl/preemption_policy/factory.cljc
+++ /dev/null
@@ -1,11 +0,0 @@
-(ns auto-sim.rc.impl.preemption-policy.factory
- "Factory for `preemption-policy`."
- (:require
- [auto-sim.rc.impl.preemption-policy.base :as sim-de-rc-preemption-policy-base]))
-
-(def default-policy sim-de-rc-preemption-policy-base/no-preemption)
-
-(defn factory
- "`preemption-policy` factory."
- [registry preemption-policy]
- (get registry preemption-policy default-policy))
diff --git a/src/cljc/auto_sim/rc/impl/preemption_policy/registry.cljc b/src/cljc/auto_sim/rc/impl/preemption_policy/registry.cljc
deleted file mode 100644
index fff143e..0000000
--- a/src/cljc/auto_sim/rc/impl/preemption_policy/registry.cljc
+++ /dev/null
@@ -1,17 +0,0 @@
-(ns auto-sim.rc.impl.preemption-policy.registry
- "Registry for `preemption-policy`."
- (:require
- [auto-sim.rc :as-alias sim-rc]
- [auto-sim.rc.impl.preemption-policy.base :as sim-de-rc-preemption-policy-base]
- [auto-sim.rc.preemption-policy :as sim-de-rc-preemption-policy]))
-
-(defn schema
- "Schema for a `preemption-policy` registry."
- []
- [:map-of :keyword (sim-de-rc-preemption-policy/schema)])
-
-(defn registry
- "The base policies for `preemption-policy`."
- []
- #:auto-sim.rc{::sim-rc/no-preemption
- sim-de-rc-preemption-policy-base/no-preemption})
diff --git a/src/cljc/auto_sim/rc/impl/resource.cljc b/src/cljc/auto_sim/rc/impl/resource.cljc
deleted file mode 100644
index 1f362f7..0000000
--- a/src/cljc/auto_sim/rc/impl/resource.cljc
+++ /dev/null
@@ -1,105 +0,0 @@
-(ns auto-sim.rc.impl.resource
- "A resource is a limited quantity of items that are used by entities as they proceed through the system. A resource has a capacity that governs the total quantity of items that may be available. All the items in the resource are homogeneous, meaning that they are indistinguishable. If an entity attempts to seize a resource that does not have any units available it must wait in a queue.
- It is often representing real world items that availability is limited (e.g. machine, wrench, ...).
-
- A resource knows its instantenous capacity, its policies,and the element waiting for its availablility in the queue. The properties of a resource are:
- * `capacity` (default 1) total number of available resources, note that this number may evolve over time.
- * `currently-consuming` (default []) list of events currently consuming this resource, is useful to track them and enabling preemption and failures. The event contains the information on the waiting entity.
- * `preemption-policy` (default ::sim-de-rc/no-preemption) is the policy to apply when a resource is consumed and none is available.
- * `queue` (default []) list of blocked entities.
- * `renewable?` (default true) when true, the disposing is not giving back the values.
- * `unblocking-policy` (default ::simde-rc/FIFO) refers to an entity from the `auto-sim.rc.policies` registry, that registry will allow to pick one element in a queue."
- (:require
- [auto-sim.rc :as-alias sim-rc]
- [auto-sim.rc.impl.preemption-policy.factory :as
- sim-de-rc-preemption-policy-factory]
- [auto-sim.rc.impl.resource.consumption :as sim-de-rc-consumption]
- [auto-sim.rc.impl.resource.queue :as sim-de-rc-queue]
- [auto-sim.rc.impl.unblocking-policy.factory :as
- sim-de-rc-unblocking-policy-factory]))
-
-(defn defaulting-values
- "Returns a resource with default values added."
- [{::sim-rc/keys
- [capacity currently-consuming preemption-policy queue renewable? unblocking-policy]
- :as resource
- :or {capacity 1
- currently-consuming {}
- preemption-policy ::sim-rc/no-preemption
- queue []
- renewable? true
- unblocking-policy ::sim-rc/FIFO}}
- unblocking-policy-registry
- preemption-policy-registry]
- (assoc resource
- ::sim-rc/capacity capacity
- ::sim-rc/currently-consuming currently-consuming
- ::sim-rc/preemption-policy preemption-policy
- ::sim-rc/queue queue
- ::sim-rc/renewable? renewable?
- ::sim-rc/unblocking-policy unblocking-policy
- ::sim-rc/cache {::sim-rc/unblocking-policy-fn (sim-de-rc-unblocking-policy-factory/factory
- unblocking-policy-registry
- unblocking-policy)
- ::sim-rc/preemption-policy-fn (sim-de-rc-preemption-policy-factory/factory
- preemption-policy-registry
- preemption-policy)}))
-
-(defn nb-consumed-resources
- "Returns the number of consumed resources."
- [{:keys [::sim-rc/currently-consuming]
- :as _resource}]
- (if (map? currently-consuming)
- (->> currently-consuming
- vals
- (map (fn [{::sim-rc/keys [consumed-quantity]
- :or {consumed-quantity 1}}]
- consumed-quantity))
- (apply + 0))
- 0))
-
-(defn nb-available-resources
- "Returns the number of available resources based on the defined `capacity,` and the `currently-consuming` resources (i.e. sum of their )."
- [{::sim-rc/keys [capacity]
- :or {capacity 1}
- :as resource}]
- (max 0 (- (or capacity 0) (nb-consumed-resources resource))))
-
-(defn seize
- "Returns a pair:
- * the `consumption-uuid` if it has happened, nil if the execution is postponed awaiting for a resource disposal
- * the `state` reflecting the `resource` consumption
-
- The `seizing-event` is added in the `currently-seizing` so:
- * the number of available resources can be calculated, based on the used `quantity`
- * in case the seizing event should be cancelled (failures or preemption), the events are found in that list."
- [resource consumed-quantity postponed-event]
- (if (>= (compare (nb-available-resources resource) consumed-quantity) 0)
- (sim-de-rc-consumption/consume resource consumed-quantity postponed-event)
- [nil (sim-de-rc-queue/queue-event resource consumed-quantity postponed-event)]))
-
-(defn dispose
- "Returns a pair of:
- * `unblockings` list of blockings that should be try to seize again the resource
- * `resource` updated with consumption `consumption-uuid` removed."
- [resource consumption-uuid]
- (let [resource (sim-de-rc-consumption/free resource consumption-uuid)]
- (sim-de-rc-queue/unqueue-event resource (nb-available-resources resource))))
-
-(defn update-capacity
- "Returns a pair of:
- * `unblocked-events` list of events that should be try to seize again the
- * `resource` updated with the resource capacity
-
- If the new capacity is lower than the number of element consumed (i.e. in `currently-consuming`), then the `preemption-policy` choose one event to stop:
- * `::no-premption` is the only implemented, it doesn't do anything and let the currently executing event finish."
- [{::sim-rc/keys [cache capacity]
- :or {capacity 1}
- :as resource}
- new-capacity]
- (let [{::sim-rc/keys [preemption-policy-fn]} cache
- resource (assoc resource ::sim-rc/capacity new-capacity)]
- (if (< new-capacity capacity)
- (preemption-policy-fn resource)
- ;; Capacity increase
- (sim-de-rc-queue/unqueue-event resource (nb-available-resources resource)))))
diff --git a/src/cljc/auto_sim/rc/impl/resource/consumption.cljc b/src/cljc/auto_sim/rc/impl/resource/consumption.cljc
deleted file mode 100644
index 4766721..0000000
--- a/src/cljc/auto_sim/rc/impl/resource/consumption.cljc
+++ /dev/null
@@ -1,37 +0,0 @@
-(ns auto-sim.rc.impl.resource.consumption
- "Resource consumption is what is happening when a resource is available and an entity seizing it.
-
- A consumption has two steps, a consume and a free of the resource.
- The resource updates a `::sim-de-rc/currently-consuming` list events that are consuming resources"
- (:require
- [automaton-core.utils.uuid-gen :as uuid-gen]
- [auto-sim.rc :as-alias sim-rc]))
-
-(defn consume
- "Consume `consumed-quantity` number of `resource`, store this consuming informations in the `currently-consuming` attribute of the resource.
-
- Returns a pair with:
- * the `consumption-uuid`
- * `resource` with `currently-consuming` updated with an entry under `consumption-uuid` entry with a map consisting in the two following entries:
- * `seizing-event` the event that has triggered a seizing.
- * `consumed-quantity` number consumed."
- [resource consumed-quantity seizing-event]
- (if (some? seizing-event)
- (let [consumption-uuid (uuid-gen/time-based-uuid)]
- [consumption-uuid
- (update resource
- ::sim-rc/currently-consuming
- assoc
- consumption-uuid
- #:auto-sim.rc{:seizing-event seizing-event
- :consumed-quantity consumed-quantity})])
- [nil resource]))
-
-(defn free
- "Remove the seizing informations matching `consumption-uuid` for that resource.
- Returns the updated resource without that `consumption` anymore."
- [resource consumption-uuid]
- (update resource
- ::sim-rc/currently-consuming
- (fn [currently-consuming]
- (if (nil? currently-consuming) {} (dissoc currently-consuming consumption-uuid)))))
diff --git a/src/cljc/auto_sim/rc/impl/resource/queue.cljc b/src/cljc/auto_sim/rc/impl/resource/queue.cljc
deleted file mode 100644
index 06080c3..0000000
--- a/src/cljc/auto_sim/rc/impl/resource/queue.cljc
+++ /dev/null
@@ -1,58 +0,0 @@
-(ns auto-sim.rc.impl.resource.queue
- "The queue of a resource is containing all event execution which are blocked while waiting for a resource to be available."
- (:require
- [auto-sim.rc :as-alias sim-rc]
- [auto-sim.simulation-engine.event :as sim-de-event]))
-
-(def schema
- "Schema of a `queue`.
- A queue should be a vector and not a general collection to preserve order."
- [:vector sim-de-event/schema])
-
-(defn queue-event
- "Returns the `resource` with `sim-de-rc/queue` updated with a sequence containing maps:
- * `::sim-rc/consumed-quantity` is the `consumed-quantity`.
- * `::sim-rc/seizing-event` is the `event` .
-
- `consumed-quantity` should be a strictly positive integer, otherwise queueuing is ignored.
-
- This is called when the resource is not available and the event should be postponed for a moment later on when the resource will be available."
- [resource consumed-quantity event]
- (cond-> (or resource {})
- (and (integer? consumed-quantity) (pos-int? consumed-quantity) (seq event))
- (update ::sim-rc/queue
- (fnil #(conj %
- #:auto-sim.rc{:seizing-event event
- ::sim-rc/consumed-quantity consumed-quantity})
- []))))
-
-(defn unqueue-event
- "Removes events in the queue of resource `resource`, based on policy chosen, as many as needed to fullfill the `available-capacity`, the capacity that is free now and that we would like to try to execute.
-
- Returns a two entry vector:
- * the `blockings` removed from the queue and which execution will be attempted.
- * and the updated resource without the event in its queue anymore.
- Note that it may happen that the availability changes before that event is really executed, (i.e. it may happen that capacity change, higher priority events change the number of available resources...)."
- [{::sim-rc/keys [queue cache]
- :as resource}
- available-capacity]
- (let [{::sim-rc/keys [unblocking-policy-fn]} cache]
- (cond
- (not (integer? available-capacity))
- (let [[_ new-queue] (unblocking-policy-fn queue)]
- [[] (assoc resource ::sim-rc/queue (if (empty? new-queue) [] new-queue))])
- (<= available-capacity 0) [[] resource]
- :else (loop [unblocked-events []
- queue queue
- released-capacity 0]
- (let [[blocking new-queue] (unblocking-policy-fn queue)
- blocked-quantity (get blocking ::sim-rc/consumed-quantity 1)
- new-released-quantity (+ released-capacity blocked-quantity)]
- (cond
- (nil? blocking)
- [unblocked-events
- (assoc resource ::sim-rc/queue (if (nil? new-queue) [] new-queue))]
- (>= available-capacity new-released-quantity)
- (recur (conj unblocked-events blocking) new-queue new-released-quantity)
- :else [unblocked-events
- (assoc resource ::sim-rc/queue (if (nil? queue) [] queue))]))))))
diff --git a/src/cljc/auto_sim/rc/impl/state.cljc b/src/cljc/auto_sim/rc/impl/state.cljc
deleted file mode 100644
index 2fd8172..0000000
--- a/src/cljc/auto_sim/rc/impl/state.cljc
+++ /dev/null
@@ -1,75 +0,0 @@
-(ns auto-sim.rc.impl.state
- "Store and update resource consumer informations in the `::sim-rc/resource` key of the state.
- Assuming state is associative."
- (:require
- [auto-sim.rc :as-alias sim-rc]
- [auto-sim.rc.impl.resource :as sim-de-rc-resource]))
-
-(defn define-resources
- "Returns the state with the resources added in it, and values defaulted."
- [state defined-resources unblocking-policy-registry preemption-policy-registry]
- (update state
- ::sim-rc/resource
- (fn [resources]
- (merge resources
- (into {}
- (map (fn [[resource-name resource]] [resource-name
- (assoc
- (sim-de-rc-resource/defaulting-values
- resource
- unblocking-policy-registry
- preemption-policy-registry)
- ::sim-rc/name
- resource-name)])
- defined-resources))))))
-
-(defn resource
- "Returns the resource called `resource-name`, nil if does not exist.
- The `resource-name` should be called as described in the `resources` map of the middleware"
- [state resource-name]
- (get-in state [::sim-rc/resource resource-name]))
-
-(defn- update-resource
- [state resource-name resource]
- (cond-> state
- (some? resource-name) (assoc-in [::sim-rc/resource resource-name] resource)))
-
-(defn update-resource-capacity
- "Returns a pair of:
- * `unblocked-events`
- * `state` where the resource called `resource-name` is set to its new capacity `new-capacity`."
- [state resource-name new-capacity]
- (let [resource (resource state resource-name)
- [unblocked-events resource] (sim-de-rc-resource/update-capacity resource new-capacity)]
- [unblocked-events (update-resource state resource-name resource)]))
-
-(defn seize
- "Seize the resource called `resource-name` and update the `state` accordingly.
- `consuming-event` event that should be executed only when the `consumed-quantity` of `resource-name` was available for that event.
-
- Returns a pair:
- * `consumption-uuid` if the seizing found available resources.
- * the state, with the resource `resource-name` seizing `consumed-quantity` before the execution of the `posponed-event`."
- [state resource-name consumed-quantity consuming-event]
- (let [resource (resource state resource-name)]
- (if (or (nil? resource) (nil? consuming-event))
- [nil state]
- (let [[executed? resource]
- (sim-de-rc-resource/seize resource consumed-quantity consuming-event)]
- [executed? (update-resource state resource-name resource)]))))
-
-(defn dispose
- "Returns a pair:
- * the `unblockings` event.
- * the `state`, with the resource `resource-name` consumption of `seizing-event` is disposed."
- [state resource-name consumption-uuid]
- (if (or (nil? consumption-uuid) (nil? resource-name))
- [[] state]
- (let [resource (resource state resource-name)
- [unblockings resource] (sim-de-rc-resource/dispose resource consumption-uuid)]
- [unblockings (update-resource state resource-name resource)])))
-
-(defn failure
- "Updates the `state` with the resource-name failing."
- [state _resource-name _seizing-event]
- (throw (ex-info "Not implemented yet" state)))
diff --git a/src/cljc/auto_sim/rc/impl/unblocking_policy/base.cljc b/src/cljc/auto_sim/rc/impl/unblocking_policy/base.cljc
deleted file mode 100644
index b6cdcdf..0000000
--- a/src/cljc/auto_sim/rc/impl/unblocking_policy/base.cljc
+++ /dev/null
@@ -1,12 +0,0 @@
-(ns auto-sim.rc.impl.unblocking-policy.base
- "The simple policies to unblock an event in the queue.")
-
-(defn fifo-policy
- "Select the first blocked consumer in the queue."
- [[next-unblocked-event & rest-blocked :as _queue]]
- [next-unblocked-event rest-blocked])
-
-(defn lifo-policy
- "Select the last blocked consumer in the queue."
- [queue]
- [(last queue) (butlast queue)])
diff --git a/src/cljc/auto_sim/rc/impl/unblocking_policy/factory.cljc b/src/cljc/auto_sim/rc/impl/unblocking_policy/factory.cljc
deleted file mode 100644
index 36e1adc..0000000
--- a/src/cljc/auto_sim/rc/impl/unblocking_policy/factory.cljc
+++ /dev/null
@@ -1,11 +0,0 @@
-(ns auto-sim.rc.impl.unblocking-policy.factory
- "Factory to return the `unblocking-policy`."
- (:require
- [auto-sim.rc.impl.unblocking-policy.base :as sim-de-rc-unblocking-policy-base]))
-
-(def default-policy sim-de-rc-unblocking-policy-base/fifo-policy)
-
-(defn factory
- "Policy factory, defaulting to `fifo-policy`."
- [registry policy]
- (get registry policy default-policy))
diff --git a/src/cljc/auto_sim/rc/impl/unblocking_policy/registry.cljc b/src/cljc/auto_sim/rc/impl/unblocking_policy/registry.cljc
deleted file mode 100644
index eb896af..0000000
--- a/src/cljc/auto_sim/rc/impl/unblocking_policy/registry.cljc
+++ /dev/null
@@ -1,17 +0,0 @@
-(ns auto-sim.rc.impl.unblocking-policy.registry
- "Registry for `unblocking-policy`."
- (:require
- [auto-sim.rc :as-alias sim-rc]
- [auto-sim.rc.impl.unblocking-policy.base :as sim-de-rc-unblocking-policy-base]
- [auto-sim.rc.unblocking-policy :as sim-de-rc-unblocking-policy]))
-
-(defn schema
- "Schema of an `unblocking-policy` registry."
- []
- [:map-of :keyword (sim-de-rc-unblocking-policy/schema)])
-
-(defn registry
- "The base policies `registry`."
- []
- #:auto-sim.rc{:FIFO sim-de-rc-unblocking-policy-base/fifo-policy
- :LIFO sim-de-rc-unblocking-policy-base/lifo-policy})
diff --git a/src/cljc/auto_sim/rc/preemption_policy.cljc b/src/cljc/auto_sim/rc/preemption_policy.cljc
index 962c6fd..91ba61a 100644
--- a/src/cljc/auto_sim/rc/preemption_policy.cljc
+++ b/src/cljc/auto_sim/rc/preemption_policy.cljc
@@ -1,4 +1,7 @@
-(ns auto-sim.rc.preemption-policy
- "When the capacity is updated (through a failure or a capacity update), the `preemption-policy` is deciding which `consumption` should be stopped.")
+(ns auto-sim.rc.preemption-policy "Basic preemption policies.")
-(defn schema "Schema of a preemption policy." [] fn?)
+(defn no-preemption
+ "Do nothing when a preemption occurs. In other words ,the failure or capacity decreases will have no effect before the next event on that resource."
+ [resource]
+ {:preempts []
+ :resource resource})
diff --git a/src/cljc/auto_sim/rc/resource.cljc b/src/cljc/auto_sim/rc/resource.cljc
new file mode 100644
index 0000000..a58935c
--- /dev/null
+++ b/src/cljc/auto_sim/rc/resource.cljc
@@ -0,0 +1,159 @@
+(ns auto-sim.rc.resource
+ "This namespace is assembling the consumption and queue logics."
+ (:require
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.entity :as sim-entity]
+ [auto-sim.rc.resource.consumption :as sim-rc-consumption]
+ [auto-sim.rc.resource.queue :as sim-rc-queue]))
+
+(defn defaulting-values
+ "Returns a resource with default values added."
+ [{::sim-engine/keys [capacity consumption queue renewable?]
+ :as resource
+ :or {capacity 1
+ consumption {}
+ queue []
+ renewable? true}}]
+ (assoc resource
+ ::sim-engine/capacity capacity
+ ::sim-engine/consumption consumption
+ ::sim-engine/queue queue
+ ::sim-engine/renewable? renewable?))
+
+(defn nb-consumed-resources
+ "Returns the number of consumed resources."
+ [{::sim-engine/keys [consumption]
+ :as _resource}]
+ (if (map? consumption)
+ (->> consumption
+ vals
+ (map (fn [{::sim-engine/keys [consumption-quantity]
+ :or {consumption-quantity 1}}]
+ consumption-quantity))
+ (apply + 0))
+ 0))
+
+(defn nb-available-resources
+ "Returns the number of available resources based on the defined `capacity,` and the `consumption` resources (i.e. sum of their )."
+ [{::sim-engine/keys [capacity]
+ :or {capacity 1}
+ :as resource}]
+ (max 0 (- capacity (nb-consumed-resources resource))))
+
+(defn seize
+ "If a `resource` contains enough available items, a `consumption` is created and stored in the `resource`.
+ Otherwise, no `consumption` is created and the `event` is queued in the `resource`, to test the seizing later on.
+
+ In any case, it returns a map with:
+ * `consumption-uuid` or `nil` if the execution is postponed awaiting for a resource disposal
+ * updated `resource` reflecting the consumption
+ * `errors`"
+ [resource event consumption-quantity priority postponable-event]
+ (if (>= (compare (nb-available-resources resource) consumption-quantity) 0)
+ (sim-rc-consumption/start resource event consumption-quantity priority)
+ (sim-rc-queue/queue-event resource
+ (sim-entity/copy-entity-id event postponable-event)
+ consumption-quantity
+ priority)))
+
+(defn- unqueue-attempts
+ "Try to unqueue events regarding the newly available items.
+
+ Returns a map with:
+ * `resource` updated
+ * `events` list of event to add in the `future-events` to try their execution again."
+ [resource unqueueing-policy-fn]
+ (let [available-capacity (nb-available-resources resource)
+ {:keys [resource unqueued]}
+ (sim-rc-queue/unqueue-event resource available-capacity unqueueing-policy-fn)]
+ {:resource resource
+ :events unqueued}))
+
+(defn dispose-consumption-uuid
+ "Dispose a specific `consumption-uuid` in the `resource`.
+
+ `unqueueing-policy-fn` is used to determine in which order events should be released.
+
+ Returns a map with:
+ * `events` list of events to add in the `future-events` again.
+ * `resource` updated with consumption `consumption-uuid` removed.
+ * `errors` if freeing has raised an error"
+ [resource unqueueing-policy-fn consumption-uuid]
+ (let [{:keys [resource errors]} (sim-rc-consumption/ended resource consumption-uuid)]
+ (if errors
+ {:resource resource
+ :errors errors}
+ (unqueue-attempts resource unqueueing-policy-fn))))
+
+(defn update-capacity
+ "Returns a map with
+ * `events` list of events that should be seized again
+ * `resource` updated with the resource capacity
+ * `preempts` the list of event to stop execution of
+
+ If the new capacity is lower than the number of element consumed (i.e. in `consumption`), then the `preemption-policy` choose one event to stop:
+ * `::no-premption` is the only implemented, it doesn't do anything and let the currently executing event finish."
+ [resource preemption-policy-fn unqueueing-policy-fn new-capacity]
+ (let [{::sim-engine/keys [capacity]
+ :or {capacity 1}}
+ resource
+ resource (assoc resource ::sim-engine/capacity new-capacity)]
+ (if (< new-capacity capacity)
+ ;;NOTE Capacity decrease
+ {:preempts (preemption-policy-fn resource)}
+ ;;NOTE Capacity increase
+ (unqueue-attempts resource unqueueing-policy-fn))))
+
+(defn dispose
+ "Dispose `quantity` items of `resource`
+
+ `unqueueing-policy-fn` is used to determine in which order events should be released.
+
+ Returns a map with:
+ * `events` list of events that should be try to seize again the resource.
+ * `resource` updated with consumptions removed.
+ * `errors` if consumption-uuid found are not existing"
+ [resource priority-comp unqueueing-policy-fn quantity]
+ (let [capacity (::sim-engine/capacity resource)]
+ (if-not (and (integer? capacity) (pos? capacity))
+ {:errors [#::sim-engine{:why :resource-dont-have-capacity
+ :capacity (::sim-engine/capacity resource)}]}
+ (let [consumptions (sim-rc-consumption/consumption-by-priority resource priority-comp)]
+ (loop [[[consumption-uuid consumption] & rconsumptions] consumptions
+ quantity-to-dispose quantity
+ resource resource
+ all-errors []]
+ (cond
+ (= 0 quantity-to-dispose)
+ ;;NOTE The quantity to dispose is achieved
+ (cond-> (unqueue-attempts resource unqueueing-policy-fn)
+ (seq all-errors) (assoc :errors all-errors))
+ (and (or (nil? consumption-uuid) (empty? consumption)) (> quantity-to-dispose 0))
+ ;;NOTE No more consumption but the disposed quantity is not reach yet
+ {:errors [#::sim-engine{:why :cant-dispose-quantity
+ :capacity capacity
+ :consumption-uuid consumption-uuid
+ :quantity quantity
+ :quantity-to-dispose quantity-to-dispose}]}
+ :else (let [{::sim-engine/keys [consumption-quantity]} consumption]
+ (if-not (and (integer? consumption-quantity) (pos? consumption-quantity))
+ ;;NOTE Consumption is malformed
+ {:errors [#::sim-engine{:why :consumption-malformed
+ :consumption-quantity consumption-quantity}]}
+ (if (>= quantity-to-dispose consumption-quantity)
+ ;;NOTE Even after that consumption removed, there are still to dispose
+ (let [{:keys [resource errors]} (sim-rc-consumption/ended resource
+ consumption-uuid)]
+ (recur rconsumptions
+ (- quantity-to-dispose consumption-quantity)
+ resource
+ (reduce conj all-errors errors)))
+ ;;NOTE Just a part of this consumption should be removed
+ (let [resource (update-in resource
+ [::sim-engine/consumption consumption-uuid]
+ update
+ ::sim-engine/consumption-quantity
+ -
+ quantity-to-dispose)]
+ (cond-> (unqueue-attempts resource unqueueing-policy-fn)
+ (seq all-errors) (assoc :errors all-errors))))))))))))
diff --git a/src/cljc/auto_sim/rc/resource/consumption.cljc b/src/cljc/auto_sim/rc/resource/consumption.cljc
new file mode 100644
index 0000000..b385c32
--- /dev/null
+++ b/src/cljc/auto_sim/rc/resource/consumption.cljc
@@ -0,0 +1,75 @@
+(ns auto-sim.rc.resource.consumption
+ "A `consumption` respresents the lifecycle of an `auto-sim.entity` seizing a `resource`.
+
+ It starts when the `resource` has enough items available for the entity with the `start` event.
+ It ends with an event called `ended` which happens when a `resource` is disposed by its entity.
+
+ A consumption is identified called `consumption-uuid`.
+ All related informations are stored in the `resource` under the `::auto-sim.engine/consumption` key."
+ (:require
+ [auto-core.uuid :as uuid-gen]
+ [auto-sim.engine :as-alias sim-engine]))
+
+(defn start
+ "Consume `quantity` items of `resource`, store these informations in the `:auto-sim.engine/consumption` attribute of the resource.
+
+ Returns a map with:
+ * `consumption-uuid` - an uuid generated
+ * `resource` with `consumption` updated with an entry under `consumption-uuid` entry with a map consisting in the following entries:
+ * `event` the event that has triggered a seizing, it should be an entity and have an `entity-id`
+ * `quantity` number consumed.
+ * `errors` non `nil` when the `entity-id` is not found in the `event`"
+ [resource event quantity priority]
+ (let [{::sim-engine/keys [entity-id]} event]
+ (cond
+ (nil? entity-id) {:resource (if (empty? resource) {} resource)
+ :errors [#::sim-engine{:why :event-miss-entity-id
+ :consumption-quantity quantity}]}
+ (not (and (integer? quantity) (pos? quantity)))
+ {:resource (if (empty? resource) {} resource)
+ :errors [#::sim-engine{:why :consumption-quantity-wrong
+ :resource resource
+ :consumption-quantity quantity}]}
+ :else (let [consumption-uuid (uuid-gen/time-based-uuid)]
+ {:consumption-uuid consumption-uuid
+ :resource (assoc-in resource
+ [::sim-engine/consumption consumption-uuid]
+ #::sim-engine{:entity-id entity-id
+ :priority priority
+ :consumption-quantity quantity})}))))
+
+(defn ended
+ "Remove the seizing informations matching `consumption-uuid` for that resource.
+
+ Returns a map with
+ * `resource` without that `consumption` anymore.
+ * `errors` if `consumption-uuid` is missing"
+ [resource consumption-uuid]
+ (if (nil? (get-in resource [::sim-engine/consumption consumption-uuid]))
+ {:resource resource
+ :errors [#::sim-engine{:why :consumption-uuid-does-not-exist
+ :resource resource
+ :consumption-uuid consumption-uuid}]}
+ {:resource (-> resource
+ (update ::sim-engine/consumption
+ (fn [consumption]
+ (if (nil? consumption) {} (dissoc consumption consumption-uuid)))))}))
+
+(defn compare-by-order
+ "Returns a comparator that implement java.util.Comparator.
+
+ First element in the order will be sorted first in a collection sorted with this comparator"
+ [order]
+ (fn [a b]
+ (cond
+ (nil? a) 666
+ (nil? b) -666
+ (not= a b) (- (.indexOf order a) (.indexOf order b))
+ :else 0)))
+
+(defn consumption-by-priority
+ "Returns `consumptions` from a `resource` ordered with their priority thanks to `priority-comparator`"
+ [resource priority-comparator]
+ (->> (::sim-engine/consumption resource)
+ (sort-by (comp ::sim-engine/priority second) priority-comparator)
+ vec))
diff --git a/src/cljc/auto_sim/rc/resource/queue.cljc b/src/cljc/auto_sim/rc/resource/queue.cljc
new file mode 100644
index 0000000..d167ada
--- /dev/null
+++ b/src/cljc/auto_sim/rc/resource/queue.cljc
@@ -0,0 +1,79 @@
+(ns auto-sim.rc.resource.queue
+ "The queue of a resource is containing all events waiting for an available resource."
+ (:require
+ [auto-sim.engine :as-alias sim-engine]))
+
+(defn queue-event
+ "Adds `event` in the queue of `resource` to wait for further available resources.
+
+ Elements in the `queue` are stored under the `:auto-sim.engine/queue` key and are defined with:
+ * `:auto-sim.engine/event` the `event` waiting for an available resource.
+ * `:auto-sim.engine/priority` priority used to define which element should be taken into account first.
+ * `:auto-sim.engine/consumption-quantity` = `consumption-quantity` (should be a strictly positive integer, otherwise queueuing is skipped).
+
+ Queueing is skipped if `consumption-quantity` is not a valid positive integer.
+
+ Returns a map of
+ * `:resource` updated if successful with `event` in its `queue`.
+ * `:errors` a vector of error if event is empty, if `consumption-quantity` is not a positive integer."
+ [resource event consumption-quantity priority]
+ (cond
+ (empty? event) {:resource resource
+ :errors [#::sim-engine{:why :queuing-an-empty-event
+ :resource resource
+ :consumption-quantity consumption-quantity
+ :priority priority
+ :event event}]}
+ (not (and (integer? consumption-quantity) (pos-int? consumption-quantity)))
+ {:resource resource
+ :errors [#::sim-engine{:why :consumption-quantity-wrong
+ :resource resource
+ :consumption-quantity consumption-quantity
+ :priority priority
+ :event event}]}
+ :else {:resource (-> (or resource {})
+ (update ::sim-engine/queue
+ (fnil #(conj %
+ #::sim-engine{:event event
+ :priority priority
+ :consumption-quantity
+ consumption-quantity})
+ [])))}))
+
+(defn unqueue-event
+ "Unqueue `events` from the `queue` of `resource`.
+
+ The `events` are removed in the order defined by `unqueueing-policy-fn`, and while `available-quantity` is not fully consumed or all events unqueued.
+
+ Returns a map of:
+ * `unqueued` events,
+ * and the updated `resource` without these events in the queue anymore.
+
+ Note that unqueued events are not executed instantaneously, so event priority may lead to a situation where the availability changes before that event is actually executed."
+ [resource available-capacity unqueueing-policy-fn]
+ (let [{::sim-engine/keys [queue]} resource]
+ (if (empty? queue)
+ ;;NOTE No waiting event is in the queue
+ {:resource (assoc resource ::sim-engine/queue [])}
+ (loop [unqueued-events []
+ queue queue
+ released-capacity 0]
+ (let [[unqueued new-queue] (unqueueing-policy-fn queue)
+ unqueued-quantity (get unqueued ::sim-engine/consumption-quantity 1)
+ new-released-quantity (+ released-capacity unqueued-quantity)]
+ (cond
+ (nil? unqueued)
+ ;;NOTE All events have been unqueued
+ {:unqueued unqueued-events
+ :resource (assoc resource ::sim-engine/queue queue)}
+ (> available-capacity new-released-quantity)
+ ;;NOTE There are still available quantity, loop again
+ (recur (conj unqueued-events unqueued) new-queue new-released-quantity)
+ (= available-capacity new-released-quantity)
+ ;;NOTE There is no more available quantity
+ {:unqueued (conj unqueued-events unqueued)
+ :resource (assoc resource ::sim-engine/queue new-queue)}
+ :else
+ ;;NOTE The last unqueued element has a too big released-quantity, don't take the last unqueing into account
+ {:unqueued unqueued-events
+ :resource (assoc resource ::sim-engine/queue queue)}))))))
diff --git a/src/cljc/auto_sim/rc/unblocking_policy.cljc b/src/cljc/auto_sim/rc/unblocking_policy.cljc
deleted file mode 100644
index 560d9ab..0000000
--- a/src/cljc/auto_sim/rc/unblocking_policy.cljc
+++ /dev/null
@@ -1,4 +0,0 @@
-(ns auto-sim.rc.unblocking-policy
- "In a queue, the policy selects the next consumer that will be unblocked. (Each queue has its own policy).")
-
-(defn schema "`unblocking-policy` schema." [] fn?)
diff --git a/src/cljc/auto_sim/rc/unqueueing_policy.cljc b/src/cljc/auto_sim/rc/unqueueing_policy.cljc
new file mode 100644
index 0000000..908b4f4
--- /dev/null
+++ b/src/cljc/auto_sim/rc/unqueueing_policy.cljc
@@ -0,0 +1,9 @@
+(ns auto-sim.rc.unqueueing-policy
+ "The simple policies to unqueue an event waiting for available resources.")
+
+(defn fifo
+ "Select the first queued consumer in the queue."
+ [[unqueued-event & rqueue :as _queue]]
+ [unqueued-event (or rqueue [])])
+
+(defn lifo "Select the last queued consumer" [queue] [(last queue) (butlast queue)])
diff --git a/src/cljc/auto_sim/route.cljc b/src/cljc/auto_sim/route.cljc
new file mode 100644
index 0000000..7d9d2ba
--- /dev/null
+++ b/src/cljc/auto_sim/route.cljc
@@ -0,0 +1,74 @@
+(ns auto-sim.route
+ "Routes are a predefined list of operations that entities will proceed.
+
+ `routes` is based on entity to store the route to execute. It contains:
+ * `route-id`
+ * `route` the rest of route elements to be executed.
+ * `current-operation` the operation currently executed"
+ (:require
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.entity :as sim-entity]))
+
+(defn entity-data
+ "Returns the data to initialize an entity that will execute routes."
+ [routes route-id]
+ (let [route (get routes route-id)]
+ #::sim-engine{:route-id route-id
+ :route route}))
+(defn get-route
+ "Returns the `route` for the current entity.
+
+ Returns `nil` if none."
+ [event-return event _]
+ (let [{::sim-engine/keys [state]} event-return
+ route (->> (sim-entity/state state event)
+ ::sim-engine/route)]
+ (when-not (empty? route) route)))
+
+(defn next-op
+ "Update the entity data to the next operation in the `route`.
+ * `current-operation` is moved to the next one.
+ * `route` has the next one removed.
+
+ Returns `event-return` with `route` updated in the entity"
+ [event-return event bucket route]
+ (let [{::sim-engine/keys [state]} event-return
+ [current-operation rroute] ((juxt first (comp vec rest)) route)]
+ (-> event-return
+ (assoc ::sim-engine/state
+ (sim-entity/update state
+ event
+ bucket
+ assoc
+ ::sim-engine/route rroute
+ ::sim-engine/current-operation current-operation)))))
+
+(defn current-operation
+ "Returns the `current-operation` of the current entity - as defined in the `event`."
+ [event-return event _bucket]
+ (let [{::sim-engine/keys [state]} event-return]
+ (-> (sim-entity/state state event)
+ ::sim-engine/current-operation)))
+
+(defn add-current-operation
+ "Adds the `current-operation` to `new-event"
+ [event-return event _bucket new-event]
+ (let [{::sim-engine/keys [state]} event-return]
+ (merge new-event
+ (select-keys (sim-entity/state state event)
+ [::sim-engine/route-id ::sim-engine/current-operation]))))
+
+(defn schedule
+ "Schedules the execution of `new-event` at `bucket` with the same entity than `event`
+
+ Returns `event-return` with `future-events` updated."
+ [event-return event bucket new-event]
+ (let [new-event (add-current-operation event-return event bucket new-event)]
+ (sim-entity/schedule event-return event bucket new-event)))
+
+(defn machines
+ [model-data]
+ (->> (::sim-engine/routes model-data)
+ (mapcat second)
+ (map :m)
+ distinct))
diff --git a/src/cljc/auto_sim/simulation_engine.cljc b/src/cljc/auto_sim/simulation_engine.cljc
deleted file mode 100644
index 19b87ae..0000000
--- a/src/cljc/auto_sim/simulation_engine.cljc
+++ /dev/null
@@ -1,83 +0,0 @@
-(ns auto-sim.simulation-engine
- "Simulation is a technique that mimics a real system - and simplifies it, to learn something useful about it.
-Discrete event simulation is modeling a real system with discrete events.
-
-* Contains a user-specific domain, constraints, a customer-specific state and events modeling and an option to render visually the effects.
-* Customer simulation can use directly `DE Simulation` or a library that eases the modeling: `rc modeling`, `industry modeling`, … "
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.impl.model :as sim-de-model]
- [auto-sim.simulation-engine.impl.model-data :as sim-de-model-data]
- [auto-sim.simulation-engine.impl.registry :as sim-de-registry]
- [auto-sim.simulation-engine.impl.scheduler :as sim-de-scheduler]
- [auto-sim.simulation-engine.response :as sim-de-response]))
-
-(defn registries "Returns the `built-in` registries of simulation-de." [] (sim-de-registry/build))
-
-(defn validate-registry
- [registry]
- (core-schema/validate-data-humanize sim-de-registry/schema registry))
-
-(defn validate-model-data
- "Validate `model-data`."
- [model-data]
- (core-schema/validate-data-humanize sim-de-model-data/schema model-data))
-
-(defn build-model
- "Build the simulation model from `model-data` with `registry`.
- `registry` is optional and is defaulted to the `registries` fn."
- ([model-data] (sim-de-model/build model-data (registries)))
- ([model-data registry] (sim-de-model/build model-data registry)))
-
-(defn validate-model
- "Model - as built with `build-model` - are validated."
- [model]
- (core-schema/validate-data-humanize sim-de-model/schema model))
-
-(defn validate-middleware-data
- "Middleware data are validated."
- [middleware-data _registries]
- (core-schema/validate-data-humanize sim-de-model-data/middlewares-schema middleware-data))
-
-(defn validate-stopping-criteria-data
- [stopping-criteria-data _registries]
- (core-schema/validate-data-humanize sim-de-model-data/stopping-criterias-schema
- stopping-criteria-data))
-
-(defn scheduler
- "Scheduler is running the simulation described in the `model`.
- There are three arities for this function.
- * First one specificies the `model` only.
- * Second one adds `stopping-criteria` and supplementary middlewares (i.e. `supp-middelwares`).
- * Third one specify also a different `snapshot` to start with (supersedes the `initial-snapshot` in the `model`).
-
- Returns a `response` containing:
- * simulation `snapshot` of the last event.
- * `stopping-causes`, see [[auto-sim.impl.stopping-definition.registry]] for possible values."
- ([{::keys [initial-snapshot]
- :as model}]
- (scheduler model [] [] initial-snapshot))
- ([{::keys [initial-snapshot]
- :as model}
- scheduler-middlewares
- scheduler-stopping-criterias]
- (scheduler model scheduler-middlewares scheduler-stopping-criterias initial-snapshot))
- ([model scheduler-middlewares scheduler-stopping-criterias snapshot]
- (when-not (sim-de-scheduler/invalid-inputs model
- scheduler-middlewares
- scheduler-stopping-criterias
- snapshot)
- (sim-de-scheduler/scheduler model
- scheduler-middlewares
- scheduler-stopping-criterias
- snapshot))))
-
-(defn extract-snapshot
- "Extract the `snapshot` of a `response`."
- [{::keys [snapshot]
- :as _response}]
- snapshot)
-
-(defn validate-response
- [response]
- (core-schema/validate-data-humanize sim-de-response/schema response))
diff --git a/src/cljc/auto_sim/simulation_engine/event.cljc b/src/cljc/auto_sim/simulation_engine/event.cljc
deleted file mode 100644
index 8712e68..0000000
--- a/src/cljc/auto_sim/simulation_engine/event.cljc
+++ /dev/null
@@ -1,32 +0,0 @@
-(ns auto-sim.simulation-engine.event
- "An event is an individual happening, taking place at a given moment. Each event is indivisible and instantaneous. The event execution is defined by its event type.
-
- Discreteness is a property of an event stating that the changes in the state could be counted (i.e. changes are discrete in the mathematical definition).
-
- Each event defines following outputs:
- * a simulation state update regarding the event that happened.
- * a list of events that should be inserted in the future events.
- * some events that are postponed.
- * some events that are cancelled.
-
- [See the entity](docs/archi/event_entity.png)
-
- An event type: The event type is used to define what event execution will happen.
-
- Event structure is a map with at least two keys:
- * `type` a the event type as found in `evt-type-priority`.
- * `date` as a date."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(def schema
- "An event is a tuple which first value is a keyword for the event type, the second is a date."
- [:map {:closed false}
- [::sim-engine/date :any]
- [::sim-engine/type :keyword]])
-
-(defn postpone-events
- "Scan event in `events` for which `(event-filter-fn event)` is true, its date is postponed to `date`."
- [events event-filter-fn date]
- (mapv (fn [event] (if (event-filter-fn event) (assoc event ::sim-engine/date date) event))
- events))
diff --git a/src/cljc/auto_sim/simulation_engine/event_execution.cljc b/src/cljc/auto_sim/simulation_engine/event_execution.cljc
deleted file mode 100644
index 7f65e3d..0000000
--- a/src/cljc/auto_sim/simulation_engine/event_execution.cljc
+++ /dev/null
@@ -1,14 +0,0 @@
-(ns auto-sim.simulation-engine.event-execution
- "An event execution is updating the state and may trigger some new events to be added in the future events. The result of the event execution could be dependent on the state or random variable.
-
- * [See entity](docs/archi/event_execution.png)"
- (:require
- [auto-sim.simulation-engine.event :as sim-de-event]
- [auto-sim.simulation-engine.event-return :as sim-de-event-return]))
-
-(def schema
- "An event is a tuple which first value is a keyword for the event type, the second is a date"
- [:function
- [:=>
- [:cat :any [:sequential sim-de-event/schema] sim-de-event/schema]
- sim-de-event-return/schema]])
diff --git a/src/cljc/auto_sim/simulation_engine/event_return.cljc b/src/cljc/auto_sim/simulation_engine/event_return.cljc
deleted file mode 100644
index 944233d..0000000
--- a/src/cljc/auto_sim/simulation_engine/event_return.cljc
+++ /dev/null
@@ -1,42 +0,0 @@
-(ns auto-sim.simulation-engine.event-return
- "What is returned by an event."
- (:refer-clojure :exclude [nth])
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.event :as sim-de-event]
- [auto-sim.simulation-engine.snapshot :as sim-de-snapshot]))
-
-(def schema
- [:map {:closed true}
- [::sim-engine/state :any]
- [::sim-engine/future-events [:sequential sim-de-event/schema]]])
-
-(defn add-event
- "Adds `event` to the event-return, so it will be executed as a future event.
- `date` is an optional parameter that impose to the event the date it should be executed."
- ([event-return event]
- (cond-> event-return
- (map? event) (update ::sim-engine/future-events conj event)))
- ([event-return event date]
- (cond-> event-return
- (map? event) (update ::sim-engine/future-events conj (assoc event ::sim-engine/date date)))))
-
-(defn add-events
- "Add events to the future-events."
- [event-return event]
- (update event-return ::sim-engine/future-events concat event))
-
-(defn nth
- "Uniformly choose one event among many."
- ([event-return events-to-choose]
- (add-event event-return (clojure.core/rand-nth events-to-choose)))
- ([event-return events-to-choose date]
- (add-event event-return (clojure.core/rand-nth events-to-choose) date)))
-
-(defn if-return
- [event-return condition then-fn else-fn]
- (if condition (then-fn event-return) (else-fn event-return)))
-
-(defn update-snapshot
- [snapshot {::sim-engine/keys [future-events state]}]
- (sim-de-snapshot/update snapshot future-events state))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/causality_broken.cljc b/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/causality_broken.cljc
deleted file mode 100644
index d8bd497..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/causality_broken.cljc
+++ /dev/null
@@ -1,28 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.causality-broken
- "`stopping-definition` to stop when causality is broken.
-
- Causality is a property of the simulation model stating that a future event cannot change what has been done in the past already, so all changes in the state should not contradict any past event.
-
- In practise, we check the `next-snapshot` `date` is equal or after the current `snapshot`."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(def stopping-definition
- {::sim-engine/id ::sim-engine/causality-broken
- ::sim-engine/next-possible? true
- ::sim-engine/doc "Stops when next snapshot is before current one."})
-
-(defn evaluates
- [snapshot next-snapshot current-event]
- (let [snapshot-date (::sim-engine/date snapshot)
- next-snapshot-date (::sim-engine/date next-snapshot)]
- (when (pos? (compare snapshot-date next-snapshot-date))
- #:auto-sim.simulation-engine{:stopping-criteria
- #:auto-sim.simulation-engine{:stopping-definition
- stopping-definition}
- :current-event current-event
- :context
- #:auto-sim.simulation-engine{:previous-date
- snapshot-date
- :next-date
- next-snapshot-date}})))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/execution_not_found.cljc b/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/execution_not_found.cljc
deleted file mode 100644
index 31846a0..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/execution_not_found.cljc
+++ /dev/null
@@ -1,25 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.execution-not-found
- "`stopping-definition` to stop when the execution of an event is not found in the registry."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.response :as sim-de-response]))
-
-(def stopping-definition
- #:auto-sim.simulation-engine{:id ::sim-engine/execution-not-found
- :next-possible? true
- :doc
- "Stops when the execution of an event is not found in the registry."})
-
-(defn evaluates
- [response event]
- (->
- response
- (sim-de-response/add-stopping-cause
- #:auto-sim.simulation-engine{:stopping-criteria
- #:auto-sim.simulation-engine{:stopping-definition
- stopping-definition}
- :current-event event
- :context
- #:auto-sim.simulation-engine{:not-found-type
- (::sim-engine/type
- event)}})))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/failed_event_execution.cljc b/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/failed_event_execution.cljc
deleted file mode 100644
index 70f49ba..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/failed_event_execution.cljc
+++ /dev/null
@@ -1,25 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.failed-event-execution
- "`stopping-definition` to stop when an execution has raised an exception."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.response :as sim-de-response]))
-
-(def stopping-definition
- #:auto-sim.simulation-engine{:id
- :auto-sim.simulation-engine/failed-event-execution
- :next-possible? true
- :doc
- "Stops when an execution has raised an exception."})
-
-(defn evaluates
- [response e current-event]
- (->
- response
- (sim-de-response/add-stopping-cause
- #:auto-sim.simulation-engine{:stopping-criteria
- #:auto-sim.simulation-engine{:stopping-definition
- stopping-definition}
- :current-event current-event
- :context
- #:auto-sim.simulation-engine{:error
- e}})))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/no_future_events.cljc b/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/no_future_events.cljc
deleted file mode 100644
index 1250f8d..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/no_future_events.cljc
+++ /dev/null
@@ -1,19 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.no-future-events
- "`stopping-definition` to stop when no future events exists anymore."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.request :as sim-de-request]))
-
-(def stopping-definition
- #:auto-sim.simulation-engine{:id ::sim-engine/no-future-events
- :next-possible? false
- :doc "Stops when no future events exists anymore."})
-
-(defn evaluates
- [request future-events]
- (cond-> request
- (empty? future-events)
- (sim-de-request/add-stopping-cause
- #:auto-sim.simulation-engine{:stopping-criteria
- #:auto-sim.simulation-engine{:stopping-definition
- stopping-definition}})))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/registry.cljc b/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/registry.cljc
deleted file mode 100644
index 829c64b..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/registry.cljc
+++ /dev/null
@@ -1,40 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.registry
- "built-in `stopping-definition` can create `stopping-cause` but they are not accessible for modellers, they are hard coded."
- (:require
- [automaton-core.adapters.schema :as
- core-schema]
- [automaton-core.utils.map :as utils-map]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.built-in-sd.causality-broken
- :as sim-de-causality-broken]
- [auto-sim.simulation-engine.impl.built-in-sd.execution-not-found
- :as sim-de-execution-not-found]
- [auto-sim.simulation-engine.impl.built-in-sd.failed-event-execution
- :as sim-failed-event-execution]
- [auto-sim.simulation-engine.impl.built-in-sd.no-future-events
- :as sim-de-no-future-events]
- [auto-sim.simulation-engine.impl.stopping.definition
- :as sim-de-sc-definition]))
-
-(def schema [:map-of sim-de-sc-definition/id-schema sim-de-sc-definition/schema])
-
-(def stopping-definitions
- [sim-de-causality-broken/stopping-definition
- sim-de-execution-not-found/stopping-definition
- sim-failed-event-execution/stopping-definition
- sim-de-no-future-events/stopping-definition])
-
-(defn build
- " The built-in stopping definition"
- []
- (->> (utils-map/maps-to-key stopping-definitions ::sim-engine/id)
- (core-schema/add-default schema)))
-
-(comment
- #?(:clj (->> (build)
- (map (fn [[k v]] (format " * `%s` %s\n" k (::sim-engine/doc v))))
- sort
- (apply str)))
- ;
-)
diff --git a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/request_validation.cljc b/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/request_validation.cljc
deleted file mode 100644
index e32795e..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/request_validation.cljc
+++ /dev/null
@@ -1,10 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.request-validation
- "Stops when the request is not valid."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn stopping-definition
- []
- {::sim-engine/doc "Stops when the request is not valid."
- ::sim-engine/id ::sim-engine/request-schema
- ::sim-engine/next-possible? true})
diff --git a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/response_validation.cljc b/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/response_validation.cljc
deleted file mode 100644
index 5ab7144..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/built_in_sd/response_validation.cljc
+++ /dev/null
@@ -1,10 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.response-validation
- "Stops when the response is not valid."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn stopping-definition
- []
- #:auto-sim.simulation-engine{:doc "Stops when the response is not valid."
- :id ::sim-engine/response-schema
- :next-possible? true})
diff --git a/src/cljc/auto_sim/simulation_engine/impl/event_registry.cljc b/src/cljc/auto_sim/simulation_engine/impl/event_registry.cljc
deleted file mode 100644
index 058c46e..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/event_registry.cljc
+++ /dev/null
@@ -1,13 +0,0 @@
-(ns auto-sim.simulation-engine.impl.event-registry
- "The `event-registry` contains `event-execution`.
-
- It associates one event type (a keyword) to its `event-execution`.
-
- * [See entity](docs/archi/registry_entity.png)"
- (:require
- [auto-sim.simulation-engine.event-execution :as sim-de-event-execution]))
-
-(def schema
- "Map associating `event-type` to `event-execution`.
- An event execution is updating the state and may trigger some new events to be added in the future events. The result of the event execution could be dependent on the state or random variable."
- [:map-of :keyword sim-de-event-execution/schema])
diff --git a/src/cljc/auto_sim/simulation_engine/impl/middleware/registry.cljc b/src/cljc/auto_sim/simulation_engine/impl/middleware/registry.cljc
deleted file mode 100644
index ac66c9b..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/middleware/registry.cljc
+++ /dev/null
@@ -1,44 +0,0 @@
-(ns auto-sim.simulation-engine.impl.middleware.registry
- "Registry for middlewares associating a keyword to its middleware function."
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.middleware.request-validation
- :as sim-de-mdw-request-validation]
- [auto-sim.simulation-engine.impl.middleware.response-validation
- :as sim-de-mdw-response-validation]
- [auto-sim.simulation-engine.impl.middleware.state-rendering
- :as sim-de-state-rendering]
- [auto-sim.simulation-engine.impl.middleware.tapping :as
- sim-de-tapping]
- [auto-sim.simulation-engine.middleware
- :as sim-de-middleware]))
-
-(def schema [:map-of sim-de-middleware/id-schema sim-de-middleware/schema])
-
-(defn build
- "Returns the registry of middlewares."
- []
- #:auto-sim.simulation-engine{:state-rendering sim-de-state-rendering/wrap
- :state-printing sim-de-state-rendering/wrap-print
- :tap-request sim-de-tapping/wrap-request
- :sim-de-mdw-request-inconsistency
- sim-de-mdw-request-validation/wrap-request
- :sim-de-mdw-response-validation
- sim-de-mdw-response-validation/wrap-response
- :tap-response sim-de-tapping/wrap-response})
-
-(defn validate [registry] (core-schema/validate-data-humanize schema registry))
-
-(defn data-to-fn
- "Turns a `middleware` - a data - to a middleware function."
- [middleware-registry middleware]
- (cond
- (= :supp-middlewares-insert middleware) :supp-middlewares-insert
- (= [:supp-middlewares-insert] middleware) :supp-middlewares-insert
- (keyword? middleware) (get middleware-registry middleware)
- (fn? middleware) middleware
- (sequential? middleware) (let [[middleware-name & middleware-params] middleware]
- (when-let [middleware-fn (get middleware-registry middleware-name)]
- (apply partial middleware-fn middleware-params)))))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/middleware/request_validation.cljc b/src/cljc/auto_sim/simulation_engine/impl/middleware/request_validation.cljc
deleted file mode 100644
index 83e3e58..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/middleware/request_validation.cljc
+++ /dev/null
@@ -1,36 +0,0 @@
-(ns auto-sim.simulation-engine.impl.middleware.request-validation
- "Stops when the request is valid through inconsistency and schema.
- This criteria is built-in to this middleware as it is requiring the `request` knowledge. User `stopping-criteria` knows only `snapshot`."
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.built-in-sd.request-validation
- :as sim-de-request-validation]
- [auto-sim.simulation-engine.request :as
- sim-de-request]
- [auto-sim.simulation-engine.snapshot :as
- sim-de-snapshot]))
-
-(defn evaluates
- [{::sim-engine/keys [snapshot current-event]
- :as request}]
- (let [request-inconsistency (sim-de-snapshot/inconsistency? snapshot)
- request-inconsistency? (not (false? request-inconsistency))
- request-schema-error (core-schema/validate-data-humanize sim-de-request/schema request)
- request-error? (some? request-schema-error)]
- (when (or request-inconsistency? request-error?)
- (cond-> {::sim-engine/stopping-criteria {::sim-engine/stopping-definition
- (sim-de-request-validation/stopping-definition)}
- ::sim-engine/current-event current-event
- ::sim-engine/context {:request request}}
- request-inconsistency? (assoc-in [::sim-engine/context :inconsistency]
- request-inconsistency)
- request-error? (assoc-in [::sim-engine/context :schema] request-schema-error)))))
-
-(defn wrap-request
- [handler]
- (fn [request]
- (-> request
- (sim-de-request/add-stopping-cause (evaluates request))
- handler)))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/middleware/response_validation.cljc b/src/cljc/auto_sim/simulation_engine/impl/middleware/response_validation.cljc
deleted file mode 100644
index 8dea78f..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/middleware/response_validation.cljc
+++ /dev/null
@@ -1,42 +0,0 @@
-(ns auto-sim.simulation-engine.impl.middleware.response-validation
- "Stops when the response is valid through inconsistency and schema.
- This criteria is built-in to this middleware as it is requiring the `response` knowledge. User `stopping-criteria` knows only `snapshot`."
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.built-in-sd.response-validation
- :as sim-de-response-validation]
- [auto-sim.simulation-engine.response :as
- sim-de-response]
- [auto-sim.simulation-engine.snapshot
- :as sim-de-snapshot]))
-
-(defn evaluates
- [{::sim-engine/keys [snapshot]
- :as response}
- current-event]
- (let [response-inconsistency (sim-de-snapshot/inconsistency? snapshot)
- response-inconsistency? (not (false? response-inconsistency))
- response-schema-error (core-schema/validate-data-humanize sim-de-response/schema response)
- response-error? (some? response-schema-error)]
- (when (or response-inconsistency? response-error?)
- (cond->
- #:auto-sim.simulation-engine{:stopping-criteria
- #:auto-sim.simulation-engine{:stopping-definition
- (sim-de-response-validation/stopping-definition)}
- :current-event current-event
- :context
- #:auto-sim.simulation-engine{:response
- response}}
- response-inconsistency? (assoc-in [::sim-engine/context ::sim-engine/inconsistency]
- response-inconsistency)
- response-error? (assoc-in [::sim-engine/context ::sim-engine/schema]
- response-schema-error)))))
-
-(defn wrap-response
- [handler]
- (fn [{::sim-engine/keys [current-event]
- :as request}]
- (let [response (handler request)]
- (sim-de-response/add-stopping-cause response (evaluates response current-event)))))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/middleware/state_rendering.cljc b/src/cljc/auto_sim/simulation_engine/impl/middleware/state_rendering.cljc
deleted file mode 100644
index 65b69a0..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/middleware/state_rendering.cljc
+++ /dev/null
@@ -1,24 +0,0 @@
-(ns auto-sim.simulation-engine.impl.middleware.state-rendering
- "Middleware to render state."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [clojure.string :as str]))
-
-(defn wrap
- "Wrap the `handler` to apply the rendering function `rendering-fn` to the state."
- [rendering-fn handler]
- (fn [request]
- (-> request
- (get-in [::sim-engine/snapshot ::sim-engine/state])
- rendering-fn)
- (handler request)))
-
-(defn wrap-print
- "Wrap the `handler` to apply the rendering function `rendering-fn` to the state."
- [rendering-fn handler]
- (fn [request]
- (println (str/join ","
- (-> request
- (get-in [::sim-engine/snapshot ::sim-engine/state])
- rendering-fn)))
- (handler request)))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/middleware/tapping.cljc b/src/cljc/auto_sim/simulation_engine/impl/middleware/tapping.cljc
deleted file mode 100644
index 11fb3db..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/middleware/tapping.cljc
+++ /dev/null
@@ -1,12 +0,0 @@
-#_{:heph-ignore {:forbidden-words ["tap>"]}}
-(ns auto-sim.simulation-engine.impl.middleware.tapping
- "Middleware to tap response and requests.")
-
-(defn wrap-response
- [handler]
- (fn [request]
- (let [response (handler request)]
- (tap> response)
- response)))
-
-(defn wrap-request [handler] (fn [request] (tap> request) (handler request)))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/middlewares.cljc b/src/cljc/auto_sim/simulation_engine/impl/middlewares.cljc
deleted file mode 100644
index 4e685dd..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/middlewares.cljc
+++ /dev/null
@@ -1,26 +0,0 @@
-(ns auto-sim.simulation-engine.impl.middlewares
- "Ordered list of middlewares.
-
- * [See entity](docs/archi/middlewares_entity.png)"
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [automaton-core.utils.sequences :as core-sequences]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.middleware :as sim-de-middleware]))
-
-(def schema [:sequential sim-de-middleware/schema])
-
-(defn wrap-handler
- "Wrap the `handler` with the middlewares.
- Returns the handler value wrapped in all the middlewares.
-
- Note that an handler is understood as a function taking a `request` and returning a `response`."
- [handler middlewares]
- (reduce (fn [handler middleware] (middleware handler)) handler middlewares))
-
-(defn concat-supp-middlewares
- "Adds `supp-middlewares` in `middlewares` where `::sim-engine/supp-middlewares-insert` stands."
- [middlewares supp-middlewares]
- (core-sequences/concat-at middlewares ::sim-engine/supp-middlewares-insert supp-middlewares))
-
-(defn validate [middlewares] (core-schema/validate-data-humanize schema middlewares))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/model.cljc b/src/cljc/auto_sim/simulation_engine/impl/model.cljc
deleted file mode 100644
index a930958..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/model.cljc
+++ /dev/null
@@ -1,62 +0,0 @@
-(ns auto-sim.simulation-engine.impl.model
- "A simulation model gathers information required to run the simulation.
-
- It includes:
-
- * `initial-snpashot` snapshot to start the model with.
- * `middlewares` sequence of middleware to execute with the model.
- * `model-data` data version of this model.
- * `ordering` ordering of events.
- * `registry` registry.
- * `stopping-criterias` list of `stopping-criteria` that defines the end of the model."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.middleware.registry :as
- sim-de-middleware-registry]
- [auto-sim.simulation-engine.impl.middlewares :as sim-de-middlewares]
- [auto-sim.simulation-engine.impl.model-data :as sim-de-model-data]
- [auto-sim.simulation-engine.impl.registry :as sim-de-registry]
- [auto-sim.simulation-engine.impl.stopping.criteria :as sim-de-criteria]
- [auto-sim.simulation-engine.ordering :as sim-de-ordering]
- [auto-sim.simulation-engine.snapshot :as sim-de-snapshot]))
-
-(def schema
- [:map {:closed false}
- [::sim-engine/initial-snapshot sim-de-snapshot/schema]
- [::sim-engine/middlewares sim-de-middlewares/schema]
- [::sim-engine/model-data sim-de-model-data/schema]
- [::sim-engine/ordering [:sequential sim-de-ordering/schema]]
- [::sim-engine/registry sim-de-registry/schema]
- [::sim-engine/stopping-criterias [:sequential sim-de-criteria/schema]]])
-
-(defn build
- "Turns `model-data` into a `model`.
- Retuns the `model`'s."
- [{::sim-engine/keys [initial-bucket middlewares ordering stopping-criterias future-events]
- :or {initial-bucket 0}
- :as model-data}
- registry]
- (let [updated-middlewares (->> middlewares
- (mapv (partial sim-de-middleware-registry/data-to-fn
- (::sim-engine/middleware registry))))
- updated-scs (->> stopping-criterias
- (map (partial sim-de-criteria/api-data-to-entity
- (::sim-engine/stopping registry)))
- (filter some?)
- (mapv sim-de-criteria/model-end))
- updated-ordering (->> ordering
- (map sim-de-ordering/data-to-fn)
- (filterv some?))]
- #:auto-sim.simulation-engine{:registry registry
- :middlewares updated-middlewares
- :model-data model-data
- :stopping-criterias updated-scs
- :ordering updated-ordering
- :initial-snapshot
- {::sim-engine/id 1
- ::sim-engine/iteration 1
- ::sim-engine/date initial-bucket
- ::sim-engine/state {}
- ::sim-engine/past-events []
- ::sim-engine/future-events
- (if (empty? future-events) [] future-events)}}))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/model_data.cljc b/src/cljc/auto_sim/simulation_engine/impl/model_data.cljc
deleted file mode 100644
index 0bae1bf..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/model_data.cljc
+++ /dev/null
@@ -1,35 +0,0 @@
-(ns auto-sim.simulation-engine.impl.model-data
- "Model data is the data used as inputs to generate the model:
-
- * data oriented, so it could be persisted easily.
- * ergonomy oriented, so it is easy to use."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.event :as sim-de-event]
- [auto-sim.simulation-engine.impl.stopping.criteria :as sim-de-criteria]
- [auto-sim.simulation-engine.middleware :as sim-de-middleware]))
-
-(def middlewares-schema
- [:sequential [:or :keyword sim-de-middleware/schema [:tuple :keyword] [:tuple :keyword :any]]])
-
-(def stopping-criterias-schema
- [:sequential [:or :keyword sim-de-criteria/schema [:tuple :keyword] [:tuple :keyword [:map]]]])
-
-(def ordering-schema
- [:sequential
- [:or
- [:tuple [:enum ::sim-engine/field] :keyword]
- [:tuple [:enum ::sim-engine/type] [:sequential :keyword]]]])
-
-(def schema
- [:map {:closed false}
- [::sim-engine/initial-bucket {:optional true}
- :int]
- [::sim-engine/future-events {:optional true}
- [:vector sim-de-event/schema]]
- [::sim-engine/middlewares {:optional true}
- middlewares-schema]
- [::sim-engine/ordering {:optional true}
- ordering-schema]
- [::sim-engine/stopping-criterias {:optional true}
- stopping-criterias-schema]])
diff --git a/src/cljc/auto_sim/simulation_engine/impl/ordering/registry.cljc b/src/cljc/auto_sim/simulation_engine/impl/ordering/registry.cljc
deleted file mode 100644
index 1349218..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/ordering/registry.cljc
+++ /dev/null
@@ -1,14 +0,0 @@
-(ns auto-sim.simulation-engine.impl.ordering.registry
- "Registry for ordering."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.ordering :as sim-de-ordering]))
-
-(def schema [:map])
-
-(defn build
- []
- #:auto-sim.simulation-engine{:compare-field {:comparison-fn
- sim-de-ordering/compare-field}
- :compare-types {:comparison-fn
- sim-de-ordering/compare-types}})
diff --git a/src/cljc/auto_sim/simulation_engine/impl/registry.cljc b/src/cljc/auto_sim/simulation_engine/impl/registry.cljc
deleted file mode 100644
index 902e97c..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/registry.cljc
+++ /dev/null
@@ -1,27 +0,0 @@
-(ns auto-sim.simulation-engine.impl.registry
- "Gathers the registries of a simulation."
- (:require
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.event-registry
- :as sim-de-event-registry]
- [auto-sim.simulation-engine.impl.middleware.registry
- :as sim-de-middleware-registry]
- [auto-sim.simulation-engine.impl.ordering.registry
- :as sim-de-ordering-registry]
- [auto-sim.simulation-engine.impl.stopping-definition.registry
- :as sim-de-stopping-registry]))
-
-(def schema
- [:map {:closed true}
- [::sim-engine/stopping sim-de-stopping-registry/schema]
- [::sim-engine/middleware sim-de-middleware-registry/schema]
- [::sim-engine/event sim-de-event-registry/schema]
- [::sim-engine/ordering sim-de-ordering-registry/schema]])
-
-(defn build
- []
- #:auto-sim.simulation-engine{:stopping (sim-de-stopping-registry/build)
- :middleware (sim-de-middleware-registry/build)
- :event {}
- :ordering (sim-de-ordering-registry/build)})
diff --git a/src/cljc/auto_sim/simulation_engine/impl/scheduler.cljc b/src/cljc/auto_sim/simulation_engine/impl/scheduler.cljc
deleted file mode 100644
index f0259ee..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/scheduler.cljc
+++ /dev/null
@@ -1,172 +0,0 @@
-(ns auto-sim.simulation-engine.impl.scheduler
- "The `scheduler` is working with a `model` describing the problem to solve.
-
- For each scheduler snapshot created, the scheduler is sorting the `future-events` based on the event ordering defined in the event-registry. The first event of that order is executed (see event execution). The resulting new values of state, past events, future events are used to create the new scheduler snapshot.
-
- An event has three parameters `(event-execution current-event state new-future-events)`:
- * `current-event` which is the current event to execute
- * `state` which is the state value before the event execution
- * `new-future-events` which is the list of future events without the current event
-
- The returned value is a `event-return`, which future events have no needs to be sorted, they will be by the scheduler.
-
- 
- 
- "
- (:require
- [automaton-core.adapters.schema :as
- core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.event-return
- :as sim-de-event-return]
- [auto-sim.simulation-engine.impl.built-in-sd.execution-not-found
- :as sim-de-execution-not-found]
- [auto-sim.simulation-engine.impl.built-in-sd.failed-event-execution
- :as sim-failed-event-execution]
- [auto-sim.simulation-engine.impl.built-in-sd.no-future-events
- :as sim-de-no-future-events]
- [auto-sim.simulation-engine.impl.middleware.registry
- :as sim-de-middleware-registry]
- [auto-sim.simulation-engine.impl.middlewares
- :as sim-de-middlewares]
- [auto-sim.simulation-engine.impl.model :as
- sim-de-model]
- [auto-sim.simulation-engine.impl.model-data
- :as sim-de-model-data]
- [auto-sim.simulation-engine.impl.stopping.criteria
- :as sim-de-criteria]
- [auto-sim.simulation-engine.ordering
- :as sim-de-ordering]
- [auto-sim.simulation-engine.response
- :as sim-de-response]
- [auto-sim.simulation-engine.snapshot
- :as sim-de-snapshot]))
-
-(defn handler
- "The handler execution is based on `request` data and is returning a `response`, it could be enriched with `middlewares`.
-
- The `response` is initiated with the `stopping-causes` of the `request`, and the `snapshot`. If succesful, it is updated with `state` and `future-events` of the `event-execution`.
-
- It may happen that errors occur and `handler` creates `stopping-cause` as:
-
- * `sim-de-execution-not-found` if an `event-execution` is not found, that event is moved to `past-events` and the `stopping-cause` added.
- * `sim-failed-event-execution` if an exception is raised during `event-execution`, the `stopping-cause` is added."
- [{::sim-engine/keys [stopping-causes snapshot event-execution sorting current-event]
- :as _request}]
- (let [response #:auto-sim.simulation-engine{:stopping-causes stopping-causes
- :snapshot snapshot}]
- (cond
- (seq stopping-causes) response
- (not (fn? event-execution)) (-> response
- (sim-de-execution-not-found/evaluates
- (get-in snapshot [::sim-engine/future-events 0]))
- (sim-de-response/consume-first-event current-event))
- :else (try (let [{::sim-engine/keys [state future-events]} snapshot
- [current-event & future-events-wo-current] future-events
- event-return (event-execution current-event state future-events-wo-current)]
- (->
- response
- (sim-de-response/consume-first-event current-event)
- (update ::sim-engine/snapshot sim-de-event-return/update-snapshot event-return)
- (update ::sim-engine/snapshot sim-de-snapshot/sort-future-events sorting)))
- (catch #?(:clj Exception
- :cljs :default)
- e
- (-> response
- (sim-failed-event-execution/evaluates e current-event)
- (sim-de-response/consume-first-event current-event)))))))
-
-(defn scheduler-loop
- "`scheduler-loop` is one loop iteration of the scheduler.
-
- It is picking the first `event` of the `future-events` is the `current-event`, used to get the `event-execution`.
- It starts with the build of a `request`, call the `handler` wrapped in `middlewares` and add `current-event` to the potential `stopping-causes`
-
- Some error may create some `stopping-causes`, they are not stopping execution here, to give a chance to middlewares to add some other `stopping-causes`:
-
- * `no-future-events` which is happening when no event is found in the `future-events` to be executed."
- [event-registry
- sorting
- ahandler
- {::sim-engine/keys [future-events]
- :as snapshot}
- stopping-criterias]
- (let [current-event (first future-events)
- event-execution (get event-registry (::sim-engine/type current-event))
- stopping-causes (->> stopping-criterias
- (mapv #(sim-de-criteria/evaluates % snapshot))
- (filter some?))
- request #:auto-sim.simulation-engine{:stopping-causes stopping-causes
- :snapshot snapshot
- :event-execution event-execution
- :current-event current-event
- :sorting sorting}]
- (-> request
- (sim-de-no-future-events/evaluates future-events)
- ahandler
- (sim-de-response/add-current-event-to-stopping-causes current-event))))
-
-(defn invalid-inputs
- "Returns a map describing why it is invalid or `nil` if it is valid."
- [model scheduler-middlewares scheduler-stopping-criterias snapshot]
- (let [validate-data
- #:auto-sim.simulation-engine{:model (core-schema/validate-data-humanize
- sim-de-model/schema
- model)
- :snapshot (core-schema/validate-data-humanize
- sim-de-snapshot/schema
- snapshot)
- :scheduler-middlewares
- (core-schema/validate-data-humanize
- sim-de-model-data/middlewares-schema
- scheduler-middlewares)
- :scheduler-stopping-criteria
- (core-schema/validate-data-humanize
- sim-de-model-data/stopping-criterias-schema
- scheduler-stopping-criterias)}]
- (when (not-every? nil? (vals validate-data)) validate-data)))
-
-(defn scheduler
- "The scheduler executes the `model` until a `stopping-cause` is met.
-
- Note that users can enrich the execution of it by:
- * enriching the `model` with augmented registries.
- * supplementary middlewares and stopping criteria that don't affect the model
-
- Note that particular attention has been paid to leverage model's preparation, e.g. stopping-criteria and middlewares aren't translated again, just their `scheduler` version is.
-
- Returns a `response` with the last snapshot and the `stopping-causes`."
- [model scheduler-middlewares scheduler-stopping-criterias snapshot]
- (let [{::sim-engine/keys [registry middlewares ordering stopping-criterias]} model
- event-registry (::sim-engine/event registry)
- updated-middlewares (->> scheduler-middlewares
- (map (partial sim-de-middleware-registry/data-to-fn
- (::sim-engine/middleware registry)))
- (filterv some?))
- updated-scs (->> scheduler-stopping-criterias
- (map (partial sim-de-criteria/api-data-to-entity
- (::sim-engine/stopping registry)))
- (filter some?)
- (mapv sim-de-criteria/out-of-model)
- (concat stopping-criterias))
- initial-snapshot (if (map? snapshot)
- snapshot
- #:auto-sim.simulation-engine{:id 1
- :iteration 1
- :date nil
- :state {}
- :past-events []
- :future-events []})
- sorting (sim-de-ordering/sorter ordering)
- wrapped-handler (->> updated-middlewares
- (sim-de-middlewares/concat-supp-middlewares middlewares)
- (sim-de-middlewares/wrap-handler handler))
- sorted-snapshot (update initial-snapshot ::sim-engine/future-events sorting)]
- (loop [iteration-nb 1
- snapshot sorted-snapshot]
- (let [response (scheduler-loop event-registry sorting wrapped-handler snapshot updated-scs)
- {stopping-causes ::sim-engine/stopping-causes
- result-snapshot ::sim-engine/snapshot}
- response]
- (if (seq stopping-causes) response (recur (inc iteration-nb) result-snapshot))))))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/stopping/cause.cljc b/src/cljc/auto_sim/simulation_engine/impl/stopping/cause.cljc
deleted file mode 100644
index 6cd9be4..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/stopping/cause.cljc
+++ /dev/null
@@ -1,19 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping.cause
- "A reason why the `scheduler` stops. A `stopping-cause` contains:
-
- * `context` data describing the context of the `stopping-criteria`, note its schema is defined freely by each `stopping-definition`.
- * `current-event` the event that is about to be executed now. It could be null, if future-event is nil and no first event found.
- * `stopping-criteria` telling the intent of the user to stop.
-
- "
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.event :as sim-de-event]
- [auto-sim.simulation-engine.impl.stopping.criteria :as sim-de-criteria]))
-
-(def schema
- [:map {:closed true}
- [::sim-engine/context {:optional true}
- :map]
- [::sim-engine/current-event [:maybe sim-de-event/schema]]
- [::sim-engine/stopping-criteria sim-de-criteria/schema]])
diff --git a/src/cljc/auto_sim/simulation_engine/impl/stopping/criteria.cljc b/src/cljc/auto_sim/simulation_engine/impl/stopping/criteria.cljc
deleted file mode 100644
index 36f5345..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/stopping/criteria.cljc
+++ /dev/null
@@ -1,71 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping.criteria
- "Declares a `stopping-criteria` to instantiate `stopping-definition`s, it precises the `params` necessary for `stopping-evaluation`.
- The data are:
-
- * `model-end?` is set to `true` if the stopping-criteria is one possible end of the model. Note that more than one is possible for the same model. Note that these model `stopping-criteria` are not supposed to be linked with anything else than the business model itself (not the rendering, not the control/computation, ...)
- * `params` is a map of parameters, which content is defined by the `stopping-definition`.
- * `stopping-definition` is the `stopping-definition` as found in the `stopping-registry`.
-
- ![entities][archi/simulation_engine/stopping_stopping-criteria.png]"
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.stopping.definition :as sim-de-sc-definition]))
-
-(def schema
- [:map {:closed true}
- [::sim-engine/model-end? {:optional true}
- :boolean]
- [::sim-engine/params {:optional true}
- :map]
- [::sim-engine/stopping-definition sim-de-sc-definition/schema]])
-
-(defn evaluates
- "Evaluates the `stopping-criteria` on `snapshot`.
-
- Returns `nil` if `stopping-evaluation` is not defined.
- Returns a map with `stop?` and `context`."
- [{::sim-engine/keys [params stopping-definition]
- :as stopping-criteria}
- snapshot]
- (let [{::sim-engine/keys [stopping-evaluation]} stopping-definition]
- (when (fn? stopping-evaluation)
- (let [{::sim-engine/keys [stop? context]} (stopping-evaluation snapshot params)]
- (when stop?
- {::sim-engine/context context
- ::sim-engine/stopping-criteria stopping-criteria})))))
-
-(defn model-end
- "Set the `stopping-criteria` as one ending the model."
- [stopping-criteria]
- (assoc stopping-criteria ::sim-engine/model-end? true))
-
-(defn out-of-model
- "Set the `stopping-criteria` as one not ending the model."
- [stopping-criteria]
- (assoc stopping-criteria ::sim-engine/model-end? false))
-
-(defn api-data-to-entity
- "Turns the `api` version of a `stopping-criteria` to one matching the entity `schema`.
-
- Three forms are offered:
-
- * `keyword` for stopping-criteria that need no params.
- * `[stopping-definition-id params]` where `stopping-definition-id` is a keyword and `params` is a map.
- * or a criteria already turned to an entity
-
- All other forms are discarded."
- [stopping-registry stopping-criteria]
- (cond
- (keyword? stopping-criteria) (let [stopping-definition-id stopping-criteria]
- (when-let [stopping-definition (get stopping-registry
- stopping-definition-id)]
- {::sim-engine/params {}
- ::sim-engine/stopping-definition stopping-definition}))
- (vector? stopping-criteria)
- (let [[stopping-definition-id params] stopping-criteria]
- (when (and (or (nil? params) (map? params)) (keyword? stopping-definition-id))
- (when-let [stopping-definition (get stopping-registry stopping-definition-id)]
- {::sim-engine/params params
- ::sim-engine/stopping-definition stopping-definition})))
- (true? (core-schema/validate-data schema stopping-criteria)) stopping-criteria))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/stopping/definition.cljc b/src/cljc/auto_sim/simulation_engine/impl/stopping/definition.cljc
deleted file mode 100644
index a0fcbf3..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/stopping/definition.cljc
+++ /dev/null
@@ -1,29 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping.definition
- "A `stopping-definition` defines what could cause the scheduler to stop.
-
- * `doc` describes the definition.
- * `id` name of the `stopping-definition`
- * `next-possible?` tells if the next call of the `scheduler` will raise the same error.
- * `stopping-evaluation` is the function to be called to evalute the criteria and decides if stops is true or not.
-
- Note that only `stopping-definition` with `stopping-evaluation` properly set are callable by users. Others are built-in `stopping-definition` triggering `stopping-cause` in the `simulation-engine` bounded context.
-
- "
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.snapshot :as sim-de-snapshot]))
-
-(def id-schema :keyword)
-
-(def schema
- [:map {:closed true}
- [::sim-engine/doc :string]
- [::sim-engine/id id-schema]
- [::sim-engine/next-possible? :boolean]
- [::sim-engine/stopping-evaluation {:optional true}
- [:function
- [:=>
- [:cat sim-de-snapshot/schema [:map]]
- [:map {:closed true}
- [::sim-engine/stop? :boolean]
- [::sim-engine/context [:map]]]]]]])
diff --git a/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/bucket.cljc b/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/bucket.cljc
deleted file mode 100644
index f7a1988..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/bucket.cljc
+++ /dev/null
@@ -1,22 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping-definition.bucket
- "`stopping-definition` to stop at a given bucket."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn stop-bucket
- "Stops after the `date` is reached, or after."
- [{::sim-engine/keys [date]
- :as _snapshot
- :or {date 0}}
- {:keys [b]
- :as _params}]
- (when (or (nil? b) (>= date b))
- #:auto-sim.simulation-engine{:stop? true
- :context nil}))
-
-(defn stopping-definition
- []
- #:auto-sim.simulation-engine{:doc "Stop at `bucket` `b` or later on."
- :id ::bucket-stopping
- :next-possible? true
- :stopping-evaluation stop-bucket})
diff --git a/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/iteration_nth.cljc b/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/iteration_nth.cljc
deleted file mode 100644
index 33e0983..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/iteration_nth.cljc
+++ /dev/null
@@ -1,23 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping-definition.iteration-nth
- "`stopping-definition` to stop at a given iteration."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn stop-nth
- "Is the `snapshot`'s `iteration` greater than or equal to `n`, the parameter in `params`."
- [snapshot
- {::sim-engine/keys [n]
- :as _params}]
- (let [snapshot-iteration (get snapshot ::sim-engine/iteration 0)]
- #:auto-sim.simulation-engine{:stop? (or (nil? n) (>= snapshot-iteration n))
- :context
- #:auto-sim.simulation-engine{:iteration
- snapshot-iteration
- :n n}}))
-
-(defn stopping-definition
- []
- #:auto-sim.simulation-engine{:doc "Stops when the iteration `n` is reached."
- :id ::sim-engine/iteration-nth
- :next-possible? true
- :stopping-evaluation stop-nth})
diff --git a/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/now.cljc b/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/now.cljc
deleted file mode 100644
index e3a6be1..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/now.cljc
+++ /dev/null
@@ -1,17 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping-definition.now
- "`stopping-definition` to stop right now."
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn stop-now
- "Stops now."
- [_snapshot _params]
- #:auto-sim.simulation-engine{:stop? true
- :context nil})
-
-(defn stopping-definition
- []
- #:auto-sim.simulation-engine{:doc "Criteria to stop right now."
- :id ::sim-engine/stop-now
- :next-possible? true
- :stopping-evaluation stop-now})
diff --git a/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/registry.cljc b/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/registry.cljc
deleted file mode 100644
index 6249f8c..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/registry.cljc
+++ /dev/null
@@ -1,41 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping-definition.registry
- "Stopping registry contains all `stopping-definition`.
-
- "
- (:require
- [automaton-core.adapters.schema :as
- core-schema]
- [automaton-core.utils.map :as utils-map]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.built-in-sd.request-validation
- :as sim-de-request-validation]
- [auto-sim.simulation-engine.impl.built-in-sd.response-validation
- :as sim-de-response-validation]
- [auto-sim.simulation-engine.impl.stopping-definition.bucket
- :as sim-de-sc-bucket]
- [auto-sim.simulation-engine.impl.stopping-definition.iteration-nth
- :as sim-de-sc-iteration-nth]
- [auto-sim.simulation-engine.impl.stopping-definition.now :as
- sim-de-sc-now]
- [auto-sim.simulation-engine.impl.stopping.definition
- :as sim-de-sc-definition]))
-
-(def schema [:map-of sim-de-sc-definition/id-schema sim-de-sc-definition/schema])
-
-(defn add-stopping-definition
- "Add the stopping definition in the registry."
- [registry & stopping-definitions]
- (merge registry
- (->> (utils-map/maps-to-key stopping-definitions ::sim-engine/id)
- (core-schema/add-default schema))))
-
-(defn build
- "The registered stopping criteria registry."
- []
- (add-stopping-definition {}
- (sim-de-sc-iteration-nth/stopping-definition)
- (sim-de-response-validation/stopping-definition)
- (sim-de-sc-bucket/stopping-definition)
- (sim-de-request-validation/stopping-definition)
- (sim-de-sc-now/stopping-definition)))
diff --git a/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/state_contains.cljc b/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/state_contains.cljc
deleted file mode 100644
index 90120f0..0000000
--- a/src/cljc/auto_sim/simulation_engine/impl/stopping_definition/state_contains.cljc
+++ /dev/null
@@ -1,24 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping-definition.state-contains
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn stop?
- "Is the `snapshot` state contains value under params `state`. Considers empty collection as no value"
- [snapshot
- {:keys [state]
- :as _params}]
- (let [snapshot-state (get snapshot ::sim-engine/state {})
- state-entry (get-in snapshot-state state)]
- #:auto-sim.simulation-engine{:stop? (if (coll? state-entry)
- (not-empty state-entry)
- (some? state-entry))
- :context
- #:auto-sim.simulation-engine{:snapshot-state
- snapshot-state}}))
-
-(defn stopping-definition
- []
- #:auto-sim.simulation-engine{:doc "Stops when `state` path is containing any value"
- :id :state-contains
- :next-possible? true
- :stopping-evaluation stop?})
diff --git a/src/cljc/auto_sim/simulation_engine/middleware.cljc b/src/cljc/auto_sim/simulation_engine/middleware.cljc
deleted file mode 100644
index 8588f68..0000000
--- a/src/cljc/auto_sim/simulation_engine/middleware.cljc
+++ /dev/null
@@ -1,11 +0,0 @@
-(ns auto-sim.simulation-engine.middleware
- "Defines a middleware, wrapping an handler to prepare the request before the handler execution, and modify the response after handler execution.
- Note that a middleware wrapping an handler returns a new handler, that can be wrapped again.
-
- * [See entity](docs/archi/middleware_entity.png)"
- (:require
- [auto-sim.simulation-engine.request :as sim-de-request]))
-
-(def id-schema :keyword)
-
-(def schema [:=> [:cat sim-de-request/schema] :map])
diff --git a/src/cljc/auto_sim/simulation_engine/orderings.cljc b/src/cljc/auto_sim/simulation_engine/orderings.cljc
deleted file mode 100644
index abb6ef3..0000000
--- a/src/cljc/auto_sim/simulation_engine/orderings.cljc
+++ /dev/null
@@ -1,7 +0,0 @@
-(ns auto-sim.simulation-engine.orderings
- "Sequence of `ordering`."
- (:require
- [auto-sim.simulation-engine.ordering :as sim-de-ordering]))
-
-(def schema [:sequential sim-de-ordering/schema])
-
diff --git a/src/cljc/auto_sim/simulation_engine/request.cljc b/src/cljc/auto_sim/simulation_engine/request.cljc
deleted file mode 100644
index 28c5f72..0000000
--- a/src/cljc/auto_sim/simulation_engine/request.cljc
+++ /dev/null
@@ -1,30 +0,0 @@
-(ns auto-sim.simulation-engine.request
- "Build a request for an handler.
-
- Contains:
-
- * `current-event`
- * `event-execution`
- * `snapshot`
- * `sorting`
- * `stopping-causes`, the scheduler snapshot and the current event.
- * "
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.event :as sim-de-event]
- [auto-sim.simulation-engine.event-execution :as sim-de-event-execution]
- [auto-sim.simulation-engine.snapshot :as sim-de-snapshot]))
-
-(def schema
- [:map {:closed false}
- [::sim-engine/current-event sim-de-event/schema]
- [::sim-engine/event-execution [:maybe sim-de-event-execution/schema]]
- [::sim-engine/snapshot sim-de-snapshot/schema]
- [::sim-engine/sorting
- [:function [:=> [:cat [:vector sim-de-event/schema]] [:vector sim-de-event/schema]]]]
- [::sim-engine/stopping-causes [:sequential :map]]])
-
-(defn add-stopping-cause
- "Adds to the `request` the map `m` among `stopping-causes`."
- [request m]
- (if (nil? m) request (update request ::sim-engine/stopping-causes conj m)))
diff --git a/src/cljc/auto_sim/simulation_engine/response.cljc b/src/cljc/auto_sim/simulation_engine/response.cljc
deleted file mode 100644
index dacd4a0..0000000
--- a/src/cljc/auto_sim/simulation_engine/response.cljc
+++ /dev/null
@@ -1,53 +0,0 @@
-(ns auto-sim.simulation-engine.response
- "Is a response of scheduler.
-
- It contains:
- * `stopping-causes`
- * `snapshot`."
- (:require
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.built-in-sd.causality-broken
- :as sim-de-causality-broken]
- [auto-sim.simulation-engine.impl.stopping.cause
- :as sim-de-stopping-cause]
- [auto-sim.simulation-engine.snapshot :as
- sim-de-snapshot]))
-
-(def schema
- [:map {:closed false}
- [::sim-engine/stopping-causes [:sequential sim-de-stopping-cause/schema]]
- [::sim-engine/snapshot sim-de-snapshot/schema]])
-
-(defn add-stopping-cause
- "Adds map `m` among `stop-causes`."
- [response
- {::sim-engine/keys [stopping-causes]
- :as m}]
- (cond-> response
- (and (nil? m) (empty? stopping-causes)) (assoc ::sim-engine/stopping-causes [])
- (some? m) (update ::sim-engine/stopping-causes conj m)))
-
-(defn consume-first-event
- "Moves the `response` to the next operation. `current-event` is added to the `stopping-cause` if causality is broken.
- Consists in:
-
- * removing the first event in the `future-events` and push it in `past-event`.
- * adding `::sim-engine/causality-broken` `stopping-cause` if that event is coming back to the past.
- Note that in case causality is broken, the date is not modified and keep the previous snapshot date instead of the faulty event date."
- [{::sim-engine/keys [snapshot]
- :as response}
- current-event]
- (let [{::sim-engine/keys [date]} snapshot
- next-snapshot (sim-de-snapshot/consume-first-event snapshot)
- causality-broken (sim-de-causality-broken/evaluates snapshot next-snapshot current-event)]
- (cond-> (assoc response ::sim-engine/snapshot (sim-de-snapshot/next-iteration next-snapshot))
- (some? causality-broken) (add-stopping-cause causality-broken)
- (some? causality-broken) (assoc-in [::sim-engine/snapshot ::sim-engine/date] date))))
-
-(defn add-current-event-to-stopping-causes
- "Adds `current-event` to `stopping-causes` in the `response`."
- [response current-event]
- (-> response
- (update ::sim-engine/stopping-causes
- (partial map #(assoc % ::sim-engine/current-event current-event)))))
diff --git a/src/cljc/auto_sim/simulation_engine/snapshot.cljc b/src/cljc/auto_sim/simulation_engine/snapshot.cljc
deleted file mode 100644
index 434109b..0000000
--- a/src/cljc/auto_sim/simulation_engine/snapshot.cljc
+++ /dev/null
@@ -1,98 +0,0 @@
-(ns auto-sim.simulation-engine.snapshot
- "A scheduler snapshot is a consistent set of data for the scheduler.
-It is containing the simulation state, past events and future events and iteration number scheduler snapshot is identified with an id property and is related to exactly one date. Past and Future events are sorted collection of events.
-
-Remarks:
-* An entity using the scheduler snapshot should not access past or future events to have some information on the state the simulation.
-
- * [See entity](docs/archi/snapshot_entity.png)"
- (:refer-clojure :exclude [update])
- (:require
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.event :as sim-de-event]))
-
-(def schema
- "Scheduler snapshot is a map containing:
- * `id` - Unique identificator of an scheduler snapshot. It is in a one to one relationship with a scheduler snapshot (so it acts like an id of that scheduler snapshot in the context of a scheduler play) in the context scheduler.
- * `iteration` - A counter of scheduler iteration. By convention, the counter is starting at 1.
- * `date` - Defines the date where that scheduler-snapshot happens
- * `state` - State modified by the event
- * `past-events` - Collection of a past event. A past event is event that has already been executed, so its date is in the past. A past event cannot be modified anymore (i.e. it is immutable).
- * `future-events` - Collection of a future event. A future event is an event that has not been executed yet, so its date is in the future. A future event may be updated during the simulation - its date may change, its data may change or it could be cancelled (i.e. it’s a mutable event)"
- [:map {:closed true}
- [::sim-engine/id :int]
- [::sim-engine/iteration :int]
- [::sim-engine/date :any]
- [::sim-engine/state :any]
- [::sim-engine/past-events [:sequential sim-de-event/schema]]
- [::sim-engine/future-events [:sequential sim-de-event/schema]]])
-
-(defn consume-first-event
- "Returns a `snapshot` where the first `future-event` is moved to the `past-events` and `date` is updated to this `date`."
- [{::sim-engine/keys [id iteration state past-events future-events date]
- :as _snapshot}]
- (let [[event & new-future-events] future-events
- {event-date ::sim-engine/date} event
- new-past-events (if (nil? event) past-events (conj past-events event))]
- {::sim-engine/id ((fnil inc 0) id)
- ::sim-engine/iteration iteration
- ::sim-engine/date (if (nil? event-date) date event-date)
- ::sim-engine/state state
- ::sim-engine/past-events (if (nil? new-past-events) [] new-past-events)
- ::sim-engine/future-events (if (nil? new-future-events) [] new-future-events)}))
-
-(defn next-iteration
- "Update the `snapshot` to the next iteration."
- [snapshot]
- (clojure.core/update snapshot ::sim-engine/iteration (fnil inc 0)))
-
-(defn initial
- "Creates an initial snapshsot"
- [date future-events]
- {::sim-engine/id 1
- ::sim-engine/iteration 1
- ::sim-engine/date date
- ::sim-engine/state {}
- ::sim-engine/past-events []
- ::sim-engine/future-events future-events})
-
-(defn inconsistency?
- "Check snapshot consistency
-
- Returns:
- * `::sim-engine/nil-date` if there is no date set in the snapshot.
- * sequence of future events which are before current date
- * past events which are after current date
- Returns false if consistent"
- [{::sim-engine/keys [date]
- :as snapshot}]
- (if (nil? date)
- ::sim-engine/nil-date
- (let [res (-> (select-keys snapshot [::sim-engine/future-events ::sim-engine/past-events])
- (clojure.core/update
- ::sim-engine/future-events
- (partial filterv #(let [d (::sim-engine/date %)] (or (nil? d) (> date d)))))
- (clojure.core/update ::sim-engine/past-events
- (partial filterv
- #(let [d (::sim-engine/date %)]
- (or (nil? d) (< date (::sim-engine/date %)))))))]
- (if (= res
- {::sim-engine/future-events []
- ::sim-engine/past-events []})
- false
- {:snapshot-date date
- :mismatching-events res}))))
-
-(defn update
- "Helper to update `future-events` and `state`.
- Please note both will be replaced and not updated."
- [snapshot future-events state]
- (assoc snapshot ::sim-engine/future-events future-events ::sim-engine/state state))
-
-(defn sort-future-events
- "Sort `future-events` in `snapshot` thanks the `sorting` sorter."
- [snapshot sorting]
- (clojure.core/update snapshot
- ::sim-engine/future-events
- (fn [future-events]
- (or (if (fn? sorting) (sorting future-events) future-events) []))))
diff --git a/src/cljc/auto_sim/stopping_criteria.cljc b/src/cljc/auto_sim/stopping_criteria.cljc
new file mode 100644
index 0000000..eb75fa2
--- /dev/null
+++ b/src/cljc/auto_sim/stopping_criteria.cljc
@@ -0,0 +1,98 @@
+(ns auto-sim.stopping-criteria
+ (:refer-clojure :exclude [eval remove])
+ (:require
+ [auto-sim.engine :as-alias sim-engine]))
+
+;; ********************************************************************************
+;; Private API
+;; ********************************************************************************
+
+(defn add-to-stopping-definition
+ [model f]
+ (-> model
+ (update ::sim-engine/stopping-definition (fnil conj []) f)))
+
+(defn stop-bucket-sd
+ [stopping-bucket]
+ (fn [snapshot]
+ (let [{snapshot-bucket ::sim-engine/bucket} snapshot]
+ (when (or (nil? snapshot-bucket) (nil? stopping-bucket) (>= snapshot-bucket stopping-bucket))
+ #::sim-engine{:doc (if (= stopping-bucket snapshot-bucket)
+ ["Stops at bucket %d as required" stopping-bucket]
+ ["Stops at bucket %d (requiring %d)" snapshot-bucket stopping-bucket])
+ :id ::bucket-stopping
+ :context {:stopping-bucket stopping-bucket
+ :snapshot-bucket snapshot-bucket}}))))
+
+(defn stop-iteration-sd
+ [iteration]
+ (fn [snapshot]
+ (let [{snapshot-iteration ::sim-engine/iteration} snapshot]
+ ;;TODO Puis regarder pourquoi faire fonctionner les logs (or (nil? snapshot-iteration) (nil? iteration) (>= snapshot-iteration iteration))
+ (when (or (nil? snapshot-iteration) (nil? iteration) (>= snapshot-iteration iteration))
+ #::sim-engine{:doc (if (= iteration snapshot-iteration)
+ ["Stops at iteration %d as required" iteration]
+ ["Stops at iteration %d (requiring %d)" snapshot-iteration iteration])
+ :id ::iteration-stopping
+ :context {:stopping-iteration iteration
+ :snapshot-iteration snapshot-iteration}}))))
+
+(defn stop-now-sd
+ "Stops now."
+ []
+ (fn [_]
+ #::sim-engine{:doc ["Stop now."]
+ :id ::stop-now
+ :context nil}))
+
+
+
+(defn stop-state-contains-sd
+ [state-path]
+ (fn [snapshot]
+ (let [snapshot-state (get snapshot ::sim-engine/state {})]
+ (when-let [state-entry (get-in snapshot-state state-path)]
+ #::sim-engine{:doc ["Stops as state contains `%s` in `%s`" state-entry state-path]
+ :id ::state-contains
+ :context #::sim-engine{:snapshot-state snapshot-state
+ :state-entry state-entry}}))))
+
+;; ********************************************************************************
+;; Public API
+;; ********************************************************************************
+
+(defn stop-bucket
+ "Stops when the the `stopping-bucket` is reached, or after."
+ [model stopping-bucket]
+ (-> model
+ (add-to-stopping-definition (stop-bucket-sd stopping-bucket))))
+
+(defn stop-iteration
+ "Stops at iteration `iteration`"
+ [model iteration]
+ (-> model
+ (add-to-stopping-definition (stop-iteration-sd iteration))))
+
+(defn stop-now
+ [model]
+ (-> model
+ (add-to-stopping-definition (stop-now-sd))))
+
+(defn stop-state-contains
+ [model state-path]
+ (-> model
+ (add-to-stopping-definition (stop-state-contains-sd state-path))))
+
+(defn eval
+ "Evaluates the `stopping-fns` on `snapshot`.
+
+ Returns `nil` if `stopping-evaluation` is not defined.
+ Returns a map with `stop?` and `context`."
+ [stopping-fns snapshot]
+ (reduce (fn [res stopping-fn]
+ (if-let [v (stopping-fn snapshot)]
+ (conj res v)
+ res))
+ []
+ stopping-fns))
+
diff --git a/src/cljc/auto_sim/transformation.cljc b/src/cljc/auto_sim/transformation.cljc
deleted file mode 100644
index 912aefa..0000000
--- a/src/cljc/auto_sim/transformation.cljc
+++ /dev/null
@@ -1,161 +0,0 @@
-(ns auto-sim.transformation
- "Transformation contains useful functions for rendering
- * [See transformation big-picture](docs/archi/transformation/transformation_big_picture.png)"
- (:require
- [auto-sim.entity :as-alias sim-entity]
- [auto-sim.rc :as-alias sim-rc]
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn- get-path
- "Return value under path, if path is nil return value itself"
- [v path]
- (cond
- (keyword? path) (get v path)
- (sequential? path) (get-in v path)
- :else v))
-
-(defn- keep-map
- "Filter out key/value pairs which values return false with `pred-fn`"
- ([pred-fn m] (keep-map pred-fn nil m))
- ([pred-fn path m] (into {} (filter (fn [[_ v]] (pred-fn (get-path v path))) m))))
-
-;; Simulation engine
-(defn keep-state
- "Keeps in simulation `state` only pairs that match with `pred-fn`"
- [pred-fn state]
- (keep-map pred-fn state))
-
-(defn keep-events
- "Keep in coll of simulation `events` only those that match with `pred-fn`"
- [pred-fn events]
- (->> events
- (filter (fn [evt] (pred-fn evt)))))
-
-(defn keep-snapshot-state
- "Filter out of `snapshot` state all items that do not match with `pred-fn` "
- ([keep-state-fn pred-fn snapshot]
- (-> snapshot
- (update ::sim-engine/state (partial keep-state-fn pred-fn))))
- ([pred-fn snapshot] (keep-snapshot-state keep-state pred-fn snapshot)))
-
-(defn keep-snapshot-past-events
- "Filter out of `snapshot` past events all events that do not match with `pred-fn`"
- [pred-fn snapshot]
- (-> snapshot
- (update ::sim-engine/past-events (partial keep-events pred-fn))))
-
-(defn keep-snapshot-future-events
- "Filter out of `snapshot` future events all events that do not match with `pred-fn`"
- [pred-fn snapshot]
- (-> snapshot
- (update ::sim-engine/future-events (partial keep-events pred-fn))))
-
-(defn keep-snapshot-events
- "Filter out of `snapshot` ALL events that do not match with `pred-fn`"
- [pred-fn snapshot]
- (->> snapshot
- (keep-snapshot-past-events pred-fn)
- (keep-snapshot-future-events pred-fn)))
-
-(defn keep-snapshot
- "Filter out of `snapshot` ALL events and state-items that do not match with `pred-fn`"
- [pred-fn snapshot]
- (->> snapshot
- (keep-snapshot-state pred-fn)
- (keep-snapshot-events pred-fn)))
-
-(defn keep-snapshot-events-based-state
- "Filter out of `snapshot` ALL state-items that do not match with `pred-fn` and filter out all events that do not mention those state-items ids"
- ([pred-fn snapshot] (keep-snapshot-events-based-state pred-fn nil snapshot))
- ([pred-fn id snapshot]
- (keep-snapshot-events-based-state keys #(keep-snapshot-state pred-fn %) id snapshot))
- ([get-state-keys-fn keep-state-fn id snapshot]
- (let [snapshot (keep-state-fn snapshot)
- state-keys (get-state-keys-fn (::sim-engine/state snapshot))]
- (keep-snapshot-events #(some (fn [v] (= v (get % id))) state-keys) snapshot))))
-
-;; Simulation response
-(defn keep-stopping-causes
- "Filter out all stopping-causes that do not match with `pred-fn`"
- [pred-fn stopping-causes]
- (filter (fn [stopping-cause] (pred-fn stopping-cause)) stopping-causes))
-
-(defn keep-stopping-causes-by-model-end
- "Keep all `stopping-causes` that model end is matching `pred-fn`"
- [pred-fn stopping-causes]
- (filter (fn [stopping-cause]
- (pred-fn (get-in stopping-cause
- [::sim-engine/stopping-criteria ::sim-engine/model-end?])))
- stopping-causes))
-
-(defn keep-stopping-causes-by-stopping-definition
- "Keep all `stopping-causes` that stopping definitio` is matching `pred-fn`"
- [pred-fn stopping-causes]
- (filter (fn [stopping-cause]
- (pred-fn (get-in stopping-cause
- [::sim-engine/stopping-criteria ::sim-engine/stopping-definition])))
- stopping-causes))
-
-;; Multiple snapshots
-(defn keep-snapshots-state
- "Expects sorted collection of `snapshots`, keeps only those that have difference between each other in filtered by `pred-fn` state"
- [pred-fn snapshots]
- (reduce (fn [acc snapshot]
- (let [last-snapshot-state (::sim-engine/state (last acc))]
- (if (= (::sim-engine/state snapshot) last-snapshot-state) acc (conj acc snapshot))))
- []
- (map #(keep-snapshot-state pred-fn %) snapshots)))
-
-;; RC
-(defn keep-state-resource
- "Keeps in simulation `state` only those resources that match with `pred-fn`"
- [pred-fn state]
- (update state ::sim-rc/resource (partial keep-state pred-fn)))
-
-(defn keep-snapshot-state-resource
- "Keeps in simulation snapshot `state` only those resources that match with `pred-fn`"
- [pred-fn snapshot]
- (keep-snapshot-state keep-state-resource pred-fn snapshot))
-
-(defn keep-snapshot-resource
- "Keeps in snapshot `state` only those resources that match with `pred-fn` and filters events with the same `pred-fn`"
- [pred-fn snapshot]
- (->> snapshot
- (keep-snapshot-state-resource pred-fn)
- (keep-snapshot-events pred-fn)))
-
-(defn keep-snapshot-events-based-state-resource
- "Keeps in snapshot `state` only those resources that match with `pred-fn` and filters events that contains those resources ids"
- ([pred-fn snapshot] (keep-snapshot-events-based-state-resource pred-fn nil snapshot))
- ([pred-fn id snapshot]
- (keep-snapshot-events-based-state #(keys (get % ::sim-rc/resource))
- #(keep-snapshot-state-resource pred-fn %)
- id
- snapshot)))
-
-;;Entity
-(defn keep-state-entity
- "Keeps in simulation `state` only those entities that match with `pred-fn`"
- [pred-fn state]
- (update state ::sim-entity/entities (partial keep-map pred-fn ::sim-entity/entity-state)))
-
-(defn keep-snapshot-state-entity
- "Keeps in simulation `snapshot` state only those entities that match with `pred-fn`"
- [pred-fn snapshot]
- (keep-snapshot-state keep-state-entity pred-fn snapshot))
-
-(defn keep-snapshot-entity
- "Filter out of `snapshot` ALL events and state-entity-items that do not match with `pred-fn`"
- [pred-fn snapshot]
- (->> snapshot
- (keep-snapshot-state-entity pred-fn)
- (keep-snapshot-events pred-fn)))
-
-(defn keep-snapshot-events-based-state-entity
- "Keeps in snapshot `state` only those entities that match with `pred-fn` and filters events that contains those resources ids"
- ([pred-fn snapshot] (keep-snapshot-events-based-state-entity pred-fn nil snapshot))
- ([pred-fn id snapshot]
- (keep-snapshot-events-based-state #(keys (::sim-entity/entities %))
- #(keep-snapshot-state-entity pred-fn %)
- id
- snapshot)))
diff --git a/src/cljc/auto_sim/transformation/delta.cljc b/src/cljc/auto_sim/transformation/delta.cljc
deleted file mode 100644
index 32c8964..0000000
--- a/src/cljc/auto_sim/transformation/delta.cljc
+++ /dev/null
@@ -1,11 +0,0 @@
-(ns auto-sim.transformation.delta
- "Uses editscript as this library is most performant, production used, considers both size optimization and speed
- https://github.com/juji-io/editscript"
- (:require
- [editscript.core :as editscript]))
-
-(defn diff [m1 m2] (editscript/diff m1 m2))
-
-(defn show-diff [diff] (editscript/get-edits diff))
-
-(defn patch [m diff] (editscript/patch m diff))
diff --git a/src/cljs/auto_sim/animation.cljs b/src/cljs/auto_sim/animation.cljs
new file mode 100644
index 0000000..b303ff8
--- /dev/null
+++ b/src/cljs/auto_sim/animation.cljs
@@ -0,0 +1,50 @@
+(ns auto-sim.animation
+ "Animation is moving render-element across time
+
+ The uuid is ensuring only one thread of ::sim/iterate is happening. If a new start is made, the uuid will be different and the older iterate will automatically stop"
+ (:require
+ [auto-sim :as-alias sim]
+ [re-frame.core :refer [dispatch reg-event-db reg-event-fx]]))
+
+(defn trajectory
+ [t src dst]
+ (let [{x-src :x
+ y-src :y
+ t-src :t}
+ src
+ {x-dst :x
+ y-dst :y
+ t-dst :t}
+ dst
+ i (/ (- t t-src) (- t-dst t-src))]
+ (cond
+ (< t t-src) src
+ (> t t-dst) dst
+ :else {:x (+ x-src (* i (- x-dst x-src)))
+ :y (+ y-src (* i (- y-dst y-src)))})))
+
+(reg-event-db ::sim/start
+ (fn [db [_ k refresh-interval]]
+ (let [uuid (random-uuid)]
+ (dispatch [::sim/iterate k uuid refresh-interval])
+ (update-in db
+ [::sim/animation k]
+ assoc
+ :start-time (.now js/Date)
+ :uuid uuid
+ :refresh-inteval refresh-interval))))
+
+(reg-event-db ::sim/stop (fn [db [_ k]] (update-in db [::sim/animation k] dissoc :uuid)))
+
+(reg-event-fx ::sim/iterate
+ (fn [{:keys [db]} [_ k uuid refresh-interval]]
+ (let [v (get-in db [::sim/animation k])]
+ (when (= uuid (:uuid v))
+ (let [{:keys [speed start-time]
+ :or {speed 1}}
+ v
+ ms (* speed (- (.now js/Date) start-time))]
+ {:db (assoc-in db [::sim/time-picker :animation :time] (/ ms 100))
+ :fx [[:dispatch-later {:ms refresh-interval
+ :dispatch
+ [::sim/iterate k uuid refresh-interval]}]]})))))
diff --git a/src/cljs/auto_sim/canvas.cljs b/src/cljs/auto_sim/canvas.cljs
new file mode 100644
index 0000000..ecc091a
--- /dev/null
+++ b/src/cljs/auto_sim/canvas.cljs
@@ -0,0 +1,442 @@
+(ns auto-sim.canvas
+ "Canvas is drawing graphically `render-items`, a map associating a `render-item` to a `name`
+
+ A `render-item` is made of:
+ - `render-id`
+ - `img` an uri to the image to display
+ - `render-items-basis` a map describing:
+ - `width` and `height`
+ - `x` and `y`
+
+ When displayed in a canvas, each `render-item` will be completed with `canvas-basis` to describe where that item will be displayed in the canvas"
+ (:require
+ [re-frame.core :refer [dispatch reg-event-db reg-sub subscribe]]
+ [reagent.core :as r]))
+
+;; ********************************************************************************
+;; Render-element selection
+
+(reg-event-db
+ ::select-render-element
+ (fn [db [_ canvas-id render-id multi-select-mode?]]
+ (let [multi-select? multi-select-mode?]
+ (cond-> db
+ (not multi-select?)
+ (update-in [::canvas canvas-id :render-items] update-vals #(dissoc % :item-selected?))
+ :else (update-in [::canvas canvas-id :render-items render-id :item-selected?] not)))))
+
+(defn- one-selected?
+ "Returns true if at least one element is selected."
+ [render-items]
+ (->> render-items
+ vals
+ (filter :item-selected?)
+ seq))
+
+(reg-event-db ::clear-selection
+ (fn [db [_ canvas-id]]
+ (update-in db
+ [::canvas canvas-id :render-items]
+ update-vals
+ (fn [x] (assoc x :item-selected? false)))))
+
+;; ********************************************************************************
+;; Basis translations
+
+(reg-sub ::canvas-basis (fn [db [_ canvas-id]] (get-in db [::canvas canvas-id :canvas-basis])))
+
+(reg-sub ::basis-translation
+ (fn [db [_ canvas-id]] (get-in db [::canvas canvas-id :basis-translation])))
+
+(reg-sub ::render-items-basis
+ (fn [db [_ canvas-id]] (get-in db [::canvas canvas-id :render-items-basis])))
+
+(defn- render-items-to-canvas
+ "Returns the parameters of the affine function to translate from `render-items` to `canvas` basis.
+
+ If one parameter is missing, returns `nil`"
+ [render-items-basis canvas-basis]
+ (let [{render-items-width :width
+ render-items-height :height}
+ render-items-basis
+ {origin-x-target :origin-x
+ origin-y-target :origin-y
+ canvas-width :width
+ canvas-height :height}
+ canvas-basis]
+ (when (every? some? [canvas-height canvas-width render-items-width render-items-height])
+ {:origin-x origin-x-target
+ :origin-y origin-y-target
+ :sd-x (/ canvas-width render-items-width)
+ :sd-y (/ canvas-height render-items-height)})))
+
+;; ********************************************************************************
+;; render-item
+
+(defn- calculate-canvas-basis
+ "Add its `canvas` basis to a `render-item`."
+ [render-item translation]
+ (let [{:keys [render-items-basis]} render-item
+ {:keys [origin-x origin-y sd-x sd-y]} translation
+ {:keys [width height x y]} render-items-basis]
+ (assoc render-item
+ :canvas-basis
+ {:width (js/Math.round (* sd-x width))
+ :height (js/Math.round (* sd-y height))
+ :x (js/Math.round (+ origin-x (* sd-x x)))
+ :y (js/Math.round (+ origin-y (* sd-y y)))})))
+
+;; ********************************************************************************
+;; Canvas
+
+(reg-event-db ::canvas-resized
+ (fn [db [_ canvas-id width height]]
+ (let [render-items-basis (get-in db [::canvas canvas-id :render-items-basis])
+ canvas-basis {:origin-x 0
+ :origin-y 0
+ :width width
+ :height height}
+ basis-translation (render-items-to-canvas render-items-basis canvas-basis)]
+ (-> db
+ (update-in [::canvas canvas-id]
+ (fn [canva]
+ (cond-> canva
+ true (assoc :basis-translation basis-translation
+ :canvas-basis canvas-basis)
+ (:render-items canva)
+ (update :render-items
+ update-vals
+ #(calculate-canvas-basis % basis-translation)))))))))
+
+;; ********************************************************************************
+;; Dragging mode
+
+(reg-event-db
+ ::drag-render-element-start
+ (fn [db [_ canvas-id drag-render-element-start]]
+ (assoc-in db [::canvas canvas-id :drag-render-element-data] drag-render-element-start)))
+
+(reg-event-db ::drag-render-element-end
+ (fn [db [_ canvas-id]]
+ (update-in db [::canvas canvas-id] dissoc :drag-render-element-data)))
+
+;; New event for updating render element position during drag
+(reg-event-db
+ ::drag-render-element-move
+ (fn [db [_ canvas-id client-x client-y]]
+ (let [drag-data (get-in db [::canvas canvas-id :drag-render-element-data])]
+ (if drag-data
+ (let [{:keys [render-id pos-in-x pos-in-y]} drag-data
+ basis-translation (get-in db [::canvas canvas-id :basis-translation])
+ {:keys [sd-x sd-y origin-x origin-y]} basis-translation
+ canvas-element (.getElementById js/document (name canvas-id))
+ canvas-rect (.getBoundingClientRect canvas-element)
+ ;; Calculate mouse position relative to canvas
+ canvas-mouse-x (- client-x (.-left canvas-rect))
+ canvas-mouse-y (- client-y (.-top canvas-rect))
+ ;; Calculate new top-left position of the item (accounting for the offset within the item)
+ new-canvas-x (- canvas-mouse-x pos-in-x)
+ new-canvas-y (- canvas-mouse-y pos-in-y)
+ ;; Convert back to render-items coordinates
+ new-render-x (/ (- new-canvas-x origin-x) sd-x)
+ new-render-y (/ (- new-canvas-y origin-y) sd-y)]
+ (-> db
+ ;; Update render-items-basis position
+ (assoc-in [::canvas canvas-id :render-items render-id :render-items-basis :x]
+ new-render-x)
+ (assoc-in [::canvas canvas-id :render-items render-id :render-items-basis :y]
+ new-render-y)
+ ;; Update canvas-basis position
+ (assoc-in [::canvas canvas-id :render-items render-id :canvas-basis :x] new-canvas-x)
+ (assoc-in [::canvas canvas-id :render-items render-id :canvas-basis :y] new-canvas-y)))
+ db))))
+
+;; Drag basis events
+(reg-event-db ::drag-basis-start
+ (fn [db [_ canvas-id drag-basis-data]]
+ (assoc-in db [::canvas canvas-id :drag-basis-data] drag-basis-data)))
+
+(reg-event-db ::drag-basis-end
+ (fn [db [_ canvas-id]]
+ (let [render-items (get-in db [::canvas canvas-id :render-items])
+ new-render-items-basis (render-items-basis render-items)]
+ (-> db
+ (update-in [::canvas canvas-id] dissoc :drag-basis-data)
+ (assoc-in [::canvas canvas-id :render-items-basis] new-render-items-basis)))))
+
+(reg-event-db
+ ::drag-basis-move
+ (fn [db [_ canvas-id client-x client-y]]
+ (let [drag-data (get-in db [::canvas canvas-id :drag-basis-data])]
+ (if drag-data
+ (let [{:keys [client-x client-y]} drag-data
+ canvas-element (.getElementById js/document (name canvas-id))
+ canvas-rect (.getBoundingClientRect canvas-element)
+ ;; Calculate mouse position relative to canvas
+ canvas-mouse-x (- client-x (.-left canvas-rect))
+ canvas-mouse-y (- client-y (.-top canvas-rect))
+ prev-canvas-mouse-x (- (:client-x drag-data) (.-left canvas-rect))
+ prev-canvas-mouse-y (- (:client-y drag-data) (.-top canvas-rect))
+ ;; Calculate the delta movement
+ dx (- canvas-mouse-x prev-canvas-mouse-x)
+ dy (- canvas-mouse-y prev-canvas-mouse-y)
+ basis-translation (get-in db [::canvas canvas-id :basis-translation])
+ {:keys [sd-x sd-y]} basis-translation
+ ;; Convert canvas delta to render-items delta
+ render-dx (/ dx sd-x)
+ render-dy (/ dy sd-y)]
+ (-> db
+ ;; Update drag data with new client position
+ (assoc-in [::canvas canvas-id :drag-basis-data :client-x] client-x)
+ (assoc-in [::canvas canvas-id :drag-basis-data :client-y] client-y)
+ ;; Move all render items by the delta
+ (update-in [::canvas canvas-id :render-items]
+ update-vals
+ (fn [render-item]
+ (let [current-x (get-in render-item [:render-items-basis :x] 0)
+ current-y (get-in render-item [:render-items-basis :y] 0)
+ new-x (+ current-x render-dx)
+ new-y (+ current-y render-dy)
+ updated-render-item (-> render-item
+ (assoc-in [:render-items-basis :x] new-x)
+ (assoc-in [:render-items-basis :y] new-y))]
+ ;; Recalculate canvas position
+ (calculate-canvas-basis updated-render-item basis-translation))))))
+ db))))
+
+(reg-sub ::drag-render-element-data
+ (fn [db [_ canvas-id]] (get-in db [::canvas canvas-id :drag-render-element-data])))
+
+(reg-sub ::drag-basis-data
+ (fn [db [_ canvas-id]] (get-in db [::canvas canvas-id :drag-basis-data])))
+
+(reg-sub ::drag-mode? (fn [db [_ canvas-id]] (= :dragging (get-in db [::canvas canvas-id :mode]))))
+
+(reg-event-db ::toggle-drag-mode
+ (fn [db [_ canvas-id]]
+ (if (= :dragging (get-in db [::canvas canvas-id :mode]))
+ (update-in db [::canvas canvas-id] dissoc :mode)
+ (assoc-in db [::canvas canvas-id :mode] :dragging))))
+
+(defn- on-drag-basis-mouse-down
+ [canvas-id]
+ (fn [e]
+ (let [p (.getElementById js/document (name canvas-id))
+ target (.-target e)
+ rect (.getBoundingClientRect target)
+ client-x (.-clientX e)
+ client-y (.-clientY e)
+ pos-in-x (- client-x (.-x rect))
+ pos-in-y (- client-y (.-y rect))
+ m {:parent p
+ :pos-in-x pos-in-x
+ :pos-in-y pos-in-y
+ :client-x client-x
+ :client-y client-y}]
+ (dispatch [::drag-basis-start canvas-id m]))))
+
+;; Auto-fit functionality
+(reg-event-db ::auto-fit
+ (fn [db [_ canvas-id]]
+ (let [render-items (get-in db [::canvas canvas-id :render-items])
+ new-render-items-basis (render-items-basis render-items)
+ canvas-basis (get-in db [::canvas canvas-id :canvas-basis])
+ new-canvas-basis (assoc canvas-basis :origin-x 0 :origin-y 0)
+ new-basis-translation (render-items-to-canvas new-render-items-basis
+ new-canvas-basis)]
+ (-> db
+ (assoc-in [::canvas canvas-id :render-items-basis] new-render-items-basis)
+ (assoc-in [::canvas canvas-id :canvas-basis] new-canvas-basis)
+ (assoc-in [::canvas canvas-id :basis-translation] new-basis-translation)
+ (update-in [::canvas canvas-id :render-items]
+ update-vals
+ #(calculate-canvas-basis % new-basis-translation))))))
+
+;; ********************************************************************************
+;; Render items
+
+(reg-sub ::render-item-ids
+ (fn [db [_ canvas-id]] (keys (get-in db [::canvas canvas-id :render-items]))))
+
+(reg-sub ::render-item
+ (fn [db [_ canvas-id render-item-id]]
+ (get-in db [::canvas canvas-id :render-items render-item-id])))
+
+(defn- render-item-bounds
+ [render-item]
+ (let [{:keys [x y width height]
+ :or {x 0
+ y 0}}
+ (:render-items-basis render-item)]
+ {:min-x x
+ :max-x (+ x width)
+ :min-y y
+ :max-y (+ y height)}))
+
+(defn- render-items-basis
+ "Calculate the bounds of `render-items`, considering each of it as a box starting at `x` and `y`, with `width` and `height` size."
+ [render-items]
+ (let [render-items (map render-item-bounds (vals render-items))
+ min-x (reduce min (map :min-x render-items))
+ max-x (reduce max (map :max-x render-items))
+ min-y (reduce min (map :min-y render-items))
+ max-y (reduce max (map :max-y render-items))]
+ {:min-x min-x
+ :max-x max-x
+ :width (- max-x min-x)
+ :height (- max-y min-y)
+ :min-y min-y
+ :max-y max-y}))
+
+;; ********************************************************************************
+;; Control bar
+
+(defn bn-autofit
+ [canvas-id]
+ [:button.w3-button {:on-click #(dispatch [::auto-fit canvas-id])}
+ [:i.fa.fa-expand]])
+
+(defn bn-drag-move
+ [canvas-id]
+ (let [pressed-opts {:box-shadow "0.3em 0.4em #888888"
+ :border-width "0.1em"}
+ drag-mode? (subscribe [::drag-mode? canvas-id])]
+ [:button.w3-button {:on-click #(do (dispatch [::toggle-drag-mode canvas-id])
+ (dispatch [::drag-render-element-end canvas-id]))
+ :class (when @drag-mode? "w3-border")
+ :style (when @drag-mode? pressed-opts)}
+ [:i.fa.fa-arrows]]))
+
+;; ********************************************************************************
+;; Layout
+
+(defn- icon
+ [opts render-item]
+ (let [{:keys [img canvas-basis item-selected?]} render-item
+ {:keys [x y width height]} canvas-basis]
+ [:img.w3-hover-shadow
+ (-> opts
+ (assoc :draggable false :src img)
+ (update
+ :style
+ #(cond->
+ (assoc % :height height :width width :border (when item-selected? "0.2em solid black"))
+ (or x y) (assoc :position "absolute" :top y :left x))))]))
+
+(defn- on-drag-render-element-mouse-down
+ [canvas-id drag-mode? render-id e]
+ (when drag-mode?
+ (let [p (.getElementById js/document (name canvas-id))
+ target (.-target e)
+ rect (.getBoundingClientRect target)
+ client-x (.-clientX e)
+ client-y (.-clientY e)
+ pos-in-x (- client-x (.-x rect))
+ pos-in-y (- client-y (.-y rect))]
+ (dispatch [::drag-render-element-start
+ canvas-id
+ {:render-id render-id
+ :parent p
+ :pos-in-x pos-in-x
+ :client-x client-x
+ :client-y client-y
+ :pos-in-y pos-in-y}]))))
+
+;; Mouse move handler for the canvas
+(defn- on-mouse-move
+ [canvas-id e]
+ (let [client-x (.-clientX e)
+ client-y (.-clientY e)]
+ (dispatch [::drag-render-element-move canvas-id client-x client-y])
+ (dispatch [::drag-basis-move canvas-id client-x client-y])))
+
+(defn layout*
+ [opts canvas-id pars]
+ (let [{:keys [multi-select-mode?]} pars]
+ (r/create-class
+ {:display-name "Simulation layout"
+ :reagent-render
+ (fn [_ _ _]
+ (let [drag-mode? (subscribe [::drag-mode? canvas-id])
+ drag-render-element-data @(subscribe [::drag-render-element-data canvas-id])
+ drag-basis-data @(subscribe [::drag-basis-data canvas-id])
+ render-item-ids (subscribe [::render-item-ids canvas-id])
+ basis-translation (subscribe [::basis-translation canvas-id])
+ canvas-basis (subscribe [::canvas-basis canvas-id])]
+ [:div
+ (-> opts
+ (assoc
+ :id canvas-id
+ :on-click (fn [_] (dispatch [::clear-selection canvas-id]))
+ :on-mouse-down (when @drag-mode? (on-drag-basis-mouse-down canvas-id))
+ :on-mouse-move #(on-mouse-move canvas-id %)
+ :on-mouse-leave #(do (when drag-render-element-data
+ (dispatch [::drag-render-element-end canvas-id]))
+ (when drag-basis-data (dispatch [::drag-basis-end canvas-id])))
+ :on-mouse-up #(do (when drag-render-element-data
+ (dispatch [::drag-render-element-end canvas-id]))
+ (when drag-basis-data (dispatch [::drag-basis-end canvas-id]))))
+ (update :style assoc
+ :position "relative"
+ :overflow "hidden"
+ :cursor (cond
+ (and @drag-mode? drag-basis-data) "move"
+ (and @drag-mode? drag-render-element-data) "grabbing"
+ @drag-mode? "grab"
+ :else "default")))
+ ;; Center marker
+ [:div.w3-border {:style {:left (/ (:width @canvas-basis) 2)
+ :top (/ (:height @canvas-basis) 2)
+ :position "absolute"
+ :width "20px"
+ :height "30px"
+ :pointer-events "none"}}]
+ ;; Render items
+ [:div
+ (->> @render-item-ids
+ (mapcat (fn [render-item-id]
+ (let [render-item (subscribe [::render-item canvas-id render-item-id])]
+ [^{:key render-item-id}
+ [icon {:on-click #(do (.stopPropagation %)
+ (dispatch [::select-render-element
+ canvas-id
+ render-item-id
+ multi-select-mode?]))
+ :on-mouse-down #(do (.stopPropagation %)
+ (on-drag-render-element-mouse-down
+ canvas-id
+ @drag-mode?
+ render-item-id
+ %))}
+ @render-item]]))))]]))
+ :component-did-mount (fn [_]
+ ;;NOTE We must wait the component is mounted to catch its dimensions
+ (let [el (.getElementById js/document (name canvas-id))
+ rect (.getBoundingClientRect el)
+ width (.-width rect)
+ height (.-height rect)]
+ (dispatch [::canvas-resized canvas-id width height])))})))
+
+;; ********************************************************************************
+;; Public api
+
+(reg-event-db ::set-render-items
+ (fn [db [_ canvas-id render-items]]
+ (let [render-items-basis (render-items-basis render-items)
+ canvas-basis (get-in db [::canvas canvas-id :canvas-basis])
+ basis-translation (render-items-to-canvas render-items-basis canvas-basis)]
+ (update-in db
+ [::canvas canvas-id]
+ (fn [canvas]
+ (assoc canvas
+ :render-items
+ (if basis-translation
+ (update-vals render-items
+ #(calculate-canvas-basis % basis-translation))
+ render-items)
+ :render-items-basis render-items-basis
+ :basis-translation basis-translation))))))
+
+(defn layout
+ [opts canvas-id pars]
+ (if (map? opts) (layout* opts canvas-id pars) (layout* {} opts canvas-id)))
diff --git a/src/cljs/auto_sim/canvas2.cljs b/src/cljs/auto_sim/canvas2.cljs
new file mode 100644
index 0000000..69b0838
--- /dev/null
+++ b/src/cljs/auto_sim/canvas2.cljs
@@ -0,0 +1,428 @@
+(ns auto-sim.canvas2
+ "Canvas present render-items:
+
+ - it can be graphically positionned
+ - save the state in the local storage
+ - it represents graphically the simulation state"
+ (:require
+ [auto-sim :as-alias sim]
+ [auto-web.local-storage :as-alias ls
+ :refer [get-ls set-ls!]]
+ [re-frame.core :refer [dispatch
+ inject-cofx
+ reg-cofx
+ reg-event-db
+ reg-event-fx
+ reg-fx
+ reg-sub
+ subscribe]]
+ [reagent.core :as r]))
+
+; ********************************************************************************
+;; Local storage saving
+
+(reg-cofx :local-storage (fn [cofx] (assoc cofx :canvas-from-ls (get-ls ::canvas))))
+
+(reg-event-fx ::load-from-ls
+ [(inject-cofx :local-storage)]
+ (fn [cofx _]
+ {:db (:db cofx)
+ :fx [[:dispatch [::set-canvas (:canvas-from-ls cofx)]]]}))
+
+(reg-fx :set-ls! (fn [value] (set-ls! ::canvas value)))
+
+(reg-event-fx ::save-to-ls
+ (fn [cofx _]
+ (let [db (:db cofx)
+ canvas (get-in db [::canvas])]
+ {:fx [[:set-ls! canvas]]
+ :db db})))
+
+;; ********************************************************************************
+;; Render-element selection
+
+(reg-event-db
+ ::select-render-element
+ (fn [db [_ canvas-id render-id multi-select-key? multi-select-mode?]]
+ (let [multi-select? (and multi-select-mode? multi-select-key?)]
+ (cond-> db
+ (not multi-select?)
+ (update-in [::canvas canvas-id :render-items] update-vals #(dissoc % :item-selected?))
+ :else (update-in [::canvas canvas-id :render-items render-id :item-selected?] not)))))
+
+
+(defn- one-selected?
+ "Returns true if at least one element is selected."
+ [render-items]
+ (->> render-items
+ vals
+ (filter :item-selected?)
+ seq))
+
+(reg-event-db ::clear-selection
+ (fn [db [_ canvas-id]]
+ (update-in db
+ [::canvas canvas-id :render-items]
+ update-vals
+ (fn [x] (assoc x :item-selected? false)))))
+
+;; ********************************************************************************
+;; Render-items
+
+(reg-sub ::render-items (fn [db [_ canvas-id]] (get-in db [::canvas canvas-id :render-items])))
+
+(defn- calculate-target-basis
+ "Transform `render-item` from `source` to `destination` basis."
+ [translation render-item]
+ (let [{:keys [src-basis]} render-item
+ {:keys [origin-x origin-y sd-x sd-y]} translation
+ {:keys [width height x y]} src-basis]
+ (assoc render-item
+ :target-basis
+ {:width (js/Math.round (* sd-x width))
+ :height (js/Math.round (* sd-y height))
+ :x (js/Math.round (+ origin-x (* sd-x x)))
+ :y (js/Math.round (+ origin-y (* sd-y y)))})))
+
+(reg-event-db ::render-item-move
+ (fn [db [_ canvas-id render-id x y]]
+ (let [translation (get-in db [::canvas canvas-id :basis :translation])]
+ (-> db
+ (update-in [::canvas canvas-id :render-items render-id]
+ (fn [render-item]
+ (let [render-item*
+ (update render-item :src-basis assoc :x x :y y)]
+ (calculate-target-basis translation render-item*))))))))
+
+;; ********************************************************************************
+;; Basis translation
+
+(defn- calculate-translation
+ "A translation from `source` to `target` is calculated"
+ [db canvas-id]
+ (let [basis (get-in db [::canvas canvas-id :basis])
+ {source-width :width
+ source-height :height}
+ (:src basis)
+ {origin-x-target :origin-x
+ origin-y-target :origin-y
+ target-width :width
+ target-height :height}
+ (:target basis)
+ sd-x (/ target-width source-width)
+ sd-y (/ target-height source-height)]
+ (when (some? target-height)
+ {:origin-x origin-x-target
+ :origin-y origin-y-target
+ :sd-x sd-x
+ :sd-y sd-y})))
+
+(reg-sub ::basis-translation
+ (fn [db [_ canvas-id]] (get-in db [::canvas canvas-id :basis :translation])))
+
+;; ********************************************************************************
+;; Dragging mode
+
+(reg-sub ::drag-mode? (fn [db [_ canvas-id]] (= :dragging (get-in db [::canvas canvas-id :mode]))))
+
+(reg-event-db ::toggle-drag-mode
+ (fn [db [_ canvas-id]]
+ (if (= :dragging (get-in db [::canvas canvas-id :mode]))
+ (update-in db [::canvas canvas-id] dissoc :mode)
+ (assoc-in db [::canvas canvas-id :mode] :dragging))))
+
+;; ********************************************************************************
+;; Target basis
+
+(defn- on-target-basis-change
+ "To be called when the target basis has changed"
+ [db canvas-id]
+ (let [translation (calculate-translation db canvas-id)]
+ (update-in db
+ [::canvas canvas-id]
+ (fn [canva]
+ (cond-> canva
+ true (assoc-in [:basis :translation] translation)
+ (:render-items canva) (update :render-items
+ update-vals
+ (partial calculate-target-basis translation)))))))
+
+(reg-event-db ::size-target-basis
+ (fn [db [_ canvas-id target-basis]]
+ (-> (update-in db
+ [::canvas canvas-id :basis :target]
+ assoc
+ :origin-x 0
+ :origin-y 0
+ :width (:width target-basis)
+ :height (:height target-basis))
+ (on-target-basis-change canvas-id))))
+
+(reg-event-db ::move-target-basis
+ (fn [db [_ canvas-id x y]]
+ (-> (update-in db [::canvas canvas-id :basis :target] assoc :origin-x x :origin-y y)
+ (on-target-basis-change canvas-id))))
+
+(reg-event-db ::auto-fit
+ (fn [db [_ canvas-id]]
+ (-> db
+ (update-in [::canvas canvas-id :basis :target] assoc :origin-x 0 :origin-y 0)
+ (on-target-basis-change canvas-id))))
+
+(defn- init-size-target-basis
+ [canvas-id]
+ (when-let [el (.getElementById js/document (name canvas-id))]
+ (let [rect (.getBoundingClientRect el)
+ width (.-width rect)
+ height (.-height rect)]
+ (dispatch [::size-target-basis
+ canvas-id
+ {:width width
+ :height height}]))))
+
+;;;; ********************************************************************************
+;; Drag render element
+
+(reg-sub ::drag-render-element-data
+ (fn [db [_ canvas-id]] (get-in db [::canvas canvas-id :drag-render-element-data])))
+
+(reg-event-db
+ ::drag-render-element-start
+ (fn [db [_ canvas-id drag-render-element-start]]
+ (assoc-in db [::canvas canvas-id :drag-render-element-data] drag-render-element-start)))
+
+(reg-event-db ::drag-render-element-end
+ (fn [db [_ canvas-id]]
+ (update-in db [::canvas canvas-id] dissoc :drag-render-element-data)))
+
+(defn- on-drag-render-element-mouse-move
+ [canvas-id drag-render-element-data translation]
+ (let [{:keys [sd-x sd-y origin-x origin-y]} translation
+ {:keys [parent render-id pos-in-x pos-in-y]} drag-render-element-data
+ rect (.getBoundingClientRect parent)]
+ (fn [e]
+ (dispatch [::render-item-move
+ canvas-id
+ render-id
+ (/ (- (.-clientX e) (.-x rect) pos-in-x origin-x) sd-x)
+ (/ (- (.-clientY e) (.-y rect) pos-in-y origin-y) sd-y)]))))
+
+(defn- on-drag-render-element-mouse-down
+ [canvas-id drag-mode? render-id e]
+ (when drag-mode?
+ (let [p (.getElementById js/document (name canvas-id))
+ target (.-target e)
+ rect (.getBoundingClientRect target)
+ client-x (.-clientX e)
+ client-y (.-clientY e)
+ pos-in-x (- client-x (.-x rect))
+ pos-in-y (- client-y (.-y rect))]
+ (dispatch [::drag-render-element-start
+ canvas-id
+ {:render-id render-id
+ :parent p
+ :pos-in-x pos-in-x
+ :client-x client-x
+ :client-y client-y
+ :pos-in-y pos-in-y}]))))
+
+;; ********************************************************************************
+;; Drag basis
+
+(reg-sub ::drag-basis-data
+ (fn [db [_ canvas-id]] (get-in db [::canvas canvas-id :drag-basis-data])))
+
+(reg-event-db ::drag-basis-start
+ (fn [db [_ canvas-id m]]
+ (-> db
+ (assoc-in [::canvas canvas-id :drag-basis-data] m))))
+
+(reg-event-db ::drag-basis-end
+ (fn [db [_ canvas-id]]
+ (-> db
+ (update-in [::canvas canvas-id] dissoc :drag-basis-data))))
+
+(defn- on-drag-basis-mouse-move
+ [canvas-id drag-basis-data]
+ (fn [e]
+ (let [{:keys [parent pos-in-x pos-in-y]} drag-basis-data
+ rect (.getBoundingClientRect parent)]
+ (dispatch [::move-target-basis
+ canvas-id
+ (- (.-clientX e) (.-x rect) pos-in-x)
+ (- (.-clientY e) (.-y rect) pos-in-y)]))))
+
+(defn- on-drag-basis-mouse-down
+ [canvas-id]
+ (fn [e]
+ (let [p (.getElementById js/document (name canvas-id))
+ target (.-target e)
+ rect (.getBoundingClientRect target)
+ client-x (.-clientX e)
+ client-y (.-clientY e)
+ pos-in-x (- client-x (.-x rect))
+ pos-in-y (- client-y (.-y rect))
+ m {:parent p
+ :pos-in-x pos-in-x
+ :pos-in-y pos-in-y
+ :client-x client-x
+ :client-y client-y}]
+ (dispatch [::drag-basis-start canvas-id m]))))
+
+;; ********************************************************************************
+
+(defn- icon
+ [opts render-item]
+ (let [{:keys [img target-basis item-selected?]} render-item
+ {:keys [x y width height]} target-basis]
+ [:img.w3-hover-shadow
+ (-> opts
+ (assoc :draggable false :src img)
+ (update
+ :style
+ #(cond->
+ (assoc % :height height :width width :border (when item-selected? "0.2em solid black"))
+ (or x y) (assoc :position "absolute" :top y :left x))))]))
+
+(defn- update-src-basis
+ [canva]
+ (let [render-items (:render-items canva)
+ res (reduce (fn [res render-item]
+ (let [{:keys [min-x max-x min-y max-y]} res
+ {:keys [x y width height]} (:src-basis render-item)]
+ {:min-x (min min-x x)
+ :min-y (min min-y y)
+ :max-x (max max-x (+ x width))
+ :max-y (max max-y (+ y height))}))
+ (let [{:keys [x y width height]
+ :or {x 0
+ y 0}}
+ (:src-basis (second (first render-items)))]
+ {:min-x x
+ :max-x (+ x width)
+ :min-y y
+ :max-y (+ y height)})
+ (rest (vals render-items)))
+ {:keys [min-x min-y max-x max-y]} res]
+ (update-in canva [:basis :src] assoc :width (- max-x min-x) :height (- max-y min-y))))
+
+;; ********************************************************************************
+;; Public API
+
+(defn render-elt-trajectory
+ [t t-src re-src t-dst re-dst]
+ (let [{x-src :x
+ y-src :y}
+ re-src
+ {x-dst :x
+ y-dst :y}
+ re-dst
+ index (/ (- t-dst t-src) (- t t-src))]
+ (assoc t-src :x (* index (- x-dst x-src)) :y (* index (- y-dst y-src)))))
+
+(reg-event-db ::set-canvas
+ (fn [_db [_ canvas]]
+ {::canvas (update-vals canvas
+ (fn [canva]
+ (-> canva
+ (update :render-items
+ #(update-vals
+ %
+ (fn [render-item]
+ (update render-item :render-id keyword))))
+ (update :mode keyword))))}))
+
+(reg-event-db ::set-render-items
+ (fn [db [_ canvas-id render-items]]
+ (init-size-target-basis canvas-id)
+ (-> db
+ (update ::canvas
+ assoc
+ canvas-id
+ (-> {:render-items render-items}
+ update-src-basis))
+ (on-target-basis-change canvas-id))))
+
+(defn control-bar
+ [canvas-id]
+ (let [drag-render-element-data @(subscribe [::drag-render-element-data canvas-id])
+ pressed {:box-shadow "0.3em 0.4em #888888"
+ :border-width "0.1em"}]
+ [:div.bar
+ [:button.w3-btn {:on-click #(dispatch [::save-to-ls])}
+ [:i.fa.fa-save]]
+ [:button.w3-btn {:on-click #(dispatch [::load-from-ls])}
+ [:i.fa.fa-folder-open]]
+ [:i "|"]
+ [:button.w3-btn {:on-click #(dispatch [::auto-fit canvas-id])}
+ [:i.fa.fa-expand]]
+ (let [drag-mode? @(subscribe [::drag-mode? canvas-id])]
+ [:button.w3-btn {:on-click #(do (dispatch [::toggle-drag-mode canvas-id])
+ (when drag-render-element-data
+ (dispatch [::drag-render-element-end canvas-id])))
+ :class (when drag-mode? "w3-border")
+ :style (when drag-mode? pressed)}
+ [:i.fa.fa-arrows]])]))
+
+(defn layout*
+ [opts canvas-id {:keys [multi-select-mode?]} render-items]
+ (r/create-class
+ {:display-name "Simulation layout"
+ :component-did-mount (fn [_]
+ ;;NOTE We must wait the component is mounted to catch its dimensions
+ (let [el (.getElementById js/document (name canvas-id))
+ rect (.getBoundingClientRect el)
+ width (.-width rect)
+ height (.-height rect)]
+ (dispatch [::size-target-basis
+ canvas-id
+ {:width width
+ :height height}])))
+ :reagent-render
+ (fn []
+ (let [drag-render-element-data @(subscribe [::drag-render-element-data canvas-id])
+ drag-basis-data @(subscribe [::drag-basis-data canvas-id])
+ translation @(subscribe [::basis-translation canvas-id])
+ drag-mode? @(subscribe [::drag-mode? canvas-id])
+ ;;render-items (or @(subscribe [::render-items canvas-id]) render-items)
+ ]
+ [:div
+ (-> opts
+ (update :style assoc
+ :position "relative"
+ :overflow "hidden"
+ :cursor (when drag-mode? "move"))
+ (assoc
+ :on-mouse-move
+ (cond
+ drag-render-element-data
+ (on-drag-render-element-mouse-move canvas-id drag-render-element-data translation)
+ drag-basis-data (on-drag-basis-mouse-move canvas-id drag-basis-data))
+ :id canvas-id
+ :on-click (fn [_] (dispatch [::clear-selection canvas-id]))
+ :on-mouse-down (when drag-mode? (on-drag-basis-mouse-down canvas-id))
+ :on-mouse-leave #(do (when drag-render-element-data
+ (dispatch [::drag-render-element-end canvas-id]))
+ (when drag-basis-data (dispatch [::drag-basis-end canvas-id])))
+ :on-mouse-up #(do (when drag-render-element-data
+ (dispatch [::drag-render-element-end canvas-id]))
+ (when drag-basis-data (dispatch [::drag-basis-end canvas-id])))))
+ (mapcat (fn [{:keys [render-id]
+ :as render-item}]
+ [^{:key render-id}
+ [icon {:on-click #(do (.stopPropagation %)
+ (dispatch [::select-render-element
+ canvas-id
+ render-id
+ (.-metaKey %)
+ multi-select-mode?]))
+ :on-mouse-down
+ #(do
+ (.stopPropagation %)
+ (on-drag-render-element-mouse-down canvas-id drag-mode? render-id %))}
+ render-item]])
+ (vals render-items))]))}))
+
+(defn layout
+ [opts canvas-id pars render-items]
+ (if (map? opts) (layout* opts canvas-id pars render-items) (layout* {} opts canvas-id pars)))
diff --git a/src/cljs/auto_sim/charts.cljs b/src/cljs/auto_sim/charts.cljs
new file mode 100644
index 0000000..81cff90
--- /dev/null
+++ b/src/cljs/auto_sim/charts.cljs
@@ -0,0 +1,68 @@
+(ns auto-sim.charts
+ (:require
+ [reagent.core :as reagent]))
+
+(defn- canva-opts
+ [canva-id label]
+ {:class "w3-border.w3-row"
+ :id canva-id
+ :role "img"
+ :aria-label label})
+
+(defn init-barchart
+ [canva-id data]
+ (fn [_] (let [canvas (.getElementById js/document canva-id)] (js/Chart. canvas (clj->js data)))))
+
+(defn bar-chart
+ [data]
+ (let [canva-id (random-uuid)]
+ (reagent/create-class {:display-name "barchart"
+ :component-did-mount (init-barchart canva-id data)
+ :reagent-render (fn [_] [:canvas (canva-opts canva-id "Bar chart")])})))
+
+(defn init-bubblechart
+ [canva-id data]
+ (fn [_] (let [canvas (.getElementById js/document canva-id)] (js/Chart. canvas (clj->js data)))))
+
+(defn bubble-chart
+ [data]
+ (let [canva-id (random-uuid)]
+ (reagent/create-class {:display-name "barchart"
+ :component-did-mount (init-bubblechart canva-id data)
+ :reagent-render (fn [_] [:canvas
+ (canva-opts canva-id "Bubble chart")])})))
+
+(defn init-doughnut-chart
+ [canva-id data]
+ (fn [_] (let [canvas (.getElementById js/document canva-id)] (js/Chart. canvas (clj->js data)))))
+
+(defn doughnut-chart
+ [data]
+ (let [canva-id (random-uuid)]
+ (reagent/create-class {:display-name "doughnut"
+ :component-did-mount (init-doughnut-chart canva-id data)
+ :reagent-render (fn [_] [:canvas
+ (canva-opts canva-id "Doughtnut chart")])})))
+
+(defn init-line-chart
+ [canva-id data]
+ (fn [_] (let [canvas (.getElementById js/document canva-id)] (js/Chart. canvas (clj->js data)))))
+
+(defn line-chart
+ [data]
+ (let [canva-id (random-uuid)]
+ (reagent/create-class {:display-name "linechart"
+ :component-did-mount (init-line-chart canva-id data)
+ :reagent-render (fn [_] [:canvas (canva-opts canva-id "Line chart")])})))
+
+(defn init-polar-chart
+ [canva-id data]
+ (fn [_] (let [canvas (.getElementById js/document canva-id)] (js/Chart. canvas (clj->js data)))))
+
+(defn polar-chart
+ [data]
+ (let [canva-id (random-uuid)]
+ (reagent/create-class {:display-name "polarchart"
+ :component-did-mount (init-polar-chart canva-id data)
+ :reagent-render (fn [_] [:canvas
+ (canva-opts canva-id "Polar chart")])})))
diff --git a/src/cljs/auto_sim/control_bar.cljs b/src/cljs/auto_sim/control_bar.cljs
new file mode 100644
index 0000000..1d97392
--- /dev/null
+++ b/src/cljs/auto_sim/control_bar.cljs
@@ -0,0 +1,110 @@
+(ns auto-sim.control-bar
+ "Components to manage a simulation"
+ (:require
+ [auto-sim :as-alias sim]
+ [auto-web.page.builder :refer [merge-opts]]
+ [re-frame.core :refer [dispatch reg-event-fx reg-sub subscribe]]))
+
+(def dic
+ {:fast-backward {:fr "Retour rapide"
+ :en "Fast backward"}
+ :backward {:fr "Retour"
+ :en "Backward"}
+ :play {:fr "Lecture"
+ :en "Play"}
+ :stop {:fr "Stop"
+ :en "Stop"}
+ :pause {:fr "Pause"
+ :en "Pause"}
+ :forward {:fr "Avance"
+ :en "Forward"}
+ :fast-forward {:fr "Avance rapide"
+ :en "Fast forward"}})
+
+(reg-sub ::sim/control-iteration (fn [db _] (get-in db [::sim/control-bar :iteration])))
+
+(reg-event-fx ::sim/stop-iteration
+ (fn [{:keys [db]} _] {:db (assoc-in db [::sim/control-bar :iteration] 0)}))
+
+(reg-event-fx ::sim/next-iteration
+ (fn [{:keys [db]} [_ m]]
+ (let [it (get-in db [::sim/control-bar :iteration])]
+ {:db (cond-> db
+ (or (nil? m) (< it (dec m))) (assoc-in [::sim/control-bar :iteration]
+ (inc it)))})))
+
+(reg-event-fx ::sim/previous-iteration
+ (fn [{:keys [db]} _] {:db (update-in db [::sim/control-bar :iteration] dec)}))
+
+(reg-event-fx ::sim/set-iteration
+ (fn [{:keys [db]} [_ it]] {:db (assoc-in db [::sim/control-bar :iteration] it)}))
+
+(defn- simulation-control-button
+ [opts fa-icon tooltip on-click]
+ [:div.w3-tooltip.w3-cell {:style {:overflow "visible"}}
+ [:button.w3-button.fa
+ (merge-opts {:style {:overflow "visible"}
+ :on-click on-click
+ :class fa-icon}
+ opts)]
+ [:div.w3-text.w3-tag.w3-padding {:style {:position "absolute"
+ :left "0px"
+ :bottom "-2em"}}
+ tooltip]])
+
+(defn simulation-control-bar
+ [opts l max-iteration]
+ (let [opts* (if (nil? max-iteration) {} opts)
+ l* (if (nil? max-iteration) opts l)
+ max-iteration* (if (nil? max-iteration) l max-iteration)
+ tr #(get-in dic [% l*])
+ disabled {:style {:cursor "default"}
+ :disabled true}
+ iteration (or @(subscribe [::sim/control-iteration]) 0)]
+ (when (< iteration 0) (dispatch [::sim/set-iteration 0]))
+ (when (>= iteration max-iteration) (dispatch [::sim/set-iteration (dec max-iteration)]))
+ [:div
+ (merge-opts {:style {:align-items "center"
+ :overflow "visible"}}
+ opts*)
+ [simulation-control-button
+ (when (= iteration 0) disabled)
+ "fa-fast-backward"
+ (tr :fast-backward)]
+ [simulation-control-button
+ (when (= iteration 0) disabled)
+ "fa-backward"
+ (tr :backward)
+ #(dispatch [::sim/previous-iteration])]
+ [simulation-control-button
+ (when (= iteration (dec max-iteration*)) disabled)
+ "fa-play"
+ (tr :play)
+ #(dispatch [::sim/next-iteration max-iteration])]
+ [simulation-control-button {}
+ "fa-pause"
+ (tr :pause)]
+ [simulation-control-button
+ (when (= iteration 0) disabled)
+ "fa-stop"
+ (tr :stop)
+ #(dispatch [::sim/stop-iteration])]
+ [simulation-control-button
+ (when (= iteration (dec max-iteration*)) disabled)
+ "fa-forward"
+ (tr :forward)
+ #(dispatch [::sim/next-iteration max-iteration])]
+ [simulation-control-button
+ (when (= iteration (dec max-iteration*)) disabled)
+ "fa-fast-forward"
+ (tr :fast-forward)]]))
+
+(defn iteration-input
+ [opts]
+ (let [control-iteration @(subscribe [::sim/control-iteration])]
+ [:input.w3-input.w3-border.w3-hover-grey.s3.w3-col
+ (assoc opts
+ :type "number"
+ :min "0"
+ :on-change #(dispatch [::sim/set-iteration (js/parseInt (.. % -target -value))])
+ :value control-iteration)]))
diff --git a/src/cljs/auto_sim/modal.cljs b/src/cljs/auto_sim/modal.cljs
new file mode 100644
index 0000000..e8d3655
--- /dev/null
+++ b/src/cljs/auto_sim/modal.cljs
@@ -0,0 +1,44 @@
+(ns auto-sim.modal
+ "Modal window to show"
+ (:require
+ [auto-sim :as-alias sim]
+ [auto-sim.control-bar :refer [iteration-input]]
+ [clojure.string :as str]
+ [re-frame.core :refer [dispatch reg-event-db reg-sub subscribe]]))
+
+(reg-sub ::sim/modal-close? (fn [db _] (get-in db [::sim/modal :close])))
+
+(reg-event-db ::sim/toggle-close-modal (fn [db _] (update-in db [::sim/modal :close] not)))
+
+(reg-sub ::sim/selected-id (fn [db _] (get-in db [::sim/modal :selected-id])))
+
+(reg-event-db ::sim/select (fn [db [_ id]] (assoc-in db [::sim/modal :selected-id] id)))
+
+(reg-event-db ::sim/unselect (fn [db _] (update db ::sim/modal dissoc :selected-id)))
+
+(defn opening-element
+ [opts]
+ [:div.w3-center (assoc opts :on-click #(dispatch [::sim/toggle-close-modal])) [:i.fa.fa-angleup]])
+
+(defn simulation-control-panel
+ [opts]
+ (let [modal-close? @(subscribe [::sim/modal-close?])]
+ [:div.w3-display-content.w3-small
+ opts
+ [:div.w3-center {:style {:border "0.3em"
+ :background-color "#eee"
+ :border-radius "1em"
+ :cursor (if modal-close? "n-resize" "s-resize")}
+ :on-click #(dispatch [::sim/toggle-close-modal])}
+ [:i.fa.fa-circle.w3-tiny]]
+ [:div.w3-row.w3-panel {:style {:display (if modal-close? "none" "block")}}
+ [:p.s1.w3-col "Iteration"]
+ [iteration-input]]
+ (when-let [{:keys [id input output]} @(subscribe [::sim/selected-id])]
+ [:div.w3-row.w3-panel {:style {:display (if modal-close? "none" "block")}}
+ [:p.s1.w3-col "Id"]
+ [:p.s3.w3-col id]
+ [:p.s1.w3-col "Input"]
+ [:p.s3.w3-col (str/join ", " input)]
+ [:p.s1.w3-col "Output"]
+ [:p.s3.w3-col (str/join ", " output)]])]))
diff --git a/stylelint.config.js b/stylelint.config.js
new file mode 100644
index 0000000..7ec6fbe
--- /dev/null
+++ b/stylelint.config.js
@@ -0,0 +1,6 @@
+/** @type {import('stylelint').Config} */
+export default {
+ rules: {
+ "block-no-empty": true
+ }
+};
diff --git a/test/cljc/automaton_simulation_de/control/computation/impl/chunk_test.cljc b/test/cljc/automaton_simulation_de/control/computation/impl/chunk_test.cljc
deleted file mode 100644
index a5349ec..0000000
--- a/test/cljc/automaton_simulation_de/control/computation/impl/chunk_test.cljc
+++ /dev/null
@@ -1,151 +0,0 @@
-(ns auto-sim.control.computation.impl.chunk-test
- (:require
- [auto-sim.control :as sim-de-control]
- [auto-sim.control.computation :as sim-de-computation]
- [auto-sim.control.computation.impl.chunk :as sut]
- [auto-sim.demo.control :as sim-demo-control]
- [auto-sim.simulation-engine :as-alias sim-engine]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])))
-
-(defn- it-nb
- [resp]
- (get-in resp [::sim-de-control/response ::sim-engine/snapshot ::sim-engine/iteration]))
-
-(defn- state-stp-context
- [resp]
- (-> resp
- (get-in [::sim-de-control/response ::sim-engine/snapshot ::sim-engine/state :m1 :process])))
-
-(defn- model-regular [] (sim-demo-control/model))
-
-(defn- model-early-stop [] (sim-demo-control/model-early-end))
-
-(defn- model-infinite [] (sim-demo-control/model-infinite))
-
-(defn- create-chunk-computation
- [model & args]
- (apply sim-de-control/make-computation model :chunk args))
-
-(def regular-model (create-chunk-computation (model-regular) 5))
-(sim-de-computation/scheduler-response regular-model
- [[::sim-engine/iteration-nth
- #:auto-sim.simulation-engine{:n 10}]])
-
-(deftest scheduler-response-test
- (let [regular-model (create-chunk-computation (model-regular) 5)
- infinite-model (create-chunk-computation (model-infinite) 10)
- model-with-end (create-chunk-computation (model-early-stop) 5)]
- (testing "Regular use-cases"
- (let [chunk-state (sut/create-storage (model-regular))
- chunk-comp (sut/->ChunkComputation chunk-state 10)]
- (sim-de-computation/scheduler-response chunk-comp
- [[::sim-engine/iteration-nth
- #:auto-sim.simulation-engine{:n 2}]]
- 0)
- (is (= 10 (first (last (:iterations @chunk-state))))))
- (let [resp (sim-de-computation/scheduler-response
- regular-model
- [[:auto-sim.simulation-engine/iteration-nth
- #:auto-sim.simulation-engine{:n 10}]]
- 0)]
- (is (= 10
- (-> resp
- it-nb)))
- (is (= :success (::sim-de-control/status resp))))
- (let [resp (sim-de-computation/scheduler-response
- infinite-model
- [[:auto-sim.simulation-engine/iteration-nth
- #:auto-sim.simulation-engine{:n 10}]]
- 0)]
- (is (= 10
- (-> resp
- it-nb)))
- (is (= :success (::sim-de-control/status resp))))
- (let [resp (sim-de-computation/scheduler-response
- model-with-end
- [[:auto-sim.simulation-engine/iteration-nth
- #:auto-sim.simulation-engine{:n 15}]]
- 0)]
- (is (= 15
- (-> resp
- it-nb)))
- (is (= :success (::sim-de-control/status resp))))
- (let [resp (sim-de-computation/scheduler-response
- regular-model
- [[:auto-sim.simulation-engine/iteration-nth
- #:auto-sim.simulation-engine{:n 50}]]
- 0)]
- (is (= 31
- (-> resp
- it-nb)))
- (is (= :no-next
- (-> resp
- ::sim-de-control/status))))
- (let [resp (sim-de-computation/scheduler-response
- model-with-end
- [[:auto-sim.simulation-engine/iteration-nth
- #:auto-sim.simulation-engine{:n 50}]]
- 0)]
- (is (= 20
- (-> resp
- it-nb)))
- (is (= :no-next
- (-> resp
- ::sim-de-control/status))))
- (let [resp (sim-de-computation/scheduler-response infinite-model [] 0)]
- (is (= 10010
- (-> resp
- it-nb)))
- (is (= :timeout
- (-> resp
- ::sim-de-control/status))))
- (let [resp (sim-de-computation/scheduler-response regular-model [] 0)]
- (is (= 31
- (-> resp
- it-nb)))
- (is (= :success
- (-> resp
- ::sim-de-control/status))))
- (let [resp (sim-de-computation/scheduler-response regular-model
- [[:state-contains {:state [:m1 :process]}]]
- 0)]
- (is (= 5
- (-> resp
- it-nb)))
- (is (= :success
- (-> resp
- ::sim-de-control/status)))
- (is (= 5
- (-> (sim-de-computation/scheduler-response regular-model
- [[:state-contains {:state [:m1
- :process]}]]
- 5)
- it-nb))))
- (testing "Manipulating iteration param is returning proper response"
- (let [mdw [[:state-contains {:state [:m1 :process]}]]]
- (is (= :p1
- (-> (sim-de-computation/scheduler-response regular-model mdw 0)
- state-stp-context))
- "Going from 0 should find specified stopping-criteria")
- (is (= :p1
- (-> (sim-de-computation/scheduler-response regular-model mdw nil)
- state-stp-context))
- "Nil is acceptable value for iteration number")
- (is (= :p2
- (-> (sim-de-computation/scheduler-response regular-model mdw 6)
- state-stp-context))
- "Specifing further iteration should yield different result")
- (is (= :p3
- (-> (sim-de-computation/scheduler-response regular-model mdw 7)
- state-stp-context))
- "Specifing further iteration should yield different result")
- (is (= :p1
- (-> (sim-de-computation/scheduler-response infinite-model mdw 15)
- state-stp-context))
- "Specifing further iteration should yield different result")
- (is
- (let [resp (sim-de-computation/scheduler-response regular-model mdw 20)]
- (and (= 31 (it-nb resp)) (= :no-next (::sim-de-control/status resp))))
- "Going outside of scope should return last possible iteration in finite simulation and fail status"))))))
-
diff --git a/test/cljc/automaton_simulation_de/control/computation_test.cljc b/test/cljc/automaton_simulation_de/control/computation_test.cljc
deleted file mode 100644
index 1e5466b..0000000
--- a/test/cljc/automaton_simulation_de/control/computation_test.cljc
+++ /dev/null
@@ -1,149 +0,0 @@
-(ns auto-sim.control.computation-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.control :as sim-de-control]
- [auto-sim.control.computation :as sut]
- [auto-sim.control.computation.response :as sim-de-comp-response]
- [auto-sim.demo.control :as sim-demo-control]
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn- it-nb
- [resp]
- (get-in resp [::sim-de-control/response ::sim-engine/snapshot ::sim-engine/iteration]))
-
-(defn- state-stp-context
- [resp]
- (-> resp
- (get-in [::sim-de-control/response ::sim-engine/snapshot ::sim-engine/state :m1 :process])))
-
-(defn model-regular [] (sim-demo-control/model))
-
-(defn model-early-stop [] (sim-demo-control/model-early-end))
-
-(defn model-infinite [] (sim-demo-control/model-infinite))
-
-(defn create-direct-computation
- [model & args]
- (apply sim-de-control/make-computation model :direct args))
-
-(deftest scheduler-response-test
- (let [regular-model (create-direct-computation (model-regular))
- infinite-model (create-direct-computation (model-infinite) 1000)
- model-with-end (create-direct-computation (model-early-stop))]
- (testing "Regular use-cases"
- (let [resp (sut/scheduler-response regular-model
- [[::sim-engine/iteration-nth {::sim-engine/n 10}]]
- 0)]
- (is (nil? (core-schema/validate-data-humanize sim-de-comp-response/schema resp)))
- (is (= 10
- (-> resp
- it-nb)))
- (is (= :success (::sim-de-control/status resp))))
- (let [resp (sut/scheduler-response regular-model
- [[::sim-engine/iteration-nth {::sim-engine/n 10}]])]
- (is (nil? (core-schema/validate-data-humanize sim-de-comp-response/schema resp)))
- (is (= 10
- (-> resp
- it-nb)))
- (is (= :success (::sim-de-control/status resp))))
- (let [resp (sut/scheduler-response infinite-model
- [[::sim-engine/iteration-nth {::sim-engine/n 10}]]
- 0)]
- (is (nil? (core-schema/validate-data-humanize sim-de-comp-response/schema resp)))
- (is (= 10
- (-> resp
- it-nb)))
- (is (= :success (::sim-de-control/status resp))))
- (let [resp (sut/scheduler-response model-with-end
- [[::sim-engine/iteration-nth {::sim-engine/n 15}]]
- 0)]
- (is (= 15
- (-> resp
- it-nb)))
- (is (= :success (::sim-de-control/status resp))))
- (let [resp (sut/scheduler-response regular-model
- [[::sim-engine/iteration-nth {::sim-engine/n 50}]]
- 0)]
- (is (= 31
- (-> resp
- it-nb)))
- (is (= :no-next
- (-> resp
- ::sim-de-control/status))))
- (let [resp (sut/scheduler-response model-with-end
- [[::sim-engine/iteration-nth {::sim-engine/n 50}]]
- 0)]
- (is (= 20
- (-> resp
- it-nb)))
- (is (= :no-next
- (-> resp
- ::sim-de-control/status))))
- (let [resp (sut/scheduler-response infinite-model [] 0)]
- (is (= 1000
- (-> resp
- it-nb)))
- (is (= :timeout
- (-> resp
- ::sim-de-control/status))))
- (let [resp (sut/scheduler-response regular-model [] 0)]
- (is (nil? (core-schema/validate-data-humanize sim-de-comp-response/schema resp)))
- (is (= 31
- (-> resp
- it-nb)))
- (is (= :success
- (-> resp
- ::sim-de-control/status))))
- (let [resp (sut/scheduler-response regular-model)]
- (is (nil? (core-schema/validate-data-humanize sim-de-comp-response/schema resp)))
- (is (= 31
- (-> resp
- it-nb)))
- (is (= :success
- (-> resp
- ::sim-de-control/status))))
- (let [resp (sut/scheduler-response regular-model
- [[:state-contains {:state [:m1 :process]}]]
- 0)]
- (is (= 5
- (-> resp
- it-nb)))
- (is (= :success
- (-> resp
- ::sim-de-control/status)))
- (is (= 5
- (-> (sut/scheduler-response regular-model
- [[:state-contains {:state [:m1 :process]}]]
- 5)
- it-nb)))))
- (testing "Manipulating iteration param is returning proper response"
- (let [mdw [[:state-contains {:state [:m1 :process]}]]]
- (is (= :p1
- (-> (sut/scheduler-response regular-model mdw 0)
- state-stp-context))
- "Going from 0 should find specified stopping-criteria")
- (is (= :p1
- (-> (sut/scheduler-response regular-model mdw nil)
- state-stp-context))
- "Nil is acceptable value for iteration number")
- (is (nil? (core-schema/validate-data-humanize
- sim-de-comp-response/schema
- (sut/scheduler-response regular-model mdw nil))))
- (is (= :p2
- (-> (sut/scheduler-response regular-model mdw 7)
- state-stp-context))
- "Specifing further iteration should yield different result")
- (is (= :p3
- (-> (sut/scheduler-response regular-model mdw 9)
- state-stp-context))
- "Specifing further iteration should yield different result")
- (is (= :p1
- (-> (sut/scheduler-response infinite-model mdw 15)
- state-stp-context))
- "Specifing further iteration should yield different result")
- (is
- (let [resp (sut/scheduler-response regular-model mdw 20)]
- (and (= 31 (it-nb resp)) (= :no-next (::sim-de-control/status resp))))
- "Going outside of scope should return last possible iteration in finite simulation and fail status")))))
diff --git a/test/cljc/automaton_simulation_de/control_test.cljc b/test/cljc/automaton_simulation_de/control_test.cljc
deleted file mode 100644
index 93194d5..0000000
--- a/test/cljc/automaton_simulation_de/control_test.cljc
+++ /dev/null
@@ -1,185 +0,0 @@
-(ns auto-sim.control-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [auto-sim.control :as sut]
- [auto-sim.control.state :as sim-de-rendering-state]
- [auto-sim.demo.control :as sim-demo-control]
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn- state-it-nb
- [state]
- (get-in (sim-de-rendering-state/get state)
- [:current-iteration ::sim-engine/snapshot ::sim-engine/iteration]))
-
-(defn- snapshot-it-nb
- [control-response]
- (get-in control-response [::sut/response ::sim-engine/snapshot ::sim-engine/iteration]))
-
-(deftest build-rendering-state-test
- (testing "Basic cases to build state"
- (is (some? (sut/build-rendering-state {:computation (sut/make-computation {} :direct)})))
- (is (number? (:play-delay @(sut/build-rendering-state {:computation
- (sut/make-computation {} :direct)})))))
- (testing "Nil returned when initial-datat is incorrect"
- (is (nil? (sut/build-rendering-state {})))
- (is (nil? (sut/build-rendering-state nil)))
- (is (nil? (sut/build-rendering-state [])))
- (is (nil? (sut/build-rendering-state {:to-much-usless-data "whenever"
- :computation (sut/make-computation {} :direct)})))))
-
-(defn make-direct-computation [model & args] (apply sut/make-computation model :direct args))
-
-(defn make-chunk-computation [model & args] (apply sut/make-computation model :chunk args))
-
-(defn- create-state
- []
- (sut/build-rendering-state {:computation (make-direct-computation (sim-demo-control/model))}))
-
-
-
-(defn- create-endless-sim-state
- []
- (sut/build-rendering-state {:computation
- (make-direct-computation (sim-demo-control/model-infinite) 1000)}))
-
-(defn- create-early-stop-state
- []
- (sut/build-rendering-state {:computation (make-direct-computation
- (sim-demo-control/model-early-end))}))
-
-(deftest move-x!-test
- (let [state (create-state)]
- (testing "Moving 1 iteration forward"
- (sut/move-x! state 1)
- (is (= 1 (state-it-nb state)))
- (sut/move-x! state 1)
- (is (= 2 (state-it-nb state)))
- (sut/move-x! state 1)
- (sut/move-x! state 1)
- (sut/move-x! state 1)
- (sut/move-x! state 1)
- (is (= 6 (state-it-nb state)))
- (is (= (state-it-nb state) (snapshot-it-nb (sut/move-x! (create-state) 6)))))
- (testing "Moving 1 iteration backward"
- (sut/move-x! state -1)
- (is (= 5 (state-it-nb state)))
- (sut/move-x! state -1)
- (is (= 4 (state-it-nb state)))
- (sut/move-x! state -1)
- (sut/move-x! state -1)
- (sut/move-x! state -1)
- (is (= 1 (state-it-nb state)))
- (let [new-state (create-state)
- _set-state-to-6-it (sut/move-x! new-state 5)]
- (is (= (state-it-nb state) (snapshot-it-nb (sut/move-x! new-state -5))))))
- (testing "Moving multiple iterations"
- (let [new-state (create-state)
- random-move (rand-int 10)]
- (sut/move-x! new-state 5)
- (is (= 5 (state-it-nb new-state)))
- (sut/move-x! new-state 5)
- (is (= 10 (state-it-nb new-state)))
- (sut/move-x! new-state random-move)
- (is (= (+ 10 random-move) (state-it-nb new-state)))
- (sut/move-x! new-state -8)
- (is (= (- (+ 10 random-move) 8) (state-it-nb new-state)))))
- (testing "edge cases"
- (is (nil? (sut/move-x! nil 5)))
- (is (nil? (sut/move-x! (atom {}) 5)))
- (sut/rewind! state)
- (sut/move-x! state 30)
- (sut/move-x! state 1)
- (sut/move-x! state 1)
- (sut/move-x! state 1)
- (sut/move-x! state 1)
- (is (= 31 (state-it-nb state)))
- (is (= 1 (snapshot-it-nb (sut/move-x! state -50))))
- (is (= 6 (snapshot-it-nb (sut/move-x! state 5)))))))
-
-(deftest pause!-test
- (testing "Basic usage"
- (let [state (create-state)]
- (sut/pause! state)
- (is (= false (:pause? (sim-de-rendering-state/get state))))
- (sut/pause! state)
- (is (= true (:pause? (sim-de-rendering-state/get state))))
- (sut/pause! state true)
- (is (= true (:pause? (sim-de-rendering-state/get state))))
- (sut/pause! state false)
- (is (= false (:pause? (sim-de-rendering-state/get state))))
- (sut/pause! state false)
- (is (= false (:pause? (sim-de-rendering-state/get state)))))))
-
-(deftest fast-foward?-test
- (testing "Basic usage"
- (let [state (create-state)] (is (= true (sut/fast-forward? state))))
- (let [state (create-endless-sim-state)] (is (= nil (sut/fast-forward? state))))))
-
-(deftest fast-forward!-test
- (testing "If it didn't reach model-end but there is no next-possible it returns last iteration"
- (let [state (create-state)] (is (= 31 (snapshot-it-nb (sut/fast-forward! state)))))
- (testing
- "Here is a question, should it work when there is no model-end? Because in case of truly endless one we will need to secure API to not run endlessly (maybe some timeout?) and in case of simulation that has an end and no model-end, does it make sense to do it?"
- (let [state (create-endless-sim-state)]
- (is (= 1000 (snapshot-it-nb (sut/fast-forward! state))))))
- (testing "If there is a stop in simulation that's not model-end? it should continue"
- (let [state (create-early-stop-state)]
- (sut/move-x! state 10)
- (sut/rewind! state)
- (is (= 20 (snapshot-it-nb (sut/fast-forward! state))))))))
-
-(deftest rewind!-test
- (testing "Rewinds to 1 iteration from any current point"
- (let [state (create-state)]
- (is (= 1 (snapshot-it-nb (sut/rewind! state))))
- (sut/fast-forward! state)
- (is (= 1 (snapshot-it-nb (sut/rewind! state))))
- (sut/move-x! state 1)
- (is (= 1 (snapshot-it-nb (sut/rewind! state))))
- (sut/move-x! state 15)
- (is (= 1 (snapshot-it-nb (sut/rewind! state))))
- (sut/rewind! state)
- (sut/rewind! state)
- (sut/rewind! state)
- (is (= 1 (snapshot-it-nb (sut/rewind! state)))))))
-
-(deftest computation-change
- (let [state (create-state)]
- (sim-de-rendering-state/set state :computation nil)
- (sut/move-x! state 1)
- (is (= nil (state-it-nb state)))
- (sut/move-x! state 1)
- (is (= nil (state-it-nb state)))
- (sim-de-rendering-state/set state
- :computation
- (make-direct-computation (sim-demo-control/model)))
- (sut/move-x! state 1)
- (is (= 1 (state-it-nb state)))
- (sut/move-x! state 3)
- (is (= 4 (state-it-nb state)))
- (sim-de-rendering-state/set state :computation nil)
- (is (= 4 (state-it-nb state)))
- (sut/move-x! state 3)
- (is (= 4 (state-it-nb state)))
- (sim-de-rendering-state/set state
- :computation
- (make-direct-computation (sim-demo-control/model)))
- (sim-de-rendering-state/set state
- :computation
- (make-chunk-computation (sim-demo-control/model) 5))
- (is (= 4 (state-it-nb state)))
- (sut/move-x! state 1)
- (is (= 5 (state-it-nb state)))
- (sim-de-rendering-state/set state :computation nil)
- (sut/rewind! state)
- (is (= 5 (state-it-nb state)))
- (sut/fast-forward! state)
- (is (= 5 (state-it-nb state)))
- (sim-de-rendering-state/set state
- :computation
- (make-chunk-computation (sim-demo-control/model) 5))
- (sut/rewind! state)
- (is (= 1 (state-it-nb state)))
- (sut/fast-forward! state)
- (is (= 31 (state-it-nb state)))))
diff --git a/test/cljc/automaton_simulation_de/demo/entity_test.cljc b/test/cljc/automaton_simulation_de/demo/entity_test.cljc
deleted file mode 100644
index 79dbd2a..0000000
--- a/test/cljc/automaton_simulation_de/demo/entity_test.cljc
+++ /dev/null
@@ -1,25 +0,0 @@
-(ns auto-sim.demo.entity-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-optimization.prng :as opt-prng]
- [auto-sim.demo.entity :as sut]
- [auto-sim.simulation-engine :as sim-engine]))
-
-(deftest validation-test
- (is (nil? (sim-engine/validate-model (sut/model))))
- (is (nil? (sim-engine/validate-registry
- (sut/registries (opt-prng/xoroshiro128 [4965052502050351187 8171162042901641346])))))
- (is (nil? (sim-engine/validate-middleware-data [] {})))
- (is (nil? (sim-engine/validate-stopping-criteria-data [[::sim-engine/iteration-nth
- #::sim-engine{:n 30}]]
- {})))
- "entity demo pass validation")
-
-(deftest run-test
- (is (nil? (sim-engine/validate-response (sim-engine/scheduler (sut/model)))))
- (is (= 15
- (-> (sut/model)
- sim-engine/scheduler
- sim-engine/extract-snapshot
- ::sim-engine/date))))
diff --git a/test/cljc/automaton_simulation_de/demo/rc_test.cljc b/test/cljc/automaton_simulation_de/demo/rc_test.cljc
deleted file mode 100644
index 86fead2..0000000
--- a/test/cljc/automaton_simulation_de/demo/rc_test.cljc
+++ /dev/null
@@ -1,25 +0,0 @@
-(ns auto-sim.demo.rc-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [auto-sim.demo.data :as sim-demo-data]
- [auto-sim.demo.rc :as sut]
- [auto-sim.simulation-engine :as sim-engine]))
-
-(deftest validation-test
- (is (nil? (sim-engine/validate-model (sut/model))))
- (is (nil? (sim-engine/validate-registry
- (sut/registries (sim-demo-data/prng [4965052502050351187 8171162042901641346])))))
- (is (nil? (sim-engine/validate-middleware-data [[:state-rendering sut/state-rendering]] {})))
- (is (nil? (sim-engine/validate-stopping-criteria-data [[::sim-engine/iteration-nth
- #::sim-engine{:n 30}]]
- {})))
- "rc demo pass validation")
-
-(deftest run-test
- (is (nil? (sim-engine/validate-response (sim-engine/scheduler (sut/model)))))
- (is (= 17
- (-> (sut/model)
- sim-engine/scheduler
- sim-engine/extract-snapshot
- ::sim-engine/date))))
diff --git a/test/cljc/automaton_simulation_de/demo/simulation_engine_test.cljc b/test/cljc/automaton_simulation_de/demo/simulation_engine_test.cljc
deleted file mode 100644
index e991655..0000000
--- a/test/cljc/automaton_simulation_de/demo/simulation_engine_test.cljc
+++ /dev/null
@@ -1,23 +0,0 @@
-(ns auto-sim.demo.simulation-engine-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [auto-sim.demo.simulation-engine :as sut]
- [auto-sim.simulation-engine :as sim-engine]))
-
-(deftest validation-test
- (is (nil? (sim-engine/validate-model (sut/model))))
- (is (nil? (sim-engine/validate-registry (sut/registries))))
- (is (nil? (sim-engine/validate-middleware-data [[:state-rendering sut/state-rendering]] {})))
- (is (nil? (sim-engine/validate-stopping-criteria-data [[::sim-engine/iteration-nth
- #::sim-engine{:n 30}]]
- {})))
- "simulation engine demo pass validation")
-
-(deftest run-test
- (is (nil? (sim-engine/validate-response (sim-engine/scheduler (sut/model)))))
- (is (= 13
- (-> (sut/model)
- sim-engine/scheduler
- sim-engine/extract-snapshot
- ::sim-engine/date))))
diff --git a/test/cljc/automaton_simulation_de/entity_test.cljc b/test/cljc/automaton_simulation_de/entity_test.cljc
deleted file mode 100644
index 74e52f3..0000000
--- a/test/cljc/automaton_simulation_de/entity_test.cljc
+++ /dev/null
@@ -1,315 +0,0 @@
-(ns auto-sim.entity-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.entity :as sut]
- [auto-sim.simulation-engine :as sim-engine]
- [auto-sim.simulation-engine.impl.model :as sim-de-model]
- [auto-sim.simulation-engine.impl.registry :as sim-de-registry]))
-
-(deftest create-test
- (is (= #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 3}
- :entity-state {:foo :bar}}}}
- (sut/create {} 3 :foo-entity {:foo :bar}))
- "Adding a new entity that was not existing before.")
- (is
- (= #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 4}
- :living #::sut{:date 5}
- :entity-state {:foo :bar
- :a :b}
- :errors [#::sut{:why ::sut/already-created
- :entity-name :foo-entity
- :state
- #::sut{:entities
- {:foo-entity
- #::sut{:created #::sut{:date 4}
- :entity-state {:a :b
- :foo :c}}}}
- :date 5
- :entity-state {:foo :bar}}]}}}
- (sut/create #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 4}
- :entity-state {:a :b
- :foo :c}}}}
- 5
- :foo-entity
- {:foo :bar}))
- "Adding an already existing entity is merging the data map, but created lifecycle is not updated and an error is documented.
-Note that `created` `date` is not modified on purpose as the real creation has happened before."))
-
-(deftest errors-test
- (is (= {} (sut/errors {})) "No errors returns an empty map.")
- (is (= :list-of-errors
- (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 5}
- :living #::sut{:date 5}
- :entity-state {:foo :bar
- :a :b}
- :errors :list-of-errors}
- :ok-entity #::sut{}}}
- (sut/errors :foo-entity)))
- "Errors of a specific `entity-name` are returned.")
- (is (= {:foo-entity [:error1 :error2]}
- (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 5}
- :living #::sut{:date 5}
- :entity-state {:foo :bar
- :a :b}
- :errors [:error1 :error2]}
- :ok-entity #::sut{}}}
- sut/errors))
- "Errors are caught in the list, only entities where an error occur."))
-
-(deftest error?-test
- (is (not (sut/error? {})) "An empty state is returning no error.")
- (is (sut/error? #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 5}
- :living #::sut{:date 5}
- :entity-state {:foo :bar
- :a :b}
- :errors :list-of-errors}
- :ok-entity #::sut{}}})
- "Detect one error."))
-
-(def state-stub
- #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 4}
- :entity-state {:data :of
- :an :entity}}}})
-
-(deftest update-test
- (is
- (= (-> state-stub
- (assoc-in [::sut/entities :foo-entity ::sut/entity-state :and] :another-data)
- (assoc-in [::sut/entities :foo-entity ::sut/living ::sut/date] 5))
- (-> state-stub
- (sut/update 5 :foo-entity assoc :and :another-data)))
- "When an existing entity that is living is updated, its entity state and living lifecycle are updated, the created is not modified.")
- (is
- (= (-> state-stub
- (update-in [::sut/entities :foo-entity ::sut/errors]
- conj
- #::sut{:why ::sut/exception-during-update
- :entity-name :foo-entity
- :state state-stub
- :exception {}
- :date 5}))
- (-> state-stub
- (sut/update 5 :foo-entity #(throw (ex-info "Hey no!" {:a %})))
- (update-in [::sut/entities :foo-entity ::sut/errors] vec)
- (assoc-in [::sut/entities :foo-entity ::sut/errors 0 ::sut/exception] {})))
- "If update raises an exception, the error is documented, the living date is not, as we consider the update did not happen.")
- (is
- (= [[#::sut{:why ::sut/updating-a-disposed-entity
- :state (-> state-stub
- (assoc-in [::sut/entities :foo-entity ::sut/disposed] #::sut{:date 5}))
- :date 12
- :entity-name :foo-entity
- :function assoc
- :args [:bar :foo]}]
- {:data :of
- :an :entity
- :bar :foo}]
- ((juxt #(sut/errors % :foo-entity) #(sut/state % :foo-entity))
- (-> state-stub
- (assoc-in [::sut/entities :foo-entity ::sut/disposed] #::sut{:date 5})
- (sut/update 12 :foo-entity assoc :bar :foo))))
- "The update function documents an error if the entity is already disposed, the creation is marked in the lifecycle status.")
- (is (= [#::sut{:why ::sut/updating-a-not-created-entity
- :state {}
- :date 12
- :entity-name :foo-entity
- :function assoc
- :args [:bar :foo]}]
- (-> {}
- (sut/update 12 :foo-entity assoc :bar :foo)
- (sut/errors :foo-entity)))
- "Update can update a non existing entity, the creation is marked in the lifecycle status."))
-
-(deftest state-test
- (is (= {:foo :bar}
- (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 3}
- :entity-state {:foo :bar}}}}
- (sut/state :foo-entity)))
- "The state is returned.")
- (is (= nil (sut/state {} :non-existing-entity)) "No state returned for non existing."))
-
-(deftest dispose-test
- (is (= #::sut{:entities {:foo-entity #::sut{:disposed #::sut{:date 10}
- :created #::sut{:date 3}
- :living #::sut{:date 5}}}}
- (-> #::sut{:entities {:foo-entity #::sut{:entity-state {:data :of
- :an :entity}
- :created #::sut{:date 3}
- :living #::sut{:date 5}}}}
- (sut/dispose 10 :foo-entity)))
- "Disposing an existing entity is updatng the lifecycle and remove is data.")
- (is (= #::sut{:entities {:foo-entity #::sut{:disposed #::sut{:date 10}
- :created #::sut{:date 10}
- :errors [#::sut{:why
- ::sut/disposing-a-not-created-entity
- :state {}
- :date 10
- :entity-name :foo-entity}]
- :living #::sut{:date 10}}}}
- (-> #::sut{}
- (sut/dispose 10 :foo-entity)))
- "Disposing a non existing entity creates it and its lifecycle data, and reports an error.")
- (is (= #::sut{:entities {:foo-entity
- #::sut{:disposed #::sut{:date 10}
- :created #::sut{:date 3}
- :errors [#::sut{:why ::sut/already-disposed
- :state #::sut{:entities
- {:foo-entity
- #::sut{:disposed #::sut{:date 7}
- :created #::sut{:date 3}
- :living #::sut{:date 5}}}}
- :date 10
- :entity-name :foo-entity}]
- :living #::sut{:date 5}}}}
- (-> #::sut{:entities {:foo-entity #::sut{:disposed #::sut{:date 7}
- :created #::sut{:date 3}
- :living #::sut{:date 5}}}}
- (sut/dispose 10 :foo-entity)))
- "Disposing an already disposed entity reports an error."))
-
-(deftest lifecycle-status-test
- (is (-> {}
- (sut/lifecycle-status :an-non-created-entity)
- empty?)
- "Non existing entity has no lifecycle status.")
- (is
- (= #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}}
- (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}
- :entity-state {:foo :bar}}}}
- (sut/lifecycle-status :foo-entity)))
- "When the entity is created, its lifecycle-status has its created and living fields at the same date.")
- (is (= #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}}
- (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}
- :entity-state {:foo :bar}}}}
- (sut/lifecycle-status :foo-entity)))
- "After update, the lifecycle has a new living date.")
- (is (= #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}
- :disposed #::sut{:date 15}}
- (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}
- :disposed #::sut{:date 15}
- :entity-state {:foo :bar}}}}
- (sut/lifecycle-status :foo-entity)))
- "After disposed, the lifecycle has a disposed data."))
-
-(deftest is-created?-test
- (is (not (some? (-> {}
- (sut/is-created? :foo-entity))))
- "A non existing entity is not created.")
- (is (some? (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}}}}
- (sut/is-created? :foo-entity)))
- "A living entity is created.")
- (is (some? (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}
- :disposed #::sut{:date 15}}}}
- (sut/is-created? :foo-entity)))
- "A disposed entity is created."))
-
-(deftest is-living?-test
- (is (nil? (-> {}
- (sut/is-living? :foo-entity)))
- "A non existing entity is not living")
- (is (= #::sut{:date 11}
- (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}}}}
- (sut/is-living? :foo-entity)))
- "A living entity is living")
- (is (nil? (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}
- :disposed #::sut{:date 15}}}}
- (sut/is-living? :foo-entity)))
- "A disposed entity is not living."))
-
-(deftest is-disposed?-test
- (is (nil? (-> {}
- (sut/is-disposed? :foo-entity)))
- "A non existing entity is not disposed.")
- (is (nil? (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}}}}
- (sut/is-disposed? :foo-entity)))
- "A living entity is not disposed.")
- (is (= #::sut{:date 15}
- (-> #::sut{:entities {:foo-entity #::sut{:created #::sut{:date 3}
- :living #::sut{:date 11}
- :disposed #::sut{:date 15}}}}
- (sut/is-disposed? :foo-entity)))
- "A disposed entity is disposed."))
-
-(deftest wrap-model-test
- (is
- (=
- #::sim-engine{:registry
- #::sim-engine{:stopping
- #::sut{:entity-lifecycle-corrupted
- #::sim-engine{:doc
- "Stops when an error occured in an entity lifecycle."
- :id ::sut/entity-lifecycle-corrupted
- :next-possible? true
- :stopping-evaluation
- sut/lifecycle-corrupted}}}}
- (->> {}
- sut/wrap-model))))
-
-;;; Assembly tests
-;;; ****************
-
-(deftest assembly-model-test
- (is (= nil
- (->> (sim-de-model/build {::sim-engine/initial-event-type :IN} (sim-de-registry/build))
- sut/wrap-model
- (core-schema/validate-data-humanize sim-de-model/schema)))))
-
-(def state0 {})
-
-(def state1
- (-> state0
- (sut/create 3
- :my-first-entity
- {:data :of
- :an :entity})))
-
-(def state2
- (-> state1
- (sut/update 5 :my-first-entity assoc :and :another-data)))
-
-(def state3
- (-> state2
- (sut/dispose 12 :my-first-entity)))
-
-(deftest assembly-tests
- (is (nil? (sut/is-created? :non-existing state1)))
- (is (nil? (sut/is-living? :non-existing state1)))
- (is (nil? (sut/is-disposed? :non-existing state1)))
- (is (= #::sut{:date 3} (sut/is-created? state1 :my-first-entity)))
- (is (= #::sut{:date 3} (sut/is-living? state1 :my-first-entity)))
- (is (nil? (sut/is-disposed? state1 :my-first-entity)))
- (is (= {:data :of
- :an :entity
- :and :another-data}
- (sut/state state2 :my-first-entity)))
- (is (= #::sut{:date 5} (sut/is-living? state2 :my-first-entity)))
- (is (= {:data :of
- :an :entity
- :and :another-data}
- (-> state2
- (sut/state :my-first-entity))))
- (is (= nil
- (-> state3
- (sut/state :my-first-entity))))
- (is (= nil
- (-> state3
- (sut/is-living? :my-first-entity))))
- (is (= #::sut{:date 12}
- (-> state3
- (sut/is-disposed? :my-first-entity)))))
diff --git a/test/cljc/automaton_simulation_de/event_registry_test.cljc b/test/cljc/automaton_simulation_de/event_registry_test.cljc
deleted file mode 100644
index bd68eb1..0000000
--- a/test/cljc/automaton_simulation_de/event_registry_test.cljc
+++ /dev/null
@@ -1,10 +0,0 @@
-(ns auto-sim.event-registry-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.impl.event-registry :as sut]))
-
-(deftest schema-test
- (testing "event registry has a valid schema"
- (is (nil? (core-schema/validate-humanize sut/schema)))))
diff --git a/test/cljc/automaton_simulation_de/predicates/composed_predicates_test.cljc b/test/cljc/automaton_simulation_de/predicates/composed_predicates_test.cljc
deleted file mode 100644
index 9bc9ddb..0000000
--- a/test/cljc/automaton_simulation_de/predicates/composed_predicates_test.cljc
+++ /dev/null
@@ -1,91 +0,0 @@
-(ns auto-sim.predicates.composed-predicates-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.predicates :as sim-pred]
- [auto-sim.predicates.composed-predicates :as sut]
- [auto-sim.predicates.equality-predicates :as sim-pred-equality]))
-
-(deftest not-test
- (is (= false ((sut/not-fn (sim-pred-equality/is?-fn :name :m1)) {:name :m1})))
- (is (= true ((sut/not-fn (sim-pred-equality/is?-fn :name :m1)) {:name :m2})))
- (is (= false ((sut/not-fn (sim-pred-equality/is?-fn :name "hello")) {:name "hello"})))
- (is (= false
- ((sut/not-fn (sim-pred-equality/is?-fn [:name :is :deep] "hello"))
- {:name {:is {:deep "hello"}}})))
- (is (= true ((sut/not-fn (sim-pred-equality/is?-fn :name "hELlo")) {:name "hello"})))
- (is (= false ((sut/not-fn (sim-pred-equality/is?-fn :name 5)) {:name 5})))
- (is (= false ((sut/not-fn (sim-pred-equality/is?-fn 5)) 5)))
- (is (= false ((sut/not-fn (sim-pred-equality/is?-fn {:a 2})) {:a 2})))
- (is (= false ((sut/not-fn (sim-pred-equality/is?-fn "hello")) "hello"))))
-
-(deftest and-test
- (is (= true
- ((sut/and-fn (sim-pred-equality/is?-fn :name :m1) (sim-pred-equality/true?-fn :something))
- {:name :m1
- :something true})))
- (is (= false
- ((sut/and-fn (sim-pred-equality/is?-fn :name :m2) (sim-pred-equality/true?-fn :something))
- {:name :m1
- :something true})))
- (is (= false
- ((sut/and-fn (sim-pred-equality/true?-fn :something) (sim-pred-equality/is?-fn :name :m2))
- {:name :m1
- :something false}))))
-
-(deftest or-test
- (is (= true
- ((sut/or-fn (sim-pred-equality/is?-fn :name :m1) (sim-pred-equality/true?-fn :something))
- {:name :m1
- :something true})))
- (is (= true
- ((sut/or-fn (sim-pred-equality/is?-fn :name :m2) (sim-pred-equality/true?-fn :something))
- {:name :m1
- :something true})))
- (is (= false
- ((sut/or-fn (sim-pred-equality/true?-fn :something) (sim-pred-equality/is?-fn :name :m2))
- {:name :m1
- :something false}))))
-
-
-(deftest registry-validation-test
- (is (true? (core-schema/validate-data sim-pred/pred-registry-schema
- sut/composed-predicates-lang-reg)))
- (is
- (true? (every? string? (map (fn [[_ v]] (:doc v)) sut/composed-predicates-lang-reg)))
- "Generally :doc is not required for registry, but for base-lib predicates registry documentation is required"))
-
-(defn- validation-fn [k] (get-in sut/composed-predicates-lang-reg [k :validation-fn]))
-
-(deftest lang-validation-test
- (testing "not"
- (is (true? ((validation-fn ::sim-pred/not) [::sim-pred/not [:some :vec]])))
- (is (true? ((validation-fn ::sim-pred/not)
- [::sim-pred/not [::sim-pred/not [:is :something :lang]]])))
- (is (false? ((validation-fn ::sim-pred/not) [::sim-pred/not])))
- (is (false? ((validation-fn ::sim-pred/not) [::sim-pred/not [:some :vec] [:some :vec]])))
- (is (false? ((validation-fn ::sim-pred/not)
- [::sim-pred/not
- [::sim-pred/not [:is :something :lang]]
- [::sim-pred/not [:is :something :lang]]]))))
- (testing "and"
- (is (true? ((validation-fn ::sim-pred/and) [::sim-pred/and [:some :vec]])))
- (is (true? ((validation-fn ::sim-pred/and)
- [::sim-pred/and [::sim-pred/and [:is :something :lang]]])))
- (is (true? ((validation-fn ::sim-pred/and) [::sim-pred/and [:some :vec] [:some :vec]])))
- (is (true? ((validation-fn ::sim-pred/and)
- [::sim-pred/and
- [::sim-pred/and [:is :something :lang]]
- [::sim-pred/and [:is :something :lang]]])))
- (is (false? ((validation-fn ::sim-pred/and) [::sim-pred/and]))))
- (testing "or"
- (is (true? ((validation-fn ::sim-pred/or) [::sim-pred/or [:some :vec]])))
- (is (true? ((validation-fn ::sim-pred/or)
- [::sim-pred/or [::sim-pred/or [:is :something :lang]]])))
- (is (true? ((validation-fn ::sim-pred/or) [::sim-pred/or [:some :vec] [:some :vec]])))
- (is (true? ((validation-fn ::sim-pred/or)
- [::sim-pred/or
- [::sim-pred/or [:is :something :lang]]
- [::sim-pred/or [:is :something :lang]]])))
- (is (false? ((validation-fn ::sim-pred/or) [::sim-pred/or])))))
diff --git a/test/cljc/automaton_simulation_de/predicates/equality_predicates_test.cljc b/test/cljc/automaton_simulation_de/predicates/equality_predicates_test.cljc
deleted file mode 100644
index 28b8986..0000000
--- a/test/cljc/automaton_simulation_de/predicates/equality_predicates_test.cljc
+++ /dev/null
@@ -1,209 +0,0 @@
-(ns auto-sim.predicates.equality-predicates-test
- (:require
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.predicates :as sim-pred]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [auto-sim.predicates.equality-predicates :as sut]))
-
-
-(deftest is?-fn-test
- (is (true? ((sut/is?-fn :name :m1) {:name :m1})))
- (is (false? ((sut/is?-fn :name :m1) {:name :m2})))
- (is (true? ((sut/is?-fn :name "hello") {:name "hello"})))
- (is (true? ((sut/is?-fn [:name :is :deep] "hello") {:name {:is {:deep "hello"}}})))
- (is (false? ((sut/is?-fn :name "hELlo") {:name "hello"})))
- (is (true? ((sut/is?-fn :name 5) {:name 5})))
- (is (true? ((sut/is?-fn 5) 5)))
- (is (true? ((sut/is?-fn {:a 2}) {:a 2})))
- (is (true? ((sut/is?-fn "hello") "hello"))))
-
-(deftest one-of?-fn-test
- (is (true? ((sut/one-of?-fn :name [:m1]) {:name :m1})))
- (is (true? ((sut/one-of?-fn :name [:m1 :m2]) {:name :m2})))
- (is (false? ((sut/one-of?-fn :name [:m1 :m2]) {:name :m3})))
- (is (true? ((sut/one-of?-fn :name ["hello"]) {:name "hello"})))
- (is (false? ((sut/one-of?-fn :name ["hello"]) {:name "hellobro"})))
- (is (true? ((sut/one-of?-fn [:name :is :deep] ["hello"]) {:name {:is {:deep "hello"}}})))
- (is (false? ((sut/one-of?-fn :name ["hELlo"]) {:name "hello"})))
- (is (true? ((sut/one-of?-fn :name (range 1 10)) {:name 5})))
- (is (true? ((sut/one-of?-fn :name (range 1 10)) {:name 2})))
- (is (true? ((sut/one-of?-fn :name (range 1 10)) {:name 9})))
- (is (true? ((sut/one-of?-fn [5]) 5)))
- (is (nil? ((sut/one-of?-fn :wrong) :wrong)))
- (is (nil? ((sut/one-of?-fn "hello") "hello")))
- (is (nil? ((sut/one-of?-fn "hello") "h"))))
-
-(deftest is-empty?-fn-test
- (is (true? ((sut/is-empty?-fn :name) {:name nil})))
- (is (true? ((sut/is-empty?-fn :name) {:name []})))
- (is (true? ((sut/is-empty?-fn :name) {:name {}})))
- (is (true? ((sut/is-empty?-fn :name) {:name '()})))
- (is (true? ((sut/is-empty?-fn [:a :b :c]) {:name {:a {:b 5}}})))
- (is (true? ((sut/is-empty?-fn) {})))
- (is (true? ((sut/is-empty?-fn) nil)))
- (is (false? ((sut/is-empty?-fn :name) {:name 5})))
- (is (false? ((sut/is-empty?-fn :name) {:name [1]})))
- (is (false? ((sut/is-empty?-fn :name) {:name {:a 2}})))
- (is (false? ((sut/is-empty?-fn :name) {:name '(3)})))
- (is (false? ((sut/is-empty?-fn [:name :a :b :c]) {:name {:a {:b {:c 8}}}})))
- (is (false? ((sut/is-empty?-fn) 5))))
-
-(deftest contains?-fn-test
- (testing "string"
- (is (true? ((sut/contains?-fn :name "MX") {:name "AMX500"})))
- (is (false? ((sut/contains?-fn :name "MX") {:name "IDon'tHaveIt"})))
- (is (true? ((sut/contains?-fn :name "MX") {:name "MX-Starts with"})))
- (is (true? ((sut/contains?-fn :name "MX") {:name "Ends with MX"})))
- (is (true? ((sut/contains?-fn [:name :what] "MX") {:name {:what "Ends with MX"}})))
- (is (true? ((sut/contains?-fn "MX") "MX"))))
- (testing "vector"
- (is (true? ((sut/contains?-fn :machines :m1) {:machines [:m1 :m2 :m3]})))
- (is (true? ((sut/contains?-fn :machines :m1) {:machines [:m1]})))
- (is (true? ((sut/contains?-fn :machines :m1) {:machines [:m2 :m3 :m1]})))
- (is (true? ((sut/contains?-fn [:machines :deep] :m1) {:machines {:deep [:m2 :m3 :m1]}})))
- (is (true? ((sut/contains?-fn :m1) [:m2 :m3 :m1])))
- (is (false? ((sut/contains?-fn :m1) [:m2 :m3])))
- (is (false? ((sut/contains?-fn :m1) [])))
- (is (false? ((sut/contains?-fn :m1) [[:m1]])))
- (is (false? ((sut/contains?-fn :non-existing :m1) [:m1]))))
- (testing "list"
- (is (true? ((sut/contains?-fn :machines :m1) {:machines '(:m1 :m2 :m3)})))
- (is (true? ((sut/contains?-fn :machines :m1) {:machines '(:m1)})))
- (is (true? ((sut/contains?-fn :machines :m1) {:machines '(:m2 :m3 :m1)})))
- (is (true? ((sut/contains?-fn '(:machines :deep) :m1) {:machines {:deep '(:m2 :m3 :m1)}})))
- (is (true? ((sut/contains?-fn :m1) '(:m2 :m3 :m1))))
- (is (false? ((sut/contains?-fn :m1) '(:m2 :m3))))
- (is (false? ((sut/contains?-fn :m1) '())))
- (is (false? ((sut/contains?-fn :m1) '([:m1]))))
- (is (false? ((sut/contains?-fn :non-existing :m1) '(:m1))))))
-
-(deftest starts-with?-fn
- (is (false? ((sut/starts-with?-fn :name "MX") {:name "AMX500"})))
- (is (false? ((sut/starts-with?-fn :name "MX") {:name "IDon'tHaveIt"})))
- (is (true? ((sut/starts-with?-fn :name "MX") {:name "MX-Starts with"})))
- (is (false? ((sut/starts-with?-fn :name "MX") {:name "Ends with MX"})))
- (is (true? ((sut/starts-with?-fn [:name :what] "MX") {:name {:what "MX5000"}})))
- (is (true? ((sut/starts-with?-fn "MX") "MX")))
- (is (nil? ((sut/starts-with?-fn "MX") 5))))
-
-
-(deftest ends-with?-fn
- (is (false? ((sut/ends-with?-fn :name "MX") {:name "AMX500"})))
- (is (false? ((sut/ends-with?-fn :name "MX") {:name "IDon'tHaveIt"})))
- (is (false? ((sut/ends-with?-fn :name "MX") {:name "MX-Starts with"})))
- (is (true? ((sut/ends-with?-fn :name "MX") {:name "Ends with MX"})))
- (is (false? ((sut/ends-with?-fn [:name :what] "MX") {:name {:what "MX5000"}})))
- (is (true? ((sut/ends-with?-fn "MX") "MX")))
- (is (nil? ((sut/ends-with?-fn "MX") 5))))
-
-(deftest true?-fn-test
- (is (true? ((sut/true?-fn :on) {:on true})))
- (is (false? ((sut/true?-fn :on) {:on false})))
- (is (false? ((sut/true?-fn :on) {:on nil})))
- (is (false? ((sut/true?-fn :on) {:whatever true})))
- (is (true? ((sut/true?-fn) true)))
- (is (false? ((sut/true?-fn) :whatever))))
-
-(deftest false?-fn-test
- (is (false? ((sut/false?-fn :on) {:on true})))
- (is (true? ((sut/false?-fn :on) {:on false})))
- (is (false? ((sut/false?-fn :on) {:on nil})))
- (is (false? ((sut/false?-fn :on) {:whatever true})))
- (is (false? ((sut/false?-fn) true)))
- (is (false? ((sut/false?-fn) :whatever))))
-
-(deftest registry-validation-test
- (is (true? (core-schema/validate-data sim-pred/pred-registry-schema
- sut/equality-predicates-lang-reg)))
- (is
- (true? (every? string? (map (fn [[_ v]] (:doc v)) sut/equality-predicates-lang-reg)))
- "Generally :doc is not required for registry, but for base-lib predicates registry documentation is required"))
-
-(defn- validation-fn [k] (get-in sut/equality-predicates-lang-reg [k :validation-fn]))
-
-(deftest lang-validation-test
- (testing "equal?"
- (is (true? ((validation-fn ::sim-pred/equal?) [::sim-pred/equal? :name :value])))
- (is (true? ((validation-fn ::sim-pred/equal?) [::sim-pred/equal? "name" :value])))
- (is (true? ((validation-fn ::sim-pred/equal?) [::sim-pred/equal? [:long :path :name] :value])))
- (is (true? ((validation-fn ::sim-pred/equal?) [::sim-pred/equal? [:long :path "name"] :value])))
- (is (true? ((validation-fn ::sim-pred/equal?) [::sim-pred/equal? :value])))
- (is (false? ((validation-fn ::sim-pred/equal?) [::sim-pred/equal?])))
- (is (false? ((validation-fn ::sim-pred/equal?) [::sim-pred/equal? :to :many :arguments]))))
- (testing "one-of?"
- (is (true? ((validation-fn ::sim-pred/one-of?) [::sim-pred/one-of? :name [:value :or :more]])))
- (is (true? ((validation-fn ::sim-pred/one-of?)
- [::sim-pred/one-of? "name" [:value "different" 5]])))
- (is (true? ((validation-fn ::sim-pred/one-of?) [::sim-pred/one-of? [:long :path :name] []])))
- (is (true? ((validation-fn ::sim-pred/one-of?) [::sim-pred/one-of? [:long :path "name"] '()])))
- (is (true? ((validation-fn ::sim-pred/one-of?) [::sim-pred/one-of? ["values" "to" "compare"]])))
- (is (false? ((validation-fn ::sim-pred/one-of?) [::sim-pred/one-of?])))
- (is (false? ((validation-fn ::sim-pred/one-of?) [::sim-pred/one-of? :to :many :arguments])))
- (is (false? ((validation-fn ::sim-pred/one-of?) [::sim-pred/one-of? :path :wrong-value])))
- (is (false? ((validation-fn ::sim-pred/one-of?)
- [::sim-pred/one-of? :path "I dont work with strings"])))
- (is (false? ((validation-fn ::sim-pred/one-of?) [::sim-pred/one-of? :path 5]))))
- (testing "is-empty?"
- (is (true? ((validation-fn ::sim-pred/is-empty?) [::sim-pred/is-empty? :name])))
- (is (true? ((validation-fn ::sim-pred/is-empty?) [::sim-pred/is-empty? "name"])))
- (is (true? ((validation-fn ::sim-pred/is-empty?) [::sim-pred/is-empty? [:long :path :name]])))
- (is (true? ((validation-fn ::sim-pred/is-empty?) [::sim-pred/is-empty? [:long :path "name"]])))
- (is (true? ((validation-fn ::sim-pred/is-empty?) [::sim-pred/is-empty?])))
- (is (false? ((validation-fn ::sim-pred/is-empty?) [::sim-pred/is-empty? :to :many :arguments])))
- (is (false? ((validation-fn ::sim-pred/is-empty?) [::sim-pred/is-empty? :path :to-many]))))
- (testing "contains?"
- (is (true? ((validation-fn ::sim-pred/contains?) [::sim-pred/contains? :name "val"])))
- (is (true? ((validation-fn ::sim-pred/contains?) [::sim-pred/contains? "name" "val"])))
- (is (true? ((validation-fn ::sim-pred/contains?)
- [::sim-pred/contains? [:long :path :name] "val"])))
- (is (true? ((validation-fn ::sim-pred/contains?)
- [::sim-pred/contains? [:long :path "name"] [:vals :more :some]])))
- (is (true? ((validation-fn ::sim-pred/contains?) [::sim-pred/contains? :name '("val" 2)])))
- (is (true? ((validation-fn ::sim-pred/contains?) [::sim-pred/contains? :name 5])))
- (is (true? ((validation-fn ::sim-pred/contains?) [::sim-pred/contains? "just value"])))
- (is (false? ((validation-fn ::sim-pred/contains?) [::sim-pred/contains?])))
- (is (false? ((validation-fn ::sim-pred/contains?)
- [::sim-pred/contains? :to :many :arguments]))))
- (testing "starts-with?"
- (is (true? ((validation-fn ::sim-pred/starts-with?) [::sim-pred/starts-with? :name "val"])))
- (is (true? ((validation-fn ::sim-pred/starts-with?) [::sim-pred/starts-with? "name" "val"])))
- (is (true? ((validation-fn ::sim-pred/starts-with?)
- [::sim-pred/starts-with? [:long :path :name] "val"])))
- (is (true? ((validation-fn ::sim-pred/starts-with?) [::sim-pred/starts-with? "just value"])))
- (is (false? ((validation-fn ::sim-pred/starts-with?)
- [::sim-pred/starts-with? :path [:vals :more :some]])))
- (is (false? ((validation-fn ::sim-pred/starts-with?)
- [::sim-pred/starts-with? :name '("val" 2)])))
- (is (false? ((validation-fn ::sim-pred/starts-with?) [::sim-pred/starts-with? :name 5])))
- (is (false? ((validation-fn ::sim-pred/starts-with?) [::sim-pred/starts-with?])))
- (is (false? ((validation-fn ::sim-pred/starts-with?)
- [::sim-pred/starts-with? :to "many" "args"]))))
- (testing "ends-with?"
- (is (true? ((validation-fn ::sim-pred/ends-with?) [::sim-pred/ends-with? :name "val"])))
- (is (true? ((validation-fn ::sim-pred/ends-with?) [::sim-pred/ends-with? "name" "val"])))
- (is (true? ((validation-fn ::sim-pred/ends-with?)
- [::sim-pred/ends-with? [:long :path :name] "val"])))
- (is (true? ((validation-fn ::sim-pred/ends-with?) [::sim-pred/ends-with? "just value"])))
- (is (false? ((validation-fn ::sim-pred/ends-with?)
- [::sim-pred/ends-with? :path [:vals :more :some]])))
- (is (false? ((validation-fn ::sim-pred/ends-with?) [::sim-pred/ends-with? :name '("val" 2)])))
- (is (false? ((validation-fn ::sim-pred/ends-with?) [::sim-pred/ends-with? :name 5])))
- (is (false? ((validation-fn ::sim-pred/ends-with?) [::sim-pred/ends-with?])))
- (is (false? ((validation-fn ::sim-pred/ends-with?) [::sim-pred/ends-with? :to "many" "args"]))))
- (testing "true?"
- (is (true? ((validation-fn ::sim-pred/true?) [::sim-pred/true? :name])))
- (is (true? ((validation-fn ::sim-pred/true?) [::sim-pred/true? "name"])))
- (is (true? ((validation-fn ::sim-pred/true?) [::sim-pred/true? [:long :path :name]])))
- (is (true? ((validation-fn ::sim-pred/true?) [::sim-pred/true? [:long :path "name"]])))
- (is (true? ((validation-fn ::sim-pred/true?) [::sim-pred/true?])))
- (is (false? ((validation-fn ::sim-pred/true?) [::sim-pred/true? :to :many :arguments])))
- (is (false? ((validation-fn ::sim-pred/true?) [::sim-pred/true? :path :to-many]))))
- (testing "false?"
- (is (true? ((validation-fn ::sim-pred/false?) [::sim-pred/false? :name])))
- (is (true? ((validation-fn ::sim-pred/false?) [::sim-pred/false? "name"])))
- (is (true? ((validation-fn ::sim-pred/false?) [::sim-pred/false? [:long :path :name]])))
- (is (true? ((validation-fn ::sim-pred/false?) [::sim-pred/false? [:long :path "name"]])))
- (is (true? ((validation-fn ::sim-pred/false?) [::sim-pred/false?])))
- (is (false? ((validation-fn ::sim-pred/false?) [::sim-pred/false? :to :many :arguments])))
- (is (false? ((validation-fn ::sim-pred/false?) [::sim-pred/false? :path :to-many])))))
diff --git a/test/cljc/automaton_simulation_de/predicates_test.cljc b/test/cljc/automaton_simulation_de/predicates_test.cljc
deleted file mode 100644
index 9af51e2..0000000
--- a/test/cljc/automaton_simulation_de/predicates_test.cljc
+++ /dev/null
@@ -1,89 +0,0 @@
-(ns auto-sim.predicates-test
- (:require
- [auto-sim.predicates :as sut]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])))
-
-(deftest apply-predicate-query-detailed
- (is (map? (sut/apply-query-detailed [::sut/equal :color :blue]
- {:name :m1
- :color :blue}))
- "Error map is returned when predicate is not in registry")
- (is (map? (sut/apply-query-detailed [::sut/not [::sut/equal :color :blue]]
- {:name :m1
- :color :green}))
- "Error map is returned when predicate inside predicate is not in registry")
- (is (map? (sut/apply-query-detailed [::sut/equal? :color :blue :to :many :params]
- {:name :m1
- :color :green}))
- "Error map is returned when predicate params are invalid")
- (is (map? (sut/apply-query-detailed [:sut/not [::sut/equal? :color :blue :to :many :params]]
- {:name :m1
- :color :green}))
- "Error map is returned when predicate params are invalid nested")
- (is (map? (sut/apply-query-detailed [:sut/not
- [::sut/equal? :color :blue :to :many :params]
- [::sut/equal? :color :blue :to :many :params]]
- {:name :m1
- :color :green}))
- "Error map is returned when predicate params are invalid")
- (is (= "test error"
- (ex-message (:error (sut/apply-query-detailed
- {::throw {:pred-fn (fn [& _] #(throw (ex-info "test error" {:d %})))}}
- [::throw]
- "whatever"))))
- "Error map is returned when predicate throws error with it's error")
- (is (= "Predicate is not matching a schema"
- (:msg (:error (sut/apply-query-detailed :pred-shouldn't-look-like-this "whatever"))))
- "Error map is returned when predicate throws error with it's error")
- (is (= "predicate does not evaluated to function"
- (:msg
- (sut/apply-query-detailed {::broken-pred {:no-pred-fn nil}} [::broken-pred] "whatever")))
- "Invalid registry causes error map to be returned"))
-
-(deftest apply-predicate-query
- (testing "Invalid options return nil"
- (is (nil? (sut/apply-query [::sut/starts-with? :color [:wrong :type]]
- {:name :m1
- :color "blue"})))
- (is (nil? (sut/apply-query [::sut/equal :color :blue]
- {:name :m1
- :color :blue})))
- (is (nil? (sut/apply-query [::sut/not [::sut/equal :color :blue]]
- {:name :m1
- :color :green})))
- (is (nil? (sut/apply-query [::sut/equal? :color :blue :to :many :params]
- {:name :m1
- :color :green})))
- (is (nil? (sut/apply-query [:sut/not [::sut/equal? :color :blue :to :many :params]]
- {:name :m1
- :color :green})))
- (is (nil? (sut/apply-query [:sut/not
- [::sut/equal? :color :blue :to :many :params]
- [::sut/equal? :color :blue :to :many :params]]
- {:name :m1
- :color :green})))
- (is (nil? (sut/apply-query {::throw {:pred-fn (fn [& _]
- #(throw (ex-info "test error" {:d %})))}}
- [::throw]
- "whatever")))
- (is (nil? (sut/apply-query {::broken-pred {:no-pred-fn nil}} [::broken-pred] "whatever"))
- "Error map is returned when predicate throws error with it's error")
- (is (nil? (sut/apply-query {::broken-pred {:no-pred-fn nil}} [::broken-pred] "whatever"))
- "Invalid registry causes error map to be returned"))
- (testing "valid queries"
- (is (true? (sut/apply-query [::sut/equal? :color :blue]
- {:name :m1
- :color :blue})))
- (is (true? (sut/apply-query [::sut/not [::sut/equal? :color :blue]]
- {:name :m1
- :color :green})))
- (is (false? (sut/apply-query [::sut/not [::sut/equal? :color :blue]]
- {:name :m1
- :color :blue})))
- (is (false? (sut/apply-query [::sut/equal? :color :blue]
- {:name :m1
- :color :green})))
- (is (true? (sut/apply-query [::sut/equal? :color :blue]
- {:name :m1
- :color :blue})))))
diff --git a/test/cljc/automaton_simulation_de/rc/impl/preemption_policy/factory_test.cljc b/test/cljc/automaton_simulation_de/rc/impl/preemption_policy/factory_test.cljc
deleted file mode 100644
index b43b255..0000000
--- a/test/cljc/automaton_simulation_de/rc/impl/preemption_policy/factory_test.cljc
+++ /dev/null
@@ -1,7 +0,0 @@
-(ns auto-sim.rc.impl.preemption-policy.factory-test
- (:require
- [auto-sim.rc.impl.preemption-policy.factory :as sut]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])))
-
-(deftest factory-test (testing "Defaulted" (is (some? (sut/factory {} nil)))))
diff --git a/test/cljc/automaton_simulation_de/rc/impl/preemption_policy/registry_test.cljc b/test/cljc/automaton_simulation_de/rc/impl/preemption_policy/registry_test.cljc
deleted file mode 100644
index 7b0b3be..0000000
--- a/test/cljc/automaton_simulation_de/rc/impl/preemption_policy/registry_test.cljc
+++ /dev/null
@@ -1,10 +0,0 @@
-(ns auto-sim.rc.impl.preemption-policy.registry-test
- (:require
- [automaton-core.adapters.schema :as core-schema]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [auto-sim.rc.impl.preemption-policy.registry :as sut]))
-
-(deftest registry-test
- (testing "Validate registry"
- (is (nil? (core-schema/validate-data-humanize (sut/schema) (sut/registry))))))
diff --git a/test/cljc/automaton_simulation_de/rc/impl/resource/consumption_test.cljc b/test/cljc/automaton_simulation_de/rc/impl/resource/consumption_test.cljc
deleted file mode 100644
index 0d8c164..0000000
--- a/test/cljc/automaton_simulation_de/rc/impl/resource/consumption_test.cljc
+++ /dev/null
@@ -1,59 +0,0 @@
-(ns auto-sim.rc.impl.resource.consumption-test
- (:require
- [auto-sim.rc :as sim-rc]
- [auto-sim.rc.impl.resource.consumption :as sut]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])))
-
-(deftest consume-test
- (testing "Incomplete events are not updated"
- (is (= [nil nil] (sut/consume nil nil nil)))
- (is (= [nil {}] (sut/consume {} nil nil)))
- (is (= [nil {:a :b}] (sut/consume {:a :b} 1 nil))))
- (testing "Seizing are stored with a uuid"
- (is (uuid? (-> (sut/consume {} 1 {:a :b})
- first)))
- (is (uuid? (-> (sut/consume {} 1 {:a :b})
- second
- ::sim-rc/currently-consuming
- ffirst)))
- (is (= {:a :b}
- (let [[consumption-uuid resource] (sut/consume {} 1 {:a :b})]
- (get-in resource
- [::sim-rc/currently-consuming consumption-uuid ::sim-rc/seizing-event])))))
- (testing "Seizing are storing event and its quantity"
- (is (= #:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 1}
- (let [[consumption-uuid resource] (sut/consume {} 1 {:a :b})]
- (get-in resource [::sim-rc/currently-consuming consumption-uuid]))))
- (is (= #:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 3}
- (let [[consumption-uuid resource] (sut/consume {} 3 {:a :b})]
- (get-in resource [::sim-rc/currently-consuming consumption-uuid]))))))
-
-(deftest free-test
- (testing "A removed event is not in the list anymore"
- (is (= #:auto-sim.rc{:currently-consuming {}}
- (sut/free #:auto-sim.rc{:currently-consuming
- {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
- #:auto-sim.rc{:event {:a :b}
- :consumed-quantity
- 3}}}
- #uuid "33497220-f844-11ee-9fa1-17acea14e9df"))))
- (testing "A non existing event is not changing the existing consumptions"
- (is (= #:auto-sim.rc{:currently-consuming
- {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
- #:auto-sim.rc{:event {:a :b}
- :consumed-quantity 3}}}
- (sut/free #:auto-sim.rc{:currently-consuming
- {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
- #:auto-sim.rc{:event {:a :b}
- :consumed-quantity
- 3}}}
- #uuid "33497220-f844-11ee-9fa1-17acea14e8ee"))))
- (testing "Empty currently consuming is ok"
- (is (= {::sim-rc/currently-consuming {}}
- (sut/free {::sim-rc/currently-consuming nil}
- #uuid "33497220-f844-11ee-9fa1-17acea14e9df")))
- (is (= {::sim-rc/currently-consuming {}}
- (sut/free nil #uuid "33497220-f844-11ee-9fa1-17acea14e9df")))))
diff --git a/test/cljc/automaton_simulation_de/rc/impl/resource/queue_test.cljc b/test/cljc/automaton_simulation_de/rc/impl/resource/queue_test.cljc
deleted file mode 100644
index 8887748..0000000
--- a/test/cljc/automaton_simulation_de/rc/impl/resource/queue_test.cljc
+++ /dev/null
@@ -1,251 +0,0 @@
-(ns auto-sim.rc.impl.resource.queue-test
- (:require
- #?(:clj [clojure.test :refer [are deftest is testing]]
- :cljs [cljs.test :refer [are deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.rc :as sim-rc]
- [auto-sim.rc.impl.preemption-policy.factory :as sim-rc-preemption-policy-factory]
- [auto-sim.rc.impl.resource.queue :as sut]
- [auto-sim.rc.impl.unblocking-policy.factory :as sim-rc-unblocking-policy-factory]
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn uncache
- "As testing the content of the cache is not necessary and cumbersome, this function removes it so we can focus on `queue` testing."
- [resource]
- (dissoc resource ::sim-rc/cache))
-
-(defn add-cache
- "The cached functions are necessary to test this namespace. They are normally added by the defaulting of the resource.
- As we don't want to entangle the test with this defaulting, this function adds the required data only."
- [resource]
- (assoc resource
- ::sim-rc/cache
- {::sim-rc/unblocking-policy-fn sim-rc-unblocking-policy-factory/default-policy
- ::sim-rc/preemption-policy-fn sim-rc-preemption-policy-factory/default-policy}))
-
-(defn- unqueue-event-cacheproof
- [resource available-capacity]
- (update (sut/unqueue-event (add-cache resource) available-capacity) 1 uncache))
-
-(deftest schema-test
- (testing "Validate queue schema" (is (nil? (core-schema/validate-humanize sut/schema)))))
-
-(deftest queue-event-test
- (testing "Empty events are not added"
- (is (= {} (sut/queue-event nil 1 {}) (sut/queue-event {} 1 {}) (sut/queue-event {} 1 nil))))
- (testing "The first event is added in the empty queue"
- (is
- (=
- #:auto-sim.rc{:queue
- [#:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 1}
- :consumed-quantity 13}]
- :resource-name ::test}
- (sut/queue-event #:auto-sim.rc{:resource-name ::test}
- 13
- #:auto-sim.simulation-engine{:type :a
- :date 1}))))
- (testing "Further events are added"
- (is (= 3
- (-> (sut/queue-event #:auto-sim.rc{:resource-name ::test
- :queue [{} {}]}
- 13
- #:auto-sim.simulation-engine{:type :a
- :date 1})
- ::sim-rc/queue
- count))))
- (testing "Non stricty positive `consumed-quantity` are ignored"
- (are [x] (= 2
- (-> x
- ::sim-rc/queue
- count))
- (-> (sut/queue-event #:auto-sim.rc{:resource-name ::test
- :queue [{} {}]}
- 0
- #:auto-sim.simulation-engine{:type :a
- :date 1}))
- (-> (sut/queue-event #:auto-sim.rc{:resource-name ::test
- :queue [{} {}]}
- -1
- #:auto-sim.simulation-engine{:type :a
- :date 1}))
- (-> (sut/queue-event #:auto-sim.rc{:resource-name ::test
- :queue [{} {}]}
- ""
- #:auto-sim.simulation-engine{:type :a
- :date 1}))
- (-> (sut/queue-event #:auto-sim.rc{:resource-name ::test
- :queue [{} {}]}
- nil
- #:auto-sim.simulation-engine{:type :a
- :date 1})))))
-
-(deftest unqueue-event-test
- (testing "Non integer `available-capacity` is ok"
- (is (= [[] {::sim-rc/queue []}]
- (unqueue-event-cacheproof nil nil)
- (unqueue-event-cacheproof
- #:auto-sim.rc{:queue
- [{::sim-rc/seizing-event
- [#:auto-sim.simulation-engine{:type :a
- :date 1}
- #:auto-sim.simulation-engine{:type :b
- :date 2}]}]}
- nil))))
- (testing "Unqueue empty queue is ok"
- (is (= [[] #:auto-sim.rc{:queue []}] (unqueue-event-cacheproof nil 1))))
- (testing
- "Unqueue a non positive integer of `available-capacity` in a non empty queue is removing one and only one event"
- (is (= [[] #:auto-sim.rc{:queue [{:a 2}]}]
- (unqueue-event-cacheproof #:auto-sim.rc{:queue [{:a 2}]} 0))))
- (testing "Unqueue takes the first event and leave next ones in the queue"
- (is
- (=
- [[#:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type :a
- :date 1}}]
- #:auto-sim.rc{:queue
- [#:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 2}}]}]
- (unqueue-event-cacheproof
- #:auto-sim.rc{:queue
- [#:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 1}}
- #:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 2}}]}
- 1)))
- (is
- (=
- [[#:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type :a
- :date 1}
- :consumed-quantity 1}]
- #:auto-sim.rc{:queue
- [#:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 2}}]}]
- (unqueue-event-cacheproof
- #:auto-sim.rc{:queue
- [#:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 1}
- :consumed-quantity 1}
- #:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 2}}]}
- 1))))
- (testing "Unqueue can drop the last element"
- (is
- (=
- [[#:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type :a
- :date 0}}]
- {::sim-rc/queue []}]
- (unqueue-event-cacheproof
- #:auto-sim.rc{:queue
- [#:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 0}}]}
- 1))))
- (testing "Thread queue and unqueue to check unqueueing is finding the first queued element first"
- (is (= [[#:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 1}]
- #:auto-sim.rc{:queue []}]
- (-> {}
- (sut/queue-event 1 {:a :b})
- (unqueue-event-cacheproof 1))))
- (is (= [[#:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 17}]
- #:auto-sim.rc{:queue [#::sim-rc{:seizing-event {:a :c}
- :consumed-quantity 19}
- #:auto-sim.rc{:seizing-event {:d :b}
- :consumed-quantity
- 11}]}]
- (-> {}
- (sut/queue-event 17 {:a :b})
- (sut/queue-event 19 {:a :c})
- (sut/queue-event 11 {:d :b})
- (unqueue-event-cacheproof 17)))))
- (testing "unqueue more than the remaining capacity"
- (is (= [[#:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 1}
- #:auto-sim.rc{:seizing-event {:d :b}
- :consumed-quantity 2}]
- #:auto-sim.rc{:queue []}]
- (-> {}
- (sut/queue-event 1 {:a :b})
- (sut/queue-event 2 {:d :b})
- (unqueue-event-cacheproof 5)))))
- (testing "unqueue less than the first capacity"
- (is (= [[]
- #:auto-sim.rc{:queue [#::sim-rc{:seizing-event {:a :b}
- :consumed-quantity 10}
- #:auto-sim.rc{:seizing-event {:d :b}
- :consumed-quantity
- 20}]}]
- (-> {}
- (sut/queue-event 10 {:a :b})
- (sut/queue-event 20 {:d :b})
- (unqueue-event-cacheproof 5)))))
- (testing "unqueue exactly the expected capacity of two events"
- (is (= [[#:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 1}
- #:auto-sim.rc{:seizing-event {:d :b}
- :consumed-quantity 2}]
- #:auto-sim.rc{:queue []}]
- (-> {}
- (sut/queue-event 1 {:a :b})
- (sut/queue-event 2 {:d :b})
- (unqueue-event-cacheproof 3))))
- (is (= [[#:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 1}]
- #:auto-sim.rc{:queue [#::sim-rc{:seizing-event {:d :b}
- :consumed-quantity 2}]}]
- (-> {}
- (sut/queue-event 1 {:a :b})
- (sut/queue-event 2 {:d :b})
- (unqueue-event-cacheproof 2))))
- (is (= [[#:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 1}
- #:auto-sim.rc{:seizing-event {:d :b}
- :consumed-quantity 2}]
- #:auto-sim.rc{:queue []}]
- (-> {}
- (sut/queue-event 1 {:a :b})
- (sut/queue-event 2 {:d :b})
- (unqueue-event-cacheproof 4))))
- (is (= [[#:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 1}
- #:auto-sim.rc{:seizing-event {:b :b}
- :consumed-quantity 2}]
- #:auto-sim.rc{:queue [#::sim-rc{:seizing-event {:c :b}
- :consumed-quantity 4}
- #:auto-sim.rc{:seizing-event {:d :b}
- :consumed-quantity
- 2}]}]
- (-> {}
- (sut/queue-event 1 {:a :b})
- (sut/queue-event 2 {:b :b})
- (sut/queue-event 4 {:c :b})
- (sut/queue-event 2 {:d :b})
- (unqueue-event-cacheproof 4))))))
diff --git a/test/cljc/automaton_simulation_de/rc/impl/resource_test.cljc b/test/cljc/automaton_simulation_de/rc/impl/resource_test.cljc
deleted file mode 100644
index a7d5832..0000000
--- a/test/cljc/automaton_simulation_de/rc/impl/resource_test.cljc
+++ /dev/null
@@ -1,255 +0,0 @@
-(ns auto-sim.rc.impl.resource-test
- (:require
- [auto-sim.rc :as sim-rc]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [auto-sim.rc.impl.resource :as sut]
- [auto-sim.rc.impl.resource.queue-test :as sim-de-resource-queue-test]
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn uncache
- "For test purposes, remove the `cache` from the `resource`."
- [resource]
- (sim-de-resource-queue-test/uncache resource))
-
-(defn add-cache
- "For test purposes, add a `cache` and its default values to the `resource`."
- [resource]
- (sim-de-resource-queue-test/add-cache resource))
-
-(defn- dispose-cacheproof
- "Checking cache content is not the concern of this namespace, so it is removed.
- Adds the default fn in the cache that are needed to executed."
- [resource consumption-uuid]
- (-> resource
- add-cache
- (sut/dispose consumption-uuid)
- (update 1 uncache)))
-
-(defn- update-capacity-cacheproof
- "Adds the default fn in the cache that are needed to executed."
- [resource new-capacity]
- (-> resource
- add-cache
- (sut/update-capacity new-capacity)
- (update 1 uncache)))
-
-(deftest defaulting-values-test
- (testing "A purely defaulted value resource"
- (is (= #:auto-sim.rc{:capacity 1
- :currently-consuming {}
- :preemption-policy ::sim-rc/no-preemption
- :queue []
- :renewable? true
- :unblocking-policy ::sim-rc/FIFO}
- (uncache (sut/defaulting-values nil {} {})))))
- (testing "Other data are kept"
- (is (= #:auto-sim.rc{:capacity 1
- :currently-consuming {}
- :preemption-policy ::sim-rc/no-preemption
- :queue []
- :renewable? true
- :unblocking-policy ::sim-rc/FIFO
- :other-keys :are-allowed}
- (uncache (sut/defaulting-values #:auto-sim.rc{:other-keys :are-allowed}
- {}
- {}))))))
-
-(deftest nb-consumed-capacity-test
- (testing "With no currently seized, all the capacity is available"
- (is (zero? (sut/nb-consumed-resources nil)))
- (is (zero? (sut/nb-consumed-resources #:auto-sim.rc{:queue []}))))
- (testing "Defaulted consumed-quantity to 1"
- (is (= 1
- (sut/nb-consumed-resources #:auto-sim.rc{:currently-consuming
- {:a {:a :b}}}))))
- (testing "Currently seized are summed up"
- (is (= 8
- (sut/nb-consumed-resources
- #:auto-sim.rc{:currently-consuming
- {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
- {::sim-rc/consumed-quantity 3}
- #uuid "33497220-f844-11ee-9fa1-17acea14e9de"
- {::sim-rc/consumed-quantity 5}}})))))
-
-(deftest nb-available-resources-test
- (testing "A non existing resource capacity is defaulted to 1"
- (is (= (sut/nb-available-resources nil) 1)))
- (testing "With no currently seized, all the capacity is available"
- (is (= 7 (sut/nb-available-resources #:auto-sim.rc{:capacity 7}))))
- (testing
- "Currently seized events are deduced from capacity, their seized quantity is taken into account"
- (is (= 9
- (sut/nb-available-resources
- #:auto-sim.rc{:capacity 17
- :currently-consuming
- {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
- {::sim-rc/event
- #:auto-sim.simulation-engine{:type ::c
- :date 11}
- ::sim-rc/consumed-quantity 3}
- #uuid "33497220-f844-11ee-9fa1-17acea14e9de"
- {::sim-rc/event
- #:auto-sim.simulation-engine{:type ::d
- :date 19}
- ::sim-rc/consumed-quantity 5}}}))))
- (testing "If all resources are used, zero are available"
- (is (zero? (sut/nb-available-resources
- #:auto-sim.rc{:capacity 8
- :currently-consuming
- {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
- {::sim-rc/event
- #:auto-sim.simulation-engine{:type ::c
- :date 11}
- ::sim-rc/consumed-quantity 3}
- #uuid "33497220-f844-11ee-9fa1-17acea14e9de"
- {::sim-rc/event
- #:auto-sim.simulation-engine{:type ::d
- :date 19}
- ::sim-rc/consumed-quantity 5}}})))
- (is (zero? (sut/nb-available-resources
- #:auto-sim.rc{:capacity 7
- :currently-consuming
- {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
- {::sim-rc/event
- #:auto-sim.simulation-engine{:type ::c
- :date 11}
- ::sim-rc/consumed-quantity 3}
- #uuid "33497220-f844-11ee-9fa1-17acea14e9de"
- {::sim-rc/event
- #:auto-sim.simulation-engine{:type ::d
- :date 19}
- ::sim-rc/consumed-quantity 5}}})))))
-
-(deftest seize-test
- (testing "Seizing one resource with that capacity already available"
- (is (= #:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 9}
- (let [[consumption-uuid resource]
- (sut/seize #:auto-sim.rc{:capacity 13} 9 {:a :b})]
- (get-in resource [::sim-rc/currently-consuming consumption-uuid]))))
- (is (= #:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 9}
- (let [[consumption-uuid resource]
- (sut/seize #:auto-sim.rc{:capacity 9} 9 {:a :b})]
- (get-in resource [::sim-rc/currently-consuming consumption-uuid]))))
- (is (= #:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 1}
- (let [[consumption-uuid resource] (sut/seize #:auto-sim.rc{} 1 {:a :b})]
- (get-in resource [::sim-rc/currently-consuming consumption-uuid])))))
- (testing "Seizing one resource with capacity missing"
- (is (nil? (first (sut/seize #:auto-sim.rc{:capacity 0} 1 {:a :b}))))
- (is (nil? (first (sut/seize #:auto-sim.rc{:capacity 12} 20 {:a :b}))))
- (is (empty? (-> (sut/seize #:auto-sim.rc{:capacity 12} 20 {:a :b})
- second
- ::sim-rc/currently-consuming)))
- (is (= #:auto-sim.rc{:capacity 12
- :queue [#:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity
- 20}]}
- (-> (sut/seize #:auto-sim.rc{:capacity 12} 20 {:a :b})
- second)))
- (is (-> (sut/seize #:auto-sim.rc{:capacity 12} 20 {:a :b})
- first
- nil?))))
-
-(deftest dispose-test
- (testing "Dispose a non existing resource is noop"
- (is (= [[]
- #:auto-sim.rc{:currently-consuming {}
- :queue []}]
- (dispose-cacheproof {} 1))))
- (testing "Dispose an existing event, no operation is pending"
- (is (= [[]
- #:auto-sim.rc{:capacity 20
- :currently-consuming {}
- :queue []}]
- (dispose-cacheproof
- #:auto-sim.rc{:capacity 20
- :currently-consuming
- {:aa #:auto-sim.rc{:consumed-quantity 13}}
- :queue []}
- :aa))))
- (testing "Dispose an existing event, an operation is pending"
- (is (= [[#:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity 12}]
- #:auto-sim.rc{:capacity 20
- :currently-consuming {}
- :queue []}]
- (dispose-cacheproof
- #:auto-sim.rc{:capacity 20
- :currently-consuming
- {:aa #:auto-sim.rc{:consumed-quantity 13}}
- :queue [#:auto-sim.rc{:seizing-event {:a :b}
- :consumed-quantity
- 12}]}
- :aa)))))
-
-(deftest dispose-seize-test
- (testing "Disposing 1 which is not enough for next event"
- (let [resource (-> #:auto-sim.rc{:capacity 1}
- (sut/seize 1 {:a :b1})
- second
- (sut/seize 2 {:a :b2})
- second
- (sut/seize 3 {:a :b3})
- second)
- consumption-uuid (-> resource
- ::sim-rc/currently-consuming
- ffirst)]
- (is (= [[]
- #:auto-sim.rc{:currently-consuming {}
- :capacity 1
- :queue
- [#:auto-sim.rc{:seizing-event {:a :b2}
- :consumed-quantity 2}
- #:auto-sim.rc{:seizing-event {:a :b3}
- :consumed-quantity 3}]}]
- (dispose-cacheproof resource consumption-uuid)))))
- (testing "There is 1 capacity left, and 1 disposed, which is enough for the next one"
- (let [resource (-> #:auto-sim.rc{:capacity 2}
- (sut/seize 1 {:a :b1})
- second
- (sut/seize 2 {:a :b2})
- second
- (sut/seize 3 {:a :b3})
- second)
- consumption-uuid (-> resource
- ::sim-rc/currently-consuming
- ffirst)]
- (is (= [[#:auto-sim.rc{:seizing-event {:a :b2}
- :consumed-quantity 2}]
- #:auto-sim.rc{:currently-consuming {}
- :capacity 2
- :queue
- [#:auto-sim.rc{:seizing-event {:a :b3}
- :consumed-quantity 3}]}]
- (dispose-cacheproof resource consumption-uuid))))))
-
-(deftest update-capacity-test
- (testing "Empty resource is updated to 7"
- (is (= [[]
- #:auto-sim.rc{:capacity 7
- :queue []}]
- (update-capacity-cacheproof {} 7)
- (update-capacity-cacheproof nil 7)
- (update-capacity-cacheproof #:auto-sim.rc{:capacity 5} 7))))
- (testing "A resource is updated with the `new-capacity`"
- (is (= 14
- (-> #:auto-sim.rc{:capacity 1
- :preemption-policy ::sim-rc/no-preemption}
- (update-capacity-cacheproof 14)
- second
- ::sim-rc/capacity))))
- (testing "Not implemented preemption policy is raising an error, if the capacity is decreased"
- (is (-> #:auto-sim.rc{:capacity 1
- :preemption-policy ::sim-rc/not-existing-policy}
- (update-capacity-cacheproof 12)))
- (is (-> #:auto-sim.rc{:capacity 5
- :preemption-policy ::sim-rc/not-existing-policy}
- (update-capacity-cacheproof 5))))
- (testing "Preemption is defaulted to no-preemption"
- (is (= [[]
- #:auto-sim.rc{:capacity 12
- :queue []}]
- (update-capacity-cacheproof #:auto-sim.rc{:capacity 5} 12)))))
diff --git a/test/cljc/automaton_simulation_de/rc/impl/state_test.cljc b/test/cljc/automaton_simulation_de/rc/impl/state_test.cljc
deleted file mode 100644
index 157729b..0000000
--- a/test/cljc/automaton_simulation_de/rc/impl/state_test.cljc
+++ /dev/null
@@ -1,237 +0,0 @@
-(ns auto-sim.rc.impl.state-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.utils.map :as utils-map]
- [auto-sim.rc :as sim-rc]
- [auto-sim.rc.impl.preemption-policy.factory :as sim-rc-preemption-policy-factory]
- [auto-sim.rc.impl.resource-test :as sim-rc-resource-test]
- [auto-sim.rc.impl.state :as sut]
- [auto-sim.rc.impl.unblocking-policy.factory :as sim-rc-unblocking-policy-factory]
- [auto-sim.simulation-engine :as-alias sim-engine]))
-
-(defn uncache
- "For test purposes, removes the `cache` from the `resource` called `resource-name`."
- [state resource-name]
- (update-in state [::sim-rc/resource resource-name] sim-rc-resource-test/uncache))
-
-(defn uncache-pair
- "For test purposes, in a pair, removes the `cache` from the `resource` called `resource-name`."
- [pair resource-name]
- (update pair 1 uncache resource-name))
-
-(defn add-cache
- [state resource-name]
- (update-in state [::sim-rc/resource resource-name] sim-rc-resource-test/add-cache))
-
-(defn update-resource-capacity-cacheproof
- [state resource-name new-capacity]
- (-> state
- (add-cache resource-name)
- (sut/update-resource-capacity resource-name new-capacity)
- (uncache-pair resource-name)))
-
-(defn dispose-cacheproof
- "For test purposes, add default cache information to the resource `resource-name` and executes `dispose` on it."
- [state resource-name consumption-uuid]
- (-> state
- (add-cache resource-name)
- (sut/dispose resource-name consumption-uuid)
- (uncache-pair resource-name)))
-
-(defn- remove-consumption-uuid
- "To remove randomness and ease testing"
- [state resource-name]
- (let [translation (-> state
- (get-in [::sim-rc/resource resource-name ::sim-rc/currently-consuming])
- utils-map/keys->sequence-number)]
- (-> state
- (update-in [::sim-rc/resource resource-name ::sim-rc/currently-consuming]
- (fn [m] (utils-map/translate-keys m translation))))))
-
-(deftest define-resources-test
- (testing "None resource is ok"
- (is (= #:auto-sim.rc{:resource {}}
- (sut/define-resources {} {} {} {})
- (sut/define-resources {} nil {} {}))))
- (testing "Existing resources are not modified"
- (is (= #:auto-sim.rc{:resource {::test #::sim-rc{:capacity 1}}}
- (sut/define-resources {::sim-rc/resource {::test #:auto-sim.rc{:capacity
- 1}}}
- {}
- {}
- {}))))
- (testing "A resource is updated"
- (is
- (=
- #:auto-sim.rc{:resource
- {::test
- #:auto-sim.rc{:capacity 1
- :name ::test
- :preemption-policy
- ::sim-rc/no-preemption
- :cache
- #:auto-sim.rc{:unblocking-policy-fn
- sim-rc-unblocking-policy-factory/default-policy
- :preemption-policy-fn
- sim-rc-preemption-policy-factory/default-policy}
- :queue []
- :currently-consuming {}
- :unblocking-policy ::sim-rc/FIFO
- :renewable? true}}}
- (sut/define-resources {} {::test #:auto-sim.rc{:capacity 1}} {} {})))))
-
-(deftest update-resource-capacity-test
- (testing "Empty resource is updated"
- (is (= [[]
- #:auto-sim.rc{:resource {::test #::sim-rc{:capacity 12
- :queue []}}}]
- (update-resource-capacity-cacheproof {} ::test 12))))
- (testing "Capacity is updated"
- (is (= [[]
- #:auto-sim.rc{:resource {::test #::sim-rc{:capacity 17
- :queue []}}}]
- (update-resource-capacity-cacheproof
- #:auto-sim.rc{:resource {::test #::sim-rc{:capacity 12}}}
- ::test
- 17)))))
-
-(deftest seize-test
- (testing "Nil event is skipped" (is (= [nil {:foo :bar}] (sut/seize {:foo :bar} ::test 1 nil))))
- (testing "Nil resource name is skipped"
- (is (= [nil {:foo :bar}]
- (sut/seize {:foo :bar}
- nil
- 1
- #:auto-sim.simulation-engine{:type ::a
- :date 4}))))
- (testing "Non existing event name is skipped"
- (is (= [nil {:foo :bar}]
- (sut/seize {:foo :bar}
- ::not-existing-resource
- 1
- #:auto-sim.simulation-engine{:type ::a
- :date 4}))))
- (testing "When capacity is big enough, it is pushed here"
- (is (= {::sim-rc/seizing-event #:auto-sim.simulation-engine{:type ::a
- :date 5}
- ::sim-rc/consumed-quantity 17}
- (let [[consumption-uuid resource]
- (-> #:auto-sim.rc{:resource {::test #::sim-rc{:capacity 20}}}
- (sut/seize ::test
- 17
- #:auto-sim.simulation-engine{:type ::a
- :date 5}))]
- (get-in resource
- [::sim-rc/resource ::test ::sim-rc/currently-consuming consumption-uuid])))))
- (testing
- "Moves the postponed event in the ::currently-seizing - in the case another event is already there"
- (is
- (=
- #:auto-sim.rc{:resource
- {::test
- #:auto-sim.rc{:currently-consuming
- {1
- #:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type
- ::a
- :date
- 5}
- :consumed-quantity
- 9}
- 2
- #:auto-sim.rc{:seizing-event
- #:auto-sim.simulation-engine{:type
- ::b
- :date
- 7}
- :consumed-quantity
- 17}}
- :capacity 30}}}
- (-> #:auto-sim.rc{:resource {::test #::sim-rc{:capacity 30}}}
- (sut/seize ::test
- 9
- #:auto-sim.simulation-engine{:type ::a
- :date 5})
- second
- (sut/seize ::test
- 17
- #:auto-sim.simulation-engine{:type ::b
- :date 7})
- second
- (remove-consumption-uuid ::test))))))
-
-(deftest dispose-capacity-test
- (testing "Disposing unknown resource is working"
- (is
- (= [[]
- {::sim-rc/resource {::a #:auto-sim.rc{:currently-consuming {}
- :queue []}}}]
- (dispose-cacheproof {}
- ::a
- #:auto-sim.simulation-engine{:type :a
- :date 1})
- (dispose-cacheproof {::sim-rc/resource {::a {::sim-rc/currently-consuming {}}}} ::a 666))))
- (testing "Disposing a currently consuming event is removed"
- (is (= [[]
- {::sim-rc/resource {::test #:auto-sim.rc{:currently-consuming {}
- :queue []
- :capacity 30}}}]
- (-> #:auto-sim.rc{:resource {::test #::sim-rc{:capacity 30}}}
- (sut/seize ::test
- 12
- #:auto-sim.simulation-engine{:type :a
- :date 1})
- second
- (remove-consumption-uuid ::test)
- (dispose-cacheproof ::test 1)))))
- (testing "A non existing resource consumption uuid doesn't change currently seizing list"
- (is
- (=
- [[]
- #:auto-sim.rc{:resource
- {::test
- #:auto-sim.rc{:currently-consuming
- {#uuid
- "33497220-f844-11ee-9fa1-17acea14e9df"
- {:a :b}}}}}]
- (->
- #:auto-sim.rc{:resource
- {::test
- #:auto-sim.rc{:currently-consuming
- {#uuid
- "33497220-f844-11ee-9fa1-17acea14e9df"
- {:a :b}}}}}
- (dispose-cacheproof ::test #uuid "33497220-f844-11ee-9fa1-17acea14e9de")))))
- (testing "Disposing known resource is removed from list - case when others are still in the list"
- (is
- (=
- [[#:auto-sim.rc{:seizing-event {:c :b}
- :consumed-quantity 4}]
- #:auto-sim.rc{:resource
- {::test
- #:auto-sim.rc{:currently-consuming
- {2
- #:auto-sim.rc{:seizing-event
- {:b
- :b}
- :consumed-quantity
- 9}}
- :queue
- [#:auto-sim.rc{:seizing-event
- {:d
- :b}
- :consumed-quantity
- 5}]
- :capacity 17}}}]
- (-> #:auto-sim.rc{:resource {::test #::sim-rc{:capacity 17}}}
- (sut/seize ::test 7 {:a :b})
- second
- (sut/seize ::test 9 {:b :b})
- second
- (sut/seize ::test 4 {:c :b})
- second
- (sut/seize ::test 5 {:d :b})
- second
- (remove-consumption-uuid ::test)
- (dispose-cacheproof ::test 1))))))
diff --git a/test/cljc/automaton_simulation_de/rc/impl/unblocking_policy/factory_test.cljc b/test/cljc/automaton_simulation_de/rc/impl/unblocking_policy/factory_test.cljc
deleted file mode 100644
index 84cf263..0000000
--- a/test/cljc/automaton_simulation_de/rc/impl/unblocking_policy/factory_test.cljc
+++ /dev/null
@@ -1,7 +0,0 @@
-(ns auto-sim.rc.impl.unblocking-policy.factory-test
- (:require
- [auto-sim.rc.impl.unblocking-policy.factory :as sut]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])))
-
-(deftest factory-test (testing "nil policy is defaulted" (is (sut/factory {} nil))))
diff --git a/test/cljc/automaton_simulation_de/rc/impl/unblocking_policy/registry_test.cljc b/test/cljc/automaton_simulation_de/rc/impl/unblocking_policy/registry_test.cljc
deleted file mode 100644
index 9d9969b..0000000
--- a/test/cljc/automaton_simulation_de/rc/impl/unblocking_policy/registry_test.cljc
+++ /dev/null
@@ -1,13 +0,0 @@
-(ns auto-sim.rc.impl.unblocking-policy.registry-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.rc.impl.unblocking-policy.registry :as sut]))
-
-(deftest schema-test
- (testing "Validate schema" (is (nil? (core-schema/validate-humanize (sut/schema))))))
-
-(deftest registry-test
- (testing "Validate registry"
- (is (nil? (core-schema/validate-data-humanize (sut/schema) (sut/registry))))))
diff --git a/test/cljc/automaton_simulation_de/rc/preemption_policy_test.cljc b/test/cljc/automaton_simulation_de/rc/preemption_policy_test.cljc
deleted file mode 100644
index 053cb72..0000000
--- a/test/cljc/automaton_simulation_de/rc/preemption_policy_test.cljc
+++ /dev/null
@@ -1,9 +0,0 @@
-(ns auto-sim.rc.preemption-policy-test
- (:require
- [automaton-core.adapters.schema :as core-schema]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [auto-sim.rc.preemption-policy :as sut]))
-
-(deftest schema-test
- (testing "Schema is valid" (is (nil? (core-schema/validate-humanize (sut/schema))))))
diff --git a/test/cljc/automaton_simulation_de/rc/unblocking_policy_test.cljc b/test/cljc/automaton_simulation_de/rc/unblocking_policy_test.cljc
deleted file mode 100644
index 0ff8e51..0000000
--- a/test/cljc/automaton_simulation_de/rc/unblocking_policy_test.cljc
+++ /dev/null
@@ -1,9 +0,0 @@
-(ns auto-sim.rc.unblocking-policy-test
- (:require
- [automaton-core.adapters.schema :as core-schema]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [auto-sim.rc.unblocking-policy :as sut]))
-
-(deftest schema-test
- (testing "Validate schema" (is (nil? (core-schema/validate-humanize (sut/schema))))))
diff --git a/test/cljc/automaton_simulation_de/rc_test.cljc b/test/cljc/automaton_simulation_de/rc_test.cljc
deleted file mode 100644
index 0c222d9..0000000
--- a/test/cljc/automaton_simulation_de/rc_test.cljc
+++ /dev/null
@@ -1,254 +0,0 @@
-(ns auto-sim.rc-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.utils.map :as utils-map]
- [auto-sim.rc :as sut]
- [auto-sim.rc.impl.resource :as sim-de-rc-resource]
- [auto-sim.rc.impl.state-test :as sim-de-rc-state-test]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.event-return :as sim-de-event-return]))
-
-(defn- default-resource-event-return
- ([resource-name] (default-resource-event-return resource-name nil))
- ([resource-name capacity]
- (let [resource (cond-> (sim-de-rc-resource/defaulting-values nil {} {})
- (not (nil? capacity)) (assoc ::sut/capacity capacity))]
- #:auto-sim.simulation-engine{:state {::sut/resource {resource-name resource}}
- :future-events []})))
-
-(defn uncache
- "For test purposes, remove cache values."
- [event-return resource-name]
- (update event-return ::sim-engine/state sim-de-rc-state-test/uncache resource-name))
-
-(defn add-cache
- "For test purposes, adds default cache values."
- [event-return resource-name]
- (update event-return ::sim-engine/state sim-de-rc-state-test/add-cache resource-name))
-
-(defn- resource-update-cacheproof
- [event-return resource-name new-capacity]
- (-> event-return
- (add-cache resource-name)
- (sut/resource-update resource-name new-capacity)
- (uncache resource-name)))
-
-(defn- dispose-cacheproof
- [event-return resource-name current-event]
- (-> event-return
- (add-cache resource-name)
- (sut/dispose resource-name current-event)
- (uncache resource-name)))
-
-(defn- remove-consumption-uuid
- [event-return resource-name]
- (let [translation
- (-> event-return
- (get-in [::sim-engine/state ::sut/resource resource-name ::sut/currently-consuming])
- utils-map/keys->sequence-number)]
- (-> event-return
- (update-in [::sim-engine/state ::sut/resource resource-name ::sut/currently-consuming]
- (fn [m] (utils-map/translate-keys m translation)))
- (update ::sim-engine/future-events
- (fn [future-events]
- (mapv (fn [future-event]
- (update-in future-event
- [::sut/resource resource-name]
- (fn [x] (get translation x x))))
- future-events))))))
-
-(deftest seizing-resource-test
- (testing "Non existing resource"
- (is (= {:a :b} (sut/seize {:a :b} ::test 1 1 {}))
- "Seizing a non existing resource doesn't change the event return"))
- (testing "Unaivalable resource"
- (is
- (= 1
- (-> (-> (default-resource-event-return ::test)
- (sut/seize ::test 2
- 1 #:auto-sim.simulation-engine{:type :a
- :date 1}))
- ::sim-engine/state
- ::sut/resource
- ::test
- ::sut/queue
- count))
- "Seizing an unavailable resource blocks the postponed-event, so it is added in the resource queue")
- (is (= 2
- (-> (default-resource-event-return ::test 0)
- (sim-de-event-return/add-events [#:auto-sim.simulation-engine{:type :a
- :date 1}
- #:auto-sim.simulation-engine{:type :b
- :date
- 2}])
- (sut/seize ::test 1 1 {:a :b})
- ::sim-engine/future-events
- count))
- "Seizing an unavailable resource don't create new future-events"))
- (testing "Available resource"
- (is
- (= 4
- (-> (default-resource-event-return ::test 20)
- (sim-de-event-return/add-events [#:auto-sim.simulation-engine{:type :a
- :date 5}
- #:auto-sim.simulation-engine{:type :b
- :date 2}
- #:auto-sim.simulation-engine{:type :c
- :date 4}])
- (sut/seize ::test 1 1 {:a :b})
- ::sim-engine/future-events
- count))
- "Seizing an available resource launch the event execution, by adding the postponed-event in future-events (and not removing existing ones)")
- (is (-> (default-resource-event-return ::test 10)
- (sut/seize ::test 1
- 1 #:auto-sim.simulation-engine{:type :a
- :date 1})
- ::sim-engine/future-events
- first
- ::sut/resource
- ::test
- uuid?)
- "When seizing an available resource, the future-events is containing the consumption-uuid"))
- (is (= 3
- (-> (sut/seize (-> (default-resource-event-return ::test 0)
- (sim-de-event-return/add-events
- [#:auto-sim.simulation-engine{:type :a
- :date 5}
- #:auto-sim.simulation-engine{:type :c
- :date 2}
- #:auto-sim.simulation-engine{:type :a
- :date 4}]))
- ::test 1
- 1 #:auto-sim.simulation-engine{:type :a
- :date 1})
- ::sim-engine/future-events
- count))
- "Seizing a non available event doesn't generates it, so it creates no new future-event"))
-
-(deftest resource-dispose-test
- (is (= #:auto-sim.simulation-engine{:state nil}
- (sut/dispose {}
- ::a
- #:auto-sim.simulation-engine{:type :a
- :date 1}))
- "Disposing a non existing resource is noop")
- (is
- (=
- #:auto-sim.simulation-engine{:state #::sut{:resource
- {::test #::sut{:currently-consuming {}
- :queue []}}}
- :future-events []}
- (-> #:auto-sim.simulation-engine{:state
- #::sut{:resource
- {::test
- #::sut{:currently-consuming
- {1 #::sut{:seizing-event {:a :b}
- :consumed-quantity 1}}
- :queue []}}}
- :future-events []}
- (dispose-cacheproof ::test {::sut/resource {::test 1}})))
- "Disposing an existing resource, currently consuming is removing it")
- (is
- (=
- #:auto-sim.simulation-engine{:state
- #::sut{:resource
- {::test
- #::sut{:currently-consuming
- {1
- #::sut{:seizing-event
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 2}
- :consumed-quantity 2}}
- :capacity 3
- :preemption-policy
- ::sut/no-preemption
- :renewable? true
- :unblocking-policy ::sut/FIFO
- :queue
- [#::sut{:seizing-event
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 2}
- :consumed-quantity 3}]}}}
- :future-events
- [#:auto-sim.simulation-engine{:type
- :a
- :date 2
- ::sut/resource
- {::test
- 1}}]}
- (let [event-return (-> (default-resource-event-return ::test 3)
- (sut/seize ::test 2
- 2 #:auto-sim.simulation-engine{:type :a
- :date 2})
- (sut/seize ::test 3
- 2 #:auto-sim.simulation-engine{:type :b
- :date 2}))
- a-currently-consuming-event (-> event-return
- ::sim-engine/future-events
- first)]
- (-> event-return
- (remove-consumption-uuid ::test)
- (dispose-cacheproof ::test a-currently-consuming-event))))
- "Disposing a resource with blocked events release them"))
-
-(deftest resource-update-test
- (is (= #:auto-sim.simulation-engine{:state #::sut{:resource {::test
- #::sut{:capacity 7
- :queue []}}}
- :future-events []}
- (resource-update-cacheproof #:auto-sim.simulation-engine{:state {}
- :future-events []}
- ::test
- 7))
- "Non existing resource is created")
- (is (= #:auto-sim.simulation-engine{:state #::sut{:resource {::test
- #::sut{:capacity 7
- :queue []}}}
- :future-events []}
- (-> #:auto-sim.simulation-engine{:state #::sut{:resource
- {::test #::sut{:capacity 5
- :queue []}}}
- :future-events []}
- (resource-update-cacheproof ::test 7)))
- "Existing resource is updated"))
-
-(defn- wo-initial-snapshot [model] (dissoc model ::sim-engine/initial-snapshot))
-
-(defn- resources-kw
- [model]
- (-> model
- (get-in [::sim-engine/initial-snapshot ::sim-engine/state ::sut/resource])
- keys
- set))
-
-(deftest wrap-model-test
- (testing "If no resource is defined, doesn't change the model"
- (is (nil? (sut/wrap-model nil nil nil)))
- (is (nil? (sut/wrap-model nil nil nil))))
- (is (= [{:a :b
- ::sim-engine/model-data {::sut/rc {:ra nil
- :rb {}}}}
- #{:ra :rb}]
- ((juxt wo-initial-snapshot resources-kw)
- (-> {:a :b
- ::sim-engine/model-data {::sut/rc {:ra nil
- :rb {}}}}
- (sut/wrap-model nil nil))))
- "Resources are added")
- (is (= [{:a :b
- ::sim-engine/model-data {::sut/rc {:rc nil
- :rd {}}}}
- #{:ra :rb :rc :rd}]
- ((juxt wo-initial-snapshot resources-kw)
- (-> {:a :b
- ::sim-engine/initial-snapshot {::sim-engine/state {::sut/resource {:ra :ra
- :rb :rb}}}
- ::sim-engine/model-data {::sut/rc {:rc nil
- :rd {}}}}
- (sut/wrap-model nil nil))))
- "Existing data are not overidden"))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/event_execution_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/event_execution_test.cljc
deleted file mode 100644
index 83a98d7..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/event_execution_test.cljc
+++ /dev/null
@@ -1,10 +0,0 @@
-(ns auto-sim.simulation-engine.event-execution-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.event-execution :as sut]))
-
-(deftest schema-test
- (testing "event execution has a valid schema"
- (is (= nil (core-schema/validate-humanize sut/schema)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/event_return_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/event_return_test.cljc
deleted file mode 100644
index a137836..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/event_return_test.cljc
+++ /dev/null
@@ -1,10 +0,0 @@
-(ns auto-sim.simulation-engine.event-return-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.event-return :as sut]))
-
-(deftest schema-test
- (testing "event return has a valid schema"
- (is (= nil (core-schema/validate-humanize sut/schema)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/event_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/event_test.cljc
deleted file mode 100644
index 401b31a..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/event_test.cljc
+++ /dev/null
@@ -1,59 +0,0 @@
-(ns auto-sim.simulation-engine.event-test
- (:require
- [automaton-core.adapters.schema :as core-schema]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.event :as sut]))
-
-(deftest schema-test
- (testing "Test schema of event" (is (= nil (core-schema/validate-humanize sut/schema))))
- (testing "Test valid events"
- (is (= nil
- (core-schema/validate-data-humanize sut/schema
- #:auto-sim.simulation-engine{:type :a
- :date
- 12})))))
-
-(deftest postpone-events-test
- (testing "Empty events are ok" (is (empty? (sut/postpone-events nil nil nil))))
- (testing "Example"
- (is
- (= [#:auto-sim.simulation-engine{:type :a
- :date 1}
- #:auto-sim.simulation-engine{:type :b
- :date 666}
- #:auto-sim.simulation-engine{:type :a
- :date 3}
- #:auto-sim.simulation-engine{:type :c
- :date 666}]
- (sut/postpone-events [#:auto-sim.simulation-engine{:type :a
- :date 1}
- #:auto-sim.simulation-engine{:type :b
- :date 2}
- #:auto-sim.simulation-engine{:type :a
- :date 3}
- #:auto-sim.simulation-engine{:type :c
- :date 10}]
- (comp even? ::sim-engine/date)
- 666))))
- (testing "None updated"
- (is
- (= [#:auto-sim.simulation-engine{:type :a
- :date 1}
- #:auto-sim.simulation-engine{:type :b
- :date 5}
- #:auto-sim.simulation-engine{:type :a
- :date 3}
- #:auto-sim.simulation-engine{:type :c
- :date 11}]
- (sut/postpone-events [#:auto-sim.simulation-engine{:type :a
- :date 1}
- #:auto-sim.simulation-engine{:type :b
- :date 5}
- #:auto-sim.simulation-engine{:type :a
- :date 3}
- #:auto-sim.simulation-engine{:type :c
- :date 11}]
- (comp even? ::sim-engine/date)
- 666)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/causality_broken_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/causality_broken_test.cljc
deleted file mode 100644
index cebc19c..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/causality_broken_test.cljc
+++ /dev/null
@@ -1,39 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.causality-broken-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.built-in-sd.causality-broken :as sut]
- [auto-sim.simulation-engine.impl.stopping.cause
- :as sim-de-stopping-cause]
- [auto-sim.simulation-engine.impl.stopping.definition
- :as sim-de-sc-definition]))
-
-(deftest stopping-definition-test
- (is (= nil
- (->> sut/stopping-definition
- (core-schema/validate-data-humanize sim-de-sc-definition/schema)))))
-
-(def event-stub
- #:auto-sim.simulation-engine{:type :a
- :date 1})
-
-(deftest evaluates-test
- (is (= nil
- (sut/evaluates #:auto-sim.simulation-engine{:date 12}
- #:auto-sim.simulation-engine{:date 12}
- event-stub))
- "Same date snapshot are accepted.")
- (is (= nil
- (sut/evaluates #:auto-sim.simulation-engine{:date 12}
- #:auto-sim.simulation-engine{:date 14}
- event-stub))
- "Greater date snapshot are accepted.")
- (is (= nil
- (->> (sut/evaluates #:auto-sim.simulation-engine{:date 15}
- #:auto-sim.simulation-engine{:date 12}
- event-stub)
- (core-schema/validate-data-humanize sim-de-stopping-cause/schema)))
- "If next snapshot' date is smaller than current one, `causality-broken` criteria is raised."))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/execution_not_found_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/execution_not_found_test.cljc
deleted file mode 100644
index 73fb466..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/execution_not_found_test.cljc
+++ /dev/null
@@ -1,40 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.execution-not-found-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.built-in-sd.execution-not-found :as sut]
- [auto-sim.simulation-engine.impl.stopping.definition
- :as sim-de-sc-definition]
- [auto-sim.simulation-engine.response
- :as sim-de-response]))
-
-(deftest stopping-definition-test
- (is (= nil
- (->> sut/stopping-definition
- (core-schema/validate-data-humanize sim-de-sc-definition/schema)))))
-
-(deftest evaluates-test
- (is
- (=
- nil
- (->>
- (sut/evaluates
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id 1
- :iteration
- 1
- :date
- 1
- :state
- {}
- :past-events
- []
- :future-events
- []}}
- #:auto-sim.simulation-engine{:type :a
- :date 12})
- (core-schema/validate-data-humanize sim-de-response/schema)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/failed_event_execution_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/failed_event_execution_test.cljc
deleted file mode 100644
index 29d6558..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/failed_event_execution_test.cljc
+++ /dev/null
@@ -1,42 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.failed-event-execution-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as
- core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.built-in-sd.failed-event-execution :as sut]
- [auto-sim.simulation-engine.impl.stopping.definition
- :as sim-de-sc-definition]
- [auto-sim.simulation-engine.response
- :as sim-de-response]))
-
-(deftest stopping-definition-test
- (is (= nil
- (->> sut/stopping-definition
- (core-schema/validate-data-humanize sim-de-sc-definition/schema)))))
-
-(deftest stopping-cause-test
- (is
- (=
- nil
- (->>
- (sut/evaluates
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id 1
- :iteration
- 1
- :date
- 1
- :state
- {}
- :past-events
- []
- :future-events
- []}}
- nil
- #:auto-sim.simulation-engine{:type :a
- :date 1})
- (core-schema/validate-data-humanize sim-de-response/schema)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/no_future_events_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/no_future_events_test.cljc
deleted file mode 100644
index 196c9d4..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/no_future_events_test.cljc
+++ /dev/null
@@ -1,54 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.no-future-events-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.built-in-sd.no-future-events :as sut]
- [auto-sim.simulation-engine.impl.stopping.definition
- :as sim-de-sc-definition]
- [auto-sim.simulation-engine.request :as
- sim-de-request]))
-
-(def event-stub
- #:auto-sim.simulation-engine{:type :a
- :date 1})
-
-(deftest stopping-definition-test
- (is (= nil
- (->> sut/stopping-definition
- (core-schema/validate-data-humanize sim-de-sc-definition/schema)))))
-
-(deftest evaluates-test
- (is
- (=
- nil
- (core-schema/validate-data-humanize
- sim-de-request/schema
- (sut/evaluates
- #:auto-sim.simulation-engine{:current-event event-stub
- :event-execution (constantly nil)
- :snapshot
- #:auto-sim.simulation-engine{:id 1
- :iteration
- 1
- :date
- 1
- :state
- {}
- :past-events
- []
- :future-events
- []}
- :sorting (constantly nil)}
- []))))
- (is (= {:request true} (sut/evaluates {:request true} [event-stub]))
- "If `future-event` is not empty, don't return the no-future-events stopping-definition")
- (is (= ::sim-engine/no-future-events
- (-> (sut/evaluates nil [])
- ::sim-engine/stopping-causes
- first
- (get-in
- [::sim-engine/stopping-criteria ::sim-engine/stopping-definition ::sim-engine/id])))
- "If no `future-event` exists, returns the `stopping-cause`."))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/registry_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/registry_test.cljc
deleted file mode 100644
index 37094ee..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/registry_test.cljc
+++ /dev/null
@@ -1,12 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.registry-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.impl.built-in-sd.registry :as sut]))
-
-(deftest build-test
- (is (= nil (core-schema/validate-data-humanize sut/schema (sut/build)))
- "Is registry matching the schema.")
- (is (= (count sut/stopping-definitions) (count (sut/build)))
- "Check that no definition is missing (can disappear if id is not well managed)."))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/request_validation_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/request_validation_test.cljc
deleted file mode 100644
index a6de31f..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/request_validation_test.cljc
+++ /dev/null
@@ -1,14 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.request-validation-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.impl.built-in-sd.request-validation :as sut]
- [auto-sim.simulation-engine.impl.stopping.definition
- :as sim-de-sc-definition]))
-
-(deftest stopping-definition-test
- (is (= nil
- (->> (sut/stopping-definition)
- (core-schema/validate-data-humanize sim-de-sc-definition/schema)))
- "Valid schema."))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/response_validation_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/response_validation_test.cljc
deleted file mode 100644
index 741419a..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/built_in_sd/response_validation_test.cljc
+++ /dev/null
@@ -1,14 +0,0 @@
-(ns auto-sim.simulation-engine.impl.built-in-sd.response-validation-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.impl.built-in-sd.response-validation :as sut]
- [auto-sim.simulation-engine.impl.stopping.definition
- :as sim-de-sc-definition]))
-
-(deftest stopping-definition-test
- (is (= nil
- (->> (sut/stopping-definition)
- (core-schema/validate-data-humanize sim-de-sc-definition/schema)))
- "Is response-schema complies to stopping-definition schema."))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/registry_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/registry_test.cljc
deleted file mode 100644
index a813f19..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/registry_test.cljc
+++ /dev/null
@@ -1,38 +0,0 @@
-(ns auto-sim.simulation-engine.impl.middleware.registry-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.middleware.registry :as sut]
- [auto-sim.simulation-engine.impl.middleware.state-rendering
- :as sim-de-state-rendering]))
-
-(deftest schema-test (is (= nil (core-schema/validate-humanize sut/schema))))
-
-(deftest build-test (testing "Is registry valid?" (is (= nil (sut/validate (sut/build))))))
-
-(deftest data-to-fn-test
- (testing "Non existing keywords returns nil." (is (= nil (sut/data-to-fn (sut/build) :aerz))))
- (testing "Keywords are translated to their matching function in the registry."
- (is (= sim-de-state-rendering/wrap (sut/data-to-fn (sut/build) ::sim-engine/state-rendering))))
- (testing "A vector with no other parameter is transformed to its matching function also."
- (is (= sim-de-state-rendering/wrap
- (sut/data-to-fn (sut/build) [::sim-engine/state-rendering]))))
- (testing "Doesn't modify the `:supp-middlewares-insert` keyword."
- (is (= :supp-middlewares-insert (sut/data-to-fn {} :supp-middlewares-insert))))
- (testing "A vector with a parameter is transformed to a function also."
- (is (= "print-state:,\n"
- (with-out-str (((sut/data-to-fn (sut/build)
- [::sim-engine/state-printing
- (fn [state] ["print-state:" state])])
- (fn [_request] {:bar :foo}))
- {}))))
- (is (= {:bar :foo}
- (((sut/data-to-fn (sut/build) [::sim-engine/state-printing (fn [_state])])
- (fn [_request] {:bar :foo}))
- {}))))
- (testing "Non existing middleware is returning nil"
- (is (= nil
- (sut/data-to-fn {}
- [:foo {}])))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/request_validation_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/request_validation_test.cljc
deleted file mode 100644
index 266ced0..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/request_validation_test.cljc
+++ /dev/null
@@ -1,63 +0,0 @@
-(ns auto-sim.simulation-engine.impl.middleware.request-validation-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.middleware.request-validation :as sut]
- [auto-sim.simulation-engine.impl.stopping.cause
- :as sim-de-stopping-cause]))
-
-(def ^:private event-stub
- #:auto-sim.simulation-engine{:type :a
- :date 1})
-
-(deftest evaluates-test
- (is
- (=
- nil
- (->
- {::sim-engine/current-event event-stub
- ::sim-engine/event-execution (constantly {})
- :auto-sim.simulation-engine/snapshot
- #:auto-sim.simulation-engine{:id 1
- :iteration 1
- :date 1
- :state {}
- :past-events []
- :future-events
- [event-stub
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 2}]}
- ::sim-engine/sorting (constantly nil)
- ::sim-engine/stopping-causes []}
- sut/evaluates))
- "Well form request is not modifying the request.")
- (is (= nil (core-schema/validate-data-humanize sim-de-stopping-cause/schema (sut/evaluates nil))))
- (is
- (=
- nil
- (->
- {::sim-engine/current-event event-stub
- ::sim-engine/event-execution (constantly {})
- :auto-sim.simulation-engine/snapshot
- #:auto-sim.simulation-engine{:id 1
- :iteration 1
- :date 1
- :state {}
- :past-events []
- :future-events
- [event-stub
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 2}]}
- ::sim-engine/sorting (constantly nil)
- ::sim-engine/stopping-causes []}
- sut/evaluates))
- "Well form request is not modifying the request.")
- (is (= nil
- (core-schema/validate-data-humanize sim-de-stopping-cause/schema (sut/evaluates nil)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/response_validation_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/response_validation_test.cljc
deleted file mode 100644
index 309ba54..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/response_validation_test.cljc
+++ /dev/null
@@ -1,77 +0,0 @@
-(ns auto-sim.simulation-engine.impl.middleware.response-validation-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.middleware.response-validation :as sut]
- [auto-sim.simulation-engine.impl.stopping.cause
- :as sim-de-stopping-cause]))
-
-(def event-stub
- #:auto-sim.simulation-engine{:type :a
- :date 1})
-
-(deftest evaluates-test
- (is
- (=
- nil
- (->
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id 1
- :iteration
- 1
- :date
- 1
- :state
- {}
- :past-events
- []
- :future-events
- [event-stub
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 2}]}}
- (sut/evaluates event-stub)))
- "Well form response returns `nil`.")
- (is (= nil
- (core-schema/validate-data-humanize sim-de-stopping-cause/schema
- (sut/evaluates nil event-stub)))
- "When detecting an issue, evaluates returns a map complying to `stopping-cause schema`."))
-
-(deftest wrap-response-test
- (is
- (=
- []
- (->>
- nil
- ((sut/wrap-response
- (fn [_request]
- (->>
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id
- 1
- :iteration
- 1
- :date
- 1
- :state
- {}
- :past-events
- []
- :future-events
- [event-stub
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 2}]}}))))
- ::sim-engine/stopping-causes))
- "Non of response.")
- (is (seq (->> nil
- ((sut/wrap-response (fn [_request] {:foo true})))
- ::sim-engine/stopping-causes))
- "Invalid response is detected."))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/tapping_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/tapping_test.cljc
deleted file mode 100644
index 4f655eb..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/middleware/tapping_test.cljc
+++ /dev/null
@@ -1,20 +0,0 @@
-#_{:heph-ignore {:forbidden-words ["tap>"]}}
-(ns auto-sim.simulation-engine.impl.middleware.tapping-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [auto-sim.simulation-engine.impl.middleware.tapping :as sut]))
-
-(deftest wrap-response-test
- (is (= {:response true}
- (let [what-is-tapped (atom nil)]
- (with-redefs [tap> (fn [tapped-value] (reset! what-is-tapped tapped-value))]
- ((sut/wrap-response (fn [_request] {:response true})) {:request true}))
- @what-is-tapped))))
-
-(deftest wrap-request-test
- (is (= {:request true}
- (let [what-is-tapped (atom nil)]
- (with-redefs [tap> (fn [tapped-value] (reset! what-is-tapped tapped-value))]
- ((sut/wrap-request (fn [_request] {:response true})) {:request true}))
- @what-is-tapped))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/middlewares_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/middlewares_test.cljc
deleted file mode 100644
index e1e298e..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/middlewares_test.cljc
+++ /dev/null
@@ -1,86 +0,0 @@
-(ns auto-sim.simulation-engine.impl.middlewares-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.middlewares :as sut]))
-
-(deftest schema-test (is (= nil (core-schema/validate-humanize sut/schema))))
-
-(def ^:private snapshot-stub
- #:auto-sim.simulation-engine{:id 2
- :iteration 2
- :date 2
- :state nil
- :past-events nil
- :future-events nil})
-
-(def ^:private request-stub
- #:auto-sim.simulation-engine{:current-event nil
- :event-execution nil
- :snapshot snapshot-stub
- :sorting (constantly nil)
- :stopping-causes nil})
-
-(deftest wrap-handler-test
- (testing "Chaining of middleware is ok"
- (is (not ((sut/wrap-handler (fn [request]
- (= {:a :b
- :c :d}
- request))
- [(fn [handler]
- (fn [request]
- (-> request
- (assoc :a :b)
- handler)))
- (fn [handler]
- (fn [request]
- (-> request
- (assoc :c :d)
- handler)))])
- request-stub)))
- (is (not ((sut/wrap-handler (fn [request]
- (= {:a :b
- :c :d}
- request))
- [(fn [handler]
- (fn [request]
- (-> request
- (assoc :c :d)
- handler)))
- (fn [handler]
- (fn [request]
- (-> request
- (assoc :a :b)
- handler)))])
- request-stub))))
- (testing "Middlewares can add data to the response"
- (is (= {:a :b
- :c :d}
- ((sut/wrap-handler (fn [_] {:a :b})
- [(fn [handler]
- (fn [request]
- (-> request
- handler
- (assoc :c :d))))
- (fn [handler]
- (fn [request]
- (-> request
- handler
- (assoc :a :b))))])
- request-stub)))
- (is (= {:a :b
- :c :d}
- ((sut/wrap-handler (fn [_] {:a :b})
- [(fn [handler]
- (fn [request]
- (-> request
- handler
- (assoc :a :b))))
- (fn [handler]
- (fn [request]
- (-> request
- handler
- (assoc :c :d))))])
- request-stub)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/model_data_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/model_data_test.cljc
deleted file mode 100644
index 65f6ce4..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/model_data_test.cljc
+++ /dev/null
@@ -1,82 +0,0 @@
-(ns auto-sim.simulation-engine.impl.model-data-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.model-data :as sut]))
-
-(deftest schema-test
- (testing "Schema are valid."
- (is (= nil (core-schema/validate-humanize sut/middlewares-schema)))
- (is (= nil (core-schema/validate-humanize sut/stopping-criterias-schema)))
- (is (= nil (core-schema/validate-humanize sut/ordering-schema)))
- (is (= nil (core-schema/validate-humanize sut/schema)))))
-
-(deftest middlewares-schema-test
- (testing "Schema is valid." (is (= nil (core-schema/validate-humanize sut/middlewares-schema))))
- (testing "Empty middlewares are ok."
- (is (= nil (core-schema/validate-data-humanize sut/middlewares-schema []))))
- (testing "Keyword middlewares are ok."
- (is (= nil (core-schema/validate-data-humanize sut/middlewares-schema [:foo :bar]))))
- (testing "Vectors of keyword middlewares are ok."
- (is (= nil (core-schema/validate-data-humanize sut/middlewares-schema [[:foo]]))))
- (testing "Vectors of keyword + maps are ok."
- (is (= nil
- (core-schema/validate-data-humanize sut/middlewares-schema
- [[:foo {:bar 1}]]))))
- (testing "Mixed vectors are ok."
- (is (= nil
- (core-schema/validate-data-humanize sut/middlewares-schema
- [[:foo {:bar 1}] :bar [:a]]))))
- (testing "Malformed vectors are ok."
- (is (some? (core-schema/validate-data-humanize sut/middlewares-schema 12))))
- (testing "Middleware that contain fn are ok"
- (is (= nil
- (core-schema/validate-data-humanize
- sut/middlewares-schema
- [[10 :state-printing (fn [handler] (fn [request] (request handler)))]])))))
-
-(deftest stopping-criteria-schema-test
- (testing "Valid stopping criteria."
- (is (= nil (core-schema/validate-data-humanize sut/stopping-criterias-schema [[:foo]])))
- (is (= nil
- (core-schema/validate-data-humanize sut/stopping-criterias-schema
- [[:foo {}]])))
- (is (= nil (core-schema/validate-data-humanize sut/stopping-criterias-schema [])))
- (is
- (=
- ["invalid type"]
- (->
- (core-schema/validate-data-humanize
- sut/stopping-criterias-schema
- #:auto-sim.simulation-engine{:model-end? false
- :params {:whatever "whenever"}
- :stopping-definition
- #:auto-sim.simulation-engine{:doc
- "test"
- :id
- :test-one
- :next-possible?
- false}})
- :error))))
- (deftest ordering-schema-test
- (testing "Invalid ordering are rejected"
- (is (= [[["should be :auto-sim.simulation-engine/field"
- "should be :auto-sim.simulation-engine/type"]
- ["should be a keyword"]]]
- (-> (core-schema/validate-data-humanize sut/ordering-schema
- [[:yop [:machine :product]]])
- :error)))
- (is (= [[["should be :auto-sim.simulation-engine/field"]
- ["should be a keyword" "invalid type"]]]
- (-> (core-schema/validate-data-humanize sut/ordering-schema [[::sim-engine/type 12]])
- :error))))
- (testing "Valid ordering are accepted."
- (is (= nil (core-schema/validate-data-humanize sut/ordering-schema [])))
- (is (= nil
- (core-schema/validate-data-humanize sut/ordering-schema
- [[::sim-engine/type [:machine :product]]])))
- (is (= nil
- (core-schema/validate-data-humanize sut/ordering-schema
- [[::sim-engine/field :machine]]))))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/model_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/model_test.cljc
deleted file mode 100644
index 722df4d..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/model_test.cljc
+++ /dev/null
@@ -1,22 +0,0 @@
-(ns auto-sim.simulation-engine.impl.model-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.model :as sut]
- [auto-sim.simulation-engine.impl.registry :as sim-de-registry]))
-
-(deftest schema-test (is (= nil (core-schema/validate-humanize sut/schema))))
-
-(deftest build-test
- (is (nil? (->> (sut/build #:auto-sim.simulation-engine{} (sim-de-registry/build))
- (core-schema/validate-data-humanize sut/schema)))
- "Minimal model with registry only is valid.")
- (is (nil? (->> (sut/build #:auto-sim.simulation-engine{} (sim-de-registry/build))
- (core-schema/validate-data-humanize sut/schema)))
- "Default registry is valid.")
- (is (->> (sut/build {} [])
- (core-schema/validate-data-humanize sut/schema)
- :error)
- "model-data can't be an empty map, building result is not validated."))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/ordering/registry_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/ordering/registry_test.cljc
deleted file mode 100644
index 4523d3f..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/ordering/registry_test.cljc
+++ /dev/null
@@ -1,12 +0,0 @@
-(ns auto-sim.simulation-engine.impl.ordering.registry-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.impl.ordering.registry :as sut]))
-
-(deftest schema-test (is (= nil (core-schema/validate-humanize sut/schema))))
-
-(deftest registry-test
- (testing "Test built-in registry compliance to schema."
- (is (= nil (core-schema/validate-data-humanize sut/schema (sut/build))))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/registry_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/registry_test.cljc
deleted file mode 100644
index 7fc3f8f..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/registry_test.cljc
+++ /dev/null
@@ -1,14 +0,0 @@
-(ns auto-sim.simulation-engine.impl.registry-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.impl.registry :as sut]))
-
-(deftest schema-test
- (testing "registry is valid regarding the schema."
- (is (= nil (core-schema/validate-humanize sut/schema)))))
-
-(deftest registry-test
- (testing "Default built-in registry is valid."
- (is (= nil (core-schema/validate-data-humanize sut/schema (sut/build))))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/scheduler_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/scheduler_test.cljc
deleted file mode 100644
index 77b4d9f..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/scheduler_test.cljc
+++ /dev/null
@@ -1,282 +0,0 @@
-(ns auto-sim.simulation-engine.impl.scheduler-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.model :as sim-de-model]
- [auto-sim.simulation-engine.impl.registry :as sim-de-registry]
- [auto-sim.simulation-engine.impl.scheduler :as sut]
- [auto-sim.simulation-engine.ordering :as sim-de-ordering]
- [auto-sim.simulation-engine.request :as sim-de-request]))
-
-(defn- first-stopping-definition-id
- [response]
- (-> response
- ::sim-engine/stopping-causes
- first
- ::sim-engine/stopping-criteria
- ::sim-engine/stopping-definition
- ::sim-engine/id))
-
-(defn- snapshot-id
- [response]
- (-> response
- ::sim-engine/snapshot
- ::sim-engine/id))
-
-(defn- snapshot-iteration
- [response]
- (-> response
- ::sim-engine/snapshot
- ::sim-engine/iteration))
-
-(defn- state [response] (get-in response [::sim-engine/snapshot ::sim-engine/state]))
-
-(defn- future-events
- [response]
- (get-in response [::sim-engine/snapshot ::sim-engine/future-events]))
-
-(defn- latest-past-event
- [response]
- (-> response
- (get-in [::sim-engine/snapshot ::sim-engine/past-events])
- last))
-
-(defn- snapshot-date
- [response]
- (-> response
- ::sim-engine/snapshot
- ::sim-engine/date))
-
-(def events-stub
- [#:auto-sim.simulation-engine{:type :a
- :date 13}
- #:auto-sim.simulation-engine{:type :b
- :date 14}
- #:auto-sim.simulation-engine{:type :d
- :date 15}])
-
-(def ^:private snapshot-stub
- #:auto-sim.simulation-engine{:id 2
- :iteration 2
- :date 2
- :state {:foo :bar}
- :past-events []
- :future-events
- [#:auto-sim.simulation-engine{:type :a
- :date
- 30}]})
-
-(def ^:private request-stub
- #:auto-sim.simulation-engine{:current-event nil
- :event-execution nil
- :snapshot snapshot-stub
- :stopping-causes []
- :sorting (sim-de-ordering/sorter
- [(sim-de-ordering/compare-field
- ::sim-engine/date)])})
-
-(deftest handler-test
- (is
- (=
- #:auto-sim.simulation-engine{:stopping-causes
- [#:auto-sim.simulation-engine{:stopping-criteria
- :test-stopping}]
- :snapshot snapshot-stub}
- (-> request-stub
- (assoc ::sim-engine/event-execution (constantly {}))
- (sim-de-request/add-stopping-cause
- #:auto-sim.simulation-engine{:stopping-criteria :test-stopping})
- sut/handler))
- "When a request has raised a `stopping-cause`, it is passed to the response and the `snapshot` is not modified.")
- (is
- (= [::sim-engine/execution-not-found 30 3]
- ((juxt first-stopping-definition-id snapshot-date snapshot-id) (sut/handler request-stub)))
- "If no valid `event-execution` is detected, the `execution-not-found` `stopping-cause` is added, `bucket` is not changed, but iteration is incremented.")
- (testing "For a valid request.\n"
- (is
- (= [2 ::sim-engine/execution-not-found 3]
- ((juxt snapshot-date first-stopping-definition-id snapshot-id)
- (-> request-stub
- (assoc-in [::sim-engine/snapshot ::sim-engine/future-events] [])
- sut/handler)))
- "Empty `future-events` creates a new `snapshot-id`, doesn't change the snapshot date and creates an `execution-not-found` as it is `nil`.")
- (is
- (= [nil
- events-stub
- #:auto-sim.simulation-engine{:type :a
- :date 30}
- {:foo3 :bar3}]
- ((juxt first-stopping-definition-id future-events latest-past-event state)
- (-> request-stub
- (assoc ::sim-engine/event-execution
- (constantly #:auto-sim.simulation-engine{:state {:foo3 :bar3}
- :future-events
- (shuffle events-stub)}))
- sut/handler)))
- "When valid, the first event in the future list is turned into a `past-event`, it creates no `stopping-cause`")
- (is
- (= [::sim-engine/failed-event-execution 3 30 3]
- ((juxt first-stopping-definition-id snapshot-id snapshot-date snapshot-iteration)
- (-> request-stub
- (assoc ::sim-engine/event-execution #(throw (ex-info "Arg" {})))
- sut/handler)))
- "When an `handler` is throwing an exception, it creates a `failed-event-execution` `stopping-cause`, the `event-execution` is skipped, but a new `snapshot` is created, with its incremented iteration number and with bucket of failed event.")
- (is
- (= [::sim-engine/causality-broken events-stub {:foo3 :bar3}]
- ((juxt first-stopping-definition-id future-events state)
- (-> request-stub
- (assoc-in [::sim-engine/snapshot ::sim-engine/date] 100)
- (assoc ::sim-engine/event-execution
- (constantly #:auto-sim.simulation-engine{:state {:foo3 :bar3}
- :future-events
- (shuffle events-stub)}))
- sut/handler)))
- "Snapshot bucket is `100`, but an event happened at `13`, so in the past and causality rule is broken, the `stopping-cause`'s `stopping-criteria` is added. Note `future-events` and `state` are replaced with values returned from event execution.")))
-
-(defn event-registry-stub
- [added-future-events]
- {:a (fn [_ state future-events]
- #:auto-sim.simulation-engine{:state (assoc state :sc :sd)
- :future-events (concat future-events
- added-future-events)})})
-
-(defn registry-stub
- [added-future-events]
- #:auto-sim.simulation-engine{:event (event-registry-stub added-future-events)
- :middleware {}
- :stopping {}
- :ordering {}})
-
-(defn initial-snapshot
- [future-events]
- #:auto-sim.simulation-engine{:id 1
- :date 1
- :iteration 1
- :state {:sa :sb}
- :past-events []
- :future-events future-events})
-
-(deftest scheduler-loop-test
- (is (= [::sim-engine/no-future-events]
- (->> (sut/scheduler-loop nil nil sut/handler nil [])
- ::sim-engine/stopping-causes
- (mapv (comp ::sim-engine/id
- ::sim-engine/stopping-definition
- ::sim-engine/stopping-criteria))))
- "Nil values are ok, it implies no future-event is detected.")
- (is
- (=
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id 2
- :iteration
- 2
- :date 10
- :state
- {:sa :sb
- :sc
- :sd}
- :past-events
- [#:auto-sim.simulation-engine{:type
- :a
- :date
- 10}]
- :future-events
- [#:auto-sim.simulation-engine{:type
- :b
- :date
- 12}
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 13}
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 14}]}}
- (sut/scheduler-loop (event-registry-stub [#:auto-sim.simulation-engine{:type :a
- :date 13}
- #:auto-sim.simulation-engine{:type :b
- :date
- 14}])
- (sim-de-ordering/sorter nil)
- sut/handler
- (initial-snapshot [#:auto-sim.simulation-engine{:type :a
- :date 10}
- #:auto-sim.simulation-engine{:type :b
- :date 12}])
- []))
- "First event is properly executed, state and future events are up to date, iteration, date and id are increased, state updated, first event is gone in the past.")
- (is
- (=
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id 2
- :iteration
- 2
- :date 10
- :state
- {:sa :sb
- :sc
- :sd}
- :past-events
- [#:auto-sim.simulation-engine{:type
- :a
- :date
- 10}]
- :future-events
- []}}
- (sut/scheduler-loop (event-registry-stub [])
- (sim-de-ordering/sorter nil)
- sut/handler
- (initial-snapshot [#:auto-sim.simulation-engine{:type :a
- :date 10}])
- []))
- "The last `event` should be executed properly, it happens when `future-events` has only one event, and none is added by the `event-execution`.")
- (is
- (= [::sim-engine/no-future-events 1 1]
- ((juxt first-stopping-definition-id snapshot-id snapshot-date)
- (sut/scheduler-loop (event-registry-stub [])
- (sim-de-ordering/sorter nil)
- sut/handler
- (initial-snapshot [])
- [])))
- "When `future-events` is empty`, the `no-future-events` `stopping-cause` is added, the same snapshot is returned, without changing anything."))
-
-(deftest scheduler-test
- (is
- (= [1 1 ::sim-engine/no-future-events {:sa :sb}]
- ((juxt snapshot-id snapshot-date first-stopping-definition-id state)
- (sut/scheduler (sim-de-model/build {} (sim-de-registry/build)) [] [] (initial-snapshot []))))
- "Executing no event is ok, it is returning the same snapshot and stops with `no-future-events`.")
- (is
- (= [2
- 4
- ::sim-engine/no-future-events
- {:sa :sb
- :sc :sd}]
- ((juxt snapshot-id snapshot-date first-stopping-definition-id state)
- (sut/scheduler (sim-de-model/build {} (registry-stub []))
- []
- []
- (initial-snapshot [#:auto-sim.simulation-engine{:type :a
- :date 4}]))))
- "Executing one only event is ok, it is creating only one `snapshot`, is at the `bucket` of the executed event and has updated the `state`.")
- (is (= [4
- 50
- ::sim-engine/no-future-events
- {:sa :sb
- :sc :sd}]
- ((juxt snapshot-id snapshot-date first-stopping-definition-id state)
- (sut/scheduler (sim-de-model/build {} (registry-stub []))
- []
- []
- (initial-snapshot [#:auto-sim.simulation-engine{:type :a
- :date 40}
- #:auto-sim.simulation-engine{:type :a
- :date 40}
- #:auto-sim.simulation-engine{:type :a
- :date
- 50}]))))
- "Executing 3 events is ok, it is creating 3 snapshots."))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping/cause_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping/cause_test.cljc
deleted file mode 100644
index 887dc54..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping/cause_test.cljc
+++ /dev/null
@@ -1,43 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping.cause-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as
- core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.stopping-definition.iteration-nth
- :as sim-de-sc-iteration-nth]
- [auto-sim.simulation-engine.impl.stopping.cause :as sut]))
-
-(deftest schema-test
- (is (= nil
- (-> sut/schema
- core-schema/validate-humanize)))
- (is
- (=
- nil
- (->
- sut/schema
- (core-schema/validate-data-humanize
- #:auto-sim.simulation-engine{:stopping-criteria
- #:auto-sim.simulation-engine{:params
- {:par1
- :a}
- :model-end?
- true
- :stopping-definition
- #:auto-sim.simulation-engine{:id
- ::sim-engine/iteration-nth
- :doc
- "doc-test"
- :next-possible?
- true
- :stopping-evaluation
- sim-de-sc-iteration-nth/stop-nth}}
- :current-event
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 1}
- :context {}})))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping/criteria_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping/criteria_test.cljc
deleted file mode 100644
index 0a71718..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping/criteria_test.cljc
+++ /dev/null
@@ -1,57 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping.criteria-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.stopping-definition.now :as sim-de-sc-now]
- [auto-sim.simulation-engine.impl.stopping.criteria :as sut]))
-
-(deftest schema-test (is (nil? (core-schema/validate-humanize sut/schema))))
-
-(deftest evaluates-test
- (is (= nil (sut/evaluates nil nil)) "Invalid stopping-definition is skipped")
- (is
- (some?
- (->
- #:auto-sim.simulation-engine{:params {:par1 :a}
- :stopping-definition
- #:auto-sim.simulation-engine{:id
- ::sim-engine/stop-now
- :built-in?
- true
- :next-possible?
- true
- :doc
- "doc-test"
- :stopping-evaluation
- sim-de-sc-now/stop-now}}
- (sut/evaluates #:auto-sim.simulation-engine{:id 1
- :iteration 1
- :date 1
- :state {}
- :past-events []
- :future-events []})
- ::sim-engine/stopping-criteria))
- "Stopping criteria `stop-now` returns a stopping criteria"))
-
-(deftest out-of-model-test
- (is (= #:auto-sim.simulation-engine{:model-end? false} (sut/out-of-model nil)))
- (is (= #:auto-sim.simulation-engine{:model-end? true} (sut/model-end nil))))
-
-(deftest api-data-to-entity-test
- (testing "Wrong type is skipped."
- (is (nil? (sut/api-data-to-entity nil {})))
- (is (nil? (sut/api-data-to-entity nil [:bad 1 {:foo :bar}]))))
- (testing "Non existing keywords in the registry returns nil."
- (is (nil? (sut/api-data-to-entity {} :a)))
- (is (nil? (sut/api-data-to-entity {} [:a]))))
- (is (= #:auto-sim.simulation-engine{:params {}
- :stopping-definition {:definition :stub}}
- (sut/api-data-to-entity {:good {:definition :stub}} :good))
- "Keyword is understood as a stopping-criteria with no params.")
- (is (= #:auto-sim.simulation-engine{:params {:foo :bar}
- :stopping-definition {:definition :stub}}
- (sut/api-data-to-entity {:good {:definition :stub}}
- [:good {:foo :bar}]))
- "A vector of keyword and map is turned into a stopping-criteria"))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping/definition_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping/definition_test.cljc
deleted file mode 100644
index 0e28b65..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping/definition_test.cljc
+++ /dev/null
@@ -1,26 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping.definition-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.stopping.definition :as sut]))
-
-(deftest id-schema-test (is (= nil (core-schema/validate-humanize sut/id-schema))))
-
-(deftest schema-test
- (testing "`stopping-evaluation` are optional."
- (is (= nil
- (core-schema/validate-data-humanize
- sut/schema
- #:auto-sim.simulation-engine{:doc ""
- :id :foo
- :next-possible? true})))
- (is (= nil
- (core-schema/validate-data-humanize
- sut/schema
- #:auto-sim.simulation-engine{:doc ""
- :id :foo
- :stopping-evaluation (constantly true)
- :next-possible? true}))))
- (is (= nil (core-schema/validate-humanize sut/schema))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/bucket_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/bucket_test.cljc
deleted file mode 100644
index 93dfd03..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/bucket_test.cljc
+++ /dev/null
@@ -1,19 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping-definition.bucket-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.stopping-definition.bucket :as sut]
- [auto-sim.simulation-engine.impl.stopping.definition
- :as sim-de-sc-definition]))
-
-(deftest stop-bucket-test
- (is (= #:auto-sim.simulation-engine{:stop? true
- :context nil}
- (sut/stop-bucket nil nil))))
-
-(deftest stopping-definition-test
- (is (= nil
- (->> (sut/stopping-definition)
- (core-schema/validate-data-humanize sim-de-sc-definition/schema)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/iteration_nth_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/iteration_nth_test.cljc
deleted file mode 100644
index 56c82ef..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/iteration_nth_test.cljc
+++ /dev/null
@@ -1,33 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping-definition.iteration-nth-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as
- core-schema]
- [auto-sim.simulation-engine :as-alias
- sim-engine]
- [auto-sim.simulation-engine.impl.stopping-definition.iteration-nth :as sut]
- [auto-sim.simulation-engine.impl.stopping.definition
- :as sim-de-sc-definition]))
-
-(deftest stop-nth-test
- (testing "Stops when the iteration number of the snpahost is greater or equal to the parameter."
- (is (sut/stop-nth #:auto-sim.simulation-engine{:iteration 12}
- #:auto-sim.simulation-engine{:n 10}))
- (is (sut/stop-nth #:auto-sim.simulation-engine{:iteration 12}
- #:auto-sim.simulation-engine{:n 12})))
- (testing
- "Doesn't stop when the iteration number of the snpahost is greater or equal to the parameter."
- (is (not (:stop? (sut/stop-nth #:auto-sim.simulation-engine{:iteration 2}
- #:auto-sim.simulation-engine{:n 10})))))
- (testing "Snapshot with no iteration number is default to 0"
- (is (not (:stop? (sut/stop-nth {} #:auto-sim.simulation-engine{:n 12}))))
- (is (:auto-sim.simulation-engine/stop?
- (sut/stop-nth {} #:auto-sim.simulation-engine{:n 0})))
- (testing "No parameter is defaulted to `-1`, stopping whatever is happening."
- (is (sut/stop-nth {} {})))))
-
-(deftest stopping-definition-test
- (is (= nil
- (->> (sut/stopping-definition)
- (core-schema/validate-data-humanize sim-de-sc-definition/schema)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/now_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/now_test.cljc
deleted file mode 100644
index ccbd2d4..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/now_test.cljc
+++ /dev/null
@@ -1,19 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping-definition.now-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.impl.stopping-definition.now :as sut]
- [auto-sim.simulation-engine.impl.stopping.definition :as
- sim-de-sc-definition]))
-
-(deftest stop-now-test
- (is (= #:auto-sim.simulation-engine{:stop? true
- :context nil}
- (sut/stop-now nil nil))))
-
-(deftest stopping-definition-test
- (is (= nil
- (->> (sut/stopping-definition)
- (core-schema/validate-data-humanize sim-de-sc-definition/schema)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/registry_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/registry_test.cljc
deleted file mode 100644
index dfa2702..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/impl/stopping_definition/registry_test.cljc
+++ /dev/null
@@ -1,12 +0,0 @@
-(ns auto-sim.simulation-engine.impl.stopping-definition.registry-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.impl.stopping-definition.registry :as sut]))
-
-(deftest schema-test (is (= nil (core-schema/validate-humanize sut/schema))))
-
-(deftest build-test
- (testing "Default built-in registry is valid."
- (is (= nil (core-schema/validate-data-humanize sut/schema (sut/build))))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/middleware_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/middleware_test.cljc
deleted file mode 100644
index 9f6f52e..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/middleware_test.cljc
+++ /dev/null
@@ -1,11 +0,0 @@
-(ns auto-sim.simulation-engine.middleware-test
- (:require
- [automaton-core.adapters.schema :as core-schema]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [auto-sim.simulation-engine.middleware :as sut]))
-
-(deftest id-schema-test (is (= nil (core-schema/validate-humanize sut/id-schema))))
-
-(deftest schema-test
- (testing "Valid schema?" (is (= nil (core-schema/validate-humanize sut/schema)))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/ordering_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/ordering_test.cljc
deleted file mode 100644
index f520978..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/ordering_test.cljc
+++ /dev/null
@@ -1,100 +0,0 @@
-(ns auto-sim.simulation-engine.ordering-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.ordering :as sut]))
-
-(deftest schema-test (is (= nil (core-schema/validate-humanize sut/schema))))
-
-(deftest compare-field-test
- (testing "Test ordering with integer."
- (is (neg? (apply (sut/compare-field ::sim-engine/date)
- [#:auto-sim.simulation-engine{:type :a
- :date 1}
- #:auto-sim.simulation-engine{:type :a
- :date 2}])))
- (is (neg? (apply (sut/compare-field ::sim-engine/date)
- [#:auto-sim.simulation-engine{:type :a
- :date 1}
- #:auto-sim.simulation-engine{:type :a
- :date 10}])))
- (is (pos? (apply (sut/compare-field ::sim-engine/date)
- [#:auto-sim.simulation-engine{:type :a
- :date 10}
- #:auto-sim.simulation-engine{:type :a
- :date 1}])))
- (is (zero? (apply (sut/compare-field ::sim-engine/date)
- [#:auto-sim.simulation-engine{:type :a
- :date 1}
- #:auto-sim.simulation-engine{:type :a
- :date 1}]))))
- (testing "Nil values are pushed to the end."
- (is (neg? ((sut/compare-field ::sim-engine/date)
- #:auto-sim.simulation-engine{:type :a
- :date 1}
- nil)))
- (is (pos? ((sut/compare-field ::sim-engine/date)
- nil
- #:auto-sim.simulation-engine{:type :a
- :date 1})))))
-
-(deftest compare-types-test
- (testing "Found values."
- (is (neg? (apply (sut/compare-types [:a :b :c])
- [#:auto-sim.simulation-engine{:type :a
- :date 0}
- #:auto-sim.simulation-engine{:type :b
- :date 0}])))
- (is (neg? (apply (sut/compare-types [:a :b :c])
- [#:auto-sim.simulation-engine{:type :a
- :date 0}
- #:auto-sim.simulation-engine{:type :c
- :date 0}])))
- (is (pos? (apply (sut/compare-types [:a :b :c])
- [#:auto-sim.simulation-engine{:type :c
- :date 0}
- #:auto-sim.simulation-engine{:type :a
- :date 0}])))
- (is (pos? (apply (sut/compare-types [:a :b :c])
- [#:auto-sim.simulation-engine{:type :b
- :date 0}
- #:auto-sim.simulation-engine{:type :a
- :date 0}]))))
- (testing "Nil values are pushed to the end."
- (is (neg? ((sut/compare-types [:a :b :c])
- #:auto-sim.simulation-engine{:type :a
- :date 1}
- nil)))
- (is (pos? ((sut/compare-types [:a :b :c])
- nil
- #:auto-sim.simulation-engine{:type :a
- :date 1})))))
-
-(deftest sorter-test
- (testing "Are dates sorted."
- (is (= [:a :b]
- (->> ((sut/sorter [(sut/compare-types [:a :b :c])])
- [#:auto-sim.simulation-engine{:type :a
- :date 1}
- #:auto-sim.simulation-engine{:type :b
- :date 2}])
- (mapv ::sim-engine/type))))
- (is (= [:a :b]
- (->> ((sut/sorter [(sut/compare-types [:a :b :c])])
- [#:auto-sim.simulation-engine{:type :b
- :date 2}
- #:auto-sim.simulation-engine{:type :a
- :date 1}])
- (mapv ::sim-engine/type))))))
-
-(deftest data-to-fn-test
- (is (= nil (sut/data-to-fn [:non-existing-one])) "Invalid ordering returns `nil`.")
- (is (= 666
- ((sut/data-to-fn [::sim-engine/field ::sim-engine/product])
- #:auto-sim.simulation-engine{:type :product
- :date 0}
- #:auto-sim.simulation-engine{:type :product
- :date 1}))
- "Valid ordering works."))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/orderings_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/orderings_test.cljc
deleted file mode 100644
index 6dbd2a1..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/orderings_test.cljc
+++ /dev/null
@@ -1,8 +0,0 @@
-(ns auto-sim.simulation-engine.orderings-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine.orderings :as sut]))
-
-(deftest schema-test (is (= nil (core-schema/validate-humanize sut/schema))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/request_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/request_test.cljc
deleted file mode 100644
index 60b3629..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/request_test.cljc
+++ /dev/null
@@ -1,23 +0,0 @@
-(ns auto-sim.simulation-engine.request-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.request :as sut]))
-
-(deftest schema-test
- (testing "Test the schema" (is (= nil (core-schema/validate-humanize sut/schema)))))
-
-(deftest add-stopping-cause-test
- (is
- (=
- #:auto-sim.simulation-engine{:request true
- :stopping-causes
- [#:auto-sim.simulation-engine{:stopping-cause
- true}]}
- (sut/add-stopping-cause #:auto-sim.simulation-engine{:request true}
- #:auto-sim.simulation-engine{:stopping-cause true}))
- "Adding a `stopping-cause` returns the request.")
- (is (= {:request true} (sut/add-stopping-cause {:request true} nil))
- "Adding a `stopping-cause` returns the request."))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/response_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/response_test.cljc
deleted file mode 100644
index 7249488..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/response_test.cljc
+++ /dev/null
@@ -1,157 +0,0 @@
-(ns auto-sim.simulation-engine.response-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.response :as sut]))
-
-(def event-stub
- #:auto-sim.simulation-engine{:type :a
- :date 1})
-
-(deftest schema-test (is (= nil (core-schema/validate-humanize sut/schema)) "Test schema"))
-
-(deftest build-test
- (is
- (=
- nil
- (->>
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id 1
- :iteration
- 1
- :date
- 1
- :state
- {}
- :past-events
- []
- :future-events
- [event-stub]}}
- (core-schema/validate-data-humanize (core-schema/close-map-schema sut/schema))))
- "Build response complies the schema."))
-
-(deftest add-stopping-cause-test
- (is (= #:auto-sim.simulation-engine{:stopping-causes [{:a :b}]}
- (sut/add-stopping-cause {::sim-engine/stopping-causes []} {:a :b}))))
-
-(defn- get-first-stopping-definition
- [response]
- (->> response
- ::sim-engine/stopping-causes
- first
- ::sim-engine/stopping-criteria
- ::sim-engine/stopping-definition
- ::sim-engine/id))
-
-(defn- get-date
- [response]
- (->> response
- ::sim-engine/snapshot
- ::sim-engine/date))
-
-(deftest consume-first-event-test
- (is
- (=
- #:auto-sim.simulation-engine{:id 4
- :iteration 4
- :date 10
- :state {}
- :past-events []
- :future-events []}
- (->
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id 3
- :iteration
- 3
- :date
- 10
- :state
- {}
- :past-events
- []
- :future-events
- []}}
- (sut/consume-first-event event-stub)
- ::sim-engine/snapshot))
- "No future events implies no modification of date, but the incrementation of iteration and id.")
- (is
- (=
- [::sim-engine/causality-broken 10]
- (->
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id 3
- :iteration
- 3
- :date
- 10
- :state
- {}
- :past-events
- []
- :future-events
- [event-stub]}}
- (sut/consume-first-event event-stub)
- ((juxt get-first-stopping-definition get-date))))
- "If the future event is happening in the past, then it breaks causality, the `date` is unchanged.")
- (is
- (empty?
- (->
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id 3
- :iteration
- 3
- :date
- 1
- :state
- {}
- :past-events
- []
- :future-events
- [event-stub]}}
- (sut/consume-first-event event-stub)
- ::sim-engine/stopping-causes))
- "A future event at the same date than the current snapshot is not creating causality issue.")
- (is
- (empty?
- (->
- #:auto-sim.simulation-engine{:stopping-causes []
- :snapshot
- #:auto-sim.simulation-engine{:id 3
- :iteration
- 3
- :date
- 0
- :state
- {}
- :past-events
- []
- :future-events
- [event-stub]}}
- (sut/consume-first-event event-stub)
- ::sim-engine/stopping-causes))
- "A future event later than the current snapshot is not creating causality issue."))
-
-(deftest add-current-event-to-stopping-causes-test
- (is
- (=
- #:auto-sim.simulation-engine{:stopping-causes
- [#:auto-sim.simulation-engine{:a :b
- :current-event
- event-stub}
- #:auto-sim.simulation-engine{:c :d
- :current-event
- event-stub}]
- :snapshot nil}
- (sut/add-current-event-to-stopping-causes
- #:auto-sim.simulation-engine{:stopping-causes
- [#:auto-sim.simulation-engine{:a :b}
- #:auto-sim.simulation-engine{:c
- :d}]
- :snapshot nil}
- event-stub))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine/snapshot_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine/snapshot_test.cljc
deleted file mode 100644
index 66816ea..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine/snapshot_test.cljc
+++ /dev/null
@@ -1,216 +0,0 @@
-(ns auto-sim.simulation-engine.snapshot-test
- (:require
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [automaton-core.adapters.schema :as core-schema]
- [auto-sim.simulation-engine :as-alias sim-engine]
- [auto-sim.simulation-engine.snapshot :as sut]))
-
-(deftest schema-test
- (testing "Testing schema validity" (is (= nil (core-schema/validate-humanize sut/schema))))
- (testing "Test an example of iteration"
- (is (= nil
- (core-schema/validate-data-humanize
- sut/schema
- #:auto-sim.simulation-engine{:id 10
- :iteration 10
- :date 12
- :state {}
- :past-events []
- :future-events []})))))
-
-(deftest consume-first-event-test
- (testing "Nullable values"
- (is (= #:auto-sim.simulation-engine{:id 1
- :iteration nil
- :date nil
- :state nil
- :past-events []
- :future-events []}
- (sut/consume-first-event nil))))
- (testing
- "As expected, current event is first future, new future head is dropped, snapshot and id, date is the next current date"
- (is
- (=
- #:auto-sim.simulation-engine{:id 2
- :iteration 2
- :date 7
- :state {:foo :bar}
- :past-events
- [#:auto-sim.simulation-engine{:type
- :a
- :date
- 1}
- #:auto-sim.simulation-engine{:type
- :c
- :date
- 7}]
- :future-events
- [#:auto-sim.simulation-engine{:type
- :b
- :date
- 12}]}
- (sut/consume-first-event
- #:auto-sim.simulation-engine{:id 1
- :iteration 2
- :date 3
- :state {:foo :bar}
- :past-events
- [#:auto-sim.simulation-engine{:type
- :a
- :date
- 1}]
- :future-events
- [#:auto-sim.simulation-engine{:type
- :c
- :date
- 7}
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 12}]}))))
- (testing "nil current-event is ok"
- (is
- (=
- #:auto-sim.simulation-engine{:id 2
- :iteration 2
- :date 3
- :state {:foo :bar}
- :past-events
- [#:auto-sim.simulation-engine{:type
- :a
- :date
- 1}]
- :future-events []}
- (sut/consume-first-event
- #:auto-sim.simulation-engine{:id 1
- :iteration 2
- :date 3
- :state {:foo :bar}
- :past-events
- [#:auto-sim.simulation-engine{:type
- :a
- :date
- 1}]
- :future-events nil}))))
- (testing "Useless data in snapshot are forgot"
- (is
- (=
- #:auto-sim.simulation-engine{:id 2
- :iteration 2
- :date 7
- :state {:foo :bar}
- :past-events
- [#:auto-sim.simulation-engine{:type
- :a
- :date
- 1}
- #:auto-sim.simulation-engine{:type
- :c
- :date
- 7}]
- :future-events
- [#:auto-sim.simulation-engine{:type
- :b
- :date
- 12}]}
- (->
- #:auto-sim.simulation-engine{:id 1
- :iteration 2
- :date 3
- :state {:foo :bar}
- :past-events
- [#:auto-sim.simulation-engine{:type
- :a
- :date
- 1}]
- :future-events
- [#:auto-sim.simulation-engine{:type
- :c
- :date
- 7}
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 12}]}
- (assoc :will :disappear)
- sut/consume-first-event)))))
-
-(deftest inconsistency?-test
- (testing "Empty past and future are consistent"
- (is (false? (sut/inconsistency? #:auto-sim.simulation-engine{:date 2
- :future-events []
- :past-events []}))))
- (testing "Past events before 5, snapshot at 5, and future after 5 are seen as consistent"
- (is
- (false?
- (sut/inconsistency?
- #:auto-sim.simulation-engine{:date 5
- :future-events
- [#:auto-sim.simulation-engine{:type
- :b
- :date
- 20}
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 7}
- #:auto-sim.simulation-engine{:type
- :b
- :date
- 5}]
- :past-events
- [#:auto-sim.simulation-engine{:type
- :b
- :date
- 4}
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 5}]}))))
- (testing "Too early future events are returned as inconsistency"
- (is
- (=
- {:snapshot-date 2
- :mismatching-events
- #:auto-sim.simulation-engine{:future-events
- [#:auto-sim.simulation-engine{:type
- :a
- :date
- 1}]
- :past-events []}}
- (sut/inconsistency?
- #:auto-sim.simulation-engine{:date 2
- :future-events
- [#:auto-sim.simulation-engine{:type
- :b
- :date
- 20}
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 1}]
- ::sut/past-events []}))))
- (testing "Too late past events are returned as inconsistency"
- (is
- (=
- {:snapshot-date 2
- :mismatching-events
- #:auto-sim.simulation-engine{:past-events
- [#:auto-sim.simulation-engine{:type
- :b
- :date
- 20}]
- :future-events []}}
- (sut/inconsistency?
- #:auto-sim.simulation-engine{:date 2
- :future-events []
- :past-events
- [#:auto-sim.simulation-engine{:type
- :b
- :date
- 20}
- #:auto-sim.simulation-engine{:type
- :a
- :date
- 1}]})))))
diff --git a/test/cljc/automaton_simulation_de/simulation_engine_test.cljc b/test/cljc/automaton_simulation_de/simulation_engine_test.cljc
deleted file mode 100644
index a8e9e4a..0000000
--- a/test/cljc/automaton_simulation_de/simulation_engine_test.cljc
+++ /dev/null
@@ -1,123 +0,0 @@
-(ns auto-sim.simulation-engine-test
- (:require
- #?(:clj [clojure.test :refer [deftest is]]
- :cljs [cljs.test :refer [deftest is] :include-macros true])
- [auto-sim.simulation-engine :as sut]))
-
-(def model-data-stub-1
- #::sut{:ordering [[::sut/field ::sut/date]]
- :future-events []
- :stopping-criterias [[::sut/iteration-nth {::sut/n 100}]]})
-
-(deftest registries-test
- (is (= nil
- (-> (sut/registries)
- sut/validate-registry))
- "built-in registries are valid."))
-
-(deftest validate-model-data-test
- (is (= nil (sut/validate-model-data model-data-stub-1)) "Valid model data are accepted")
- (is (some? (sut/validate-model-data (assoc model-data-stub-1 ::sut/future-events 2)))
- "Invalid model data are not accepted"))
-
-(deftest build-model-test
- (is (->> [(sut/build-model nil nil)]
- (mapv sut/validate-model)
- (every? map?))
- "Invalid models are detected")
- (is (empty? (->> [(sut/build-model model-data-stub-1 (sut/registries))]
- (map sut/validate-model)
- (filter some?)))
- "Models build with `build-model` are accepted"))
-
-(deftest validate-middleware-data-test
- (is (= nil (sut/validate-middleware-data [] {})) "No middleware is accepted.")
- (is (= nil
- (sut/validate-middleware-data [:supp-middlewares-insert [:state-printing (constantly nil)]]
- {}))
- ":supp-middleware-insert is accepted, and also state-printing.")
- (is (map? (sut/validate-middleware-data :int {})) "Non vector middlewares are detected.")
- (is (map? (sut/validate-middleware-data [10 :state-printing (constantly nil)] {}))
- "Vector with invalid middlewares are detected."))
-
-(deftest validate-stopping-criteria-data-test
- (is (some? (sut/validate-stopping-criteria-data 12 {}))
- "Stopping criteria which is not a vector is invalid.")
- (is (some? (sut/validate-stopping-criteria-data [12] {}))
- "Stopping criteria which is a vector of invalid data is invalid.")
- (is (= nil (sut/validate-stopping-criteria-data [] {})) "No stopping criteria is possible.")
- (is (= nil (sut/validate-stopping-criteria-data [:yop] {}))
- "A valid name of a stopping criteria is accepted."))
-
-(deftest extract-snapshot-test
- (is (= nil (sut/extract-snapshot (sut/build-model model-data-stub-1 sut/registries)))
- "The result of a scheduler can be extracted to generate the next scheduler call."))
-
-(defn- extract-stopping-causes
- [response]
- (->> response
- ::sut/stopping-causes
- (mapv #(get-in % [::sut/stopping-criteria ::sut/stopping-definition ::sut/id]))
- sort
- vec))
-
-(defn- extract-snapshot-id [response] (get-in response [::sut/snapshot ::sut/id]))
-
-(defn- extract-snapshot-date [response] (get-in response [::sut/snapshot ::sut/date]))
-
-(def causes-and-snapshot-id-date-and-validation
- (juxt extract-stopping-causes extract-snapshot-id extract-snapshot-date sut/validate-response))
-
-(deftest assembly-test
- (is
- (= [[::sut/iteration-nth] 1 0 nil]
- (-> (sut/build-model (assoc model-data-stub-1
- ::sut/future-events
- [#::sut{:type :a
- :date 10}]))
- (sut/scheduler [::sut/response-validation :request-validation]
- [[::sut/iteration-nth {::sut/n 0}]])
- causes-and-snapshot-id-date-and-validation))
- "A valid model stopped at first iteration is returning one stopping cause only about `::sut/iteration-nth`, and returns the same snapshot with `id` 1 and `date` 0`")
- (is
- (= [[::sut/no-future-events] 1 0 nil]
- (-> (sut/build-model model-data-stub-1 (sut/registries))
- (sut/scheduler [::sut/response-validation :request-validation] [])
- causes-and-snapshot-id-date-and-validation))
- "When the first executed event creates no future event, then simulation stops at the second iteration with ::sim-engine/no-future-events.")
- (is (= [[::sut/iteration-nth ::sut/iteration-nth ::sut/no-future-events] 1 0 nil]
- (-> (sut/build-model model-data-stub-1 (sut/registries))
- (sut/scheduler [::sut/response-validation :request-validation]
- [[::sut/iteration-nth {::sut/n 1}] [::sut/iteration-nth {::sut/n 1}]])
- causes-and-snapshot-id-date-and-validation))
- "When more than one stopping-criteria exists, they are all returned.")
- (is (= [[::sut/iteration-nth] 1 0 nil]
- (-> (sut/build-model (update model-data-stub-1
- ::sut/future-events
- conj
- {::sut/type :non-existing
- ::sut/date 0}))
- (sut/scheduler [::sut/response-validation :request-validation]
- [[::sut/iteration-nth {::sut/n 0}]])
- causes-and-snapshot-id-date-and-validation))
- "If a non existing event is returned, but not executed yet, everything's fine.")
- (is (= [[::sut/execution-not-found] 2 0 nil]
- (-> (sut/build-model (update model-data-stub-1
- ::sut/future-events
- conj
- {::sut/type :non-existing
- ::sut/date 0}))
- (sut/scheduler [::sut/response-validation :request-validation]
- [[::sut/iteration-nth {::sut/n 3}]])
- causes-and-snapshot-id-date-and-validation))
- "A non existing event trying to be executed is failing.")
- (is (= [[::sut/execution-not-found] 2 0 nil]
- (-> (sut/build-model (update model-data-stub-1
- ::sut/future-events
- conj
- {::sut/type :non-existing
- ::sut/date 0}))
- (sut/scheduler [::sut/response-validation :request-validation]
- [[::sut/iteration-nth {::sut/n 3}]])
- causes-and-snapshot-id-date-and-validation))
- "When executed, the date of an event advances the snapshot date."))
diff --git a/test/cljc/automaton_simulation_de/transformation_test.cljc b/test/cljc/automaton_simulation_de/transformation_test.cljc
deleted file mode 100644
index 7df1aa6..0000000
--- a/test/cljc/automaton_simulation_de/transformation_test.cljc
+++ /dev/null
@@ -1,820 +0,0 @@
-(ns auto-sim.transformation-test
- (:require
- [auto-sim.entity :as sim-entity]
- [auto-sim.predicates :as sim-pred]
- [auto-sim.rc :as-alias sim-rc]
- [auto-sim.simulation-engine :as-alias sim-engine]
- #?(:clj [clojure.test :refer [deftest is testing]]
- :cljs [cljs.test :refer [deftest is testing] :include-macros true])
- [auto-sim.transformation :as sut]))
-
-(deftest snapshot-use-cases
- (testing "state filtering"
- (is (= {:m1 {:id :m1}}
- (-> [::sim-pred/equal? :id :m1]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-state {:m1 {:id :m1}
- :m2 {:id :m2}
- :m3 {:id :m3}
- :m4 {:id :m4}})))
- "state contains only :m1")
- (is (= {:m2 {:id :m2
- :processing :p1}
- :m4 {:id :m4
- :processing :p2}}
- (-> [::sim-pred/one-of? :processing [:p1 :p2]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-state {:m1 {:id :m1
- :processing :p3}
- :m2 {:id :m2
- :processing :p1}
- :m3 {:id :m3}
- :m4 {:id :m4
- :processing :p2}})))
- "state contains only machines having :p1 or :p2 under :processing")
- (is (= {:m2 {:id :m2
- :name "MX5009"}
- :m3 {:id :m3
- :name "MX-TURBO-5892"}}
- (-> [::sim-pred/starts-with? :name "MX"]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-state {:m1 {:id :m1
- :name "BR500"}
- :m2 {:id :m2
- :name "MX5009"}
- :m3 {:id :m3
- :name "MX-TURBO-5892"}
- :m4 {:id :m4
- :name "MA4"
- :processing :p2}})))
- "state contains only machines starting with name MX"))
- (testing "events filtering"
- (is (= [{:product :p1
- :first :me}
- {:product :p1
- :second :me}]
- (-> [::sim-pred/equal? :product :p1]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-events [{:product :p1
- :first :me}
- {:product :p2}
- {:product :p1
- :second :me}
- {:whatever :other}
- {:more "whatever"}])))
- "past events that are regarding a product"))
- (testing "snapshot state filtering"
- (is
- (=
- {::sim-engine/state {:m2 {:id :m2
- :processing :p1}
- :m4 {:id :m4
- :processing :p2}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:more "whatever"
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3}
- {:product :p1
- :machine :m4}]}
- (-> [::sim-pred/one-of? :processing [:p1 :p2]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-snapshot-state
- {::sim-engine/state {:m1 {:id :m1
- :processing :p3}
- :m2 {:id :m2
- :processing :p1}
- :m3 {:id :m3}
- :m4 {:id :m4
- :processing :p2}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:more "whatever"
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3}
- {:product :p1
- :machine :m4}]})))
- "state contains only machines having :p1 or :p2 under :processing"))
- (testing "snapshot based on events filtering"
- (is
- (=
- {::sim-engine/state {:m4 {:id :m4
- :name "MA4"
- :processing :p2}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:whatever :other
- :machine :m4}]
- ::sim-engine/future-events [{:product :p1
- :machine :m4}]}
- (-> [::sim-pred/not [::sim-pred/is-empty? :processing]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-snapshot-events-based-state :machine
- {::sim-engine/state {:m1 {:id :m1
- :name "BR500"}
- :m2 {:id :m2
- :name "MX5009"}
- :m3 {:id :m3
- :name "MX-TURBO-5892"}
- :m4 {:id :m4
- :name "MA4"
- :processing :p2}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:more "whatever"
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3}
- {:product :p1
- :machine :m4}]})))
- "Filter state to only consist of machines that have somethin in :processing in their state and filter all events regarding them")
- (is
- (=
- {::sim-engine/state {:m1 {:id :m1
- :name "BR500"
- :color "blue"}
- :m3 {:id :m3
- :name "MX-TURBO-5892"
- :color "blue"}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:important true
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3
- :important true}]}
- (-> [::sim-pred/or [::sim-pred/equal? :color "blue"] [::sim-pred/true? :important]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-snapshot
- {::sim-engine/state {:m1 {:id :m1
- :name "BR500"
- :color "blue"}
- :m2 {:id :m2
- :name "MX5009"}
- :m3 {:id :m3
- :name "MX-TURBO-5892"
- :color "blue"}
- :m4 {:id :m4
- :name "MA4"
- :processing :p2}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:important true
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3
- :important true}
- {:product :p1
- :machine :m4}]})))
- "Filter state machines that has :blue color or :important true and filter all events regarding them")))
-
-(deftest stopping-causes
- (is
- (=
- [{::sim-engine/context {::sim-engine/iteration 1
- ::sim-engine/n 1}
- ::sim-engine/stopping-criteria {::sim-engine/params {::sim-engine/n 1}
- ::sim-engine/stopping-definition
- {::sim-engine/doc "Stops when the iteration `n` is reached."
- ::sim-engine/id ::sim-engine/iteration-nth
- ::sim-engine/next-possible? true
- ::sim-engine/stopping-evaluation nil}
- ::sim-engine/model-end? false}
- ::sim-engine/current-event {::sim-engine/type :IN
- ::sim-engine/date 0}}]
- (-> [::sim-pred/equal? [::sim-engine/id] ::sim-engine/iteration-nth]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-stopping-causes-by-stopping-definition
- [{::sim-engine/stopping-criteria {::sim-engine/stopping-definition
- {::sim-engine/id ::sim-engine/no-future-events
- ::sim-engine/next-possible? false
- ::sim-engine/doc
- "Stops when no future events exists anymore."}}
- ::sim-engine/current-event nil}
- {::sim-engine/context {::sim-engine/iteration 1
- ::sim-engine/n 1}
- ::sim-engine/stopping-criteria {::sim-engine/params {::sim-engine/n 1}
- ::sim-engine/stopping-definition
- {::sim-engine/doc
- "Stops when the iteration `n` is reached."
- ::sim-engine/id ::sim-engine/iteration-nth
- ::sim-engine/next-possible? true
- ::sim-engine/stopping-evaluation nil}
- ::sim-engine/model-end? false}
- ::sim-engine/current-event {::sim-engine/type :IN
- ::sim-engine/date 0}}])))
- "stopping causes are filtered to contain only iteration-nth stopping-cause")
- (is (= []
- (-> [::sim-pred/one-of? :processing [:p1 :p2]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-stopping-causes-by-model-end
- [{::sim-engine/stopping-criteria {::sim-engine/stopping-definition
- {::sim-engine/id ::sim-engine/no-future-events
- ::sim-engine/next-possible? false
- ::sim-engine/doc
- "Stops when no future events exists anymore."}}
- ::sim-engine/current-event nil}
- {::sim-engine/context {::sim-engine/iteration 1
- ::sim-engine/n 1}
- ::sim-engine/stopping-criteria {::sim-engine/params {::sim-engine/n 1}
- ::sim-engine/stopping-definition
- {::sim-engine/doc
- "Stops when the iteration `n` is reached."
- ::sim-engine/id ::sim-engine/iteration-nth
- ::sim-engine/next-possible? true
- ::sim-engine/stopping-evaluation nil}
- ::sim-engine/model-end? false}
- ::sim-engine/current-event {::sim-engine/type :IN
- ::sim-engine/date 0}}])))
- "No model-end returns empty array")
- (is (= [{::sim-engine/stopping-criteria {::sim-engine/stopping-definition
- {::sim-engine/id ::sim-engine/no-future-events
- ::sim-engine/next-possible? false
- ::sim-engine/doc
- "Stops when no future events exists anymore."}
- ::sim-engine/model-end? true}
- ::sim-engine/current-event nil}]
- (-> [::sim-pred/true?]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-stopping-causes-by-model-end
- [{::sim-engine/stopping-criteria {::sim-engine/stopping-definition
- {::sim-engine/id ::sim-engine/no-future-events
- ::sim-engine/next-possible? false
- ::sim-engine/doc
- "Stops when no future events exists anymore."}
- ::sim-engine/model-end? true}
- ::sim-engine/current-event nil}
- {::sim-engine/context {::sim-engine/iteration 1
- ::sim-engine/n 1}
- ::sim-engine/stopping-criteria {::sim-engine/params {::sim-engine/n 1}
- ::sim-engine/stopping-definition
- {::sim-engine/doc
- "Stops when the iteration `n` is reached."
- ::sim-engine/id ::sim-engine/iteration-nth
- ::sim-engine/next-possible? true
- ::sim-engine/stopping-evaluation nil}
- ::sim-engine/model-end? false}
- ::sim-engine/current-event {::sim-engine/type :IN
- ::sim-engine/date 0}}])))
- "Model end stopping-criteria is filtered"))
-
-
-
-(deftest multiple-snapshots-use-cases
- (testing
- "I have multiple snapshots, I want to keep only those that after applying keep-predicate on state it's different from previous filtered snapshot under state"
- (is
- (=
- [{::sim-engine/state {:m4 {:id :m4
- :processing :p2}}
- ::sim-engine/iteration 10
- ::sim-engine/date 0
- ::sim-engine/past-events [{:whatever :other
- :machine :m4}]
- ::sim-engine/future-events [{:product :p1
- :machine :m4}]}
- {::sim-engine/state {:m4 {:id :m4
- :processing nil}}
- ::sim-engine/iteration 12
- ::sim-engine/date 0
- ::sim-engine/past-events [{:whatever :other
- :machine :m4}]
- ::sim-engine/future-events [{:product :p1
- :machine :m4}]}
- {::sim-engine/state {:m4 {:id :m4
- :input [:p1]
- :processing nil}}
- ::sim-engine/iteration 14
- ::sim-engine/date 0
- ::sim-engine/past-events [{:whatever :other
- :machine :m4}]
- ::sim-engine/future-events [{:product :p1
- :machine :m4}]}]
- (-> [::sim-pred/equal? :id :m4]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-snapshots-state
- [{::sim-engine/state {:m4 {:id :m4
- :processing :p2}}
- ::sim-engine/iteration 10
- ::sim-engine/date 0
- ::sim-engine/past-events [{:whatever :other
- :machine :m4}]
- ::sim-engine/future-events [{:product :p1
- :machine :m4}]}
- {::sim-engine/state {:m4 {:id :m4
- :processing :p2}}
- ::sim-engine/iteration 11
- ::sim-engine/date 0
- ::sim-engine/past-events [{:whatever :other
- :machine :m4}]
- ::sim-engine/future-events [{:product :p1
- :machine :m4}]}
- {::sim-engine/state {:m4 {:id :m4
- :processing nil}}
- ::sim-engine/iteration 12
- ::sim-engine/date 0
- ::sim-engine/past-events [{:whatever :other
- :machine :m4}]
- ::sim-engine/future-events [{:product :p1
- :machine :m4}]}
- {::sim-engine/state {:m4 {:id :m4
- :processing nil}}
- ::sim-engine/iteration 13
- ::sim-engine/date 0
- ::sim-engine/past-events [{:whatever :other
- :machine :m4}]
- ::sim-engine/future-events [{:product :p1
- :machine :m4}]}
- {::sim-engine/state {:m4 {:id :m4
- :input [:p1]
- :processing nil}}
- ::sim-engine/iteration 14
- ::sim-engine/date 0
- ::sim-engine/past-events [{:whatever :other
- :machine :m4}]
- ::sim-engine/future-events [{:product :p1
- :machine :m4}]}]))))))
-
-(deftest rc-snapshot-use-cases
- (testing "state filtering"
- (is (= {::sim-rc/resource {:m1 {:id :m1}}}
- (-> [::sim-pred/equal? :id :m1]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-state-resource {::sim-rc/resource {:m1 {:id :m1}
- :m2 {:id :m2}
- :m3 {:id :m3}
- :m4 {:id :m4}}})))
- "state contains only :m1")
- (is (= {::sim-rc/resource {:m2 {:id :m2
- :processing :p1}
- :m4 {:id :m4
- :processing :p2}}}
- (-> [::sim-pred/one-of? :processing [:p1 :p2]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-state-resource {::sim-rc/resource {:m1 {:id :m1
- :processing :p3}
- :m2 {:id :m2
- :processing :p1}
- :m3 {:id :m3}
- :m4 {:id :m4
- :processing :p2}}})))
- "state contains only machines having :p1 or :p2 under :processing")
- (is (= {::sim-rc/resource {:m2 {:id :m2
- :name "MX5009"}
- :m3 {:id :m3
- :name "MX-TURBO-5892"}}}
- (-> [::sim-pred/starts-with? :name "MX"]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-state-resource {::sim-rc/resource {:m1 {:id :m1
- :name "BR500"}
- :m2 {:id :m2
- :name "MX5009"}
- :m3 {:id :m3
- :name "MX-TURBO-5892"}
- :m4 {:id :m4
- :name "MA4"
- :processing :p2}}})))
- "state contains only machines starting with name MX"))
- (testing "snapshot state filtering"
- (is
- (=
- {::sim-engine/state {::sim-rc/resource {:m2 {:id :m2
- :processing :p1}
- :m4 {:id :m4
- :processing :p2}}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:more "whatever"
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3}
- {:product :p1
- :machine :m4}]}
- (-> [::sim-pred/one-of? :processing [:p1 :p2]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-snapshot-state-resource
- {::sim-engine/state {::sim-rc/resource {:m1 {:id :m1
- :processing :p3}
- :m2 {:id :m2
- :processing :p1}
- :m3 {:id :m3}
- :m4 {:id :m4
- :processing :p2}}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:more "whatever"
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3}
- {:product :p1
- :machine :m4}]})))
- "state contains only machines having :p1 or :p2 under :processing"))
- (testing "snapshot based on events filtering"
- (is
- (=
- {::sim-engine/state {::sim-rc/resource {:m4 {:id :m4
- :name "MA4"
- :processing :p2}}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:whatever :other
- :machine :m4}]
- ::sim-engine/future-events [{:product :p1
- :machine :m4}]}
- (-> [::sim-pred/not [::sim-pred/is-empty? :processing]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-snapshot-events-based-state-resource
- :machine
- {::sim-engine/state {::sim-rc/resource {:m1 {:id :m1
- :name "BR500"}
- :m2 {:id :m2
- :name "MX5009"}
- :m3 {:id :m3
- :name "MX-TURBO-5892"}
- :m4 {:id :m4
- :name "MA4"
- :processing :p2}}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:more "whatever"
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3}
- {:product :p1
- :machine :m4}]})))
- "Filter state to only consist of machines that have somethin in :processing in their state and filter all events regarding them")
- (is
- (=
- {::sim-engine/state {::sim-rc/resource {:m1 {:id :m1
- :name "BR500"
- :color "blue"}
- :m3 {:id :m3
- :name "MX-TURBO-5892"
- :color "blue"}}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:important true
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3
- :important true}]}
- (-> [::sim-pred/or [::sim-pred/equal? :color "blue"] [::sim-pred/true? :important]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-snapshot-resource
- {::sim-engine/state {::sim-rc/resource {:m1 {:id :m1
- :name "BR500"
- :color "blue"}
- :m2 {:id :m2
- :name "MX5009"}
- :m3 {:id :m3
- :name "MX-TURBO-5892"
- :color "blue"}
- :m4 {:id :m4
- :name "MA4"
- :processing :p2}}}
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:important true
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3
- :important true}
- {:product :p1
- :machine :m4}]})))
- "Filter state machines that has :blue color or :important true and filter all events regarding them")))
-
-(deftest entity-snapshot-use-cases
- (testing "state filtering"
- (is (= (sim-entity/create {}
- 3
- :p1
- {:data :of
- :an :entity
- :id :p1})
- (-> [::sim-pred/equal? :id :p1]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-state-entity
- (-> {}
- (sim-entity/create 3
- :p1
- {:data :of
- :an :entity
- :id :p1})
- (sim-entity/create 5
- :p2
- {:data :of
- :an :entity
- :id :p2})
- (sim-entity/create 7
- :p3
- {:data :of
- :an :entity
- :id :p3})
- (sim-entity/create 8
- :p4
- {:data :of
- :an :entity
- :id :p4})))))
- "state contains only :m1")
- (is
- (=
- (-> {}
- (sim-entity/create 3
- :p1
- {:data :of
- :an :entity
- :color :green
- :id :p1})
- (sim-entity/create 3
- :p3
- {:data :of
- :color :blue
- :an :entity
- :id :p3}))
- (-> [::sim-pred/one-of? :color [:blue :green]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-state-entity
- (-> {}
- (sim-entity/create 3
- :p1
- {:data :of
- :an :entity
- :color :green
- :id :p1})
- (sim-entity/create 3
- :p2
- {:data :of
- :color :red
- :an :entity
- :id :p2})
- (sim-entity/create 3
- :p3
- {:data :of
- :color :blue
- :an :entity
- :id :p3})
- (sim-entity/create 3
- :p4
- {:data :of
- :color :yellow
- :an :entity
- :id :p2})))))
- "state contains only products having :blue or :green under :color data")
- (is
- (=
- (-> {}
- (sim-entity/create 3
- :p3
- {:data :of
- :an :entity
- :name "MX5009"
- :id :p3})
- (sim-entity/create 3
- :p4
- {:data :of
- :name "MX-TURBO-5892"
- :an :entity
- :id :p4}))
- (-> [::sim-pred/starts-with? :name "MX"]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-state-entity
- (-> {}
- (sim-entity/create 3
- :p1
- {:data :of
- :an :entity
- :name "BR500"
- :id :p1})
- (sim-entity/create 3
- :p2
- {:data :of
- :an :entity
- :id :p2})
- (sim-entity/create 3
- :p3
- {:data :of
- :an :entity
- :name "MX5009"
- :id :p3})
- (sim-entity/create 3
- :p4
- {:data :of
- :name "MX-TURBO-5892"
- :an :entity
- :id :p4})))))
- "state contains only products starting with name MX"))
- (testing "snapshot state filtering"
- (is
- (=
- {::sim-engine/state (-> {}
- (sim-entity/create 3
- :p3
- {:data :of
- :an :entity
- :name "MX5009"
- :id :p3})
- (sim-entity/create 3
- :p4
- {:data :of
- :name "MX-TURBO-5892"
- :an :entity
- :id :p4}))
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:more "whatever"
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3}
- {:product :p1
- :machine :m4}]}
- (-> [::sim-pred/one-of? :id [:p3 :p4]]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-snapshot-state-entity
- {::sim-engine/state (-> {}
- (sim-entity/create 3
- :p1
- {:data :of
- :an :entity
- :name "BR500"
- :id :p1})
- (sim-entity/create 3
- :p2
- {:data :of
- :an :entity
- :id :p2})
- (sim-entity/create 3
- :p3
- {:data :of
- :an :entity
- :name "MX5009"
- :id :p3})
- (sim-entity/create 3
- :p4
- {:data :of
- :name "MX-TURBO-5892"
- :an :entity
- :id :p4}))
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:more "whatever"
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3}
- {:product :p1
- :machine :m4}]})))
- "state contains only machines having :p1 or :p2 under :processing"))
- (testing "snapshot based on events filtering"
- (is
- (=
- {::sim-engine/state (sim-entity/create {}
- 3
- :p1
- {:data :of
- :an :entity
- :name "BR500"
- :id :p1})
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3}
- {:product :p1
- :machine :m4}]}
- (-> [::sim-pred/equal? :name "BR500"]
- sim-pred/predicate-lang->predicate-fn
- (sut/keep-snapshot-events-based-state-entity
- :product
- {::sim-engine/state (-> {}
- (sim-entity/create 3
- :p1
- {:data :of
- :an :entity
- :name "BR500"
- :id :p1})
- (sim-entity/create 3
- :p2
- {:data :of
- :an :entity
- :id :p2})
- (sim-entity/create 3
- :p3
- {:data :of
- :an :entity
- :name "MX5009"
- :id :p3})
- (sim-entity/create 3
- :p4
- {:data :of
- :name "MX-TURBO-5892"
- :an :entity
- :id :p4}))
- ::sim-engine/date 0
- ::sim-engine/past-events [{:product :p1
- :first :me
- :machine :m1}
- {:product :p2
- :machine :m1}
- {:product :p1
- :second :me
- :machine :m2}
- {:whatever :other
- :machine :m4}
- {:more "whatever"
- :machine :m1}]
- ::sim-engine/future-events [{:product :p1
- :machine :m3}
- {:product :p1
- :machine :m4}]})))
- "Filter state to only consist of machines that have somethin in :processing in their state and filter all events regarding them")))
diff --git a/test/demo/cljc/auto_sim/demo_entity.cljc b/test/demo/cljc/auto_sim/demo_entity.cljc
new file mode 100644
index 0000000..57565d7
--- /dev/null
+++ b/test/demo/cljc/auto_sim/demo_entity.cljc
@@ -0,0 +1,113 @@
+(ns auto-sim.demo-entity
+ (:require
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])
+ [auto-opti.distribution :as opt-distribution]
+ [auto-opti.prng :as opt-prng]
+ [auto-sim.engine :as sim-engine]
+ [auto-sim.entity :as sim-entity]
+ [auto-sim.machine :as sim-machine]
+ [auto-sim.ordering :as sim-ordering]
+ [auto-sim.route :as sim-route]))
+
+(defn clean-ns-kw
+ [m]
+ (-> m
+ (update-keys (comp keyword name))))
+
+(def model-data
+ #::sim-engine{:starting-bucket 0
+ :waiting-time 100
+ :max-nb-entity 4
+ :routes {:blue [{:m :transport
+ :pt 5}
+ {:m :m4
+ :pt 1}
+ {:m :transport
+ :pt 4}
+ {:m :m2
+ :pt 3}
+ {:m :transport
+ :pt 7}
+ {:m :m1
+ :pt 2}]
+ :purple [{:m :transport
+ :pt 5}
+ {:m :m4
+ :pt 1}
+ {:m :transport
+ :pt 4}
+ {:m :m3
+ :pt 3}
+ {:m :transport
+ :pt 4}
+ {:m :m1
+ :pt 1}]}
+ ::seed #uuid "e85427c1-ed25-4ed4-9b11-52238d268265"})
+
+
+
+(defn event-types
+ [model-data prng]
+ (let [#::sim-engine{:keys [routes]} model-data
+ colors (-> routes
+ keys
+ vec)
+ color-distribution (opt-distribution/distribution {:prng prng
+ :params {:a 0
+ :b (count colors)}
+ :dst-name :uniform-int})]
+ {:CE (fn [event-return event bucket]
+ (let [product-data (->> (nth colors (opt-distribution/draw color-distribution))
+ (sim-route/entity-data routes))]
+ (-> event-return
+ (sim-entity/schedule-entity-every event bucket ::product product-data)
+ (sim-entity/schedule-new-entity event bucket #::sim-engine{:type :MT}))))
+ :MP (fn [event-return event bucket]
+ (sim-machine/infinite-capacity event-return event bucket #::sim-engine{:type :MT} :pt))
+ :MT (fn [event-return event bucket]
+ (if-let [route (sim-route/get-route event-return event bucket)]
+ (-> event-return
+ (sim-route/next-op event bucket route)
+ (sim-route/schedule event bucket #::sim-engine{:type :MP}))
+ (-> event-return
+ (sim-entity/schedule event bucket #::sim-engine{:type :PT}))))
+ :PT sim-entity/sink}))
+
+(defn create-model
+ [model-data]
+ (let [{::sim-engine/keys [starting-bucket waiting-time max-nb-entity]} model-data
+ evt1 (sim-entity/n-entities-event starting-bucket max-nb-entity waiting-time :CE)]
+ (assoc (-> model-data
+ (sim-engine/initial-snapshot starting-bucket {} [evt1]))
+ ::sim-engine/sorter (sim-ordering/sorter (sim-ordering/fields ::sim-engine/bucket)
+ (sim-ordering/types [:CE :PA :MA :MP :MT :PT])
+ (sim-ordering/fields ::product))
+ ::sim-engine/event-registry (event-types model-data
+ (opt-prng/xoroshiro128 (::seed model-data))))))
+
+(deftest assembly-test
+ (is (= (let [{::sim-engine/keys [routes max-nb-entity]} model-data
+ nb-operations (-> routes
+ first
+ second
+ count)
+ nb-events-for-operations (* 2 nb-operations) ;; Each operation has MP and MT
+ w-starting-and-ending (+ 2 nb-events-for-operations 1) ;; Each entity starts with CE and a MT and ends with PT
+ ]
+ (* max-nb-entity w-starting-and-ending))
+ (-> (-> model-data
+ create-model
+ sim-engine/run)
+ ::sim-engine/past-events
+ count))))
+
+(comment
+ (-> model-data
+ create-model
+ sim-engine/run
+ (update ::sim-engine/past-events (partial mapv clean-ns-kw))
+ (update ::sim-engine/state clean-ns-kw)
+ (update-in [::sim-engine/state :entity] update-vals clean-ns-kw))
+ ;
+)
diff --git a/test/demo/cljc/auto_sim/demo_resource.cljc b/test/demo/cljc/auto_sim/demo_resource.cljc
new file mode 100644
index 0000000..e002cb0
--- /dev/null
+++ b/test/demo/cljc/auto_sim/demo_resource.cljc
@@ -0,0 +1,245 @@
+(ns auto-sim.demo-resource
+ (:require
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])
+ [auto-opti.distribution :as opt-distribution]
+ [auto-opti.prng :as opt-prng]
+ [auto-sim.engine :as sim-engine]
+ [auto-sim.entity :as sim-entity]
+ [auto-sim.machine :as sim-machine]
+ [auto-sim.ordering :as sim-ordering]
+ [auto-sim.printer.rc-entity-route :as sim-printer-rc-entity-route
+ :refer [uuid-idx]]
+ [auto-sim.rc :as sim-rc]
+ [auto-sim.rc.resource.consumption :as sim-rc-consumption]
+ [auto-sim.rc.unqueueing-policy :refer [fifo]]
+ [auto-sim.route :as sim-route]
+ [clojure.string :as str]))
+
+(defn clean-ns-kw
+ [m]
+ (-> m
+ (update-keys (comp keyword name))))
+
+(def model-data
+ #::sim-engine{:starting-bucket 0
+ ::resource-input {:m1 {}
+ :m2 {}
+ :m3 {}
+ :m4 {}}
+ :waiting-time 0
+ :max-nb-entity 2
+ :routes {:blue [{:m :m4
+ :pt 1}
+ {:m :m2
+ :pt 3}
+ {:m :m1
+ :pt 2}]
+ :purple [{:m :m4
+ :pt 1}
+ {:m :m3
+ :pt 3}
+ {:m :m1
+ :pt 1}]}
+ ::seed #uuid "e85427c1-ed25-4ed4-9b11-52238d268265"})
+
+(defn event-types
+ [model-data prng]
+ (let [#::sim-engine{:keys [routes]} model-data
+ colors (-> routes
+ keys
+ vec)
+ prio (sim-rc-consumption/compare-by-order [:high])
+ color-distribution (opt-distribution/distribution {:prng prng
+ :params {:a 0
+ :b (count colors)}
+ :dst-name :uniform-int})]
+ {:CE (fn [event-return event bucket]
+ (let [product-data (->> (nth colors (opt-distribution/draw color-distribution))
+ (sim-route/entity-data routes))]
+ (-> event-return
+ (sim-entity/schedule-entity-every event bucket ::product product-data)
+ (sim-entity/schedule-new-entity event bucket #::sim-engine{:type :PS}))))
+ :PS (fn [event-return event bucket]
+ (if-let [route (sim-route/get-route event-return event bucket)]
+ (-> event-return
+ (sim-route/next-op event bucket route)
+ (sim-route/schedule event bucket #::sim-engine{:type :IS}))
+ (-> event-return
+ (sim-entity/schedule event bucket #::sim-engine{:type :PT}))))
+ :IS
+ (fn [event-return event bucket]
+ (let [{:keys [m _pt]} (::sim-engine/current-operation event)
+ evt
+ (sim-route/add-current-operation event-return event bucket #::sim-engine{:type :MP})]
+ (-> event-return
+ (sim-rc/seize event bucket m 1 evt :high))))
+ :MP (fn [event-return event bucket]
+ (-> event-return
+ (sim-machine/infinite-capacity event bucket #::sim-engine{:type :OS} :pt)))
+ :OS (fn [event-return event bucket]
+ (let [{:keys [m _pt]} (::sim-engine/current-operation event)]
+ (-> event-return
+ (sim-rc/dispose event bucket m 1 fifo prio)
+ (sim-route/schedule event bucket #::sim-engine{:type :MT}))))
+ :MT (fn [event-return event bucket]
+ (if-let [route (sim-route/get-route event-return event bucket)]
+ (-> event-return
+ (sim-route/next-op event bucket route)
+ (sim-route/schedule event bucket #::sim-engine{:type :IS}))
+ (-> event-return
+ (sim-entity/schedule event bucket #::sim-engine{:type :PT}))))
+ :PT sim-entity/sink}))
+
+(defn create-model
+ [model-data]
+ (let [{::sim-engine/keys [starting-bucket waiting-time max-nb-entity]} model-data
+ evt1 (sim-entity/n-entities-event starting-bucket max-nb-entity waiting-time :CE)]
+ (assoc (-> model-data
+ (sim-engine/initial-snapshot starting-bucket {} [evt1])
+ (sim-rc/define-resource nil nil :m1 {})
+ (sim-rc/define-resource nil nil :m2 {})
+ (sim-rc/define-resource nil nil :m3 {})
+ (sim-rc/define-resource nil nil :m4 {}))
+ ::sim-engine/sorter (sim-ordering/sorter (sim-ordering/fields ::sim-engine/bucket)
+ (sim-ordering/types
+ [:CE :PS :IS :MP :OS :MT :PT])
+ (sim-ordering/fields ::product))
+ ::sim-engine/event-registry (event-types model-data
+ (opt-prng/xoroshiro128 (::seed model-data))))))
+
+(deftest assembly-test
+ (is (= (let [{::sim-engine/keys [routes max-nb-entity]} model-data
+ nb-operations (-> routes
+ first
+ second
+ count)
+ nb-events-for-operations (* 4 nb-operations) ;; Each operation has IS, MP, OS and MT
+ w-starting-and-ending (+ 2 nb-events-for-operations 1) ;; Each entity starts with CE and a MT and ends with PT
+ ]
+ (* max-nb-entity w-starting-and-ending))
+ (-> (-> model-data
+ create-model
+ sim-engine/run)
+ ::sim-engine/past-events
+ count))))
+
+(defn past-events
+ [model entity-translation]
+ (->> model
+ ::sim-engine/past-events
+ (mapv (fn [{::sim-engine/keys [type bucket entity-id]
+ :as _event}]
+ (cond
+ (sim-printer-rc-entity-route/check type [:CE])
+ (println
+ (str bucket "-new entity (" (uuid-idx entity-translation entity-id) ")")))))))
+
+(defn entities
+ [model entity-translation]
+ (doseq [[entity-id entity] (-> model
+ ::sim-engine/state
+ ::sim-engine/entity)]
+ (let [{::sim-engine/keys [entity-state]} entity
+ {::sim-engine/keys [route-id route]} entity-state]
+ (println (str "- e(" (uuid-idx entity-translation entity-id)
+ "), route " (name route-id)
+ " = " (str/join ", "
+ (mapv (fn [{:keys [m pt]}] (str "(" (name m) "," pt ")"))
+ route))))))
+ model)
+
+(defn separator [model] (println (apply str (repeat 80 "*"))) model)
+
+(defn snapshot
+ [model]
+ (let [{::sim-engine/keys [bucket _id iteration]} model]
+ (println (str "Iteration " iteration ", bucket " bucket)))
+ model)
+
+(defn snapshot-header
+ [model]
+ (let [{::sim-engine/keys [bucket iteration]} model] (print (str iteration " t(" bucket ") ")))
+ model)
+
+(defn event*
+ [event entity-translation]
+ (let [{::sim-engine/keys [type bucket entity-id _route-id current-operation]
+ ::sim-entity/keys [waiting-time nb-entity max-nb-entity]}
+ event
+ {:keys [m pt]} current-operation]
+ (->> (concat [(name type)]
+ (case type
+ :CE (concat [", creates entity " (inc nb-entity) " of " max-nb-entity]
+ (if (>= (inc nb-entity) max-nb-entity)
+ [", last one"]
+ [", next in " waiting-time]))
+ :PS [", starts product e(" (uuid-idx entity-translation entity-id) ")"]
+ :IS [", e(" (uuid-idx entity-translation entity-id) ") seizes in " m]
+ :MP [", e("
+ (uuid-idx entity-translation entity-id)
+ ") starts production on "
+ m
+ " during "
+ pt
+ " buckets"]
+ :OS [", e(" (uuid-idx entity-translation entity-id) ") ends production on " m]
+ :MT [", e(" (uuid-idx entity-translation entity-id) ") quits machine " m]
+ :PT [", ends product e(" (uuid-idx entity-translation entity-id) ")"]
+ [])
+ [", ends in " bucket " bucket"])
+ (apply str)
+ println)))
+
+(defn resources
+ [model entity-translation]
+ (doseq [[resource-id resource] (get-in model [::sim-engine/state ::sim-engine/resource])]
+ (let [{::sim-engine/keys [capacity consumption queue]} resource
+ prefix " "]
+ (println (str "* " (name resource-id) " capa=" capacity))
+ (doseq [[_ consumption-detail] consumption]
+ (let [{::sim-engine/keys [consumption-quantity _priority entity-id]} consumption-detail]
+ (println
+ (str prefix "e(" (uuid-idx entity-translation entity-id) ") " consumption-quantity))))
+ (doseq [queue-item queue]
+ (let [{::sim-engine/keys [event _priority consumption-quantity]} queue-item]
+ (print (str prefix "\\-> quantity " consumption-quantity " required by "))
+ (event* event entity-translation)))))
+ model)
+
+(defn next-event
+ [model entity-translation]
+ (-> model
+ ::sim-engine/future-events
+ first
+ (event* entity-translation))
+ model)
+
+#?(:cljc (do (defn errors
+ [model]
+ (let [{::sim-engine/keys [stopping-criteria]} model]
+ (if (seq stopping-criteria)
+ (doseq [{::sim-engine/keys [doc]} stopping-criteria]
+ (when doc (println (apply format doc))))
+ model)))
+ (let [entity-translation (sim-printer-rc-entity-route/create-translation)]
+ (reduce (fn [model i]
+ (if (seq (::sim-engine/stopping-criteria model))
+ model
+ (some-> model
+ (sim-engine/run-iteration i)
+ separator
+ snapshot
+ errors
+ ;(entities entity-translation)
+ (resources entity-translation)
+ (next-event entity-translation))))
+ (create-model model-data)
+ (range 1 100)))
+ (-> model-data
+ create-model
+ (sim-engine/run-iteration 9))))
+
+(comment
+ ;
+)
diff --git a/test/demo/cljc/auto_sim/demo_stock_dimensionning.cljc b/test/demo/cljc/auto_sim/demo_stock_dimensionning.cljc
new file mode 100644
index 0000000..894c0ec
--- /dev/null
+++ b/test/demo/cljc/auto_sim/demo_stock_dimensionning.cljc
@@ -0,0 +1,106 @@
+(ns auto-sim.demo-stock-dimensionning
+ "Stock dimensionning models regular items getting in your workshop.
+
+ We generate products in proportion of field quantities.
+
+ By measuring the size of products in input stocks, we can measure the bottleneck is.
+ Of course, it may sound unreal to have too many, but in reality your team will slow down the workflow for such products.
+
+ Why stock number of slots are not modelled: As in practise, situations where a machine is stuck as there is no place"
+ (:require
+ [auto-sim.engine :as sim-engine]))
+
+(def model-data
+ #::sim-engine{:starting-bucket 0
+ :max-nb-entity 4
+ :waiting {:time 100
+ :type :exponential}
+ :products {:parts-1 {:route [{:m [:tvm-1 :tvm-2 :tvm-3]
+ :is 2
+ :os 2
+ :pt {:law :normal
+ :location 12
+ :scale 2}}
+ {:m :orc
+ :is 2
+ :os 2
+ :pt {:law :normal
+ :location 12
+ :scale 2}}
+ {:m [:lvt-1 :lvt-2 :lvt-3]
+ :is 2
+ :os 2
+ :pt {:law :normal
+ :location 12
+ :scale 2}}]
+ :quantity 100}
+ :parts-2 {:route
+ [{:m [:cn5-1 :cn5-2 :cn5-3 :cn5-4 :cn5-5 :cn5-6 :cn5-7 :cn5-8]
+ :pt {:law :normal
+ :location 12
+ :scale 2}}]
+ :quantity 100}
+ :parts-3 {:route [{:m [:phib-1 :phib2]
+ :pt {:law :normal
+ :location 12
+ :scale 2}}
+ {:m :hf
+ :pt {:law :normal
+ :location 12
+ :scale 2}}
+ {:m :psk
+ :pt {:law :normal
+ :location 12
+ :scale 2}}]
+ :quantity 100}
+ :csp {:route [{:m [:lvt :tfm]
+ :pt {:law :normal
+ :location 12
+ :scale 2}}
+ {:m [:dmc-1 :dmc-2]
+ :pt {:law :normal
+ :location 12
+ :scale 2}}
+ {:m :hf
+ :pt {:law :normal
+ :location 12
+ :scale 2}}]
+ :quantity 100}}
+ ::seed #uuid "e85427c1-ed25-4ed4-9b11-52238d268265"})
+
+{:max-nb-entity 4
+ :routes {:anneau [{:is 2 ;; Number of stock slots
+ :m [:tvm-1 :tvm-2 :tvm-3] ;; machines
+ :os 2 ;; Numbers of stock slots
+ :pt {:law :normal ;; Distribution of processing times
+ :location 12 ;; Mean value of the normal law
+ :scale 2 ;; Variance of the normal law
+ }}
+ {:is 2
+ :m :orc
+ :os 2
+ :pt {:law :normal
+ :location 12
+ :scale 2}}
+ {:is 2
+ :m [:lvt-1 :lvt-2 :lvt-3]
+ :os 2
+ :pt {:law :normal
+ :location 12
+ :scale 2}}]
+ :csp [{:m [:lvt :tfm]
+ :pt {:law :normal
+ :location 12
+ :scale 2}}
+ {:m [:dmc-1 :dmc-2]
+ :pt {:law :normal
+ :location 12
+ :scale 2}}
+ {:m :hf
+ :pt {:law :normal
+ :location 12
+ :scale 2}}]}
+ :waiting {:type :exponential ;; Probabilistic distribution law
+ :location 10 ;; Average
+ :scale 2 ;; Standard
+ }}
diff --git a/test/demo/cljc/auto_sim/three_machines_infinite_stock.cljc b/test/demo/cljc/auto_sim/three_machines_infinite_stock.cljc
new file mode 100644
index 0000000..b9ea72b
--- /dev/null
+++ b/test/demo/cljc/auto_sim/three_machines_infinite_stock.cljc
@@ -0,0 +1,60 @@
+(ns auto-sim.three-machines-infinite-stock
+ "Example of thee routings, with no intermediate stock."
+ (:require
+ [auto-sim.engine :as sim-engine]
+ [auto-sim.ordering :as sim-ordering]))
+
+(def order-stub
+ (sim-ordering/sorter (sim-ordering/fields ::sim-engine/bucket)
+ (sim-ordering/types [:new-op :new-job])))
+
+(def routings
+ [[{:m :m2
+ :p 3}
+ {:m :m1
+ :p 4}
+ {:m :m3
+ :p 2}]
+ [{:m :m3
+ :p 2}
+ {:m :m2
+ :p 4}
+ {:m :m1
+ :p 3}]])
+
+(def max-jobs 2)
+
+(defn new-job
+ [event-return _ bucket]
+ (let [{::sim-engine/keys [state future-events]} event-return
+ {:keys [n-jobs]} state
+ routing (rand-nth routings)]
+ #::sim-engine{:state (-> state
+ (assoc :n-jobs (inc n-jobs)))
+ :future-events (cond-> future-events
+ (< n-jobs (dec max-jobs)) (conj #::sim-engine{:type :new-job
+ :bucket
+ (+ 100 bucket)})
+ :else (conj #::sim-engine{:type :new-op
+ :routings routing
+ :bucket bucket}))}))
+
+(defn new-op
+ [event-return event bucket]
+ (let [{::sim-engine/keys [routings]} event
+ [routing & rroutings] routings]
+ (-> event-return
+ (update ::sim-engine/future-events
+ #(cond-> %
+ routing (conj #::sim-engine{:type :new-op
+ :routings (vec rroutings)
+ :bucket (+ bucket (:p routing))}))))))
+
+(-> #::sim-engine{:sorter order-stub
+ :event-registry {:new-job new-job
+ :new-op new-op}}
+ (sim-engine/initial-snapshot 0
+ {:n-jobs 0}
+ [#::sim-engine{:type :new-job
+ :bucket 0}])
+ (sim-engine/continue))
diff --git a/test/unit/cljc/auto_sim/engine_test.cljc b/test/unit/cljc/auto_sim/engine_test.cljc
new file mode 100644
index 0000000..2b45372
--- /dev/null
+++ b/test/unit/cljc/auto_sim/engine_test.cljc
@@ -0,0 +1,317 @@
+(ns auto-sim.engine-test
+ (:require
+ [auto-sim.engine :as sut]
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])
+ [auto-sim.ordering :as sim-ordering]))
+
+;; ********************************************************************************
+;; Helpers
+;; ********************************************************************************
+
+(def order-stub (sim-ordering/sorter (sim-ordering/fields :foo) (sim-ordering/types [:a :b :c])))
+
+(deftest initial-snapshot-test
+ (is (= #::sut{:id 1
+ :iteration 1
+ :bucket 10
+ :state {}
+ :past-events []
+ :future-events []}
+ (sut/initial-snapshot {} 10 nil nil))
+ "Empty state and future-events")
+ (is (= #::sut{:id 1
+ :iteration 1
+ :bucket 0
+ :state {:foo :bar}
+ :past-events []
+ :future-events [{:a :b}]}
+ (sut/initial-snapshot {} 0 {:foo :bar} [{:a :b}]))
+ "State and future events are copied"))
+
+(deftest continue-test
+ (is (= #::sut{:stopping-criteria [#::sut{:id ::sut/missing-sorter
+ :doc ["Event sorter is not defined"]}]
+ :id 1
+ :iteration 1
+ :bucket 0
+ :state {}
+ :past-events []
+ :future-events []}
+ (-> {}
+ (sut/initial-snapshot 0 {} nil)
+ sut/continue))
+ "A missing sorter is a stopping criteria")
+ (is
+ (= #::sut{:stopping-criteria [#::sut{:id ::sut/no-future-events
+ :doc ["No more future events to execute"]}]
+ :id 1
+ :iteration 1
+ :bucket 0
+ :state {}
+ :past-events []
+ :sorter order-stub
+ :future-events []}
+ (-> #::sut{:sorter order-stub}
+ (sut/initial-snapshot 0 {} nil)
+ sut/continue))
+ "When there are no future events, the stopping criteria is raised, no modification is made on the snapshot")
+ (is
+ (=
+ #::sut{:stopping-criteria
+ [#::sut{:id ::sut/execution-not-found
+ :doc
+ ["Event has an unknown event type `%s` (event is `%s`, possible values are `%s`)"
+ :a
+ #::sut{:type :a}
+ []]
+ :event #::sut{:type :a}
+ :not-found-type :a
+ :possible-types []}]
+ :id 1
+ :iteration 1
+ :bucket 0
+ :state {}
+ :sorter order-stub
+ :past-events [#::sut{:type :a}]
+ :future-events []}
+ (-> #::sut{:sorter order-stub}
+ (sut/initial-snapshot 0 {} [#::sut{:type :a}])
+ sut/continue))
+ "When no event execution is found, the stopping criteria is raised, no modification is made on the snapshot")
+ (is
+ (= #::sut{:id 2
+ :iteration 2
+ :bucket 2
+ :state {:foo 1}
+ :past-events [#::sut{:type :a
+ :bucket 2}]
+ :future-events []
+ :stopping-criteria [#::sut{:id ::sut/no-future-events
+ :doc ["No more future events to execute"]}]}
+ (select-keys (-> #::sut{:sorter order-stub
+ :event-registry {:a (fn [event-return _ _]
+ (-> event-return
+ (update-in [::sut/state :foo]
+ (fnil inc 0))))}}
+ (sut/initial-snapshot 0
+ {}
+ [#::sut{:type :a
+ :bucket 2}])
+ sut/continue)
+ [::sut/id
+ ::sut/iteration
+ ::sut/bucket
+ ::sut/state
+ ::sut/past-events
+ ::sut/stopping-criteria
+ ::sut/future-events]))
+ "A simple event execution advances id and iteration, bucket is advanced to the event bucket, state is modified. Execution stops with no future events as no more event are existing.")
+ (is
+ (= #::sut{:id 3
+ :iteration 3
+ :bucket 5
+ :state {:foo 2}
+ :past-events [#::sut{:type :a
+ :bucket 2}
+ #::sut{:type :a
+ :bucket 5}]
+ :future-events []
+ :stopping-criteria [#::sut{:id ::sut/no-future-events
+ :doc ["No more future events to execute"]}]}
+ (let [a-evt (fn [event-return _ _]
+ (-> event-return
+ (update-in [::sut/state :foo] (fnil inc 0))))]
+ (-> #::sut{:sorter order-stub
+ :event-registry {:a a-evt}}
+ (sut/initial-snapshot 0
+ {}
+ [#::sut{:type :a
+ :bucket 2}
+ #::sut{:type :a
+ :bucket 5}])
+ sut/continue
+ (select-keys [::sut/id
+ ::sut/iteration
+ ::sut/bucket
+ ::sut/state
+ ::sut/past-events
+ ::sut/stopping-criteria
+ ::sut/future-events]))))
+ "A doubled execution of the same event advances twice id and iteration. State is modified twice also. Past events are stored in the execution order.")
+ (is
+ (=
+ #::sut{:bucket 0
+ :future-events [#::sut{:type :a
+ :bucket 5}]
+ :id 2
+ :iteration 2
+ :state {}
+ :past-events [:hey #::sut{:type :a
+ :bucket 2}]
+ :stopping-criteria [#::sut{:id ::sut/error-happens
+ :doc ["Errors has been documented during event execution: %s"
+ [{::sut/why :test}]]
+ :current-event #::sut{:type :a
+ :bucket 2}
+ :errors [{::sut/why :test}]}]}
+ (-> #::sut{:sorter order-stub
+ :event-registry {:a (fn [event-return _ _]
+ (-> event-return
+ (assoc ::sut/errors [#::sut{:why :test}])))}}
+ (sut/initial-snapshot 0
+ {}
+ [#::sut{:type :a
+ :bucket 2}
+ #::sut{:type :a
+ :bucket 5}])
+ ((fn [x] (assoc x ::sut/past-events [:hey])))
+ sut/continue
+ (select-keys [::sut/id
+ ::sut/iteration
+ ::sut/bucket
+ ::sut/state
+ ::sut/past-events
+ ::sut/stopping-criteria
+ ::sut/future-events])))
+ "When an event returns an `error`, a stopping criteria is added, the event execution stops")
+ (is
+ (=
+ #::sut{:id 3
+ :iteration 3
+ :bucket 10
+ :state {:foo 2
+ :bar 1}
+ :past-events [#::sut{:type :b
+ :bucket 2}
+ #::sut{:type :a
+ :bucket 10}]
+ :future-events []
+ :stopping-criteria [#::sut{:id ::sut/no-future-events
+ :doc ["No more future events to execute"]}]}
+ (let [a-evt (fn [event-return _ _]
+ (-> event-return
+ (update-in [::sut/state :foo] (comp inc (fnil inc 0)))))
+ b-evt (fn [{::sut/keys [state future-events]} _ _]
+ #::sut{:future-events (conj future-events
+ #::sut{:type :a
+ :bucket 10})
+ :state (update state :bar (fnil inc 0))})]
+ (-> #::sut{:sorter order-stub
+ :event-registry {:a a-evt
+ :b b-evt}}
+ (sut/initial-snapshot 0
+ {}
+ [#::sut{:type :b
+ :bucket 2}])
+ sut/continue
+ (select-keys [::sut/id
+ ::sut/iteration
+ ::sut/bucket
+ ::sut/state
+ ::sut/past-events
+ ::sut/stopping-criteria
+ ::sut/future-events]))))
+ "An event creating an event is working. Each state update is executed. Pas-events are stored in the execution order.")
+ (is
+ (=
+ #::sut{:id 1
+ :iteration 1
+ :bucket 10
+ :state {}
+ :past-events [#::sut{:type :a
+ :bucket 2}]
+ :future-events []
+ :stopping-criteria
+ [#::sut{:id ::sut/causality-broken
+ :doc
+ ["Internal error - causality-broken: bucket is %d, next-event bucket is %d (event is `%s`)"
+ 10
+ 2
+ #::sut{:type :a
+ :bucket 2}]
+ :current-bucket 10
+ :event-bucket 2}]}
+ (-> #::sut{:sorter order-stub
+ :event-registry {:a (fn [event-return _ _]
+ (-> event-return
+ (update-in [::sut/state :foo] (fnil inc 0))))}}
+ (sut/initial-snapshot 10
+ {}
+ [#::sut{:type :a
+ :bucket 2}])
+ sut/continue
+ (select-keys [::sut/id
+ ::sut/iteration
+ ::sut/bucket
+ ::sut/state
+ ::sut/past-events
+ ::sut/stopping-criteria
+ ::sut/future-events])))
+ "When causality is broken, there is no advancement on `id` and `iteration`. The faulty event is moved to `past-events`")
+ (is (= #::sut{:bucket 1
+ :future-events []
+ :id 2
+ :iteration 2
+ :state {}
+ :past-events [#::sut{:type :a
+ :bucket 2}]
+ :stopping-criteria [#::sut{:id ::sut/failed-event-execution
+ :doc ["Internal error - failed execution of event"]
+ :current-event #::sut{:type :a
+ :bucket 2}
+ :exception true}]}
+ (update-in (let [a-evt (fn [_ _ _] (throw (ex-info "test" {})))]
+ (-> #::sut{:sorter order-stub
+ :event-registry {:a a-evt}}
+ (sut/initial-snapshot 1
+ {}
+ [#::sut{:type :a
+ :bucket 2}])
+ sut/continue
+ (select-keys [::sut/id
+ ::sut/iteration
+ ::sut/bucket
+ ::sut/state
+ ::sut/past-events
+ ::sut/stopping-criteria
+ ::sut/future-events])))
+ [::sut/stopping-criteria 0 ::sut/exception]
+ some?))
+ "When execution is failing, returns a failed-event-execution"))
+
+(deftest run-iteration-test
+ (is (= 2
+ (-> #::sut{:sorter order-stub
+ :event-registry {:a (fn [event-return _ _]
+ (-> event-return
+ (update-in [::sut/state :foo] (fnil inc 0))))}}
+ (sut/initial-snapshot 1
+ {}
+ [#::sut{:type :a
+ :bucket 2}
+ #::sut{:type :a
+ :bucket 2}
+ #::sut{:type :a
+ :bucket 2}])
+ (sut/run-iteration 2)
+ ::sut/iteration))
+ "The run-iteration stops at the iteration asked")
+ (is (= #::sut{:iteration 2
+ :bucket 2
+ :id 2}
+ (-> #::sut{:sorter order-stub
+ :event-registry {:a (fn [event-return _ _]
+ (-> event-return
+ (update-in [::sut/state :foo] (fnil inc 0))))}}
+ (sut/initial-snapshot 1
+ {}
+ [#::sut{:type :a
+ :bucket 2}
+ #::sut{:type :a
+ :bucket 2}
+ #::sut{:type :a
+ :bucket 2}])
+ (sut/run-iteration 2)
+ (select-keys [::sut/iteration ::sut/bucket ::sut/id])))
+ "The run-iteration stops at the iteration asked"))
diff --git a/test/unit/cljc/auto_sim/entity_test.cljc b/test/unit/cljc/auto_sim/entity_test.cljc
new file mode 100644
index 0000000..a04a36a
--- /dev/null
+++ b/test/unit/cljc/auto_sim/entity_test.cljc
@@ -0,0 +1,332 @@
+(ns auto-sim.entity-test
+ (:require
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.entity :as sut]))
+
+(deftest create-test
+ (is (= #::sim-engine{:entity {:uuid-1 #::sim-engine{:created 3
+ :living 3
+ :entity-state {:foo :bar}}}}
+ (sut/create {} 3 :foo-entity :uuid-1 {:foo :bar}))
+ "Adding a new entity that was not existing before.")
+ (is
+ (= {::sim-engine/entity {:uuid-1 #::sim-engine{:created 4
+ :entity-state {:foo :c
+ :a :b}
+ :errors
+ [#::sim-engine{:why ::sim-engine/already-created
+ :entity-name :foo-entity
+ :entity-id :uuid-1
+ :bucket 5
+ :entity-state {:foo :bar}}]}}}
+ (sut/create #::sim-engine{:entity {:uuid-1 #::sim-engine{:created 4
+ :entity-state {:a :b
+ :foo :c}}}}
+ 5 :foo-entity
+ :uuid-1 {:foo :bar}))
+ "Adding an already existing entity is merging the data map, but created lifecycle is not updated and an error is documented.
+Note that `created` `bucket` is not modified on purpose as the real creation has happened before."))
+
+(deftest errors-test
+ (is (= {} (sut/errors {})) "No errors returns an empty map.")
+ (is (= {:entity-with-error [:list-of-errors]}
+ (-> #::sim-engine{:entity {:entity-with-error
+ #::sim-engine{:created #::sim-engine{:bucket 5}
+ :living #::sim-engine{:bucket 5}
+ :entity-state {:foo :bar
+ :a :b}
+ :errors [:list-of-errors]}
+ :entity-without-error #::sim-engine{}}}
+ sut/errors))
+ "Errors of a specific `entity-name` are returned.")
+ (is (= {:foo-entity [:error1 :error2]}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 5}
+ :living #::sim-engine{:bucket 5}
+ :entity-state {:foo :bar
+ :a :b}
+ :errors [:error1 :error2]}
+ :ok-entity #::sim-engine{}}}
+ sut/errors))
+ "Errors are caught in the list, only entities where an error occur."))
+
+(deftest entity-errors-test
+ (is (nil? (sut/entity-errors {} :uuid-1)) "A non existing entity has no error")
+ (is (= :list-of-errors
+ (-> #::sim-engine{:entity {:entity-with-error
+ #::sim-engine{:created #::sim-engine{:bucket 5}
+ :living #::sim-engine{:bucket 5}
+ :entity-state {:foo :bar
+ :a :b}
+ :errors :list-of-errors}
+ :entity-without-error #::sim-engine{}}}
+ (sut/entity-errors {::sim-engine/entity-id :entity-with-error})))
+ "Errors of a specific `entity-id` is returned."))
+
+(def state-stub
+ #::sim-engine{:entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 4}
+ :entity-state {:data :of
+ :an :entity}}}})
+
+(deftest update-test
+ (is
+ (= #::sim-engine{:entity {:foo-entity #::sim-engine{:created 3
+ :living 5
+ :entity-state {:data :of
+ :and :another-data
+ :an :entity}}}}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created 3
+ :living 4
+ :entity-state {:data :of
+ :an :entity}}}}
+ (sut/update {::sim-engine/entity-id :foo-entity} 5 assoc :and :another-data)))
+ "When an existing entity that is living is updated, its entity state and living lifecycle are updated, the created is not modified.")
+ (is
+ (= #::sim-engine{:entity {:foo-entity
+ #::sim-engine{:created 3
+ :living 4
+ :entity-state {:data :of
+ :an :entity}
+ ::sim-engine/errors
+ [#::sim-engine{:why ::sim-engine/exception-during-update
+ :entity-id :foo-entity
+ :old-entity #::sim-engine{:created 3
+ :living 4
+ :entity-state
+ {:data :of
+ :an :entity}}
+ :bucket 5
+ :args nil}]}}}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created 3
+ :living 4
+ :entity-state {:data :of
+ :an :entity}}}}
+ (sut/update {::sim-engine/entity-id :foo-entity} 5 #(throw (ex-info "Hey no!" {:a %})))
+ (update-in [::sim-engine/entity :foo-entity ::sim-engine/errors 0]
+ dissoc
+ ::sim-engine/exception
+ ::sim-engine/function)))
+ "If update is raising an exception, the error is documented, the living date is not, as we consider the update skipped.")
+ (is
+ (= #::sim-engine{:entity {:foo-entity
+ #::sim-engine{:created 3
+ :living 12
+ :entity-state {:data :of
+ :an :entity
+ :bar :foo}
+ :disposed 5
+ :errors
+ [#::sim-engine{:why
+ ::sim-engine/updating-a-disposed-entity
+ :bucket 12
+ :entity-id :foo-entity
+ :old-entity #::sim-engine{:created 3
+ :living 4
+ :entity-state
+ {:data :of
+ :an :entity}
+ :disposed 5}
+ :function assoc
+ :args [:bar :foo]}]}}}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created 3
+ :living 4
+ :entity-state {:data :of
+ :an :entity}
+ :disposed 5}}}
+ (sut/update {::sim-engine/entity-id :foo-entity} 12 assoc :bar :foo)))
+ "The update function documents an error if the entity is already disposed, the creation is marked in the lifecycle status.")
+ (is (= [#::sim-engine{:why ::sim-engine/updating-a-not-created-entity
+ :entity-id :foo-entity
+ :old-entity nil
+ :bucket 12
+ :function assoc
+ :args [:bar :foo]}]
+ (-> {}
+ (sut/update {::sim-engine/entity-id :foo-entity} 12 assoc :bar :foo)
+ (sut/entity-errors {::sim-engine/entity-id :foo-entity})))
+ "Update can update a non existing entity, the creation is marked in the lifecycle status."))
+
+(deftest state-test
+ (is (= {:foo :bar}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created 3
+ :living 3
+ :entity-state {:foo :bar}}}}
+ (sut/state {::sim-engine/entity-id :foo-entity})))
+ "The state is returned.")
+ (is (nil? (sut/state {} :non-existing-entity)) "No state returned for non existing."))
+
+(deftest dispose-test
+ (is (= #::sim-engine{:entity {:foo-entity #::sim-engine{:created 3
+ :living 5
+ :disposed 10}}}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:entity-state {:data :of
+ :an :entity}
+ :created 3
+ :living 5}}}
+ (sut/dispose {::sim-engine/entity-id :foo-entity} 10)))
+ "Disposing an existing entity is updatng the lifecycle and remove its entity-state")
+ (is (= {::sim-engine/entity
+ {:foo-entity
+ #::sim-engine{:created 10
+ :disposed 10
+ :errors [#::sim-engine{:bucket 10
+ :entity-id :foo-entity
+ :old-entity nil
+ :why ::sim-engine/disposing-a-not-created-entity}]
+ :living 10}}}
+ (-> #::sim-engine{}
+ (sut/dispose {::sim-engine/entity-id :foo-entity} 10)))
+ "Disposing a non existing entity creates it and its lifecycle data, and reports an error.")
+ (is (= #::sim-engine{:entity {:foo-entity
+ #::sim-engine{:disposed 10
+ :created 3
+ :errors
+ [#::sim-engine{:bucket 10
+ :entity-id :foo-entity
+ :old-entity #::sim-engine{:disposed 7
+ :created 3
+ :living 5}
+ :why ::sim-engine/already-disposed}]
+ :living 5}}}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:disposed 7
+ :created 3
+ :living 5}}}
+ (sut/dispose {::sim-engine/entity-id :foo-entity} 10)))
+ "Disposing an already disposed entity reports an error."))
+
+(deftest lifecycle-status-test
+ (is (-> {}
+ (sut/lifecycle-status :an-non-created-entity)
+ empty?)
+ "Non existing entity has no lifecycle status.")
+ (is
+ (= #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 11}}
+ (-> {::sim-engine/entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 11}
+ :entity-state {:foo :bar}}}}
+ (sut/lifecycle-status {::sim-engine/entity-id :foo-entity})))
+ "When the entity is created, its lifecycle-status has its created and living fields at the same date.")
+ (is (= #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 11}}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 11}
+ :entity-state {:foo :bar}}}}
+ (sut/lifecycle-status {::sim-engine/entity-id :foo-entity})))
+ "After update, the lifecycle has a new living date.")
+ (is (= #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 11}
+ :disposed #::sim-engine{:bucket 15}}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 11}
+ :disposed #::sim-engine{:bucket 15}
+ :entity-state {:foo :bar}}}}
+ (sut/lifecycle-status {::sim-engine/entity-id :foo-entity})))
+ "After disposed, the lifecycle has a disposed data."))
+
+(deftest is-created?-test
+ (is (not (some? (-> {}
+ (sut/is-created? :foo-entity))))
+ "A non existing entity is not created.")
+ (is (some? (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket
+ 11}}}}
+ (sut/is-created? {::sim-engine/entity-id :foo-entity})))
+ "A living entity is created.")
+ (is (some? (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 11}
+ :disposed #::sim-engine{:bucket
+ 15}}}}
+ (sut/is-created? {::sim-engine/entity-id :foo-entity})))
+ "A disposed entity is created."))
+
+(deftest is-living?-test
+ (is (nil? (-> {}
+ (sut/is-living? :foo-entity)))
+ "A non existing entity is not living")
+ (is (= #::sim-engine{:bucket 11}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 11}}}}
+ (sut/is-living? {::sim-engine/entity-id :foo-entity})))
+ "A living entity is living")
+ (is (nil? (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 11}
+ :disposed #::sim-engine{:bucket
+ 15}}}}
+ (sut/is-living? {::sim-engine/entity-id :foo-entity})))
+ "A disposed entity is not living."))
+
+(deftest is-disposed?-test
+ (is (nil? (-> {}
+ (sut/is-disposed? {::sim-engine/entity-id :foo-entity})))
+ "A non existing entity is not disposed.")
+ (is (nil? (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket
+ 11}}}}
+ (sut/is-disposed? {::sim-engine/entity-id :foo-entity})))
+ "A living entity is not disposed.")
+ (is (= #::sim-engine{:bucket 15}
+ (-> #::sim-engine{:entity {:foo-entity #::sim-engine{:created #::sim-engine{:bucket 3}
+ :living #::sim-engine{:bucket 11}
+ :disposed #::sim-engine{:bucket 15}}}}
+ (sut/is-disposed? {::sim-engine/entity-id :foo-entity})))
+ "A disposed entity is disposed."))
+
+;; ********************************************************************************
+;;; Assembly tests
+;; ********************************************************************************
+
+(def state0 {})
+
+(def state1
+ (-> state0
+ (sut/create 3 :my-first-entity
+ :uuid-1 {:data :of
+ :an :entity})))
+
+(def state2
+ (-> state1
+ (sut/update {::sim-engine/entity-id :uuid-1} 5 assoc :and :another-data)))
+
+(def state3
+ (-> state2
+ (sut/dispose {::sim-engine/entity-id :uuid-1} 12)))
+
+(deftest assembly-tests
+ (is (nil? (sut/is-created? :non-existing state1)))
+ (is (nil? (sut/is-living? :non-existing state1)))
+ (is (nil? (sut/is-disposed? :non-existing state1)))
+ (is (= 3 (sut/is-created? state1 {::sim-engine/entity-id :uuid-1})))
+ (is (= 3 (sut/is-living? state1 {::sim-engine/entity-id :uuid-1})))
+ (is (nil? (sut/is-disposed? state1 {::sim-engine/entity-id :uuid-1})))
+ (is (= {:data :of
+ :an :entity
+ :and :another-data}
+ (sut/state state2 {::sim-engine/entity-id :uuid-1})))
+ (is (= 5 (sut/is-living? state2 {::sim-engine/entity-id :uuid-1})))
+ (is (= {:data :of
+ :an :entity
+ :and :another-data}
+ (-> state2
+ (sut/state {::sim-engine/entity-id :uuid-1}))))
+ (is (= nil
+ (-> state3
+ (sut/state {::sim-engine/entity-id :uuid-1}))))
+ (is (= nil
+ (-> state3
+ (sut/is-living? {::sim-engine/entity-id :uuid-1}))))
+ (is (= 12
+ (-> state3
+ (sut/is-disposed? {::sim-engine/entity-id :uuid-1})))))
+
+;; ********************************************************************************
+;; Event API
+;; ********************************************************************************
+(deftest schedule-test
+ (is (= #::sim-engine{:future-events [#::sim-engine{:event :data
+ :entity-id :entity-uuid-1
+ :bucket 3}]}
+ (sut/schedule nil {::sim-engine/entity-id :entity-uuid-1} 3 {::sim-engine/event :data}))
+ "Copy entity id"))
diff --git a/test/unit/cljc/auto_sim/middleware_test.cljc b/test/unit/cljc/auto_sim/middleware_test.cljc
new file mode 100644
index 0000000..56aaa55
--- /dev/null
+++ b/test/unit/cljc/auto_sim/middleware_test.cljc
@@ -0,0 +1,76 @@
+(ns auto-sim.middleware-test
+ (:require
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.middleware :as sut]
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])))
+
+(deftest wrap-tap-request-test
+ (is (= {:state #:state{:foo :bar}
+ :current-event {:current :event}
+ :response true
+ :future-events [{:foo :bar}]}
+ ((sut/wrap-tap-request (fn [current-event state future-events]
+ {:state state
+ :current-event current-event
+ :response true
+ :future-events future-events}))
+ {:current :event}
+ #:state{:foo :bar}
+ [{:foo :bar}]))
+ "Wrap-tap-request is returning the handler executed, returned value shows handler execution"))
+
+(deftest wrap-tap-response-test
+ (is (= {:state #:state{:foo :bar}
+ :current-event {:current :event}
+ :response true
+ :future-events [{:foo :bar}]}
+ ((sut/wrap-tap-response (fn [current-event state future-events]
+ {:state state
+ :current-event current-event
+ :response true
+ :future-events future-events}))
+ {:current :event}
+ #:state{:foo :bar}
+ [{:foo :bar}])))
+ "Wrap-tap-response is returning the handler executed, returned value shows handler execution")
+
+(deftest wrap-rendering-test
+ (is (= "{:foo :bar}\n"
+ (with-out-str ((sut/wrap-rendering (fn [state] (println state))
+ (fn [current-event state future-events]
+ {:state state
+ :current-event current-event
+ :response true
+ :future-events future-events}))
+ {:current :event}
+ {:foo :bar}
+ [{:foo :bar}])))
+ "Wrap-rendering is using the `rendering-fn` to print the state."))
+
+(deftest wrap-test
+ (is (= "state is: {:to-be :printed}\n"
+ (with-out-str ((sut/wrap [(partial sut/wrap-rendering
+ (fn [state] (println "state is:" state)))]
+ (fn [current-event state future-events]
+ {:state state
+ :current-event current-event
+ :response true
+ :future-events future-events}))
+ {:current :event}
+ {:to-be :printed}
+ [{:foo :bar}])))
+ "wrap is applying the wrap-rendering")
+ (is (= "state1 is: {:to-be :printed}\nstate2 is: {:to-be :printed}\n"
+ (with-out-str ((sut/wrap
+ [(partial sut/wrap-rendering (fn [state] (println "state1 is:" state)))
+ (partial sut/wrap-rendering (fn [state] (println "state2 is:" state)))]
+ (fn [current-event state future-events]
+ {:state state
+ :current-event current-event
+ :response true
+ :future-events future-events}))
+ {:current :event}
+ {:to-be :printed}
+ [{:foo :bar}])))
+ "Two middlewares are executed"))
diff --git a/test/unit/cljc/auto_sim/ordering_test.cljc b/test/unit/cljc/auto_sim/ordering_test.cljc
new file mode 100644
index 0000000..5e1298d
--- /dev/null
+++ b/test/unit/cljc/auto_sim/ordering_test.cljc
@@ -0,0 +1,55 @@
+(ns auto-sim.ordering-test
+ (:require
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.ordering :as sut]
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])))
+
+(deftest fields-test
+ (is (neg? ((sut/fields :foo) {:foo 1} {:foo 2})) "first is lower")
+ (is (pos? ((sut/fields :foo) {:foo 1} {:foo 0})) "second is lower")
+ (is (zero? ((sut/fields :foo) {:foo 2} {:foo 2})) "equality")
+ (is (pos? ((sut/fields :foo) {} {:foo 2})) "first not defined is considered like infinity")
+ (is (neg? ((sut/fields :foo) {:foo 1} {})) "second not defined is considered like infinity"))
+
+(deftest types-test
+ (is (neg? ((sut/types [:a :b]) {::sim-engine/type :a} {::sim-engine/type :b})) "first is lower")
+ (is (pos? ((sut/types [:b :c]) {::sim-engine/type :c} {::sim-engine/type :b})) "second is lower")
+ (is (zero? ((sut/types []) {::sim-engine/type :b} {::sim-engine/type :b})) "equality")
+ (is (pos? ((sut/types [:a :b :c]) {} {::sim-engine/type :b}))
+ "first not defined is considered like infinity")
+ (is (neg? ((sut/types [:a :b :c]) {::sim-engine/type :a} {}))
+ "second not defined is considered like infinity"))
+
+(deftest hashes-test
+ (is (= ((sut/hashes)
+ {::sim-engine/type :a
+ :foo 1}
+ {::sim-engine/type :b
+ :foo 2})
+ (- ((sut/hashes)
+ {::sim-engine/type :b
+ :foo 2}
+ {::sim-engine/type :a
+ :foo 1})))
+ "If hash says that a before b, so it says b is after a"))
+
+(deftest sorter-test
+ (is (= [{:auto-sim.engine/type :a
+ :foo 1}
+ {:auto-sim.engine/type :b
+ :foo 2}]
+ ((sut/sorter (sut/fields :foo) (sut/types [:a :b :c]))
+ [{::sim-engine/type :a
+ :foo 1}
+ {::sim-engine/type :b
+ :foo 2}])))
+ (is (= [{:auto-sim.engine/type :a
+ :foo 1}
+ {:auto-sim.engine/type :b
+ :foo 2}]
+ ((sut/sorter (sut/fields :foo) (sut/types [:a :b :c]))
+ [{::sim-engine/type :b
+ :foo 2}
+ {::sim-engine/type :a
+ :foo 1}]))))
diff --git a/test/unit/cljc/auto_sim/rc/resource/consumption_test.cljc b/test/unit/cljc/auto_sim/rc/resource/consumption_test.cljc
new file mode 100644
index 0000000..59ab6e1
--- /dev/null
+++ b/test/unit/cljc/auto_sim/rc/resource/consumption_test.cljc
@@ -0,0 +1,100 @@
+(ns auto-sim.rc.resource.consumption-test
+ (:require
+ [auto-sim.engine :as-alias sim-engine]
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])
+ [auto-sim.rc.resource.consumption :as sut]))
+
+(deftest consume-test
+ (is (= {:resource {}
+ :errors [#::sim-engine{:why :event-miss-entity-id
+ :consumption-quantity nil}]}
+ (sut/start nil nil nil :a))
+ "An event with no entity-id is documented as an error")
+ (is (= {:resource {}
+ :errors [#::sim-engine{:why :consumption-quantity-wrong
+ :resource nil
+ :consumption-quantity nil}]}
+ (sut/start nil {::sim-engine/entity-id :entity-uuuid} nil :a))
+ "A wrong consumption quantity is documented as an error")
+ (is
+ (= {:consumption-uuid :uuid-stub
+ :resource #:auto-sim.engine{:consumption {:uuid-stub
+ #:auto-sim.engine{:entity-id :entity-uuid
+ :priority :a
+ :consumption-quantity 1}}}}
+ (let [{:keys [consumption-uuid resource]} (sut/start {}
+ #::sim-engine{:a :b
+ :entity-id :entity-uuid}
+ 1
+ :a)]
+ {:consumption-uuid :uuid-stub
+ :resource (update resource
+ ::sim-engine/consumption
+ update-keys
+ (fn [k] (if (= k consumption-uuid) :uuid-stub k)))}))
+ "The consumption stores `entity-id` and `consumption-quantity` under the generated `consumption-uuid`"))
+
+(deftest free-test
+ (is (= {:resource #::sim-engine{:consumption {}}}
+ (sut/ended #::sim-engine{:consumption {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
+ #::sim-engine{:entity-id :entity-uuid
+ :consumed-quantity 3}}}
+ #uuid "33497220-f844-11ee-9fa1-17acea14e9df"))
+ "An event that has been successfully removed is not the consumption list anymore")
+ (is (let [resource #::sim-engine{:consumption {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
+ #::sim-engine{:event {:a :b}
+ :consumed-quantity 3}}}]
+ (= {:resource resource
+ :errors [#::sim-engine{:why :consumption-uuid-does-not-exist
+ :resource resource
+ :consumption-uuid #uuid "33497220-f844-11ee-9fa1-17acea14e8ee"}]}
+ (sut/ended resource #uuid "33497220-f844-11ee-9fa1-17acea14e8ee")))
+ "A non existing consumption-uuid does not modify the resource but returns an error"))
+
+(deftest compare-by-order-test
+ (is (neg? ((sut/compare-by-order [:a :b]) :a :b)) "a is before b -> negative value")
+ (is (pos? ((sut/compare-by-order [:a :b]) :b :a)) "b is before a -> positive value")
+ (is (zero? ((sut/compare-by-order [:a :b]) :b :b)) "b equals b -> zero"))
+
+(deftest consumption-by-priority-test
+ (is (= [#:auto-sim.engine{:entity-id :entity-uuid
+ :priority :a
+ :consumption-quantity 1}
+ #:auto-sim.engine{:entity-id :entity-uuid
+ :priority :b
+ :consumption-quantity 2}]
+ (mapv second
+ (-> (sut/start {}
+ #::sim-engine{:a :b
+ :entity-id :entity-uuid}
+ 1
+ :a)
+ :resource
+ (sut/start #::sim-engine{:c :d
+ :entity-id :entity-uuid}
+ 2
+ :b)
+ :resource
+ (sut/consumption-by-priority (sut/compare-by-order [:a :b])))))
+ "Returns `a` first as the order is describing")
+ (is (= [#:auto-sim.engine{:entity-id :entity-uuid
+ :priority :b
+ :consumption-quantity 2}
+ #:auto-sim.engine{:entity-id :entity-uuid
+ :priority :a
+ :consumption-quantity 1}]
+ (mapv second
+ (-> (sut/start {}
+ #::sim-engine{:a :b
+ :entity-id :entity-uuid}
+ 1
+ :a)
+ :resource
+ (sut/start #::sim-engine{:c :d
+ :entity-id :entity-uuid}
+ 2
+ :b)
+ :resource
+ (sut/consumption-by-priority (sut/compare-by-order [:b :a])))))
+ "Returns `b` first as the order is describing"))
diff --git a/test/unit/cljc/auto_sim/rc/resource/queue_test.cljc b/test/unit/cljc/auto_sim/rc/resource/queue_test.cljc
new file mode 100644
index 0000000..0105aee
--- /dev/null
+++ b/test/unit/cljc/auto_sim/rc/resource/queue_test.cljc
@@ -0,0 +1,215 @@
+(ns auto-sim.rc.resource.queue-test
+ (:require
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.rc.resource.queue :as sut]
+ [auto-sim.rc.unqueueing-policy :refer [fifo]]))
+
+(deftest queue-event-test
+ (is (= {:resource nil
+ :errors [#::sim-engine{:why :queuing-an-empty-event
+ :resource nil
+ :consumption-quantity 1
+ :priority :low
+ :event {}}]}
+ (sut/queue-event nil {} 1 :low))
+ "Empty events are not queued")
+ (is (= {:resource nil
+ :errors [#::sim-engine{:why :consumption-quantity-wrong
+ :resource nil
+ :consumption-quantity -1
+ :priority :low
+ :event {::sim-engine/type :a}}]}
+ (sut/queue-event nil {::sim-engine/type :a} -1 :low))
+ "Wrong consumption-quantity are not queued")
+ (is (= {:resource #::sim-engine{:queue [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :priority :low
+ :consumption-quantity 13}]
+ :resource-name ::test}}
+ (sut/queue-event #::sim-engine{:resource-name ::test}
+ #::sim-engine{:type :a
+ :bucket 1}
+ 13
+ :low))
+ "Successfully queuing an event in an empty queue.")
+ (is (= 3
+ (-> (sut/queue-event #::sim-engine{:resource-name ::test
+ :queue [:stub1 :stub2]}
+ #::sim-engine{:type :a
+ :bucket 1}
+ 13
+ :low)
+ :resource
+ ::sim-engine/queue
+ count))
+ "Further events are queued"))
+
+(deftest unqueue-event-test
+ (is (= {:resource #::sim-engine{:queue []}} (sut/unqueue-event {::sim-engine/queue []} 1 fifo))
+ "Unqueue an empty queue is noop")
+ (is
+ (= {:unqueued []
+ :resource #::sim-engine{:queue [{:a 2}]}}
+ (sut/unqueue-event #::sim-engine{:queue [{:a 2}]} 0 fifo))
+ "If unqueue is triggered with a zero or negative availability, it is not modifying the resource")
+ (is (= {:unqueued [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :consumption-quantity 2}]
+ :resource #::sim-engine{:queue [#::sim-engine{:event #::sim-engine{:type :b
+ :bucket 2}
+ :consumption-quantity 2}]}}
+ (sut/unqueue-event #::sim-engine{:queue [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :consumption-quantity 2}
+ #::sim-engine{:event #::sim-engine{:type :b
+ :bucket 2}
+ :consumption-quantity 2}]}
+ 2
+ fifo))
+ "With FIFO, the first met event in the queue is released.")
+ (is (= {:unqueued []
+ :resource #::sim-engine{:queue [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :consumption-quantity 2}
+ #::sim-engine{:event #::sim-engine{:type :b
+ :bucket 2}
+ :consumption-quantity 2}]}}
+ (sut/unqueue-event #::sim-engine{:queue [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :consumption-quantity 2}
+ #::sim-engine{:event #::sim-engine{:type :b
+ :bucket 2}
+ :consumption-quantity 2}]}
+ 1
+ fifo))
+ "If the released quantity is not enough, no event is returned")
+ (is
+ (= {:unqueued []
+ :resource #::sim-engine{:queue [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :consumption-quantity 2}
+ #::sim-engine{:event #::sim-engine{:type :b
+ :bucket 2}
+ :consumption-quantity 1}]}}
+ (sut/unqueue-event #::sim-engine{:queue [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :consumption-quantity 2}
+ #::sim-engine{:event #::sim-engine{:type :b
+ :bucket 2}
+ :consumption-quantity 1}]}
+ 1
+ fifo))
+ "If the released quantity is not enough, no event is returned. Even if a further event is matching, unqueuing policy is more important")
+ (is (= {:unqueued [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :consumption-quantity 2}
+ #::sim-engine{:event #::sim-engine{:type :b
+ :bucket 2}
+ :consumption-quantity 1}]
+ :resource #::sim-engine{:queue []}}
+ (sut/unqueue-event #::sim-engine{:queue [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :consumption-quantity 2}
+ #::sim-engine{:event #::sim-engine{:type :b
+ :bucket 2}
+ :consumption-quantity 1}]}
+ 100
+ fifo))
+ "When quantity is big enough, all events are released.")
+ (is (= {:unqueued [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :consumption-quantity 2}
+ #::sim-engine{:event #::sim-engine{:type :b
+ :bucket 2}
+ :consumption-quantity 1}]
+ :resource #::sim-engine{:queue []}}
+ (sut/unqueue-event #::sim-engine{:queue [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 1}
+ :consumption-quantity 2}
+ #::sim-engine{:event #::sim-engine{:type :b
+ :bucket 2}
+ :consumption-quantity 1}]}
+ 3
+ fifo))
+ "Available quantity is matching exactly the sum of released quantity")
+ (is (= {:unqueued [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 0}}]
+ :resource {::sim-engine/queue []}}
+ (sut/unqueue-event #::sim-engine{:queue [#::sim-engine{:event #::sim-engine{:type :a
+ :bucket 0}}]}
+ 1
+ fifo))
+ "Unqueue can drop the last element and returns an empty queue"))
+
+
+(deftest assembly
+ (is (= {:unqueued [#::sim-engine{:event {:event :a}
+ :priority :high
+ :consumption-quantity 1}]
+ :resource #::sim-engine{:queue []}}
+ (-> (sut/queue-event {} {:event :a} 1 :high)
+ :resource
+ (sut/unqueue-event 1 fifo)))
+ "Unqueue returns the element if the quantity is matching")
+ (is (= {:unqueued [#::sim-engine{:event {:a :b}
+ :priority :high
+ :consumption-quantity 17}]
+ :resource {::sim-engine/queue [#::sim-engine{:event {:a :c}
+ :priority :high
+ :consumption-quantity 19}
+ #::sim-engine{:event {:d :b}
+ :priority :high
+ :consumption-quantity 11}]}}
+ (-> {}
+ (sut/queue-event {:a :b} 17 :high)
+ :resource
+ (sut/queue-event {:a :c} 19 :high)
+ :resource
+ (sut/queue-event {:d :b} 11 :high)
+ :resource
+ (sut/unqueue-event 17 fifo)))
+ "Unqueue is exactly matching the first element")
+ (is (= {:unqueued [#::sim-engine{:event {:a :b}
+ :priority :high
+ :consumption-quantity 1}
+ #::sim-engine{:event {:d :b}
+ :priority :high
+ :consumption-quantity 2}]
+ :resource #::sim-engine{:queue []}}
+ (-> {}
+ (sut/queue-event {:a :b} 1 :high)
+ :resource
+ (sut/queue-event {:d :b} 2 :high)
+ :resource
+ (sut/unqueue-event 5 fifo)))
+ "Unqueue all events")
+ (is (= {:unqueued []
+ :resource #::sim-engine{:queue [#::sim-engine{:event {:a :b}
+ :priority :high
+ :consumption-quantity 10}
+ #::sim-engine{:event {:d :b}
+ :priority :high
+ :consumption-quantity 20}]}}
+ (-> {}
+ (sut/queue-event {:a :b} 10 :high)
+ :resource
+ (sut/queue-event {:d :b} 20 :high)
+ :resource
+ (sut/unqueue-event 5 fifo)))
+ "No event is released if available capacity is less than what is seized")
+ (is (= {:unqueued [#::sim-engine{:event {:a :b}
+ :priority :high
+ :consumption-quantity 1}
+ #::sim-engine{:event {:d :b}
+ :priority :high
+ :consumption-quantity 2}]
+ :resource #::sim-engine{:queue []}}
+ (-> {}
+ (sut/queue-event {:a :b} 1 :high)
+ :resource
+ (sut/queue-event {:d :b} 2 :high)
+ :resource
+ (sut/unqueue-event 3 fifo)))
+ "unqueue exactly the expected capacity of two events"))
diff --git a/test/unit/cljc/auto_sim/rc/resource_test.cljc b/test/unit/cljc/auto_sim/rc/resource_test.cljc
new file mode 100644
index 0000000..ebd4337
--- /dev/null
+++ b/test/unit/cljc/auto_sim/rc/resource_test.cljc
@@ -0,0 +1,295 @@
+(ns auto-sim.rc.resource-test
+ (:require
+ #?(:clj [clojure.test :refer [deftest is testing]]
+ :cljs [cljs.test :refer [deftest is testing] :include-macros true])
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.rc.preemption-policy :refer [no-preemption]]
+ [auto-sim.rc.resource :as sut]
+ [auto-sim.rc.resource.consumption :as sim-rc-consumption]
+ [auto-sim.rc.unqueueing-policy :refer [fifo]]))
+
+(deftest defaulting-values-test
+ (is (= #::sim-engine{:capacity 1
+ :consumption {}
+ :queue []
+ :renewable? true}
+ (sut/defaulting-values nil))
+ "A purely defaulted value resource")
+ (is (= #::sim-engine{:capacity 1
+ :consumption {}
+ :queue []
+ :renewable? true
+ :other-keys :are-allowed}
+ (sut/defaulting-values #::sim-engine{:other-keys :are-allowed}))
+ "Other data are kept"))
+
+(deftest nb-consumed-capacity-test
+ (is (zero? (sut/nb-consumed-resources nil))
+ "With no currently seized, all the capacity is available")
+ (is (zero? (sut/nb-consumed-resources #::sim-engine{:queue []}))
+ "With no currently seized, all the capacity is available")
+ (is (= 1 (sut/nb-consumed-resources #::sim-engine{:consumption {:a {:a :b}}}))
+ "Defaulted consumption-quantity to 1")
+ (is (= 8
+ (sut/nb-consumed-resources #::sim-engine{:consumption
+ {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
+ {::sim-engine/consumption-quantity 3}
+ #uuid "33497220-f844-11ee-9fa1-17acea14e9de"
+ {::sim-engine/consumption-quantity 5}}}))
+ "Currently seized are summed up"))
+
+(deftest nb-available-resources-test
+ (is (= 7 (sut/nb-available-resources #::sim-engine{:capacity 7}))
+ "With no currently seized, all the capacity is available")
+ (is
+ (= 9
+ (sut/nb-available-resources #::sim-engine{:capacity 17
+ :consumption
+ {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
+ {::sim-engine/event #::sim-engine{:type ::c
+ :date 11}
+ ::sim-engine/consumption-quantity 3}
+ #uuid "33497220-f844-11ee-9fa1-17acea14e9de"
+ {:sim-engine/event #::sim-engine{:type ::d
+ :date 19}
+ ::sim-engine/consumption-quantity 5}}}))
+ "Currently seized events are deduced from capacity, their seized quantity is taken into account")
+ (is (zero? (sut/nb-available-resources #::sim-engine{:capacity 8
+ :consumption
+ {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
+ {::sim-engine/event #::sim-engine{:type ::c
+ :date 11}
+ ::sim-engine/consumption-quantity 3}
+ #uuid "33497220-f844-11ee-9fa1-17acea14e9de"
+ {::sim-engine/event #::sim-engine{:type ::d
+ :date 19}
+ ::sim-engine/consumption-quantity 5}}}))
+ "If all resources are used, zero are available")
+ (is (zero? (sut/nb-available-resources #::sim-engine{:capacity 7
+ :consumption
+ {#uuid "33497220-f844-11ee-9fa1-17acea14e9df"
+ {::sim-engine/event #::sim-engine{:type ::c
+ :date 11}
+ ::sim-engine/consumption-quantity 3}
+ #uuid "33497220-f844-11ee-9fa1-17acea14e9de"
+ {::sim-engine/event #::sim-engine{:type ::d
+ :date 19}
+ ::sim-engine/consumption-quantity 5}}}))
+ "If more than all resources are used, zero are available"))
+
+(deftest seize-test
+ (testing "Seizing with enough capacity is consuming"
+ (is (= #::sim-engine{:entity-id :entity-uuid
+ :priority :medium
+ :consumption-quantity 9}
+ (let [res (sut/seize #::sim-engine{:capacity 13}
+ #::sim-engine{:entity-id :entity-uuid}
+ 9
+ :medium
+ #::sim-engine{:a :b})
+ {:keys [consumption-uuid resource]} res]
+ (get-in resource [::sim-engine/consumption consumption-uuid])))
+ "Seizing one resource with enough capacity available")
+ (is (= #::sim-engine{:entity-id :entity-uuid
+ :priority :medium
+ :consumption-quantity 9}
+ (let [res (sut/seize #::sim-engine{:capacity 9}
+ #::sim-engine{:entity-id :entity-uuid}
+ 9
+ :medium
+ #::sim-engine{:a :b})
+ {:keys [consumption-uuid resource]} res]
+ (get-in resource [::sim-engine/consumption consumption-uuid])))
+ "Seizing one resource with the exact capacity available")
+ (is (= #::sim-engine{:entity-id :entity-uuid
+ :priority :medium
+ :consumption-quantity 1}
+ (let [res (sut/seize #::sim-engine{}
+ #::sim-engine{:entity-id :entity-uuid}
+ 1
+ :medium
+ #::sim-engine{:a :b})
+ {:keys [consumption-uuid resource]} res]
+ (get-in resource [::sim-engine/consumption consumption-uuid])))
+ "No capacity defined for the resource is defaulted to 1")
+ (is (= {:resource {}
+ :errors [#::sim-engine{:why :consumption-quantity-wrong
+ :resource {}
+ :consumption-quantity -1}]}
+ (sut/seize #::sim-engine{}
+ #::sim-engine{:entity-id :entity-uuid}
+ -1
+ :medium
+ #::sim-engine{:a :b}))
+ "Errors are returned"))
+ (testing "Seizing with missing capacity returns `nil` consumption and adds it to the queue."
+ (is (= {:resource #::sim-engine{:capacity 0
+ :queue [#::sim-engine{:event #::sim-engine{:a :b
+ :entity-id
+ :entity-uuid}
+ :priority :high
+ :consumption-quantity 1}]}}
+ (sut/seize #::sim-engine{:capacity 0}
+ #::sim-engine{:entity-id :entity-uuid}
+ 1
+ :high
+ #::sim-engine{:a :b}))
+ "A resource with zero capacity is queueing all events")
+ (is (= {:resource #::sim-engine{:capacity 12}
+ :errors [#::sim-engine{:why :consumption-quantity-wrong
+ :resource #::sim-engine{:capacity 12}
+ :consumption-quantity -20}]}
+ (sut/seize #::sim-engine{:capacity 12}
+ #::sim-engine{:entity-id :entity-uuid}
+ -20
+ :high
+ #::sim-engine{:a :b}))
+ "An error is seizing is returned.")
+ (is (= {:resource #::sim-engine{:capacity 12
+ :queue [#::sim-engine{:event #::sim-engine{:a :b
+ :entity-id
+ :entity-uuid}
+ :priority :high
+ :consumption-quantity 20}]}}
+ (sut/seize #::sim-engine{:capacity 12}
+ #::sim-engine{:entity-id :entity-uuid}
+ 20
+ :high
+ #::sim-engine{:a :b}))
+ "A too high capacity required is queueing all events")))
+
+(deftest dispose-consumption-uuid-test
+ (is (= {:resource {}
+ :errors [#::sim-engine{:why :consumption-uuid-does-not-exist
+ :resource {}
+ :consumption-uuid :foo}]}
+ (sut/dispose-consumption-uuid {} fifo :foo))
+ "A non existing consumption uuid documents an error")
+ (is (= {:resource #::sim-engine{:queue []
+ :capacity 14
+ :consumption {}}
+ :events [#::sim-engine{:event {:a :b}}]}
+ (-> #::sim-engine{:queue [#::sim-engine{:event {:a :b}}]
+ :capacity 14
+ :consumption {:uuid-stub #::sim-engine{:consumption-quantity 12}}}
+ (sut/dispose-consumption-uuid fifo :uuid-stub)))
+ "Consumption is removed from the resource, events returned in the `events` keyword"))
+
+(deftest dispose-test
+ (is (= {:errors [#::sim-engine{:why :resource-dont-have-capacity
+ :capacity nil}]}
+ (sut/dispose {} (sim-rc-consumption/compare-by-order []) fifo 1))
+ "Disposing a non-existing resource is noop on the resource and documents an error")
+ (is (= {:errors [#::sim-engine{:why :cant-dispose-quantity
+ :capacity 20
+ :quantity-to-dispose 1
+ :consumption-uuid nil
+ :quantity 1}]}
+ (sut/dispose #::sim-engine{:capacity 20
+ :consumption {}
+ :queue []}
+ (sim-rc-consumption/compare-by-order [])
+ fifo
+ 1))
+ "When too much is disposed, an error is documented")
+ (is (= {:resource #::sim-engine{:capacity 20
+ :consumption {}
+ :queue []}
+ :events nil}
+ (-> #::sim-engine{:capacity 20
+ :consumption {:consumption-uuid-stub
+ #::sim-engine{:consumption-quantity 1
+ :entity-id :entity-id-stub}}
+ :queue []}
+ (sut/dispose (sim-rc-consumption/compare-by-order []) fifo 1)))
+ "Dispose the last consumption, no other event is pending")
+ (is (= {:resource #::sim-engine{:capacity 20
+ :consumption {:consumption-uuid-stub
+ #::sim-engine{:consumption-quantity 7
+ :entity-id :entity-id-stub}}
+ :queue []}
+ :events nil}
+ (-> #::sim-engine{:capacity 20
+ :consumption {:consumption-uuid-stub
+ #::sim-engine{:consumption-quantity 10
+ :entity-id :entity-id-stub}}
+ :queue []}
+ (sut/dispose (sim-rc-consumption/compare-by-order []) fifo 3)))
+ "Dispose a part of a consumption, so a part of that consumption remains")
+ (is (= {:events [#::sim-engine{:event {:a :b}
+ :consumption-quantity 12}]
+ :resource #::sim-engine{:capacity 20
+ :consumption {}
+ :queue []}}
+ (sut/dispose #::sim-engine{:capacity 20
+ :consumption {:consumption-stub
+ #::sim-engine{:consumption-quantity 13}}
+ :queue [#::sim-engine{:event {:a :b}
+ :consumption-quantity 12}]}
+ (sim-rc-consumption/compare-by-order [])
+ fifo
+ 13))
+ "Dispose an event, another in the queue is to be executed."))
+
+(deftest dispose-seize-test
+ (is (= {:resource #::sim-engine{:consumption {}
+ :capacity 1
+ :queue
+ [#::sim-engine{:event #::sim-engine{:a :b2
+ :entity-id :entity-uuid}
+ :priority :high
+ :consumption-quantity 2}
+ #::sim-engine{:event #::sim-engine{:a :b3
+ :entity-id :entity-uuid}
+ :priority :high
+ :consumption-quantity 3}]}
+ :events []}
+ (-> #::sim-engine{:capacity 1}
+ (sut/seize #::sim-engine{:entity-id :entity-uuid} 1 :high #::sim-engine{:a :b1})
+ :resource
+ (sut/seize #::sim-engine{:entity-id :entity-uuid} 2 :high #::sim-engine{:a :b2})
+ :resource
+ (sut/seize #::sim-engine{:entity-id :entity-uuid} 3 :high #::sim-engine{:a :b3})
+ :resource
+ (sut/dispose (sim-rc-consumption/compare-by-order []) fifo 1)))
+ "Disposing 1 which is not enough for next event")
+ (is (= {:events [#::sim-engine{:event #::sim-engine{:a :b2
+ :entity-id :entity-uuid}
+ :priority :high
+ :consumption-quantity 2}]
+ :resource #::sim-engine{:consumption {}
+ :capacity 2
+ :queue [#::sim-engine{:event #::sim-engine{:a :b3
+ :entity-id
+ :entity-uuid}
+ :priority :high
+ :consumption-quantity 3}]}}
+ (-> #::sim-engine{:capacity 2}
+ (sut/seize #::sim-engine{:entity-id :entity-uuid} 1 :high #::sim-engine{:a :b1})
+ :resource
+ (sut/seize #::sim-engine{:entity-id :entity-uuid} 2 :high #::sim-engine{:a :b2})
+ :resource
+ (sut/seize #::sim-engine{:entity-id :entity-uuid} 3 :high #::sim-engine{:a :b3})
+ :resource
+ (sut/dispose (sim-rc-consumption/compare-by-order []) fifo 1)))
+ "There is 1 capacity left, and 1 disposed, which is enough for the next one"))
+
+(deftest update-capacity-test
+ (is (= {:resource #::sim-engine{:capacity 7
+ :queue []}
+ :events nil}
+ (sut/update-capacity {} no-preemption fifo 7)
+ (sut/update-capacity nil no-preemption fifo 7)
+ (sut/update-capacity #::sim-engine{:capacity 5} no-preemption fifo 7))
+ "Empty resource is updated to 7")
+ (is (= 14
+ (-> #::sim-engine{:capacity 1}
+ (sut/update-capacity no-preemption fifo 14)
+ :resource
+ ::sim-engine/capacity))
+ "A resource is updated with the `new-capacity`")
+ (is (= {:resource #::sim-engine{:capacity 12
+ :queue []}
+ :events nil}
+ (sut/update-capacity #::sim-engine{:capacity 5} no-preemption fifo 12))
+ "Preemption is defaulted to no-preemption"))
diff --git a/test/unit/cljc/auto_sim/rc/unqueueing_policy_test.cljc b/test/unit/cljc/auto_sim/rc/unqueueing_policy_test.cljc
new file mode 100644
index 0000000..0da594a
--- /dev/null
+++ b/test/unit/cljc/auto_sim/rc/unqueueing_policy_test.cljc
@@ -0,0 +1,10 @@
+(ns auto-sim.rc.unqueueing-policy-test
+ (:require
+ [auto-sim.rc :as-alias sim-rc]
+ [auto-sim.rc.unqueueing-policy :as sut]
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])))
+
+(deftest fifo-test (is (= [:a [:b :c]] (sut/fifo [:a :b :c]))))
+
+(deftest lifo-test (is (= [:c [:a :b]] (sut/lifo [:a :b :c]))))
diff --git a/test/unit/cljc/auto_sim/rc_test.cljc b/test/unit/cljc/auto_sim/rc_test.cljc
new file mode 100644
index 0000000..e0f9e61
--- /dev/null
+++ b/test/unit/cljc/auto_sim/rc_test.cljc
@@ -0,0 +1,128 @@
+(ns auto-sim.rc-test
+ (:require
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.rc :as sut]
+ [auto-sim.rc.preemption-policy :refer [no-preemption]]
+ [auto-sim.rc.resource.consumption :as sim-rc-consumption]
+ [auto-sim.rc.unqueueing-policy :refer [fifo]]))
+
+(deftest define-resource-test
+ (is (= {::sim-engine/state {::sim-engine/resource {:foo #::sim-engine{:resource :content
+ :capacity 1
+ :consumption {}
+ :queue []
+ :renewable? true}}}}
+ (sut/define-resource {} nil 0 :foo #::sim-engine{:resource :content}))))
+
+(deftest seize-test
+ (is (= {::sim-engine/errors [#::sim-engine{:why :resource-not-found
+ :resource-name :auto-sim.rc-test/test
+ :quantity 1
+ :possible-resources []}]}
+ (sut/seize {} nil 3 ::test 1 {} :high))
+ "If the `resource-name` is not already defined in the `state`, the seizing is noop")
+ (is
+ (= #::sim-engine{:state {::sim-engine/resource
+ {::test #::sim-engine{:capacity 1
+ :consumption {}
+ :queue [#::sim-engine{:event
+ {:event :seizing
+ ::sim-engine/entity-id
+ :entity-id-stub}
+ :priority :high
+ :consumption-quantity 2}]
+ :renewable? true}}}}
+ (-> {}
+ (sut/define-resource nil 0 ::test {})
+ (sut/seize {::sim-engine/entity-id :entity-id-stub} 3 ::test 2 {:event :seizing} :high)))
+ "Seizing an non-available resource postpones the event execution. So it is in the queue and not in the future-events")
+ (is
+ (= #::sim-engine{:state {::sim-engine/resource
+ {::test #::sim-engine{:capacity 3
+ :consumption
+ {:uuid #::sim-engine{:entity-id :uuid-1
+ :consumption-quantity 2
+ :priority :high}}
+ :queue []
+ :renewable? true}}}
+ :future-events [#::sim-engine{:type :a
+ :bucket 3
+ :entity-id :uuid-1}]}
+ (-> {}
+ (sut/define-resource nil nil ::test {::sim-engine/capacity 3})
+ (sut/seize {::sim-engine/entity-id :uuid-1} 3 ::test 2 #::sim-engine{:type :a} :high)
+ (update-in [::sim-engine/state ::sim-engine/resource ::test ::sim-engine/consumption]
+ update-keys
+ (fn [_] :uuid))))
+ "When seizing an available resource, the state stores that consumption, and the event is scheduled now."))
+
+(deftest dispose-test
+ (is
+ (=
+ {::sim-engine/errors [#::sim-engine{:why :resource-not-found
+ :resource-name :auto-sim.rc-test/non-existing-resource
+ :quantity 3}]}
+ (->
+ {}
+ (sut/dispose nil 7 ::non-existing-resource 3 (sim-rc-consumption/compare-by-order []) fifo)))
+ "Disposing a non existing resource is noop")
+ (is (= #::sim-engine{:state #::sim-engine{:resource {::test #::sim-engine{:capacity 3
+ :consumption {}
+ :queue []
+ :renewable? true}}}
+ :errors [#::sim-engine{:why :cant-dispose-quantity
+ :capacity 3
+ :consumption-uuid nil
+ :quantity 3
+ :quantity-to-dispose 3}]}
+ (-> {}
+ (sut/define-resource nil nil ::test {::sim-engine/capacity 3})
+ (sut/dispose nil 7 ::test 3 (sim-rc-consumption/compare-by-order []) fifo)))
+ "Disposing more than what is seized")
+ (is (= #::sim-engine{:state {::sim-engine/resource {::test #::sim-engine{:capacity 3
+ :consumption {}
+ :queue []
+ :renewable? true}}}
+ :future-events [{:event :a
+ :auto-sim.engine/entity-id :entity-1
+ :auto-sim.engine/bucket 0}]}
+ (-> {}
+ (sut/define-resource nil nil ::test {::sim-engine/capacity 3})
+ (sut/seize {::sim-engine/entity-id :entity-1} 0 ::test 3 {:event :a} :high)
+ (sut/dispose nil 7 ::test 3 (sim-rc-consumption/compare-by-order []) fifo)))
+ "Disposing exactly what is seized")
+ (is (= 2
+ (-> {}
+ (sut/define-resource nil nil ::test {::sim-engine/capacity 5})
+ (sut/seize {::sim-engine/entity-id :entity-1} 0 ::test 5 {:event :a} :high)
+ (sut/dispose nil 7 ::test 3 (sim-rc-consumption/compare-by-order []) fifo)
+ (sut/nb-consumed-resources nil nil ::test)))
+ "Disposing a part of what is seized")
+ ;;
+ (is "Disposing a resource with blocked events release them"))
+
+(deftest update-capacity-test
+ (is (= {::sim-engine/errors [#::sim-engine{:why :resource-not-found
+ :resource-name :auto-sim.rc-test/test
+ :new-capacity 7}]}
+ (->
+ {}
+ (sut/update-capacity {::sim-engine/entity-id :entity-1} 2 ::test 7 no-preemption fifo)))
+ "Non existing resource are documented as an error")
+ (is (= #::sim-engine{:state #::sim-engine{:resource {::test #::sim-engine{:capacity 7
+ :consumption {}
+ :renewable? true
+ :queue []}}}}
+ (-> {}
+ (sut/define-resource nil nil ::test {::sim-engine/capacity 3})
+ (sut/update-capacity #::sim-engine{:resource {::test #::sim-engine{:capacity 5
+ :queue []}}}
+ []
+ ::test
+ 7
+ no-preemption
+ fifo)))
+ "Existing resource is updated"))
+
diff --git a/test/unit/cljc/auto_sim/stopping_criteria_test.cljc b/test/unit/cljc/auto_sim/stopping_criteria_test.cljc
new file mode 100644
index 0000000..af0f489
--- /dev/null
+++ b/test/unit/cljc/auto_sim/stopping_criteria_test.cljc
@@ -0,0 +1,52 @@
+(ns auto-sim.stopping-criteria-test
+ (:require
+ [auto-sim.engine :as-alias sim-engine]
+ [auto-sim.stopping-criteria :as sut]
+ #?(:clj [clojure.test :refer [deftest is]]
+ :cljs [cljs.test :refer [deftest is] :include-macros true])))
+
+(deftest stop-bucket-sd-test
+ (is (nil? ((sut/stop-bucket-sd 2) #::sim-engine{:bucket 1}))
+ "A bucket in the future doesn't stop")
+ (is (= #::sim-engine{:doc ["Stops at bucket %d as required" 2]
+ :id ::sut/bucket-stopping
+ :context {:stopping-bucket 2
+ :snapshot-bucket 2}}
+ ((sut/stop-bucket-sd 2) #::sim-engine{:bucket 2}))
+ "When the bucket is reached, returns an error")
+ (is (= #::sim-engine{:doc ["Stops at bucket %d (requiring %d)" 3 2]
+ :id ::sut/bucket-stopping
+ :context {:stopping-bucket 2
+ :snapshot-bucket 3}}
+ ((sut/stop-bucket-sd 2) #::sim-engine{:bucket 3}))
+ "When a bucket is exceeded, returned an error"))
+
+(deftest stop-now-sd-test
+ (is (= #::sim-engine{:doc ["Stop now."]
+ :id ::sut/stop-now
+ :context nil}
+ ((sut/stop-now-sd) {}))))
+
+(deftest stop-state-contains-sd-test
+ (is (nil? ((sut/stop-state-contains-sd #::sim-engine{:state-path [:foo :bar]}) {:foo {}}))
+ "If the path is not present, returns no error.")
+ (is (= #::sim-engine{:doc ["Stops as state contains `%s` in `%s`" true [:foo :bar]]
+ :id ::sut/state-contains
+ :context #::sim-engine{:snapshot-state {:foo {:bar true}}
+ :state-entry true}}
+ ((sut/stop-state-contains-sd [:foo :bar]) #::sim-engine{:state {:foo {:bar true}}}))))
+
+(deftest eval-test
+ (is (not-empty (sut/eval [(sut/stop-now-sd)] {}))
+ "A stopping criteria stops the whole evaluation")
+ (is (= [] (sut/eval [(sut/stop-state-contains-sd #::sim-engine{:state-path [:foo]})] {}))
+ "A criteria which is not matched")
+ (is (= [#::sim-engine{:doc ["Stop now."]
+ :id ::sut/stop-now
+ :context nil}]
+ (sut/eval [(sut/stop-state-contains-sd #::sim-engine{:state-path [:foo]})
+ (sut/stop-now-sd)]
+ {}))
+ "A criteria which is not matched"))
+
+(deftest stop-bucket-test (sut/stop-bucket {} 12))