diff --git a/CHANGELOG.md b/CHANGELOG.md index a763148..13d4d3b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,18 +1,84 @@ # 1.1.1 -ADDED `commando.debug` namespace — new dedicated module for debug visualization. Provides two main entry points: -- `execute-debug` — execute an instruction and visualize it in one of six display modes: `:tree`, `:table`, `:graph`, `:stats`, `:instr-before` / `:instr-after`. Supports combining multiple modes via a vector. -- `execute-trace` — trace all nested `commando/execute` calls. +## Breaking Changes -REMOVED **BREAKING** `print-stats`, `print-trace` (`print-deep-stats`) from `commando.impl.utils`. These functions have been replaced by the richer `commando.debug` namespace. +**BREAKING** `execute` accepts an optional third argument — a config map that replaces the old `binding`-based `*execute-config*` dynamic var for passing options. Users no longer need `(binding [utils/*execute-config* {...}] (execute ...))`. +- `(execute registry instruction)` — unchanged +- `(execute registry instruction {:error-data-string false})` — new opts map +- Config keys: `:error-data-string`, `:hook-execute-start`, `:hook-execute-end` +- Config is inherited by nested execute calls; inner calls can override specific keys. -FIXED `crop-final-status-map` in `commando.core` — internal keys (`:internal/cm-list`, `:internal/cm-dependency`, `:internal/cm-running-order`, `:registry`) are now properly stripped from the result when `:debug-result` is not enabled. +**BREAKING** `execute-trace` signature changed from `(execute-trace exec-fn)` to `(execute-trace registry instruction)` / `(execute-trace registry instruction opts)`. No longer requires wrapping in a zero-arg function. -FIXED `execute-command-impl` in `commando.impl.executing` — added guard for non-map `command-data` before calling `dissoc` on driver keys (`:=>`, `"=>`), preventing errors when command data is a non-map value. +**BREAKING** Removed `:debug-result` configuration option. Internal structures (`:internal/cm-list`, `:internal/cm-dependency`, `:internal/cm-running-order`, `:internal/path-trie`, `:internal/cm-results`, `:internal/original-instruction`, `:registry`) are now **always** retained in the status-map. If you relied on stripped status-maps, dissoc internal keys yourself. -UPDATED documentation — restructured `README.md` with improved navigation, added "Managing the Registry" and "Debugging" sections. Moved doc files from `doc/` to `examples/` directory with richer, runnable code examples: `walkthrough.clj`, `integrant.clj`, `component.clj`, `json.clj`, `reitit.clj`, `reagent_front.cljs`. +**BREAKING** Removed dependency modes `:all-inside-recur` and `:point-and-all-inside-recur`. Supported modes: `:point`, `:all-inside`, `:none`. -UPDATED tests — split monolithic `core_test.cljc` into focused test namespaces: `dependency_test.cljc`, `finding_commands_test.cljc`, `graph_test.cljc`. Added `debug_test.cljc` for the new debug module. Updated performance tests. +**BREAKING** Removed `print-stats`, `print-trace` (`print-deep-stats`) from `commando.impl.utils`. Replaced by `commando.debug` namespace. + +**BREAKING** `registry_test.clj` renamed to `registry_test.cljc` (cross-platform). + +## Added + +ADDED `commando.debug` namespace — dedicated module for debug visualization: +- `execute-debug` — execute and visualize in one of six display modes: `:tree`, `:table`, `:graph`, `:stats`, `:instr-before` / `:instr-after`. Supports combining multiple modes via vector. +- `execute-trace` — trace all nested `commando/execute` calls with timing and structure. + +ADDED `commando.impl.pathtrie` module — trie data structure for O(depth) command lookup by path. Built during the same traversal pass as command discovery, eliminating extra passes over the instruction tree. + +ADDED new status-map keys always present after execution: +- `:internal/cm-results` — map `{CommandMapPath -> resolved-value}` with result of each command's `:apply` function. +- `:internal/path-trie` — nested trie for efficient command lookup by path. +- `:internal/original-instruction` — the original instruction before command evaluation. + +ADDED `structural-command-type?` and `structural-command-types` in `commando.impl.registry` for detecting internal structural commands (`:instruction/_value`, `:instruction/_map`, `:instruction/_vec`). + +## Performance + +OPTIMIZED `find-commands` BFS traversal in `commando.impl.finding_commands`: +- Replaced vector-based queue with transient index-based queue (O(N) vs O(N^2) from subvec+into). +- Transient set for found-commands accumulation. +- Direct `enqueue-coll-children!` / `enqueue-command-children!` instead of intermediate mapv vectors. +- Path-trie built in the same pass — no separate traversal needed. + +OPTIMIZED `execute-commands` in `commando.impl.executing`: +- Transient results map avoids N persistent map copies during execution loop. +- Index-based loop with `nth` instead of `rest`/`first` on remaining commands. + +OPTIMIZED `build-dependency-graph` in `commando.impl.dependency`: +- Accepts pre-built path-trie from `find-commands` instead of rebuilding it. +- Transient accumulation for forward dependency map. +- `:all-inside` dependency resolution uses `reduce-kv` on trie subtree instead of dissoc+vals+keep+set chain. + +OPTIMIZED `topological-sort` in `commando.impl.graph`: +- Transient maps during in-degree computation. +- Transient queue for sorted result accumulation. + +OPTIMIZED `CommandMapPath` in `commando.impl.command_map`: +- Hash computed once at construction time and cached. +- `vector-starts-with?` uses indexed loop instead of lazy seq/take. + +OPTIMIZED Malli validation in `commando.commands.builtin`: +- Pre-computed validators and explainers for each command spec. +- Cached coercer for status-map messages. Avoids re-creating schemas on every call. + +## Fixed + +FIXED `execute-command-impl` in `commando.impl.executing` — guard for non-map `command-data` before calling `dissoc` on driver keys (`:=>`, `"=>`). + +FIXED point dependency errors in `commando.impl.dependency` now include `:command-path`, `:path`, and `:command` in error data. + +## Updated + +UPDATED `resolve-relative-path` in `commando.impl.dependency` — refactored from reduce to recursive loop for clarity and correct early termination. + +UPDATED `find-anchor-path` in `commando.impl.dependency` — refactored from reduce to loop. + +UPDATED documentation — restructured `README.md` with comprehensive status-map documentation, improved navigation, "Managing the Registry" and "Debugging" sections. Moved doc files to `examples/` with runnable code examples. + +UPDATED performance test alias from `:performance` to `:performance-core` in `deps.edn`. + +UPDATED tests — split monolithic `core_test.cljc` into focused namespaces: `dependency_test.cljc`, `finding_commands_test.cljc`, `graph_test.cljc`, `pathtrie_test.cljc`. Added `debug_test.cljc`. Converted `registry_test` to `.cljc` for cross-platform support. # 1.1.0 diff --git a/README.md b/README.md index ba1094b..a982038 100644 --- a/README.md +++ b/README.md @@ -739,11 +739,24 @@ Add `:__title` (or `"__title"`) to an instruction to label it in the trace outpu ## Status-Map and Internals -The main function for executing instructions is `commando.core/execute`, which returns a so-called Status-Map. A Status-Map is a data structure that contains the outcome of instruction execution, including results, successes, warnings, errors, and internal execution order.) - -On successful execution (`:ok`), you get: -- `:instruction` - the resulting evaluated data map. -- `:successes` - information about successful execution steps. +`commando.core/execute` returns a **Status-Map** — a data structure that contains the full outcome of instruction execution. All keys are always present in the result, regardless of whether execution succeeded or failed. + +- `:status` — `:ok` or `:failed`. Outcome of the execution. +- `:instruction` — on `:ok`, the fully evaluated instruction with all commands resolved to their values. On `:failed`, the partially or completely unexecuted original instruction. +- `:errors` — vector of error objects accumulated during execution. Each entry is a map with at least `:message`; may also contain `:error` (serialized exception), `:command-path`, `:command-type`. Empty `[]` on success. +- `:warnings` — vector of non-critical issues, e.g. skipped pipeline steps after a failure. Empty `[]` when there are no warnings. +- `:successes` — vector of informational messages about completed pipeline steps. Each entry is a map with `:message`. +- `:stats` — vector of timing measurements for each pipeline step. Each entry is a tuple `[step-name duration-ns formatted-string]`, e.g. `["execute-commands!" 95838 "95.838µs"]`. +- `:uuid` — unique identifier for this execution invocation. +- `:registry` — the built command registry used for this execution. +- `:internal/cm-list` — set of all discovered Command objects (`CommandMapPath`) found during the `find-commands` step. +- `:internal/cm-dependency` — forward dependency graph `{CommandMapPath → #{deps}}`, which commands each command depends on. +- `:internal/cm-running-order` — vector of commands in topologically sorted execution order (Kahn's algorithm). +- `:internal/cm-results` — map `{CommandMapPath → resolved-value}`, the result of each command's `:apply` function. +- `:internal/path-trie` — nested trie structure for O(depth) command lookup by path. +- `:internal/original-instruction` — the original instruction as passed by the user, before any command evaluation. + +### Example: successful execution ```clojure (require '[commando.core :as commando]) @@ -755,144 +768,85 @@ On successful execution (`:ok`), you get: "2" {:commando/from ["1"]} "3" {:commando/from ["2"]}}) -;; RETURN => -{:status :ok, +;; => +{:status :ok :instruction {"1" 1, "2" 1, "3" 1} - :stats - [["execute-commands!" 95838 "95.838µs"] - ["execute" 1085471 "1.085471ms"]] + :errors [] + :warnings [] :successes - [{:message - "Commando. parse-instruction-map. Entities was successfully collected"} - {:message - "Commando. build-deps-tree. Dependency map was successfully built"} - {:message - "Commando. sort-entities-by-deps. Entities were sorted and prepared for evaluation"} - {:message - "Commando. compress-execution-data. Status map was compressed"} - {:message - "Commando. evaluate-instruction-commands. Data term was processed"}]} -``` - -On unsuccessful execution (`:failed`), you get: -- `:instruction` - the partially or completely unexecuted instruction given by the user -- `:successes` - a list of successful actions completed before the failure -- `:warnings` - a list of non-critical errors or skipped steps -- `:errors` - a list of error objects, sometimes with exception data or additional keys -- `:internal/cm-list` (optional) - a list of Command objects with command meta-information -- `:internal/cm-dependency` (optional) - a map of dependencies -- `:internal/cm-running-order` (optional) - the resulting list of commands to be executed in order + [{:message "Commands were successfully collected"} + {:message "Dependency map was successfully built"} + {:message "..."}] + :stats + [["use-registry" 12500 "12.5µs"] + ["find-commands" 35000 "35µs"] + ["build-deps-tree" 18000 "18µs"] + ["sort-commands-by-deps" 9000 "9µs"] + ["execute-commands!" 95838 "95.838µs"] + ["execute" 1085471 "1.085471ms"]] + :uuid "a1b2c3..." + :registry ... + :internal/cm-list #{...} + :internal/cm-dependency {...} + :internal/cm-running-order [...] + :internal/cm-results {...} + :internal/path-trie {...} + :internal/original-instruction {"1" 1, "2" {:commando/from ["1"]}, "3" {:commando/from ["2"]}}} +``` -```clojure -(require '[commando.core :as commando]) -(require '[commando.commands.builtin :as commands-builtin]) +### Example: failed execution +```clojure (commando/execute [commands-builtin/command-from-spec] {"1" 1 "2" {:commando/from ["1"]} "3" {:commando/from ["WRONG" "PATH"]}}) -;; RETURN => +;; => {:status :failed :instruction {"1" 1 "2" {:commando/from ["1"]} "3" {:commando/from ["WRONG" "PATH"]}} :errors - [{:message "build-deps-tree. Failed to build `:point` dependency. Key `Commando.` with path: `:commando/from`, - referring to non-existing value", - :path ["3"], - :command {:commando/from ["WRONG" "PATH"]}}], + [{:message "Point dependency failed: key ':commando/from' references non-existent path [\"WRONG\" \"PATH\"]" + :path ["3"] + :command {:commando/from ["WRONG" "PATH"]}}] :warnings - [{:message - "Commando. sort-entities-by-deps. Skipping mandatory step"} - {:message - "Commando. compress-execution-data. Skipping mandatory step"} - {:message - "Commando. evaluate-instruction-commands. Skipping mandatory step"}], + [{:message "Skipping sort-commands-by-deps"} + {:message "Skipping execute-commands!"}] :successes - [{:message - "Commando. parse-instruction-map. Entities were successfully collected"}], - :internal/cm-list - [# - # - # - #]} + [{:message "Commands were successfully collected"}] + :stats [...] + :uuid "d4e5f6..." + :internal/cm-list #{...} + ...} ``` -### Configuring Execution Behavior - -The `commando.impl.utils/*execute-config*` dynamic variable allows for fine-grained control over `commando/execute`'s behavior. You can bind this variable to a map containing the following configuration keys: - -- `:debug-result` (boolean) -- `:error-data-string` (boolean) -- `:hook-execute-start` (function) — called before execution begins, receives execution context map -- `:hook-execute-end` (function) — called after execution completes, receives execution context map with `:stats` and `:instruction` - -Hooks allow you to observe or instrument the execution lifecycle — for example, to collect timing data, log nested executions, or build execution traces. See [Debugging](#debugging) for a practical use via `execute-trace`. +Helper predicates for checking status: -#### `:debug-result` +```clojure +(commando/ok? result) ;; => true | false +(commando/failed? result) ;; => true | false +``` -When set to `true`, the returned status-map will include additional execution information, such as `:internal/cm-list`, `:internal/cm-dependency`, and `:internal/cm-running-order`. This helps in analyzing the instruction's execution flow. +### Configuring Execution Behavior -Here's an example of how to use `:debug-result`: +`commando/execute` accepts an optional third argument — a configuration map. Config keys control execution behavior and are automatically inherited by nested `execute` calls (e.g. from `:commando/macro` or `:commando/resolve`). Inner calls can override specific keys — non-overridden keys come from the parent. ```clojure -(require '[commando.core :as commando]) -(require '[commando.commands.builtin :as commands-builtin]) -(require '[commando.impl.utils :as commando-utils]) - -(binding [commando-utils/*execute-config* {:debug-result true}] - (commando/execute - [commands-builtin/command-from-spec] - {"1" 1 - "2" {:commando/from ["1"]} - "3" {:commando/from ["2"]}})) - -;; RETURN => -{:status :ok, - :instruction {"1" 1, "2" 1, "3" 1} - :stats - [["use-registry" 111876 "111.876µs"] - ["find-commands" 303062 "303.062µs"] - ["build-deps-tree" 134049 "134.049µs"] - ["sort-commands-by-deps" 292206 "292.206µs"] - ["execute-commands!" 53762 "53.762µs"] - ["execute" 1074110 "1.07411ms"]] - :registry - [{:type :commando/from, - :recognize-fn #function[commando.commands.builtin/fn], - :validate-params-fn #function[commando.commands.builtin/fn], - :apply #function[commando.commands.builtin/fn], - :dependencies {:mode :point, :point-key [:commando/from]}}], - :warnings [], - :errors [], - :successes - [{:message "Commands were successfully collected"} - {:message "Dependency map was successfully built"} - {:message "Commando. sort-entities-by-deps. Entities was sorted and prepare for evaluating"} - {:message "All commands executed successfully"}], - :internal/cm-list - ["root[_map]" - "root,1[_value]" - "root,2[from]" - "root,3[from]"] - :internal/cm-running-order - ["root,2[from]" - "root,3[from]"], - :internal/cm-dependency - {"root[_map]" #{"root,2[from]" "root,1[_value]" "root,3[from]"}, - "root,1[_value]" #{}, - "root,2[from]" #{"root,1[_value]"}, - "root,3[from]" #{"root,2[from]"}}} +(commando/execute registry instruction + {:error-data-string false + :hook-execute-start (fn [status-map] ...) + :hook-execute-end (fn [status-map] ...)}) ``` -`:internal/cm-list` - a list of all recognized commands in an instruction. This list also contains the `_map`, `_value`, and the unmentioned `_vector` commands. Commando includes several internal built-in commands that describe the _instruction's structure_. An _instruction_ is a composition of maps, their values, and vectors that represent its structure and help build a clear dependency graph. These commands are removed from the final output after this step, but included in the compiled registry. - -`:internal/cm-dependency` - describes how parts of an _instruction_ depend on each other. - -`:internal/cm-running-order` - the correct order in which to execute commands. +- `:error-data-string` (boolean, default `true`) +- `:hook-execute-start` (function) — called before execution begins, receives execution context map +- `:hook-execute-end` (function) — called after execution completes, receives execution context map with `:stats` and `:instruction` +Hooks allow you to observe or instrument the execution lifecycle — for example, to collect timing data, log nested executions, or build execution traces. See [Debugging](#debugging) for a practical use via `execute-trace`. #### `:error-data-string` @@ -918,10 +872,10 @@ When `:error-data-string` is `true`, the `:data` key within serialized `Exceptio (def value - (binding [sut/*execute-config* {:error-data-string false}] - (commando/execute [commands-builtin/command-from-spec] - {"a" 10 - "ref" {:commando/from "BROKEN"}}))) + (commando/execute [commands-builtin/command-from-spec] + {"a" 10 + "ref" {:commando/from "BROKEN"}} + {:error-data-string false})) (get-in value [:errors 0 :error]) ;; => ;; {:type "exception-info", @@ -948,7 +902,7 @@ All benchmarks were conducted on an **Intel Core i9-13980HX**. The primary metri The graph below illustrates the total execution time for instructions with a typical number of dependencies, ranging from 1,250 to 80,000. As you can see, the execution time scales linearly and remains in the low millisecond range, demonstrating excellent performance for common use cases.
- +
#### Execution Step Analysis @@ -967,7 +921,7 @@ The following graphs show the performance of each step under both normal and ext Under normal conditions, each execution step completes in just a few milliseconds. The overhead of parsing, dependency resolution, and execution is minimal, ensuring a fast and responsive system.
- +
**Massive Workloads (up to 5,000,000 dependencies)** @@ -975,7 +929,7 @@ Under normal conditions, each execution step completes in just a few millisecond To test the limits of the library, we benchmarked it with instructions containing up to 5 million dependencies. The graph below shows that while the system scales, the `find-commands` (parsing) and `build-deps-tree` (dependency graph construction) phases become the primary bottlenecks. This demonstrates that the core execution remains fast, but performance at extreme scales is dominated by the initial analysis steps.
- +
# Examples & Guides diff --git a/deps.edn b/deps.edn index dd4b66b..a495cc5 100644 --- a/deps.edn +++ b/deps.edn @@ -9,9 +9,9 @@ :main-opts ["-m" "cljs-test-runner.main" "-d" "test/unit"] :patterns [".*-test$"]} ;;For local performance regression tests - :performance + :clj-test-perf-execute {:extra-deps {cljfreechart/cljfreechart {:mvn/version "0.2.0"}} - :main-opts ["-m" "commando.core-perf-test"] + :main-opts ["-m" "commando.execute.execute-test"] :extra-paths ["test/perf"]} ;;Build jar :build {:deps {io.github.clojure/tools.build {:mvn/version "0.10.10"}} diff --git a/examples/walkthrough.clj b/examples/walkthrough.clj index 5df0bab..4b2b272 100644 --- a/examples/walkthrough.clj +++ b/examples/walkthrough.clj @@ -438,14 +438,13 @@ (:instruction (debug/execute-trace - #(commando/execute - [builtin/command-from-spec - builtin/command-fn-spec - builtin/command-macro-spec - builtin/command-apply-spec] - {:__title "Result Of Two" - :result-1 {:commando/macro :sum-of-products :a 2 :b 3 :c 4 :d 5} - :result-2 {:commando/macro :sum-of-products :a 2 :b 3 :c 4 :d 5}}))) + [builtin/command-from-spec + builtin/command-fn-spec + builtin/command-macro-spec + builtin/command-apply-spec] + {:__title "Result Of Two" + :result-1 {:commando/macro :sum-of-products :a 2 :b 3 :c 4 :d 5} + :result-2 {:commando/macro :sum-of-products :a 2 :b 3 :c 4 :d 5}})) ;; => {:result 26} ;; because (2*3) + (4*5) = 6 + 20 = 26 ;; diff --git a/src/commando/commands/builtin.cljc b/src/commando/commands/builtin.cljc index 2216b5d..d634fea 100644 --- a/src/commando/commands/builtin.cljc +++ b/src/commando/commands/builtin.cljc @@ -10,6 +10,16 @@ ;; Fn ;; ====================== +(def ^:private -schema:command-fn + [:map + [:commando/fn utils/ResolvableFn] + [:args {:optional true} coll?] + [:=> {:optional true} utils/malli:driver-spec] + ["=>" {:optional true} utils/malli:driver-spec]]) + +(def ^:private -validator:command-fn (malli/validator -schema:command-fn)) +(def ^:private -explainer:command-fn (malli/explainer -schema:command-fn)) + (def ^{:doc " Description @@ -39,17 +49,9 @@ {:type :commando/fn :recognize-fn #(and (map? %) (contains? % :commando/fn)) :validate-params-fn (fn [m] - (if-let [m-explain - (malli-error/humanize - (malli/explain - [:map - [:commando/fn utils/ResolvableFn] - [:args {:optional true} coll?] - [:=> {:optional true} utils/malli:driver-spec] - ["=>" {:optional true} utils/malli:driver-spec]] - m))] - m-explain - true)) + (if (-validator:command-fn m) + true + (malli-error/humanize (-explainer:command-fn m)))) :apply (fn [_instruction _command-map m] (let [m-fn (utils/resolve-fn (:commando/fn m)) m-args (:args m []) @@ -60,6 +62,15 @@ ;; Apply ;; ====================== +(def ^:private -schema:command-apply + [:map + [:commando/apply :any] + [:=> {:optional true} utils/malli:driver-spec] + ["=>" {:optional true} utils/malli:driver-spec]]) + +(def ^:private -validator:command-apply (malli/validator -schema:command-apply)) +(def ^:private -explainer:command-apply (malli/explainer -schema:command-apply)) + (def ^{:doc " Description command-apply-spec - Returns value of `:commando/apply`. @@ -80,14 +91,9 @@ {:type :commando/apply :recognize-fn #(and (map? %) (contains? % :commando/apply)) :validate-params-fn (fn [m] - (if-let [m-explain - (malli-error/humanize - (malli/explain [:map - [:commando/apply :any] - [:=> {:optional true} utils/malli:driver-spec] - ["=>" {:optional true} utils/malli:driver-spec]] m))] - m-explain - true)) + (if (-validator:command-apply m) + true + (malli-error/humanize (-explainer:command-apply m)))) :apply (fn [_instruction _command-path-obj command-map] (:commando/apply command-map)) :dependencies {:mode :all-inside}}) @@ -101,6 +107,24 @@ [:sequential {:error/message "commando/from should be a sequence path to value in Instruction: [:some 2 \"value\"]"} [:or :string :keyword :int]])) +(def ^:private -schema:command-from-kw + [:map + [:commando/from -malli:commando-from-path] + [:=> {:optional true} utils/malli:driver-spec] + ["=>" {:optional true} utils/malli:driver-spec]]) + +(def ^:private -validator:command-from-kw (malli/validator -schema:command-from-kw)) +(def ^:private -explainer:command-from-kw (malli/explainer -schema:command-from-kw)) + +(def ^:private -schema:command-from-str + [:map + ["commando-from" -malli:commando-from-path] + [:=> {:optional true} utils/malli:driver-spec] + ["=>" {:optional true} utils/malli:driver-spec]]) + +(def ^:private -validator:command-from-str (malli/validator -schema:command-from-str)) +(def ^:private -explainer:command-from-str (malli/explainer -schema:command-from-str)) + (def ^{:doc " Description @@ -162,22 +186,12 @@ "The keyword :commando/from and the string \"commando-from\" cannot be used simultaneously in one command." (contains? m :commando/from) - (malli-error/humanize - (malli/explain - [:map - [:commando/from -malli:commando-from-path] - [:=> {:optional true} utils/malli:driver-spec] - ["=>" {:optional true} utils/malli:driver-spec]] - m)) + (when-not (-validator:command-from-kw m) + (malli-error/humanize (-explainer:command-from-kw m))) (contains? m "commando-from") - (malli-error/humanize - (malli/explain - [:map - ["commando-from" -malli:commando-from-path] - [:=> {:optional true} utils/malli:driver-spec] - ["=>" {:optional true} utils/malli:driver-spec]] - m)))] + (when-not (-validator:command-from-str m) + (malli-error/humanize (-explainer:command-from-str m))))] (if m-explain m-explain true))) @@ -192,6 +206,26 @@ ;; Context ;; ====================== +(def ^:private -schema:command-context-kw + [:map + [:commando/context [:sequential {:error/message "commando/context should be a sequential path: [:some :key]"} + [:or :string :keyword :int]]] + [:=> {:optional true} utils/malli:driver-spec] + ["=>" {:optional true} utils/malli:driver-spec]]) + +(def ^:private -validator:command-context-kw (malli/validator -schema:command-context-kw)) +(def ^:private -explainer:command-context-kw (malli/explainer -schema:command-context-kw)) + +(def ^:private -schema:command-context-str + [:map + ["commando-context" [:sequential {:error/message "commando-context should be a sequential path: [\"some\" \"key\"]"} + [:or :string :keyword :int]]] + [:=> {:optional true} utils/malli:driver-spec] + ["=>" {:optional true} utils/malli:driver-spec]]) + +(def ^:private -validator:command-context-str (malli/validator -schema:command-context-str)) +(def ^:private -explainer:command-context-str (malli/explainer -schema:command-context-str)) + (defn command-context-spec "Creates a CommandMapSpec that resolves references to external context data captured via closure. Context is immutable per registry and resolves before @@ -233,42 +267,29 @@ `commando.commands.builtin/command-from-spec`" [ctx] {:pre [(map? ctx)]} - (let [kw-key :commando/context - str-key "commando-context"] - {:type kw-key - :recognize-fn #(and (map? %) - (or (contains? % kw-key) - (contains? % str-key))) - :validate-params-fn - (fn [m] - (let [m-explain - (cond - (and (contains? m kw-key) (contains? m str-key)) - "The keyword :commando/context and the string \"commando-context\" cannot be used simultaneously in one command." - (contains? m kw-key) - (malli-error/humanize - (malli/explain - [:map - [kw-key [:sequential {:error/message "commando/context should be a sequential path: [:some :key]"} - [:or :string :keyword :int]]] - [:=> {:optional true} utils/malli:driver-spec] - ["=>" {:optional true} utils/malli:driver-spec]] - m)) - (contains? m str-key) - (malli-error/humanize - (malli/explain - [:map - [str-key [:sequential {:error/message "commando-context should be a sequential path: [\"some\" \"key\"]"} - [:or :string :keyword :int]]] - [:=> {:optional true} utils/malli:driver-spec] - ["=>" {:optional true} utils/malli:driver-spec]] - m)))] - (if m-explain m-explain true))) - :apply - (fn [_instruction _command-path-obj command-map] - (let [path (or (get command-map kw-key) (get command-map str-key))] - (get-in ctx path nil))) - :dependencies {:mode :none}})) + {:type :commando/context + :recognize-fn #(and (map? %) + (or + (contains? % :commando/context) + (contains? % "commando-context"))) + :validate-params-fn + (fn [m] + (let [m-explain + (cond + (and (contains? m :commando/context) (contains? m "commando-context")) + "The keyword :commando/context and the string \"commando-context\" cannot be used simultaneously in one command." + (contains? m :commando/context) + (when-not (-validator:command-context-kw m) + (malli-error/humanize (-explainer:command-context-kw m))) + (contains? m "commando-context") + (when-not (-validator:command-context-str m) + (malli-error/humanize (-explainer:command-context-str m))))] + (if m-explain m-explain true))) + :apply + (fn [_instruction _command-path-obj command-map] + (let [path (or (get command-map :commando/context) (get command-map "commando-context"))] + (get-in ctx path nil))) + :dependencies {:mode :none}}) ;; ====================== ;; Mutation @@ -285,6 +306,22 @@ "'") {:commando/mutation undefined-tx-type}))) +(def ^:private -schema:command-mutation-kw + [:map [:commando/mutation [:or :keyword :string]] + [:=> {:optional true} utils/malli:driver-spec] + ["=>" {:optional true} utils/malli:driver-spec]]) + +(def ^:private -validator:command-mutation-kw (malli/validator -schema:command-mutation-kw)) +(def ^:private -explainer:command-mutation-kw (malli/explainer -schema:command-mutation-kw)) + +(def ^:private -schema:command-mutation-str + [:map ["commando-mutation" [:or :keyword :string]] + [:=> {:optional true} utils/malli:driver-spec] + ["=>" {:optional true} utils/malli:driver-spec]]) + +(def ^:private -validator:command-mutation-str (malli/validator -schema:command-mutation-str)) +(def ^:private -explainer:command-mutation-str (malli/explainer -schema:command-mutation-str)) + (def ^{:doc " Description command-mutation-spec - execute mutation of Instruction data. @@ -339,19 +376,11 @@ (contains? m "commando-mutation")) "The keyword :commando/mutation and the string \"commando-mutation\" cannot be used simultaneously in one command." (contains? m :commando/mutation) - (malli-error/humanize - (malli/explain - [:map [:commando/mutation [:or :keyword :string]] - [:=> {:optional true} utils/malli:driver-spec] - ["=>" {:optional true} utils/malli:driver-spec]] - m)) + (when-not (-validator:command-mutation-kw m) + (malli-error/humanize (-explainer:command-mutation-kw m))) (contains? m "commando-mutation") - (malli-error/humanize - (malli/explain - [:map ["commando-mutation" [:or :keyword :string]] - [:=> {:optional true} utils/malli:driver-spec] - ["=>" {:optional true} utils/malli:driver-spec]] - m)))] + (when-not (-validator:command-mutation-str m) + (malli-error/humanize (-explainer:command-mutation-str m))))] (if m-explain m-explain true))) @@ -375,6 +404,24 @@ "command-macro. Undefinied '" undefinied-tx-type "'") {:commando/macro undefinied-tx-type}))) +(def ^:private -schema:command-macro-kw + [:map + [:commando/macro [:or :keyword :string]] + [:=> {:optional true} utils/malli:driver-spec] + ["=>" {:optional true} utils/malli:driver-spec]]) + +(def ^:private -validator:command-macro-kw (malli/validator -schema:command-macro-kw)) +(def ^:private -explainer:command-macro-kw (malli/explainer -schema:command-macro-kw)) + +(def ^:private -schema:command-macro-str + [:map + ["commando-macro" [:or :keyword :string]] + [:=> {:optional true} utils/malli:driver-spec] + ["=>" {:optional true} utils/malli:driver-spec]]) + +(def ^:private -validator:command-macro-str (malli/validator -schema:command-macro-str)) +(def ^:private -explainer:command-macro-str (malli/explainer -schema:command-macro-str)) + (def ^{:doc " Description command-macro-spec - help to define reusable instruction template, @@ -474,29 +521,19 @@ (contains? m "commando-macro")) "The keyword :commando/macro and the string \"commando-macro\" cannot be used simultaneously in one command." (contains? m :commando/macro) - (malli-error/humanize - (malli/explain - [:map - [:commando/macro [:or :keyword :string]] - [:=> {:optional true} utils/malli:driver-spec] - ["=>" {:optional true} utils/malli:driver-spec]] - m)) + (when-not (-validator:command-macro-kw m) + (malli-error/humanize (-explainer:command-macro-kw m))) (contains? m "commando-macro") - (malli-error/humanize - (malli/explain - [:map - ["commando-macro" [:or :keyword :string]] - [:=> {:optional true} utils/malli:driver-spec] - ["=>" {:optional true} utils/malli:driver-spec]] - m)))] + (when-not (-validator:command-macro-str m) + (malli-error/humanize (-explainer:command-macro-str m))))] (if m-explain m-explain true))) :apply (fn [_instruction _command-map m] (let [[macro-type macro-data] (cond - (get m :commando/macro) [(get m :commando/macro) (dissoc m :commando/macro)] - (get m "commando-macro") [(get m "commando-macro") (dissoc m "commando-macro")]) + (contains? m :commando/macro) [(get m :commando/macro) (dissoc m :commando/macro)] + (contains? m "commando-macro") [(get m "commando-macro") (dissoc m "commando-macro")]) result (commando/execute (utils/command-map-spec-registry) (command-macro macro-type macro-data))] diff --git a/src/commando/commands/query_dsl.cljc b/src/commando/commands/query_dsl.cljc index 477b646..bb259c2 100644 --- a/src/commando/commands/query_dsl.cljc +++ b/src/commando/commands/query_dsl.cljc @@ -330,6 +330,18 @@ "Unedefinied command-resolve '" undefinied-tx-type "'") {:resolver/tx undefinied-tx-type}))) +(def ^:private -explainer:command-resolve-kw + (malli/explainer + [:map + [:commando/resolve :keyword] + [:QueryExpression {:optional true} QueryExpressionMalli]])) + +(def ^:private -explainer:command-resolve-str + (malli/explainer + [:map + ["commando-resolve" [:string {:min 1}]] + ["QueryExpression" {:optional true} QueryExpressionMalli]])) + (def ^{:doc " Description command-resolve-spec - behave like command-mutation-spec @@ -518,22 +530,10 @@ "The keyword :commando/resolve and the string \"commando-resolve\" cannot be used simultaneously in one command." (contains? m :commando/resolve) (malli-error/humanize - (malli/explain - [:map - [:commando/resolve :keyword] - [:QueryExpression - {:optional true} - QueryExpressionMalli]] - m)) + (-explainer:command-resolve-kw m)) (contains? m "commando-resolve") (malli-error/humanize - (malli/explain - [:map - ["commando-resolve" [:string {:min 1}]] - ["QueryExpression" - {:optional true} - QueryExpressionMalli]] - m)))] + (-explainer:command-resolve-str m)))] (if m-explain m-explain true))) diff --git a/src/commando/core.cljc b/src/commando/core.cljc index 30f66a6..ed11497 100644 --- a/src/commando/core.cljc +++ b/src/commando/core.cljc @@ -1,6 +1,6 @@ (ns commando.core (:require - [commando.impl.dependency :as deps] + [commando.impl.dependency :as dependency] [commando.impl.executing :as executing] [commando.impl.finding-commands :as finding-commands] [commando.impl.graph :as graph] @@ -90,17 +90,21 @@ [{:keys [instruction registry] :as status-map}] (smap/core-step-safe status-map "find-commands" (fn [sm] - (-> sm - (assoc :internal/cm-list (finding-commands/find-commands instruction registry)) - (smap/status-map-handle-success {:message "Commands were successfully collected"}))))) + (let [{:keys [commands trie]} (finding-commands/find-commands instruction registry)] + (-> sm + (assoc :internal/cm-list commands) + (assoc :internal/path-trie trie) + (smap/status-map-handle-success {:message "Commands were successfully collected"})))))) (defn ^:private build-deps-tree - [{:keys [instruction] :internal/keys [cm-list] :as status-map}] + "Builds forward dependency graph using the path-trie produced by find-commands." + [{:keys [instruction] :internal/keys [cm-list path-trie] :as status-map}] (smap/core-step-safe status-map "build-deps-tree" (fn [sm] - (-> sm - (assoc :internal/cm-dependency (deps/build-dependency-graph instruction cm-list)) - (smap/status-map-handle-success {:message "Dependency map was successfully built"}))))) + (let [fwd (dependency/build-dependency-graph instruction cm-list path-trie)] + (-> sm + (assoc :internal/cm-dependency fwd) + (smap/status-map-handle-success {:message "Dependency map was successfully built"})))))) (defn ^:private sort-commands-by-deps [status-map] @@ -126,16 +130,19 @@ (binding [utils/*command-map-spec-registry* registry] (if (empty? cm-running-order) (smap/status-map-handle-success sm {:message "No commands to execute"}) - (let [[updated-instruction error-info] (executing/execute-commands instruction cm-running-order)] + (let [[updated-instruction error-info cm-results] + (executing/execute-commands instruction cm-running-order)] (if error-info (-> sm (assoc :instruction updated-instruction) + (assoc :internal/cm-results cm-results) (smap/status-map-handle-error {:message "Command execution failed during evaluation" :error (utils/serialize-exception (:original-error error-info)) :command-path (:command-path error-info) :command-type (:command-type error-info)})) (-> sm (assoc :instruction updated-instruction) + (assoc :internal/cm-results cm-results) (smap/status-map-handle-success {:message "All commands executed successfully"}))))))))) (defn ^:private prepare-execution-status-map [status-map] @@ -145,34 +152,51 @@ (update :internal/cm-running-order registry/remove-runtime-registry-commands-from-command-list) (update :registry registry/reset-runtime-registry)))) -(defn ^:private crop-final-status-map [status-map] - (if (:debug-result (utils/execute-config)) - status-map - (dissoc status-map - :internal/cm-list - :internal/cm-dependency - :internal/cm-running-order - :registry))) - -;; -- Execute -- +;; -- Full Execute (internal) -- -(defn execute +(defn- full-execute + "Full execution pipeline. Always retains internal structures." [registry instruction] - {:pre [(or (vector? registry) (registry/built? registry))]} - (binding [utils/*execute-internals* (utils/-execute-internals-push (str (random-uuid)))] - (let [start-time (utils/now)] - (-> (smap/status-map-pure {:instruction instruction}) - (utils/hook-process (:hook-execute-start (utils/execute-config))) - (use-registry registry) - (find-commands) - (build-deps-tree) - (sort-commands-by-deps) - (prepare-execution-status-map) - (execute-commands!) - (smap/status-map-add-measurement "execute" start-time (utils/now)) - (utils/hook-process (:hook-execute-end (utils/execute-config))) - (crop-final-status-map))))) + (let [start-time (utils/now) + config (utils/execute-config)] + (-> (smap/status-map-pure {:instruction instruction}) + (utils/hook-process (:hook-execute-start config)) + (use-registry registry) + (find-commands) + (build-deps-tree) + (sort-commands-by-deps) + (prepare-execution-status-map) + (execute-commands!) + (smap/status-map-add-measurement "execute" start-time (utils/now)) + (utils/hook-process (:hook-execute-end config)) + (assoc :internal/original-instruction instruction)))) + +;; -- Public API -- (defn failed? [status-map] (smap/failed? status-map)) (defn ok? [status-map] (smap/ok? status-map)) +(defn execute + "Evaluates an instruction with a command registry. + + The optional third argument is a config map: + :error-data-string - (boolean) serialize exception data as strings + :hook-execute-start - (fn [status-map]) called before execution + :hook-execute-end - (fn [status-map]) called after execution + + Config keys are inherited by nested execute calls. Inner calls can + override specific keys — non-overridden keys come from the parent. + + Examples: + ;; Full execution + (execute reg instruction) + + ;; With config + (execute reg instruction {:error-data-string false})" + ([registry instruction] (execute registry instruction nil)) + ([registry instruction opts] + {:pre [(or (vector? registry) (registry/built? registry))]} + (binding [utils/*execute-internals* (utils/-execute-internals-push (str (random-uuid))) + utils/*execute-config* (utils/execute-config-update opts)] + (full-execute registry instruction)))) + diff --git a/src/commando/debug.cljc b/src/commando/debug.cljc index f1e6b50..9c3a639 100644 --- a/src/commando/debug.cljc +++ b/src/commando/debug.cljc @@ -490,9 +490,7 @@ ([registry instruction] (execute-debug registry instruction :table)) ([registry instruction mode] - (let [result (binding [utils/*execute-config* - (assoc (utils/execute-config) :debug-result true)] - (commando/execute registry instruction))] + (let [result (commando/execute registry instruction)] (pprint-debug result instruction mode) result))) @@ -592,39 +590,39 @@ (defn execute-trace "Trace all nested commando/execute calls with timing. - Takes a zero-argument function that calls commando/execute and - returns its result unchanged. Prints a tree showing every execute - invocation (including recursive calls from macros/mutations) with - timing stats and instruction keys. + Calls commando/execute with the given registry and instruction, + prints a tree showing every execute invocation (including recursive + calls from macros/mutations) with timing stats and instruction keys. Add :__title or \"__title\" to an instruction to label it in the trace. Usage: - (execute-trace - #(commando/execute registry instruction))" - [execution-fn] - (let [stats-state (atom {}) - result - (binding [utils/*execute-config* - (assoc (utils/execute-config) - :hook-execute-start - (fn [e] - (swap! stats-state - (fn [s] - (update-in s (:stack utils/*execute-internals*) - #(merge % {:instruction-title - (when (map? (:instruction e)) - (or (get (:instruction e) "__title") - (get (:instruction e) :__title)))}))))) - :hook-execute-end - (fn [e] - (swap! stats-state - (fn [s] - (update-in s (:stack utils/*execute-internals*) - #(merge % {:stats (:stats e) - :instruction-keys (when (map? (:instruction e)) - (vec (keys (:instruction e))))}))))))] - (execution-fn))] - (trace-print @stats-state) - result)) + (execute-trace registry instruction) + (execute-trace registry instruction {:error-data-string false})" + ([registry instruction] + (execute-trace registry instruction nil)) + ([registry instruction opts] + (let [stats-state (atom {}) + trace-opts + (merge opts + {:hook-execute-start + (fn [e] + (swap! stats-state + (fn [s] + (update-in s (:stack utils/*execute-internals*) + #(merge % {:instruction-title + (when (map? (:instruction e)) + (or (get (:instruction e) "__title") + (get (:instruction e) :__title)))}))))) + :hook-execute-end + (fn [e] + (swap! stats-state + (fn [s] + (update-in s (:stack utils/*execute-internals*) + #(merge % {:stats (:stats e) + :instruction-keys (when (map? (:instruction e)) + (vec (keys (:instruction e))))})))))}) + result (commando/execute registry instruction trace-opts)] + (trace-print @stats-state) + result))) diff --git a/src/commando/impl/command_map.cljc b/src/commando/impl/command_map.cljc index c033961..519287c 100644 --- a/src/commando/impl/command_map.cljc +++ b/src/commando/impl/command_map.cljc @@ -19,16 +19,15 @@ ^{:doc "Represents a command found in the instruction map at a specific `path`. Holds both the path to the command and its command specification data. + Hash is cached at construction time for fast map/set lookups. Equality is based only on path, not on data. This allows commands at the same path to be treated as equivalent regardless of their specification."} CommandMapPath - [path data] + [path data ^int _hash] Object (equals [this path-obj] (if (instance? CommandMapPath path-obj) (= (.-path this) (.-path path-obj)) false)) - (hashCode [_this] - #?(:clj (hash path) - :cljs (hash path))) + (hashCode [_this] _hash) (toString ^String [_] (str (cm-generate-id path) (when-let [meta-info (cm-path-string-meta data)] (str "[" meta-info "]")))))) #?(:clj (do (defmethod print-method CommandMapPath @@ -43,40 +42,53 @@ :doc "Represents a command found in the instruction map at a specific path. Holds both the path to the command and its command specification data. + Hash is cached at construction time for fast map/set lookups. Equality is based only on path, not on data. This allows commands at the same path to be treated as equivalent regardless of their specification."} CommandMapPath - [path data] + [path data _hash] cljs.core/IEquiv (-equiv [this path-obj] (and (instance? CommandMapPath path-obj) (= (.-path this) (.-path path-obj)))) cljs.core/IHash - (-hash [this] (hash (.-path this))) + (-hash [_this] _hash) IPrintWithWriter (-pr-writer [o writer _opts] (-write writer (.toString o))) Object (equals [this path-obj] (if (instance? CommandMapPath path-obj) (= (.-path this) (.-path path-obj)) false)) - (hashCode [_this] - #?(:clj (hash path) - :cljs (hash path))) + (hashCode [_this] _hash) (toString ^String [_] (str (cm-generate-id path) (when-let [meta-info (cm-path-string-meta data)] (str "[" meta-info "]")))))) +(defn command-map-path + "Constructs a CommandMapPath with cached hash for fast map/set lookups." + [path data] + (CommandMapPath. path data (hash path))) + (defn command-map? [obj] (instance? CommandMapPath obj)) (defn command-id [p] (when (instance? CommandMapPath p) (.toString p))) (defn command-path [p] (when (instance? CommandMapPath p) (.-path p))) (defn command-data [p] (when (instance? CommandMapPath p) (.-data p))) (defn vector-starts-with? + "Checks if vector `s` starts with all elements of `prefix`. + Uses indexed loop instead of seq/take to avoid lazy sequence allocation per call." [s prefix] (if (or (nil? s) (nil? prefix)) false (let [s-len (count s) prefix-len (count prefix)] - (or (and (>= s-len prefix-len) (= (seq prefix) (take prefix-len s))) - ;; this mean situation while (vector-starts-with? [:A :B] []) -> true - (= prefix-len 0))))) + (if (= prefix-len 0) + true + (if (< s-len prefix-len) + false + (loop [i 0] + (if (= i prefix-len) + true + (if (= (nth s i) (nth prefix i)) + (recur (inc i)) + false)))))))) (defn start-with? [p1 p2] (vector-starts-with? (command-path p1) (command-path p2))) diff --git a/src/commando/impl/dependency.cljc b/src/commando/impl/dependency.cljc index 38bd503..e552d9f 100644 --- a/src/commando/impl/dependency.cljc +++ b/src/commando/impl/dependency.cljc @@ -4,22 +4,6 @@ [commando.impl.command-map :as cm] [commando.impl.utils :as utils])) -(defn- build-path-trie - "Builds a trie from a list of CommandMapPath objects for efficient path-based lookups." - [cm-list] - (reduce - (fn [trie cmd] - (assoc-in trie (conj (cm/command-path cmd) ::command) cmd)) - {} - cm-list)) - -(defn- get-all-nested-commands - "Lazily traverses a trie. - Returns a lazy sequence of all command objects found." - [trie] - (->> (tree-seq map? (fn [node] (vals (dissoc node ::command))) trie) - (keep ::command))) - (defmulti find-command-dependencies "Finds command dependencies based on dependency-type. @@ -28,38 +12,40 @@ Modes: - :all-inside - depends on all commands inside the Command: if it Map - the values, if it Vector - elements of vectors - - :all-inside-recur - depends on all commands nested within this command's path - :point - depends on command(s) at a specific path, defined by :point-key setting key. :point collect only one depedency - the only one it refering. - - :point-and-all-inside-recur - joined approach of :point and :all-inside-recur. - collect dependencies for path it pointing along with nested dependecies under - the pointed item. First tries to find a command at the exact target path. If not found, - walks up the path hierarchy to find parent commands that will create/modify - the target path. - :none - no dependencies (not implemented, returns empty set by default)" (fn [_command-path-obj _instruction _path-trie dependency-type] dependency-type)) +;; -- Default -- + (defmethod find-command-dependencies :default [_command-path-obj _instruction _path-trie type] (throw (ex-info (str utils/exception-message-header "Undefined dependency mode: " type) - {:message (str utils/exception-message-header "Undefined dependency mode: " type) - :dependency-mode type}))) + {:message (str utils/exception-message-header "Undefined dependency mode: " type) + :dependency-mode type}))) + +;; -- None -- + +(defmethod find-command-dependencies :none [_command-path-obj _instruction _path-trie _type] #{}) + +;; -- All Inside -- (defmethod find-command-dependencies :all-inside [command-path-obj _instruction path-trie _type] + ;; Direct reduce-kv instead of dissoc+vals+keep+set chain. + ;; Avoids: 1 dissoc (new map), 1 vals (lazy seq), 1 keep (lazy seq), 1 set (materialization). (let [command-path (cm/command-path command-path-obj) sub-trie (get-in path-trie command-path)] - (->> (vals (dissoc sub-trie ::command)) - (keep ::command) - set))) + (reduce-kv (fn [acc k v] + (if (identical? k :commando.impl.pathtrie/command) + acc + (if-let [cmd (:commando.impl.pathtrie/command v)] + (conj acc cmd) + acc))) + #{} sub-trie))) -(defmethod find-command-dependencies :all-inside-recur - [command-path-obj _instruction path-trie _type] - (let [command-path (cm/command-path command-path-obj) - sub-trie (get-in path-trie command-path)] - (->> (get-all-nested-commands sub-trie) - (remove #(= % command-path-obj)) - set))) +;; -- Point -- (defn- find-anchor-path "Walks UP from current-path looking for the nearest ancestor map @@ -69,8 +55,8 @@ (loop [path (vec current-path)] (let [node (get-in instruction path)] (if (and (map? node) - (= anchor-name (or (get node "__anchor") - (get node :__anchor)))) + (= anchor-name (or (get node "__anchor") + (get node :__anchor)))) path (when (seq path) (recur (pop path))))))) @@ -86,34 +72,30 @@ (requires instruction to be passed as first argument) any other - descend into that key" [instruction base-path segments] - (let [result - (reduce - (fn [acc segment] - (let [{:keys [relative path]} acc - current-base (or relative base-path)] - (cond - (= segment "../") - {:relative (vec (butlast current-base)) :path path} - - (= segment "./") - {:relative (vec current-base) :path path} - - (and instruction - (string? segment) - (str/starts-with? segment "@")) - (let [anchor-name (subs segment 1) - anchor-path (find-anchor-path instruction (butlast current-base) anchor-name)] - (if anchor-path - {:relative anchor-path :path path} - (reduced nil))) - - :else - {:relative relative :path (conj path segment)}))) - {:relative nil :path []} - segments)] - (when result - (let [{:keys [relative path]} result] - (if relative (vec (concat relative path)) (vec path)))))) + (loop [remaining (seq segments) + relative nil + path []] + (if-not remaining + (if relative (into relative path) path) + (let [segment (first remaining) + current-base (or relative base-path)] + (cond + (= segment "../") + (recur (next remaining) (vec (butlast current-base)) path) + + (= segment "./") + (recur (next remaining) (vec current-base) path) + + (and instruction + (string? segment) + (str/starts-with? segment "@")) + (let [anchor-name (subs segment 1) + anchor-path (find-anchor-path instruction (butlast current-base) anchor-name)] + (when anchor-path + (recur (next remaining) anchor-path path))) + + :else + (recur (next remaining) relative (conj path segment))))))) (defn path-exists-in-instruction? "Checks if a path exists in the instruction map." @@ -156,43 +138,21 @@ (defmethod find-command-dependencies :point [command-path-obj instruction path-trie _type] (let [target-path (point-target-path instruction command-path-obj)] - (if-let [point-command (get-in path-trie (conj target-path ::command))] + (if-let [point-command (get-in path-trie (conj target-path :commando.impl.pathtrie/command))] #{point-command} (throw-point-error command-path-obj target-path instruction)))) -(defn- point-find-parent-command - "Walks up the path hierarchy to find the first parent command that exists in the trie." - [path-trie target-path] - (loop [current-path target-path] - (when (seq current-path) - (if-let [cmd (get-in path-trie (conj current-path ::command))] - cmd - (recur (butlast current-path)))))) - -(defmethod find-command-dependencies :point-and-all-inside-recur - [command-path-obj instruction path-trie _type] - (let [target-path (point-target-path instruction command-path-obj) - sub-trie (get-in path-trie target-path) - commands-at-target (set (get-all-nested-commands sub-trie)) - parent-command (point-find-parent-command path-trie target-path)] - (cond - (not-empty commands-at-target) commands-at-target - parent-command #{parent-command} - (path-exists-in-instruction? instruction target-path) #{} - :else (throw-point-error command-path-obj target-path instruction)))) - -(defmethod find-command-dependencies :none [_command-path-obj _instruction _path-trie _type] #{}) +;; Dependency (defn build-dependency-graph - "Builds the dependency map for all commands in `cm-list`. - Returns a map from CommandMapPath objects to their dependency sets." - [instruction cm-list] - (let [path-trie (build-path-trie cm-list)] - (reduce (fn [dependency-acc command-path-obj] - (let [dependency-mode (get-in (cm/command-data command-path-obj) [:dependencies :mode])] - (assoc dependency-acc - command-path-obj - (find-command-dependencies command-path-obj instruction path-trie dependency-mode)))) - {} - cm-list))) + "Builds forward dependency graph using a pre-built path-trie. + Returns {CommandMapPath -> #{deps}}." + [instruction cm-list path-trie] + (persistent! + (reduce (fn [fwd command-path-obj] + (let [dep-mode (get-in (cm/command-data command-path-obj) [:dependencies :mode]) + deps (find-command-dependencies command-path-obj instruction path-trie dep-mode)] + (assoc! fwd command-path-obj deps))) + (transient {}) + cm-list))) diff --git a/src/commando/impl/executing.cljc b/src/commando/impl/executing.cljc index 2e2d920..ecfccb0 100644 --- a/src/commando/impl/executing.cljc +++ b/src/commando/impl/executing.cljc @@ -71,20 +71,27 @@ (defn execute-commands "Execute commands in order, stopping on first failure. - Returns [updated-instruction error-info] where error-info is nil on success." + Returns [updated-instruction error-info cm-results]. + Transient results map: avoids N persistent map copies during execution loop. + Each command adds one entry — transient turns N×assoc into N×assoc! (zero HAMT copies)." [instruction commands] - (loop [current-instruction instruction - remaining-commands commands] - (if (empty? remaining-commands) - [current-instruction nil] - (let [command (first remaining-commands) - execution-result (try (execute-single-command current-instruction command) - (catch #?(:clj Exception - :cljs :default) - e - {:error {:command-path (cm/command-path command) - :command-type (:type (cm/command-data command)) - :original-error e}}))] - (if (:error execution-result) - [current-instruction (:error execution-result)] - (recur execution-result (rest remaining-commands))))))) + (let [cmd-count (count commands)] + (loop [current-instruction instruction + idx 0 + results (transient {})] + (if (= idx cmd-count) + [current-instruction nil (persistent! results)] + (let [command (nth commands idx) + command-path (cm/command-path command) + root? (empty? command-path) + execution-result (try (execute-single-command current-instruction command) + (catch #?(:clj Exception + :cljs :default) + e + {:error {:command-path command-path + :command-type (:type (cm/command-data command)) + :original-error e}}))] + (if (:error execution-result) + [current-instruction (:error execution-result) (persistent! results)] + (let [cmd-result (if root? execution-result (get-in execution-result command-path))] + (recur execution-result (inc idx) (assoc! results command cmd-result))))))))) diff --git a/src/commando/impl/finding_commands.cljc b/src/commando/impl/finding_commands.cljc index 7c7f997..8d4d8d8 100644 --- a/src/commando/impl/finding_commands.cljc +++ b/src/commando/impl/finding_commands.cljc @@ -1,23 +1,34 @@ (ns commando.impl.finding-commands (:require [commando.impl.command-map :as cm] + [commando.impl.pathtrie :as pathtrie] [commando.impl.utils :as utils])) -(defn ^:private coll-child-paths - "Returns child paths for regular collections that should be traversed." - [value current-path] +(defn ^:private enqueue-coll-children! + "Enqueues child paths for regular collections directly into the transient queue. + Avoids intermediate vector allocation compared to mapv approach." + [queue value current-path] (cond - (map? value) (doall (map (fn [[k _v]] (conj current-path k)) (seq value))) - (coll? value) (doall (map (fn [i] (conj current-path i)) (range (count value)))) - :else [])) + (map? value) + (reduce-kv (fn [q k _] (conj! q (conj current-path k))) queue value) -(defmulti ^:private command-child-paths - "Returns child paths that should be traversed for a command based on its dependency mode." - (fn [command-spec _value _current-path] (get-in command-spec [:dependencies :mode]))) + (coll? value) + (let [c (count value)] + (loop [i 0 q queue] + (if (= i c) q + (recur (inc i) (conj! q (conj current-path i)))))) -(defmethod command-child-paths :default [_command-spec _value _current-path] []) + :else queue)) -(defmethod command-child-paths :all-inside [_command-spec value current-path] (coll-child-paths value current-path)) +(defmulti ^:private enqueue-command-children! + "Enqueues child paths that should be traversed for a command based on its dependency mode. + Takes a transient queue vector and returns it with children added." + (fn [_queue command-spec _value _current-path] (get-in command-spec [:dependencies :mode]))) + +(defmethod enqueue-command-children! :default [queue _command-spec _value _current-path] queue) + +(defmethod enqueue-command-children! :all-inside [queue _command-spec value current-path] + (enqueue-coll-children! queue value current-path)) (defn command? [{:keys [recognize-fn] @@ -48,51 +59,46 @@ (some (fn [command-spec] (when (command? command-spec value) (let [value-valid-return (command-valid? command-spec value)] - (cond - (true? value-valid-return) command-spec - (or - (false? value-valid-return) - (nil? value-valid-return)) - (throw - (ex-info - (str - "Failed while validating params for " (:type command-spec) ". Check ':validate-params-fn' property for corresponding command with value it was evaluated on.") - {:command-type (:type command-spec) - :path path - :value value})) - :else - (throw - (ex-info - (str - "Failed while validating params for " (:type command-spec) ". Check ':validate-params-fn' property for corresponding command with value it was evaluated on.") - {:command-type (:type command-spec) - :reason value-valid-return - :path path - :value value})))))) + (if (true? value-valid-return) command-spec + (throw + (ex-info + (str + "Failed while validating params for " (:type command-spec) ". Check ':validate-params-fn' property for corresponding command with value it was evaluated on.") + {:command-type (:type command-spec) + :reason (when value-valid-return value-valid-return) + :path path + :value value})))))) command-spec-vector)) (defn find-commands - "Traverses the instruction tree (BFS algo) and collects all commands defined by the registry." - [instruction {:keys [registry-runtime] :as _command-registry}] - (loop [queue (vec [[]]) - found-commands [] - debug-stack-map {}] - (if (empty? queue) - found-commands - (let [current-path (first queue) - remaining-paths (subvec queue 1) - current-value (get-in instruction current-path) - debug-stack (if (:debug-result (utils/execute-config)) (get debug-stack-map current-path (list)) (list))] - (if-let [command-spec (instruction-command-spec registry-runtime current-value current-path)] - (let [command (cm/->CommandMapPath - current-path - (if (:debug-result (utils/execute-config)) (merge command-spec {:__debug_stack debug-stack}) command-spec)) - child-paths (command-child-paths command-spec current-value current-path) - updated-debug-stack-map (if (:debug-result (utils/execute-config)) - (reduce #(assoc %1 %2 (conj debug-stack command)) debug-stack-map child-paths) - {})] - (recur (into remaining-paths child-paths) (conj found-commands command) updated-debug-stack-map)) - ;; No match - traverse children if coll, skip if leaf - (recur (into remaining-paths (coll-child-paths current-value current-path)) - found-commands - debug-stack-map)))))) + "Traverses the instruction tree (BFS) and collects all commands defined by the registry. + Returns {:commands #{...} :trie {...}} — the command set and path-trie built in the same pass. + + Options: + Optimizations: + - Index-based transient queue: O(N) instead of O(N²) from subvec+into copying + - Transient found-commands set: O(N) set allocations saved + - Direct enqueue: no intermediate mapv vectors for child-path generation + - Transient trie root: N root-level HAMT copies avoided during bulk construction" + ([instruction command-registry] + (find-commands instruction command-registry nil)) + ([instruction {:keys [registry-runtime] :as _command-registry} _opts] + (loop [queue (transient [[]]) + idx 0 + found-commands (transient #{}) + trie (transient {})] + (if (= idx (count queue)) + {:commands (persistent! found-commands) :trie (persistent! trie)} + (let [current-path (nth queue idx) + current-value (get-in instruction current-path)] + (if-let [command-spec (instruction-command-spec registry-runtime current-value current-path)] + (let [command (cm/command-map-path current-path command-spec)] + (recur (enqueue-command-children! queue command-spec current-value current-path) + (inc idx) + (conj! found-commands command) + (pathtrie/trie-insert-command! trie command))) + (recur (enqueue-coll-children! queue current-value current-path) + (inc idx) + found-commands + trie))))))) + diff --git a/src/commando/impl/graph.cljc b/src/commando/impl/graph.cljc index 634fc6e..9969412 100644 --- a/src/commando/impl/graph.cljc +++ b/src/commando/impl/graph.cljc @@ -1,6 +1,4 @@ -(ns commando.impl.graph - (:require - [clojure.set :as set])) +(ns commando.impl.graph) (defn topological-sort "Efficiently sorts a directed acyclic graph using Kahn's algorithm with in-degree counting. @@ -9,26 +7,31 @@ and :cyclic containing the remaining nodes if a cycle is detected." [g] (let [;; Build the reverse graph to easily find dependents and collect all nodes. - rev-g (reduce-kv (fn [acc k vs] - (reduce (fn [a v] (update a v (fnil conj []) k)) acc vs)) - {} g) - all-nodes (set/union (set (keys g)) (set (keys rev-g))) + rev-g (persistent! + (reduce-kv (fn [acc k vs] + (reduce (fn [a v] + (let [existing (get a v [])] + (assoc! a v (conj existing k)))) + acc vs)) + (transient {}) g)) + node-count (count g) ;; calculate in-degrees for all nodes. - in-degrees (reduce-kv (fn [acc node deps] - (assoc acc node (count deps))) - {} g) + in-degrees (persistent! + (reduce-kv (fn [acc node deps] + (assoc! acc node (count deps))) + (transient {}) g)) ;; Initialize the queue with nodes that have no incoming edges. ;; Using a vector as a FIFO queue. - q (reduce (fn [queue node] - (if (zero? (get in-degrees node 0)) - (conj queue node) - queue)) - [] all-nodes)] + q (reduce-kv (fn [queue node deps] + (if (zero? (count deps)) + (conj queue node) + queue)) + [] g)] (loop [queue q - sorted-result [] - degrees in-degrees] + sorted-result (transient []) + degrees (transient in-degrees)] (if-let [node (first queue)] (let [dependents (get rev-g node []) ;; Reduce in-degree for all dependents @@ -36,17 +39,19 @@ [next-degrees new-zero-nodes] (reduce (fn [[degs zeros] dep] (let [new-degree (dec (get degs dep))] - [(assoc degs dep new-degree) + [(assoc! degs dep new-degree) (if (zero? new-degree) (conj zeros dep) zeros)])) [degrees []] dependents)] (recur (into (subvec queue 1) new-zero-nodes) - (conj sorted-result node) + (conj! sorted-result node) next-degrees)) - (if (= (count sorted-result) (count all-nodes)) - {:sorted sorted-result :cyclic {}} - (let [cyclic-nodes (->> degrees - (filter (fn [[_ v]] (pos? v))) - (into {}))] - {:sorted sorted-result :cyclic cyclic-nodes})))))) + (let [sorted (persistent! sorted-result)] + (if (= (count sorted) node-count) + {:sorted sorted :cyclic {}} + (let [final-degrees (persistent! degrees) + cyclic-nodes (->> final-degrees + (filter (fn [[_ v]] (pos? v))) + (into {}))] + {:sorted sorted :cyclic cyclic-nodes}))))))) diff --git a/src/commando/impl/pathtrie.cljc b/src/commando/impl/pathtrie.cljc new file mode 100644 index 0000000..a427dc2 --- /dev/null +++ b/src/commando/impl/pathtrie.cljc @@ -0,0 +1,45 @@ +(ns commando.impl.pathtrie + (:require + [commando.impl.command-map :as cm])) + +(defn trie-insert-command! + "Inserts a command into a trie with transient root." + [trie! cmd] + (let [path (cm/command-path cmd)] + (if (empty? path) + (assoc! trie! ::command cmd) + (let [k (first path) + sub (get trie! k {})] + (if (= (count path) 1) + (assoc! trie! k (assoc sub ::command cmd)) + (let [rest-keys (subvec (conj path ::command) 1)] + (assoc! trie! k (assoc-in sub rest-keys cmd)))))))) + +(defn build-path-trie + "Builds a trie from a collection of CommandMapPath objects. + Uses transient root for efficient bulk construction." + [cm-list] + (persistent! + (reduce trie-insert-command! (transient {}) cm-list))) + +(defn trie-remove-paths + "Removes all entries from a trie whose paths start with the given prefixes." + [trie paths-to-remove] + (reduce + (fn [t path] + (if (seq path) + (let [parent-path (butlast path) + leaf (last path)] + (if (seq parent-path) + (update-in t (vec parent-path) dissoc leaf) + (dissoc t leaf))) + {})) + trie + paths-to-remove)) + +(defn trie-insert-commands + "Inserts commands into an existing trie." + [trie new-commands] + (reduce (fn [trie cmd] + (assoc-in trie (conj (cm/command-path cmd) ::command) cmd)) + trie new-commands)) diff --git a/src/commando/impl/registry.cljc b/src/commando/impl/registry.cljc index d660ea1..b7dfb97 100644 --- a/src/commando/impl/registry.cljc +++ b/src/commando/impl/registry.cljc @@ -68,6 +68,16 @@ default-command-map-spec default-command-value-spec]) +(def structural-command-types + "Set of internal/structural command types that don't affect execution order." + (into #{} (map :type internal-command-specs))) + +(defn structural-command-type? + "Returns true if the given command type is a structural/internal type + (:instruction/_value, :instruction/_map, :instruction/_vec)." + [command-type] + (contains? structural-command-types command-type)) + (defn built? "Returns true if the given value is a properly built registry map." [registry] @@ -107,12 +117,11 @@ (dissoc enriched-registry :registry-runtime)) (defn remove-runtime-registry-commands-from-command-list [cm-vector] - (let [cm-type-instruction-defaults - (into #{} (map :type internal-command-specs))] - (reduce (fn [acc command-map] - (if (contains? cm-type-instruction-defaults (:type (cm/command-data command-map))) - acc (conj acc command-map))) - [] cm-vector))) + ;; Reuse `structural-command-types` def instead of rebuilding the set on every call. + (reduce (fn [acc command-map] + (if (contains? structural-command-types (:type (cm/command-data command-map))) + acc (conj acc command-map))) + [] cm-vector)) ;; ---------------- ;; Registry Helpers @@ -136,3 +145,4 @@ (build new-vec))) + diff --git a/src/commando/impl/status_map.cljc b/src/commando/impl/status_map.cljc index 7bcc77c..09e1c55 100644 --- a/src/commando/impl/status_map.cljc +++ b/src/commando/impl/status_map.cljc @@ -3,9 +3,6 @@ [commando.impl.utils :as utils] [malli.core :as malli])) -(def ^:private status-map-message-schema - [:map [:message [:string {:min 5}]]]) - ;;;------ ;;; Stats ;;;------ @@ -20,35 +17,34 @@ duration (utils/format-time duration)]))) +(def ^:private -coercer:status-map-message + (malli/coercer [:map [:message [:string {:min 5}]]])) + (defn status-map-handle-warning [status-map m] - (update status-map :warnings (fnil conj []) (malli/coerce status-map-message-schema m))) + (update status-map :warnings (fnil conj []) (-coercer:status-map-message m))) (defn status-map-handle-error [status-map m] (-> status-map - (update :errors (fnil conj []) (malli/coerce status-map-message-schema m)) + (update :errors (fnil conj []) (-coercer:status-map-message m)) (assoc :status :failed))) (defn status-map-handle-success [status-map m] - (update status-map :successes (fnil conj []) (malli/coerce status-map-message-schema m))) + (update status-map :successes (fnil conj []) (-coercer:status-map-message m))) (defn status-map-pure - ([] (status-map-pure nil)) + ([] (status-map-pure {})) ([m] - (merge {:uuid (:uuid utils/*execute-internals*) - :status :ok - :errors [] - :warnings [] - :successes [] - :stats []} - m))) - -(defn status-map-undefined-status - [status-map] - (throw (ex-info (str "Status map exception, :status value incorrect: " (:status status-map)) - {:status (:status status-map)}))) + (-> m + (assoc :uuid (:uuid utils/*execute-internals*)) + (cond-> + (not (contains? m :status)) (assoc :status :ok) + (not (contains? m :errors)) (assoc :errors []) + (not (contains? m :warnings)) (assoc :warnings []) + (not (contains? m :successes)) (assoc :successes []) + (not (contains? m :stats)) (assoc :stats []))))) (defn failed? [status-map] (= (:status status-map) :failed)) diff --git a/src/commando/impl/utils.cljc b/src/commando/impl/utils.cljc index 8a63d80..4f24655 100644 --- a/src/commando/impl/utils.cljc +++ b/src/commando/impl/utils.cljc @@ -9,16 +9,16 @@ ;; ------------------ (def ^:private -execute-config-default - {:debug-result false - :error-data-string true + {:error-data-string true :hook-execute-end nil :hook-execute-start nil}) (def ^:dynamic *execute-config* "Dynamic configuration for `commando/execute` behavior. - - `:debug-result` (boolean): When true, adds additional execution - information to the returned status-map, aiding in instruction analysis. + Bound automatically by `commando.core/execute` — prefer passing config + via the opts map to `execute` rather than binding directly. + - `:error-data-string` (boolean): When true, the `:data` key in serialized `ExceptionInfo` (via `commando.impl.utils/serialize-exception`) will be a string representation of the data. When false, it will return @@ -29,17 +29,15 @@ passed in value. Example - (binding [commando.impl.utils/*execute-config* - {:debug-result true - :error-data-string false - :hook-execute-start (fn [e] (println (:uuid e))) - :hook-execute-end (fn [e] (println (:uuid e) (:stats e)))}] - (commando.core/execute - [commando.commands.builtin/command-from-spec] - {\"1\" 1 - \"2\" {:commando/from [\"1\"]} - \"3\" {:commando/from [\"2\"]}}))" - -execute-config-default) + (commando.core/execute + [commando.commands.builtin/command-from-spec] + {\"1\" 1 + \"2\" {:commando/from [\"1\"]} + \"3\" {:commando/from [\"2\"]}} + {:error-data-string false + :hook-execute-start (fn [e] (println (:uuid e))) + :hook-execute-end (fn [e] (println (:uuid e) (:stats e)))})" + nil) (def ^:dynamic *execute-internals* @@ -62,10 +60,24 @@ (assoc :uuid uuid-execute-identifier) (update :stack conj uuid-execute-identifier))) +(def ^:private -config-keys + #{:error-data-string :hook-execute-start :hook-execute-end}) + (defn execute-config - "Returns the effective configuration for `commando/execute`, getting data from dynamic variable `commando.impl.utils/*execute-config*`" + "Returns the effective configuration for `commando/execute`. + Inside `execute` — returns the bound `*execute-config*`. + Outside — returns defaults." [] - (merge -execute-config-default *execute-config*)) + (or *execute-config* -execute-config-default)) + +(defn execute-config-update + "Merges config-relevant keys from `opts` into the current + effective config. Non-config keys (e.g. `:previous`) are ignored." + [opts] + (let [overrides (select-keys opts -config-keys)] + (if (empty? overrides) + (execute-config) + (merge (execute-config) overrides)))) (defn hook-process "Function will handle a hooks passed from users. diff --git a/test/perf/commando/core_perf_test.clj b/test/perf/commando/core_perf_test.clj deleted file mode 100644 index b11279f..0000000 --- a/test/perf/commando/core_perf_test.clj +++ /dev/null @@ -1,467 +0,0 @@ -(ns commando.core-perf-test - (:require - [cljfreechart.core :as cljfreechart] - [commando.commands.builtin] - [commando.commands.query-dsl] - [commando.core] - [commando.debug :as debug] - [commando.impl.utils :as commando-utils])) - -;; ======================================= -;; AVERAGE EXECUTION OF REAL WORLD EXAMPLE -;; ======================================= - -(defn ^:private calculate-average-stats - "Takes a collection of status-maps and calculates the average duration for each stat-key." - [status-maps] - {:pre [(not-empty status-maps)]} - (let [keys-order (map first (:stats (first status-maps))) - all-stats (mapcat :stats status-maps) - grouped-stats (group-by first all-stats) - averages-grouped - (reduce (fn [acc [stat-key measurements]] - (let [total-duration (reduce + (map second measurements)) - count-measurements (count measurements) - average-duration (long (/ total-duration count-measurements))] - (assoc acc stat-key [stat-key average-duration (commando.impl.utils/format-time average-duration)]))) - {} grouped-stats)] - {:stats (mapv #(get averages-grouped %) keys-order)})) - -(defmacro repeat-n-and-print-stats - "Repeats the execution of `body` `n` times, collects the status-maps," - [n & body] - `(let [results# (doall (for [_# (range ~n)] - ~@body)) - avg-stats# (calculate-average-stats results#)] - (println "Repeating instruction " ~n " times") - (#'debug/pprint-stats-mode - (assoc avg-stats# :status :ok :errors [] :internal/cm-running-order []) - nil))) - -(defn real-word-calculation-average-of-50 [] - (println "\n=====================Benchmark=====================") - (println "Real Word calculation. Show average of 50 execution") - (println "===================================================") - (repeat-n-and-print-stats 50 - (commando.core/execute - [commando.commands.builtin/command-fn-spec - commando.commands.builtin/command-from-spec - commando.commands.builtin/command-apply-spec] - { ;; -------------------------------------------------------------------------------- - ;; RAW DATA & CONFIGURATION - ;; -------------------------------------------------------------------------------- - :config - {:commission-rates {:standard 0.07 :senior 0.12} - :bonus-threshold 50000 - :performance-bonus 2500 - :tax-rate 0.21 - :department-op-cost {:sales 15000 :marketing 10000 :engineering 25000}} - - :products - {"prod-001" {:name "Alpha Widget" :price 250.0} - "prod-002" {:name "Beta Gadget" :price 475.0} - "prod-003" {:name "Gamma Gizmo" :price 1200.0}} - - :employees - {"emp-101" {:name "John Doe" :department :sales :level :senior} - "emp-102" {:name "Jane Smith" :department :sales :level :standard} - "emp-103" {:name "Peter Jones" :department :marketing :level :senior} - "emp-201" {:name "Mary Major" :department :engineering :level :standard}} - - :sales-records - [ ;; John's Sales - {:employee-id "emp-101" :product-id "prod-003" :units-sold 50} - {:employee-id "emp-101" :product-id "prod-001" :units-sold 120} - ;; Jane's Sales - {:employee-id "emp-102" :product-id "prod-001" :units-sold 80} - {:employee-id "emp-102" :product-id "prod-002" :units-sold 40} - ;; Peter's Sales (Marketing can also sell) - {:employee-id "emp-103" :product-id "prod-002" :units-sold 10}] - - :calculations - {:sales-revenues - {:commando/fn (fn [sales products] - (mapv (fn [sale] - (let [product (get products (:product-id sale))] - (assoc sale :total-revenue (* (:units-sold sale) (:price product))))) - sales)) - :args [{:commando/from [:sales-records]} - {:commando/from [:products]}]} - - :employee-sales-totals - {:commando/fn (fn [sales-revenues] - (reduce (fn [acc sale] - (update acc - (:employee-id sale) - (fnil + 0) - (:total-revenue sale))) - {} - sales-revenues)) - :args [{:commando/from [:calculations :sales-revenues]}]} - - :employee-commissions - {:commando/apply - {:sales-totals {:commando/from [:calculations :employee-sales-totals]} - :employees {:commando/from [:employees]} - :rates {:commando/from [:config :commission-rates]}} - :=> [:fn (fn [{:keys [sales-totals employees rates]}] - (into {} - (map (fn [[emp-id total-sales]] - (let [employee (get employees emp-id) - rate-key (:level employee) - commission-rate (get rates rate-key 0)] - [emp-id (* total-sales commission-rate)])) - sales-totals)))]} - - :employee-bonuses - {:commando/apply - {:sales-totals {:commando/from [:calculations :employee-sales-totals]} - :threshold {:commando/from [:config :bonus-threshold]} - :bonus-amount {:commando/from [:config :performance-bonus]}} - :=> [:fn (fn [{:keys [sales-totals threshold bonus-amount]}] - (into {} - (map (fn [[emp-id total-sales]] - [emp-id (if (> total-sales threshold) bonus-amount 0)]) - sales-totals)))]} - - :employee-total-compensation - {:commando/fn (fn [commissions bonuses] - (merge-with + commissions bonuses)) - :args [{:commando/from [:calculations :employee-commissions]} - {:commando/from [:calculations :employee-bonuses]}]} - - :department-financials - {:commando/apply - {:employees {:commando/from [:employees]} - :sales-totals {:commando/from [:calculations :employee-sales-totals]} - :compensations {:commando/from [:calculations :employee-total-compensation]} - :op-costs {:commando/from [:config :department-op-cost]}} - :=> [:fn (fn [{:keys [employees sales-totals compensations op-costs]}] - (let [initial-agg {:sales {:total-revenue 0 :total-compensation 0} - :marketing {:total-revenue 0 :total-compensation 0} - :engineering {:total-revenue 0 :total-compensation 0}}] - (as-> (reduce-kv (fn [agg emp-id emp-data] - (let [dept (:department emp-data) - revenue (get sales-totals emp-id 0) - compensation (get compensations emp-id 0)] - (-> agg - (update-in [dept :total-revenue] + revenue) - (update-in [dept :total-compensation] + compensation)))) - initial-agg - employees) data - (merge-with - (fn [dept-data op-cost] - (let [profit (- (:total-revenue dept-data) - (+ (:total-compensation dept-data) op-cost))] - (assoc dept-data - :operating-cost op-cost - :net-profit profit))) - data - op-costs))))]}} - - :final-report - {:commando/apply - {:dept-financials {:commando/from [:calculations :department-financials]} - :total-sales-per-employee {:commando/from [:calculations :employee-sales-totals]} - :total-compensation-per-employee {:commando/from [:calculations :employee-total-compensation]} - :tax-rate {:commando/from [:config :tax-rate]}} - :=> [:fn (fn [{:keys [dept-financials total-sales-per-employee total-compensation-per-employee tax-rate]}] - (let [company-total-revenue (reduce + (map :total-revenue (vals dept-financials))) - company-total-compensation (reduce + (map :total-compensation (vals dept-financials))) - company-total-op-cost (reduce + (map :operating-cost (vals dept-financials))) - company-gross-profit (- company-total-revenue - (+ company-total-compensation company-total-op-cost)) - taxes-payable (* company-gross-profit tax-rate) - company-net-profit (- company-gross-profit taxes-payable)] - {:company-summary - {:total-revenue company-total-revenue - :total-compensation company-total-compensation - :total-operating-cost company-total-op-cost - :gross-profit company-gross-profit - :taxes-payable taxes-payable - :net-profit-after-tax company-net-profit} - :department-breakdown dept-financials - :employee-performance - {:top-earner (key (apply max-key val total-compensation-per-employee)) - :top-seller (key (apply max-key val total-sales-per-employee))}}))]}}))) - - -;; ============================== -;; FLAME FOR RECURSIVE INVOCATION -;; ============================== - -(defmethod commando.commands.query-dsl/command-resolve :query-B [_ {:keys [x QueryExpression]}] - (let [x (or x 10)] - (-> {:map {:a - {:b {:c x} - :d {:c (inc x) - :f (inc (inc x))}}} - :query-A (commando.commands.query-dsl/resolve-instruction-qe - "error" - {:commando/resolve :query-A - :x 1})} - (commando.commands.query-dsl/->query-run QueryExpression)))) - -(defmethod commando.commands.query-dsl/command-resolve :query-A [_ {:keys [x QueryExpression]}] - (let [x (or x 10)] - (-> {:map {:a - {:b {:c x} - :d {:c (inc x) - :f (inc (inc x))}}} - - :resolve-fn (commando.commands.query-dsl/resolve-fn - "error" - (fn [{:keys [x]}] - (let [y (or x 1) - range-y (if (< 10 y) 10 y)] - (for [z (range 0 range-y)] - {:a - {:b {:c (+ y z)} - :d {:c (inc (+ y z)) - :f (inc (inc (+ y z)))}}})))) - - - - :instruction-A (commando.commands.query-dsl/resolve-instruction - "error" - {:__title "Resolve instruction-A" - :commando/fn (fn [& [y]] - {:a - {:b {:c y} - :d {:c (inc y) - :f (inc (inc y))}}}) - :args [x]}) - - - :query-A (commando.commands.query-dsl/resolve-instruction-qe - "error" - {:__title "Resolve query-A" - :commando/resolve :query-A - :x 1}) - :query-B (commando.commands.query-dsl/resolve-instruction-qe - "error" - {:__title "Resolve query-B" - :commando/resolve :query-B - :x 1})} - (commando.commands.query-dsl/->query-run QueryExpression)))) - -(defn run-execute-in-depth-with-using-queryDSL [] - (println "\n===================Benchmark=====================") - (println "Run commando/execute in depth with using queryDSL") - (println "=================================================") - (debug/execute-trace - #(commando.core/execute - [commando.commands.query-dsl/command-resolve-spec - commando.commands.builtin/command-from-spec - commando.commands.builtin/command-fn-spec] - {:__title "TOPLEVEL" - :commando/resolve :query-A - :x 1 - :QueryExpression - [{:map - [{:a - [:b]}]} - {:instruction-A [:a]} - {:query-A - [{:map - [{:a - [:b]}]} - {:query-A - [{:map - [{:a - [:b]}]} - {:query-A - [{:map - [{:a - [:b]}]}]}]}]} - {:query-B - [{:map - [{:a - [:b]}]} - {:query-A - [{:map - [{:a - [:b]}]} - {:query-A - [{:instruction-A [:a]}]}]}]}]}))) - -;; ===================================== -;; BUILDING DEPENDECY COMPLEX TEST CASES -;; ===================================== - -(defn instruction-build-v+m [{:keys [wide-n long-n]}] - {:dependecy-token (* 2 wide-n long-n) - :source-maps - (mapv (fn [_n] - (into {} (mapv (fn [v] [(keyword (str "k" v)) v]) - (range 1 wide-n)))) - (range 1 long-n)) - :result-maps - (mapv (fn [n] - (into {} - (mapv - (fn [v] - (let [k (keyword (str "k" v))] - [k {:commando/from [:source-maps n k]}])) - (range 1 wide-n)))) - (range 1 long-n))}) - -(defn instruction-build-m [{:keys [wide-n long-n]}] - {:dependecy-token (* 2 wide-n long-n) - :source-maps - (reduce (fn [acc n] - (assoc acc (keyword (str "r" n)) - (into {} (mapv (fn [v] [(keyword (str "k" v)) v]) - (range 1 wide-n))))) - {} - (range 1 long-n)) - :result-maps - (reduce (fn [acc n] - (assoc acc (keyword (str "r" n)) - (into {} - (mapv - (fn [v] - (let [k (keyword (str "k" v))] - [k {:commando/from [:source-maps (keyword (str "r" n)) k]}])) - (range 1 wide-n))))) - {} - (range 1 long-n))}) - -(defn execute-complexity [{:keys [mode wide-n long-n]}] - (let [instruction-builder (case mode - :m (instruction-build-m {:wide-n wide-n :long-n long-n}) - :v+m (instruction-build-v+m {:wide-n wide-n :long-n long-n}))] - (binding [commando.impl.utils/*execute-config* - {:debug-result true}] - (let [result (commando.core/execute - [commando.commands.builtin/command-from-spec] - instruction-builder) - stats-grouped (reduce (fn [acc [k v _label]] - (assoc acc k v)) - {} - (:stats result))] - {:dependecy-token (:dependecy-token instruction-builder) - :stats (:stats result) - :stats-grouped stats-grouped})))) - -;; ================================ -;; PLOT LOAD TEST CASES IN PNG FILE -;; WITH USING JFREECHART -;; ================================ - -(defn ^:private chat-custom-styles [chart] - (let [plotObject (.getPlot chart) - plotObjectRenderer (.getRenderer plotObject)] - (.setBackgroundPaint chart (java.awt.Color/new 255, 255, 255)) - (.setBackgroundPaint plotObject (java.awt.Color/new 255, 255, 255)) - (.setSeriesPaint plotObjectRenderer 0 (java.awt.Color/new 64, 115, 62)) - (.setSeriesPaint plotObjectRenderer 1 (java.awt.Color/new 62, 65, 115)) - (.setSeriesPaint plotObjectRenderer 2 (java.awt.Color/new 115, 94, 62)) - (.setSeriesPaint plotObjectRenderer 3 (java.awt.Color/new 115, 62, 62)) - (.setOutlineVisible plotObject false) - chart)) - -(defn execute-steps-grow_s_x_dep [] - (println "\n==================Benchmark====================") - (println "execute-steps(massive dep grow) secs_x_deps.png") - (println "===============================================") - (let [instruction-stats-result [(execute-complexity {:mode :v+m :wide-n 50 :long-n 50}) - (execute-complexity {:mode :v+m :wide-n 50 :long-n 500}) - (execute-complexity {:mode :v+m :wide-n 50 :long-n 5000}) - (execute-complexity {:mode :v+m :wide-n 50 :long-n 50000})] - chart-data (mapv (fn [e] (let [{:keys [dependecy-token stats-grouped]} e] - (-> stats-grouped - (dissoc "execute") - (update-vals (fn [nanosecs-t] - ;; (/ nanosecs-t 1000000) ;; miliseconds - (/ nanosecs-t 1000000000) ;; seconds - )) - (assoc "dependecy-token" dependecy-token)))) - instruction-stats-result)] - (doseq [{:keys [dependecy-token stats]} instruction-stats-result] - (println (str "Dependency Counts: " dependecy-token)) - (#'debug/pprint-stats-mode - {:stats stats :status :ok :errors [] :internal/cm-running-order []} - nil)) - (cljfreechart/save-chart-as-file - (-> chart-data - (cljfreechart/make-category-dataset {:group-key "dependecy-token"}) - (cljfreechart/make-bar-chart "commando.core/execute steps on massive count of dependencies" - {:category-title "Dependency Counts" - :value-title "Seconds"}) - (chat-custom-styles)) - "./test/perf/commando/execute-steps(massive dep grow) secs_x_deps.png" {:width 1200 :height 400}))) - -(defn execute-steps-normal_ms_x_dep [] - (println "\n================Benchmark================") - (println "execute-steps(normal) milisecs_x_deps.png") - (println "=========================================") - (let [instruction-stats-result - [(execute-complexity {:mode :m :wide-n 5 :long-n 10}) - (execute-complexity {:mode :m :wide-n 5 :long-n 14}) - (execute-complexity {:mode :m :wide-n 5 :long-n 15}) - (execute-complexity {:mode :m :wide-n 5 :long-n 20})] - chart-data (mapv (fn [e] (let [{:keys [dependecy-token stats-grouped]} e] - (-> stats-grouped - (dissoc "execute") - (update-vals (fn [nanosecs-t] - (/ nanosecs-t 1000000) ;; miliseconds - ;; (/ nanosecs-t 1000000000) ;; seconds - )) - (assoc "dependecy-token" dependecy-token)))) - instruction-stats-result)] - (doseq [{:keys [dependecy-token stats]} instruction-stats-result] - (println (str "Dependency Counts: " dependecy-token)) - (#'debug/pprint-stats-mode - {:stats stats :status :ok :errors [] :internal/cm-running-order []} - nil)) - (cljfreechart/save-chart-as-file - (-> chart-data - (cljfreechart/make-category-dataset {:group-key "dependecy-token"}) - (cljfreechart/make-bar-chart "commando.core/execute steps" - {:category-title "Dependency Counts" - :value-title "Miliseconds"}) - (chat-custom-styles)) - "./test/perf/commando/execute-steps(normal) milisecs_x_deps.png" {:width 1200 :height 400}))) - -(defn execute-normal_ms_x_dep [] - (println "\n=============Benchmark=============") - (println "execute(normal) milisecs_x_deps.png") - (println "===================================") - (let [instruction-stats-result - [(execute-complexity {:mode :v+m :wide-n 25 :long-n 25}) - (execute-complexity {:mode :v+m :wide-n 50 :long-n 50}) - (execute-complexity {:mode :v+m :wide-n 100 :long-n 100}) - (execute-complexity {:mode :v+m :wide-n 200 :long-n 200})] - chart-data (mapv (fn [e] (let [{:keys [dependecy-token stats-grouped]} e] - (-> stats-grouped - (select-keys ["execute"]) - (update-vals (fn [nanosecs-t] - (float (/ nanosecs-t 1000000)) ;; miliseconds - ;; (float (/ nanosecs-t 1000000000)) ;; seconds - )) - (assoc "dependecy-token" dependecy-token)))) - instruction-stats-result)] - (doseq [{:keys [dependecy-token stats]} instruction-stats-result] - (println (str "Dependency Counts: " dependecy-token)) - (#'debug/pprint-stats-mode - {:stats stats :status :ok :errors [] :internal/cm-running-order []} - nil)) - (cljfreechart/save-chart-as-file - (-> chart-data - (cljfreechart/make-category-dataset {:group-key "dependecy-token"}) - (cljfreechart/make-bar-chart "commando.core/execute times" - {:category-title "Dependency Counts" - :value-title "Miliseconds"}) - (chat-custom-styles)) - "./test/perf/commando/execute(normal) milisecs_x_deps.png" {:width 1200 :height 400}))) - -(defn -main [] - ;; Execution stats. - (real-word-calculation-average-of-50) - (run-execute-in-depth-with-using-queryDSL) - ;; Drow plot for special cases. - (execute-steps-normal_ms_x_dep) - (execute-normal_ms_x_dep) - (execute-steps-grow_s_x_dep)) - diff --git a/test/perf/commando/execute(normal) milisecs_x_deps.png b/test/perf/commando/execute(normal) milisecs_x_deps.png deleted file mode 100644 index 4f28981..0000000 --- a/test/perf/commando/execute(normal) milisecs_x_deps.png +++ /dev/null @@ -1,3 +0,0 @@ -version https://git-lfs.github.com/spec/v1 -oid sha256:c95740b0ee83130fb35d576357fcc8912fc9f4223e284f2faa87d8f5a47e3dbc -size 20366 diff --git a/test/perf/commando/execute-steps(massive dep grow) secs_x_deps.png b/test/perf/commando/execute-steps(massive dep grow) secs_x_deps.png deleted file mode 100644 index df05d85..0000000 --- a/test/perf/commando/execute-steps(massive dep grow) secs_x_deps.png +++ /dev/null @@ -1,3 +0,0 @@ -version https://git-lfs.github.com/spec/v1 -oid sha256:6114d208235d618bb388771c635eae98ffed6b1234887366b5463382bca8f1bd -size 18310 diff --git a/test/perf/commando/execute-steps(normal) milisecs_x_deps.png b/test/perf/commando/execute-steps(normal) milisecs_x_deps.png deleted file mode 100644 index 0979830..0000000 --- a/test/perf/commando/execute-steps(normal) milisecs_x_deps.png +++ /dev/null @@ -1,3 +0,0 @@ -version https://git-lfs.github.com/spec/v1 -oid sha256:5a12d26057edc1fb0406047f40774167eea092625014ea74f13c92127ab170f7 -size 21889 diff --git a/test/perf/commando/execute/Execute. Massive Dependency Steps.png b/test/perf/commando/execute/Execute. Massive Dependency Steps.png new file mode 100644 index 0000000..70089f3 --- /dev/null +++ b/test/perf/commando/execute/Execute. Massive Dependency Steps.png @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:b52fc71a895b7a4c68a84e1064687ba46d75d03c3f44ad2dc7490582d2952661 +size 16748 diff --git a/test/perf/commando/execute/Execute. Normal Steps.png b/test/perf/commando/execute/Execute. Normal Steps.png new file mode 100644 index 0000000..b828f99 --- /dev/null +++ b/test/perf/commando/execute/Execute. Normal Steps.png @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:11421352641cb86307b80eaff32a31ab21c52797b29c564be399570157652b13 +size 24806 diff --git a/test/perf/commando/execute/Execute. Normal Total.png b/test/perf/commando/execute/Execute. Normal Total.png new file mode 100644 index 0000000..51ae000 --- /dev/null +++ b/test/perf/commando/execute/Execute. Normal Total.png @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:1ac53573c13516e3f121d695f03483f9b666312996a8edbe9e39dc8838177808 +size 15432 diff --git a/test/perf/commando/execute/Execute. Real World Avg50.png b/test/perf/commando/execute/Execute. Real World Avg50.png new file mode 100644 index 0000000..958c095 --- /dev/null +++ b/test/perf/commando/execute/Execute. Real World Avg50.png @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:fb21844e608c4077d654a497c550baa710ed51b031b0e1d9b34443e22854fd52 +size 19466 diff --git a/test/perf/commando/execute/QueryDSL. Recursive Execution.png b/test/perf/commando/execute/QueryDSL. Recursive Execution.png new file mode 100644 index 0000000..9ca8293 --- /dev/null +++ b/test/perf/commando/execute/QueryDSL. Recursive Execution.png @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:c13650ebc7c516469b2975fb430c76499dfb89fc8b6d14327fb25038f7223d1d +size 18515 diff --git a/test/perf/commando/execute/execute_test.clj b/test/perf/commando/execute/execute_test.clj new file mode 100644 index 0000000..b65dfd3 --- /dev/null +++ b/test/perf/commando/execute/execute_test.clj @@ -0,0 +1,525 @@ +(ns commando.execute.execute-test + (:require + [cljfreechart.core :as cljfreechart] + [commando.commands.builtin] + [commando.commands.query-dsl] + [commando.core] + [commando.debug :as debug] + [commando.impl.utils :as commando-utils])) + +;; ===================================== +;; BUILDING DEPENDENCY COMPLEX TEST CASES +;; ===================================== + +(defn build-instruction-vec+map [{:keys [wide-n long-n]}] + {:dependency-token (* 2 wide-n long-n) + :source-maps + (mapv (fn [_n] + (into {} (mapv (fn [v] [(keyword (str "k" v)) v]) + (range 1 wide-n)))) + (range 1 long-n)) + :result-maps + (mapv (fn [n] + (into {} + (mapv + (fn [v] + (let [k (keyword (str "k" v))] + [k {:commando/from [:source-maps n k]}])) + (range 1 wide-n)))) + (range 1 long-n))}) + +(defn build-instruction-map [{:keys [wide-n long-n]}] + {:dependency-token (* 2 wide-n long-n) + :source-maps + (reduce (fn [acc n] + (assoc acc (keyword (str "r" n)) + (into {} (mapv (fn [v] [(keyword (str "k" v)) v]) + (range 1 wide-n))))) + {} + (range 1 long-n)) + :result-maps + (reduce (fn [acc n] + (assoc acc (keyword (str "r" n)) + (into {} + (mapv + (fn [v] + (let [k (keyword (str "k" v))] + [k {:commando/from [:source-maps (keyword (str "r" n)) k]}])) + (range 1 wide-n))))) + {} + (range 1 long-n))}) + +(defn execute-complexity [{:keys [mode wide-n long-n]}] + (let [instruction-builder (case mode + :m (build-instruction-map {:wide-n wide-n :long-n long-n}) + :v+m (build-instruction-vec+map {:wide-n wide-n :long-n long-n}))] + (let [result (commando.core/execute + [commando.commands.builtin/command-from-spec] + instruction-builder) + stats-grouped (reduce (fn [acc [k v _label]] + (assoc acc k v)) + {} + (:stats result))] + {:dependency-token (:dependency-token instruction-builder) + :stats (:stats result) + :stats-grouped stats-grouped}))) + +;; ======================================= +;; CHART HELPERS +;; ======================================= + +(def ^:private perf-output-dir "./test/perf/commando/execute/") + +(def ^:private modern-palette + [(java.awt.Color/new 79 134 247) ;; blue + (java.awt.Color/new 52 199 137) ;; green + (java.awt.Color/new 247 181 56) ;; amber + (java.awt.Color/new 239 83 80) ;; red + (java.awt.Color/new 156 120 242) ;; purple + (java.awt.Color/new 38 198 218)]) ;; cyan + +(def ^:private font-family "SansSerif") + +(defn ^:private chart-custom-styles [chart] + (let [plot (.getPlot chart) + renderer (.getRenderer plot) + domain-axis (.getDomainAxis plot) + range-axis (.getRangeAxis plot) + white (java.awt.Color/new 255 255 255) + grid-color (java.awt.Color/new 230 230 230) + text-color (java.awt.Color/new 60 60 60) + title-font (java.awt.Font. font-family java.awt.Font/BOLD 15) + axis-label-font (java.awt.Font. font-family java.awt.Font/PLAIN 12) + tick-font (java.awt.Font. font-family java.awt.Font/PLAIN 11) + legend-font (java.awt.Font. font-family java.awt.Font/PLAIN 11)] + ;; backgrounds + (.setBackgroundPaint chart white) + (.setBackgroundPaint plot white) + (.setOutlineVisible plot false) + ;; title + (when-let [title (.getTitle chart)] + (.setFont title title-font) + (.setPaint title text-color)) + ;; grid + (.setRangeGridlinePaint plot grid-color) + (.setRangeGridlineStroke plot (java.awt.BasicStroke. 1.0)) + (.setDomainGridlinesVisible plot false) + ;; axes + (doto domain-axis + (.setLabelFont axis-label-font) + (.setLabelPaint text-color) + (.setTickLabelFont tick-font) + (.setTickLabelPaint text-color) + (.setAxisLinePaint grid-color) + (.setTickMarkPaint grid-color)) + (doto range-axis + (.setLabelFont axis-label-font) + (.setLabelPaint text-color) + (.setTickLabelFont tick-font) + (.setTickLabelPaint text-color) + (.setAxisLinePaint grid-color) + (.setTickMarkPaint grid-color)) + ;; bars + (.setShadowVisible renderer false) + (.setBarPainter renderer (org.jfree.chart.renderer.category.StandardBarPainter.)) + (.setItemMargin renderer 0.02) + (.setMaximumBarWidth renderer 0.08) + ;; series colors + (doseq [i (range (count modern-palette))] + (.setSeriesPaint renderer i (nth modern-palette i))) + ;; legend + (when-let [legend (.getLegend chart)] + (.setItemFont legend legend-font) + (.setItemPaint legend text-color) + (.setBackgroundPaint legend white) + (.setFrame legend (org.jfree.chart.block.BlockBorder. white))) + chart)) + +(defn ^:private save-benchmark-chart + [{:keys [chart-data group-key chart-title category-title value-title file-name + width height] + :or {width 1200 height 400}}] + (cljfreechart/save-chart-as-file + (-> chart-data + (cljfreechart/make-category-dataset {:group-key group-key}) + (cljfreechart/make-bar-chart chart-title + {:category-title category-title + :value-title value-title}) + (chart-custom-styles)) + (str perf-output-dir file-name) {:width width :height height})) + +(defn ^:private print-stats [stats] + (#'debug/pprint-stats-mode + {:stats stats :status :ok :errors [] :internal/cm-running-order []} + nil)) + +(defn ^:private run-complexity-benchmark + [{:keys [title file-name runs stats-transform value-title]}] + (let [results (mapv execute-complexity runs)] + (doseq [{:keys [dependency-token stats]} results] + (println (str "Dependency Counts: " dependency-token)) + (print-stats stats)) + (save-benchmark-chart + {:chart-data (mapv (fn [{:keys [dependency-token stats-grouped]}] + (-> (stats-transform stats-grouped) + (assoc "dependency-token" dependency-token))) + results) + :group-key "dependency-token" + :chart-title title + :category-title "Dependency Counts" + :value-title value-title + :file-name file-name}))) + +;; ======================================= +;; AVERAGE EXECUTION OF REAL WORLD EXAMPLE +;; ======================================= + +(defn ^:private calculate-average-stats + "Takes a collection of status-maps and calculates the average duration for each stat-key." + [status-maps] + {:pre [(not-empty status-maps)]} + (let [keys-order (map first (:stats (first status-maps))) + all-stats (mapcat :stats status-maps) + grouped-stats (group-by first all-stats) + averages-grouped + (reduce (fn [acc [stat-key measurements]] + (let [total-duration (reduce + (map second measurements)) + count-measurements (count measurements) + average-duration (long (/ total-duration count-measurements))] + (assoc acc stat-key [stat-key average-duration (commando-utils/format-time average-duration)]))) + {} grouped-stats)] + {:stats (mapv #(get averages-grouped %) keys-order)})) + +(defmacro ^:private repeat-n-execute + "Repeats the execution of `body` `n` times, returns average stats." + [n & body] + `(let [results# (doall (for [_# (range ~n)] + ~@body))] + (calculate-average-stats results#))) + +(defn real-world-calculation-average-of-50 [] + (let [avg-stats + (repeat-n-execute 50 + (commando.core/execute + [commando.commands.builtin/command-fn-spec + commando.commands.builtin/command-from-spec + commando.commands.builtin/command-apply-spec] + { ;; -------------------------------------------------------------------------------- + ;; RAW DATA & CONFIGURATION + ;; -------------------------------------------------------------------------------- + :config + {:commission-rates {:standard 0.07 :senior 0.12} + :bonus-threshold 50000 + :performance-bonus 2500 + :tax-rate 0.21 + :department-op-cost {:sales 15000 :marketing 10000 :engineering 25000}} + + :products + {"prod-001" {:name "Alpha Widget" :price 250.0} + "prod-002" {:name "Beta Gadget" :price 475.0} + "prod-003" {:name "Gamma Gizmo" :price 1200.0}} + + :employees + {"emp-101" {:name "John Doe" :department :sales :level :senior} + "emp-102" {:name "Jane Smith" :department :sales :level :standard} + "emp-103" {:name "Peter Jones" :department :marketing :level :senior} + "emp-201" {:name "Mary Major" :department :engineering :level :standard}} + + :sales-records + [ ;; John's Sales + {:employee-id "emp-101" :product-id "prod-003" :units-sold 50} + {:employee-id "emp-101" :product-id "prod-001" :units-sold 120} + ;; Jane's Sales + {:employee-id "emp-102" :product-id "prod-001" :units-sold 80} + {:employee-id "emp-102" :product-id "prod-002" :units-sold 40} + ;; Peter's Sales (Marketing can also sell) + {:employee-id "emp-103" :product-id "prod-002" :units-sold 10}] + + :calculations + {:sales-revenues + {:commando/fn (fn [sales products] + (mapv (fn [sale] + (let [product (get products (:product-id sale))] + (assoc sale :total-revenue (* (:units-sold sale) (:price product))))) + sales)) + :args [{:commando/from [:sales-records]} + {:commando/from [:products]}]} + + :employee-sales-totals + {:commando/fn (fn [sales-revenues] + (reduce (fn [acc sale] + (update acc + (:employee-id sale) + (fnil + 0) + (:total-revenue sale))) + {} + sales-revenues)) + :args [{:commando/from [:calculations :sales-revenues]}]} + + :employee-commissions + {:commando/apply + {:sales-totals {:commando/from [:calculations :employee-sales-totals]} + :employees {:commando/from [:employees]} + :rates {:commando/from [:config :commission-rates]}} + :=> [:fn (fn [{:keys [sales-totals employees rates]}] + (into {} + (map (fn [[emp-id total-sales]] + (let [employee (get employees emp-id) + rate-key (:level employee) + commission-rate (get rates rate-key 0)] + [emp-id (* total-sales commission-rate)])) + sales-totals)))]} + + :employee-bonuses + {:commando/apply + {:sales-totals {:commando/from [:calculations :employee-sales-totals]} + :threshold {:commando/from [:config :bonus-threshold]} + :bonus-amount {:commando/from [:config :performance-bonus]}} + :=> [:fn (fn [{:keys [sales-totals threshold bonus-amount]}] + (into {} + (map (fn [[emp-id total-sales]] + [emp-id (if (> total-sales threshold) bonus-amount 0)]) + sales-totals)))]} + + :employee-total-compensation + {:commando/fn (fn [commissions bonuses] + (merge-with + commissions bonuses)) + :args [{:commando/from [:calculations :employee-commissions]} + {:commando/from [:calculations :employee-bonuses]}]} + + :department-financials + {:commando/apply + {:employees {:commando/from [:employees]} + :sales-totals {:commando/from [:calculations :employee-sales-totals]} + :compensations {:commando/from [:calculations :employee-total-compensation]} + :op-costs {:commando/from [:config :department-op-cost]}} + :=> [:fn (fn [{:keys [employees sales-totals compensations op-costs]}] + (let [initial-agg {:sales {:total-revenue 0 :total-compensation 0} + :marketing {:total-revenue 0 :total-compensation 0} + :engineering {:total-revenue 0 :total-compensation 0}}] + (as-> (reduce-kv (fn [agg emp-id emp-data] + (let [dept (:department emp-data) + revenue (get sales-totals emp-id 0) + compensation (get compensations emp-id 0)] + (-> agg + (update-in [dept :total-revenue] + revenue) + (update-in [dept :total-compensation] + compensation)))) + initial-agg + employees) data + (merge-with + (fn [dept-data op-cost] + (let [profit (- (:total-revenue dept-data) + (+ (:total-compensation dept-data) op-cost))] + (assoc dept-data + :operating-cost op-cost + :net-profit profit))) + data + op-costs))))]}} + + :final-report + {:commando/apply + {:dept-financials {:commando/from [:calculations :department-financials]} + :total-sales-per-employee {:commando/from [:calculations :employee-sales-totals]} + :total-compensation-per-employee {:commando/from [:calculations :employee-total-compensation]} + :tax-rate {:commando/from [:config :tax-rate]}} + :=> [:fn (fn [{:keys [dept-financials total-sales-per-employee total-compensation-per-employee tax-rate]}] + (let [company-total-revenue (reduce + (map :total-revenue (vals dept-financials))) + company-total-compensation (reduce + (map :total-compensation (vals dept-financials))) + company-total-op-cost (reduce + (map :operating-cost (vals dept-financials))) + company-gross-profit (- company-total-revenue + (+ company-total-compensation company-total-op-cost)) + taxes-payable (* company-gross-profit tax-rate) + company-net-profit (- company-gross-profit taxes-payable)] + {:company-summary + {:total-revenue company-total-revenue + :total-compensation company-total-compensation + :total-operating-cost company-total-op-cost + :gross-profit company-gross-profit + :taxes-payable taxes-payable + :net-profit-after-tax company-net-profit} + :department-breakdown dept-financials + :employee-performance + {:top-earner (key (apply max-key val total-compensation-per-employee)) + :top-seller (key (apply max-key val total-sales-per-employee))}}))]}})) + chart-data [(-> (reduce (fn [acc [stat-key nanos _]] + (assoc acc stat-key (float (/ nanos 1000000)))) + {} (:stats avg-stats)) + (assoc "benchmark" "avg of 50"))]] + (println "Repeating instruction 50 times") + (print-stats (:stats avg-stats)) + (save-benchmark-chart + {:chart-data chart-data + :group-key "benchmark" + :chart-title "Real World calculation — average pipeline steps (50 runs)" + :category-title "Pipeline Step" + :value-title "Milliseconds" + :file-name "Execute. Real World Avg50.png"}))) + + +;; ============================== +;; FLAME FOR RECURSIVE INVOCATION +;; ============================== + +(defmethod commando.commands.query-dsl/command-resolve :query-B [_ {:keys [x QueryExpression]}] + (let [x (or x 10)] + (-> {:map {:a + {:b {:c x} + :d {:c (inc x) + :f (inc (inc x))}}} + :query-A (commando.commands.query-dsl/resolve-instruction-qe + "error" + {:commando/resolve :query-A + :x 1})} + (commando.commands.query-dsl/->query-run QueryExpression)))) + +(defmethod commando.commands.query-dsl/command-resolve :query-A [_ {:keys [x QueryExpression]}] + (let [x (or x 10)] + (-> {:map {:a + {:b {:c x} + :d {:c (inc x) + :f (inc (inc x))}}} + + :resolve-fn (commando.commands.query-dsl/resolve-fn + "error" + (fn [{:keys [x]}] + (let [y (or x 1) + range-y (if (< 10 y) 10 y)] + (for [z (range 0 range-y)] + {:a + {:b {:c (+ y z)} + :d {:c (inc (+ y z)) + :f (inc (inc (+ y z)))}}})))) + + + + :instruction-A (commando.commands.query-dsl/resolve-instruction + "error" + {:__title "Resolve instruction-A" + :commando/fn (fn [& [y]] + {:a + {:b {:c y} + :d {:c (inc y) + :f (inc (inc y))}}}) + :args [x]}) + + + :query-A (commando.commands.query-dsl/resolve-instruction-qe + "error" + {:__title "Resolve query-A" + :commando/resolve :query-A + :x 1}) + :query-B (commando.commands.query-dsl/resolve-instruction-qe + "error" + {:__title "Resolve query-B" + :commando/resolve :query-B + :x 1})} + (commando.commands.query-dsl/->query-run QueryExpression)))) + +(defn run-execute-in-depth-with-using-queryDSL [] + (let [result + (debug/execute-trace + [commando.commands.query-dsl/command-resolve-spec + commando.commands.builtin/command-from-spec + commando.commands.builtin/command-fn-spec] + {:__title "TOPLEVEL" + :commando/resolve :query-A + :x 1 + :QueryExpression + [{:map + [{:a + [:b]}]} + {:instruction-A [:a]} + {:query-A + [{:map + [{:a + [:b]}]} + {:query-A + [{:map + [{:a + [:b]}]} + {:query-A + [{:map + [{:a + [:b]}]}]}]}]} + {:query-B + [{:map + [{:a + [:b]}]} + {:query-A + [{:map + [{:a + [:b]}]} + {:query-A + [{:instruction-A [:a]}]}]}]}]}) + chart-data [(-> (reduce (fn [acc [stat-key nanos _]] + (assoc acc stat-key (float (/ nanos 1000000)))) + {} (:stats result)) + (assoc "benchmark" "queryDSL recursive"))]] + (save-benchmark-chart + {:chart-data chart-data + :group-key "benchmark" + :chart-title "Recursive QueryDSL execution — pipeline steps" + :category-title "Pipeline Step" + :value-title "Milliseconds" + :file-name "QueryDSL. Recursive Execution.png"}))) + + + +;; ================================ +;; DEPENDENCY SCALING BENCHMARKS +;; ================================ + +(defn execute-steps-grow_s_x_dep [] + (run-complexity-benchmark + {:title "commando.core/execute steps on massive count of dependencies" + :file-name "Execute. Massive Dependency Steps.png" + :value-title "Seconds" + :runs [{:mode :v+m :wide-n 50 :long-n 50} + {:mode :v+m :wide-n 50 :long-n 500} + {:mode :v+m :wide-n 50 :long-n 5000} + {:mode :v+m :wide-n 50 :long-n 50000}] + :stats-transform (fn [stats-grouped] + (-> stats-grouped + (dissoc "execute") + (update-vals (fn [nanosecs-t] + (/ nanosecs-t 1000000000)))))})) + +(defn execute-steps-normal_ms_x_dep [] + (run-complexity-benchmark + {:title "commando.core/execute steps" + :file-name "Execute. Normal Steps.png" + :value-title "Milliseconds" + :runs [{:mode :m :wide-n 5 :long-n 10} + {:mode :m :wide-n 5 :long-n 14} + {:mode :m :wide-n 5 :long-n 15} + {:mode :m :wide-n 5 :long-n 20}] + :stats-transform (fn [stats-grouped] + (-> stats-grouped + (dissoc "execute") + (update-vals (fn [nanosecs-t] + (/ nanosecs-t 1000000)))))})) + +(defn execute-normal_ms_x_dep [] + (run-complexity-benchmark + {:title "commando.core/execute times" + :file-name "Execute. Normal Total.png" + :value-title "Milliseconds" + :runs [{:mode :v+m :wide-n 25 :long-n 25} + {:mode :v+m :wide-n 50 :long-n 50} + {:mode :v+m :wide-n 100 :long-n 100} + {:mode :v+m :wide-n 200 :long-n 200}] + :stats-transform (fn [stats-grouped] + (-> stats-grouped + (select-keys ["execute"]) + (update-vals (fn [nanosecs-t] + (float (/ nanosecs-t 1000000))))))})) + +(defn -main [] + ;; Real-world scenario with chart. + (real-world-calculation-average-of-50) + ;; Recursive QueryDSL with chart. + (run-execute-in-depth-with-using-queryDSL) + ;; Dependency scaling benchmarks. + (execute-steps-normal_ms_x_dep) + (execute-normal_ms_x_dep) + (execute-steps-grow_s_x_dep)) diff --git a/test/unit/commando/commands/builtin_test.cljc b/test/unit/commando/commands/builtin_test.cljc index d91bb8d..4fba0bd 100644 --- a/test/unit/commando/commands/builtin_test.cljc +++ b/test/unit/commando/commands/builtin_test.cljc @@ -5,7 +5,6 @@ [clojure.string] [commando.commands.builtin :as command-builtin] [commando.core :as commando] - [commando.impl.utils :as commando-utils] [malli.core :as malli] [commando.test-helpers :as helpers])) @@ -32,12 +31,10 @@ (testing "Failure test cases" (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute [command-builtin/command-fn-spec] + (commando/execute [command-builtin/command-fn-spec] {:commando/fn "STRING" - :args [[1 2 3] [3 2 1]]})) + :args [[1 2 3] [3 2 1]]} + {:error-data-string false}) (fn [error] (= (-> error :error :data) @@ -51,12 +48,10 @@ "Waiting on error, bacause commando/fn has wrong type for :commando/fn") (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute [command-builtin/command-fn-spec] + (commando/execute [command-builtin/command-fn-spec] {:commando/fn (fn [& [v1 v2]] (reduce + (map * v1 v2))) - :args "BROKEN"})) + :args "BROKEN"} + {:error-data-string false}) (fn [error] (= (-> error :error :data (dissoc :value)) @@ -228,9 +223,9 @@ (testing "Failure test cases" (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* {:error-data-string false}] - (commando/execute [command-builtin/command-from-spec] - {:ref {:commando/from ["@nonexistent" :value]}})) + (commando/execute [command-builtin/command-from-spec] + {:ref {:commando/from ["@nonexistent" :value]}} + {:error-data-string false}) (fn [error] (= (get-in error [:error :data]) @@ -240,10 +235,10 @@ "Anchor not found: should produce error with :anchor key in data") (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* {:error-data-string false}] - (commando/execute [command-builtin/command-from-spec] + (commando/execute [command-builtin/command-from-spec] {"source" {:a 1 :b 2} - "missing" {:commando/from ["UNEXISING"]}})) + "missing" {:commando/from ["UNEXISING"]}} + {:error-data-string false}) (fn [error] (= (get-in error [:error :data]) @@ -253,10 +248,10 @@ "Waiting on error, bacause commando/from seding to unexising path") (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* {:error-data-string false}] - (commando/execute [command-builtin/command-from-spec] + (commando/execute [command-builtin/command-from-spec] {"source" {:a 1 :b 2} - "missing" {"commando-from" ["UNEXISING"]}})) + "missing" {"commando-from" ["UNEXISING"]}} + {:error-data-string false}) (fn [error] (= (get-in error [:error :data]) @@ -266,13 +261,11 @@ "Waiting on error, bacause \"commando-from\" seding to unexising path") (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute [command-builtin/command-from-spec] + (commando/execute [command-builtin/command-from-spec] {"value" 1 "result" {:commando/from ["value"] - "commando-from" ["value"]}})) + "commando-from" ["value"]}} + {:error-data-string false}) (fn [error] (= (-> error :error :data) @@ -282,12 +275,10 @@ :value {:commando/from ["value"], "commando-from" ["value"]}}))) "Using string and keyword form shouldn't be allowed") (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute + (commando/execute [command-builtin/command-from-spec] - {:commando/from "BROKEN"})) + {:commando/from "BROKEN"} + {:error-data-string false}) (fn [error] (= (-> error :error :data) @@ -355,10 +346,9 @@ "String keys test"))) (testing "Failure test cases" (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false :error-data-string false}] - (commando/execute [ctx-spec] - {:val {:commando/context "NOT-A-PATH"}})) + (commando/execute [ctx-spec] + {:val {:commando/context "NOT-A-PATH"}} + {:error-data-string false}) (fn [error] (= (-> error :error :data) {:command-type :commando/context @@ -367,10 +357,9 @@ :value {:commando/context "NOT-A-PATH"}}))) "Should fail validation when path is not sequential") (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false :error-data-string false}] - (commando/execute [ctx-spec] - {:val {:commando/context [:colors] "commando-context" ["colors"]}})) + (commando/execute [ctx-spec] + {:val {:commando/context [:colors] "commando-context" ["colors"]}} + {:error-data-string false}) (fn [error] (= (-> error :error :data) {:command-type :commando/context @@ -427,14 +416,12 @@ (testing "Failure test cases" (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute [command-builtin/command-mutation-spec] + (commando/execute [command-builtin/command-mutation-spec] {:commando/mutation :dot-product "commando-mutation" "dot-product" "vector1" [1 2 3] - "vector2" [3 2 1]})) + "vector2" [3 2 1]} + {:error-data-string false}) (fn [error] (= (-> error :error :data) @@ -449,11 +436,9 @@ "Using string and keyword form shouldn't be allowed") (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute [command-builtin/command-mutation-spec] - {:commando/mutation (fn [] "BROKEN")})) + (commando/execute [command-builtin/command-mutation-spec] + {:commando/mutation (fn [] "BROKEN")} + {:error-data-string false}) (fn [error] (= (-> error :error :data (dissoc :value)) @@ -463,13 +448,11 @@ "Waiting on error, bacause commando/mutation has wrong type for :commando/mutation") (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute [command-builtin/command-mutation-spec] + (commando/execute [command-builtin/command-mutation-spec] {:commando/mutation :dot-product :vector1 [1 "_" 3] - :vector2 [3 2 1]})) + :vector2 [3 2 1]} + {:error-data-string false}) (fn [error] (= (-> error :error (helpers/remove-stacktrace) (dissoc :data)) @@ -559,10 +542,7 @@ (testing "Failure test cases" (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute + (commando/execute [command-builtin/command-macro-spec command-builtin/command-fn-spec command-builtin/command-from-spec @@ -570,7 +550,8 @@ {:commando/macro :string-vectors-dot-product "commando-macro" "string-vectors-dot-product" "vector1-str" ["1" "2" "3"] - "vector2-str" ["4" "5" "6"]})) + "vector2-str" ["4" "5" "6"]} + {:error-data-string false}) (fn [error] (= (-> error :error :data) @@ -585,11 +566,9 @@ "Using string and keyword form shouldn't be allowed") (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute [command-builtin/command-macro-spec] - {:commando/macro (fn [])})) + (commando/execute [command-builtin/command-macro-spec] + {:commando/macro (fn [])} + {:error-data-string false}) (fn [error] (= (-> error :error :data (dissoc :value)) @@ -604,10 +583,10 @@ (deftest non-map-command-data (testing "String-based recognize-fn (command data is not a map)" - (let [bang-spec {:type :bang - :recognize-fn #(and (string? %) (clojure.string/ends-with? % "!")) - :apply (fn [_ _ s] (clojure.string/upper-case s)) - :dependencies {:mode :none}} + (let [bang-spec {:type :bang + :recognize-fn #(and (string? %) (clojure.string/ends-with? % "!")) + :apply (fn [_ _ s] (clojure.string/upper-case s)) + :dependencies {:mode :none}} result (commando/execute [bang-spec] {:calm "hello" :excited "hello!"})] (is (commando/ok? result) "Non-map command executes without error") (is (= "hello" (get-in (:instruction result) [:calm])) "Non-command values unchanged") diff --git a/test/unit/commando/commands/query_dsl_test.cljc b/test/unit/commando/commands/query_dsl_test.cljc index 4ccc1cd..ff013c6 100644 --- a/test/unit/commando/commands/query_dsl_test.cljc +++ b/test/unit/commando/commands/query_dsl_test.cljc @@ -5,7 +5,6 @@ [clojure.string :as string] [commando.commands.builtin :as command-builtin] [commando.commands.query-dsl :as command-query-dsl] - [commando.impl.utils :as commando-utils] [commando.core :as commando] [commando.test-helpers :as helpers])) @@ -514,16 +513,14 @@ (is (helpers/status-map-contains-error? - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute + (commando/execute registry {:commando/resolve :test-instruction-qe "commando-resolve" :test-instruction-qe :x 1 :QueryExpression - [:string]})) + [:string]} + {:error-data-string false}) (fn [error] (= (-> error :error :data) @@ -568,16 +565,14 @@ (is (helpers/status-map-contains-error? (get-in - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute + (commando/execute registry {:commando/resolve :test-instruction-qe :x 20 :QueryExpression [{:resolve-fn-error - [:a]}]})) + [:a]}]} + {:error-data-string false}) [:instruction :resolve-fn-error]) (fn [error] (= @@ -591,16 +586,14 @@ (is (helpers/status-map-contains-error? (get-in - (binding [commando-utils/*execute-config* - {:debug-result false - :error-data-string false}] - (commando/execute + (commando/execute registry {:commando/resolve :test-instruction-qe :x 20 :QueryExpression [{:resolve-instruction-with-error - [{:a [:b]}]}]})) + [{:a [:b]}]}]} + {:error-data-string false}) [:instruction :resolve-instruction-with-error]) (fn [error] (= diff --git a/test/unit/commando/core_test.cljc b/test/unit/commando/core_test.cljc index 0a70406..61c4c80 100644 --- a/test/unit/commando/core_test.cljc +++ b/test/unit/commando/core_test.cljc @@ -5,6 +5,8 @@ [commando.commands.builtin :as cmds-builtin] [commando.core :as commando] [commando.impl.command-map :as cm] + [commando.impl.pathtrie :as pathtrie] + [commando.impl.utils :as utils] [malli.core :as malli] [commando.impl.registry :as commando-registry])) @@ -58,40 +60,40 @@ :instruction {"val" 10 "cmd" {:test/add-id "data"}} :registry (commando/registry-create registry) - :internal/cm-running-order [(cm/->CommandMapPath ["cmd"] test-add-id-command)]}) + :internal/cm-running-order [(cm/command-map-path ["cmd"] test-add-id-command)]}) (def from-command {:status :ok :instruction {"source" 42 "ref" {:commando/from ["source"]}} :registry (commando/registry-create [cmds-builtin/command-from-spec]) - :internal/cm-running-order [(cm/->CommandMapPath ["ref"] cmds-builtin/command-from-spec)]}) + :internal/cm-running-order [(cm/command-map-path ["ref"] cmds-builtin/command-from-spec)]}) (def fn-command {:status :ok :instruction {"calc" {:commando/fn + :args [1 2 3]}} :registry (commando/registry-create [cmds-builtin/command-fn-spec]) - :internal/cm-running-order [(cm/->CommandMapPath ["calc"] cmds-builtin/command-fn-spec)]}) + :internal/cm-running-order [(cm/command-map-path ["calc"] cmds-builtin/command-fn-spec)]}) (def apply-command {:status :ok :instruction {"transform" {:commando/apply {"data" 10} :=> [:fn #(get % "data")]}} :registry (commando/registry-create [cmds-builtin/command-apply-spec]) - :internal/cm-running-order [(cm/->CommandMapPath ["transform"] cmds-builtin/command-apply-spec)]}) + :internal/cm-running-order [(cm/command-map-path ["transform"] cmds-builtin/command-apply-spec)]}) (def nil-handler-execution-map {:status :ok :instruction {"nil-handler" {:handle-nil nil}} :registry (commando/registry-create [nil-handler-command]) - :internal/cm-running-order [(cm/->CommandMapPath ["nil-handler"] nil-handler-command)]}) + :internal/cm-running-order [(cm/command-map-path ["nil-handler"] nil-handler-command)]}) (def bad-command-execution-map {:status :ok :instruction {"bad" {:will-fail true}} :registry (commando/registry-create [(:bad-cmd failing-commands)]) - :internal/cm-running-order [(cm/->CommandMapPath ["bad"] (:bad-cmd failing-commands))]}) + :internal/cm-running-order [(cm/command-map-path ["bad"] (:bad-cmd failing-commands))]}) (def midway-fail-execution-map {:status :ok @@ -100,18 +102,18 @@ "never" {:test/add-id "should-not-execute"}} :registry (commando/registry-create [test-add-id-command (:bad-cmd failing-commands)]) - :internal/cm-running-order [(cm/->CommandMapPath ["good"] test-add-id-command) - (cm/->CommandMapPath ["bad"] (:bad-cmd failing-commands)) - (cm/->CommandMapPath ["never"] test-add-id-command)]}) + :internal/cm-running-order [(cm/command-map-path ["good"] test-add-id-command) + (cm/command-map-path ["bad"] (:bad-cmd failing-commands)) + (cm/command-map-path ["never"] test-add-id-command)]}) (def deep-nested-execution-map {:status :ok :instruction {"level1" {"level2" {"level3" {"deep" {:test/add-id "deep-value"}}}}} :registry (commando/registry-create [test-add-id-command]) - :internal/cm-running-order [(cm/->CommandMapPath ["level1" "level2" "level3" "deep"] test-add-id-command)]}) + :internal/cm-running-order [(cm/command-map-path ["level1" "level2" "level3" "deep"] test-add-id-command)]}) (def large-commands-execution-map - (let [commands (mapv #(cm/->CommandMapPath [%] test-add-id-command) (range 20)) + (let [commands (mapv #(cm/command-map-path [%] test-add-id-command) (range 20)) instruction (into {} (map #(vector % {:test/add-id (str "value-" %)}) (range 20)))] {:status :ok :instruction instruction @@ -226,3 +228,20 @@ (is (commando/ok? result) "Vector instruction is acceptable") (is (= [{:value 10} 11 22] (:instruction result)))))) +;; ----------- +;; Internals always retained +;; ----------- + +(deftest internals-always-retained-test + (testing "Status-map always retains internal keys" + (let [result (commando/execute [cmds-builtin/command-from-spec] + {:a 1 :b {:commando/from [:a]}})] + (is (commando/ok? result)) + (is (some? (:internal/cm-list result)) "cm-list retained") + (is (some? (:internal/cm-dependency result)) "dependency graph retained") + (is (some? (:internal/path-trie result)) "path-trie retained") + (is (some? (:internal/cm-running-order result)) "running order retained") + (is (some? (:internal/cm-results result)) "cm-results retained") + (is (some? (:internal/original-instruction result)) "original instruction retained") + (is (some? (:registry result)) "registry retained")))) + diff --git a/test/unit/commando/debug_test.cljc b/test/unit/commando/debug_test.cljc index 48ea3ab..a99daf5 100644 --- a/test/unit/commando/debug_test.cljc +++ b/test/unit/commando/debug_test.cljc @@ -131,14 +131,13 @@ (testing "execute-trace with nested macro + mutation" (println "\n--- execute-trace: nested macro/mutation ---") (let [r (debug/execute-trace - #(commando/execute - [builtin/command-fn-spec - builtin/command-from-spec - builtin/command-macro-spec - builtin/command-mutation-spec] - {:value {:commando/mutation :rand-n :v 200} - :result {:commando/macro :sum-n - :v {:commando/from [:value]}}}))] + [builtin/command-fn-spec + builtin/command-from-spec + builtin/command-macro-spec + builtin/command-mutation-spec] + {:value {:commando/mutation :rand-n :v 200} + :result {:commando/macro :sum-n + :v {:commando/from [:value]}}})] (is (commando/ok? r))))) ;; ============================================================ @@ -172,19 +171,18 @@ (testing "execute-trace with vector dot product macro" (println "\n--- execute-trace: vector dot product ---") (let [r (debug/execute-trace - #(commando/execute - [builtin/command-macro-spec - builtin/command-fn-spec - builtin/command-from-spec - builtin/command-apply-spec] - {:vector-dot-1 - {:commando/macro :vector-dot-product - :vector1-str ["1" "2" "3"] - :vector2-str ["4" "5" "6"]} - :vector-dot-2 - {:commando/macro :vector-dot-product - :vector1-str ["10" "20" "30"] - :vector2-str ["4" "5" "6"]}}))] + [builtin/command-macro-spec + builtin/command-fn-spec + builtin/command-from-spec + builtin/command-apply-spec] + {:vector-dot-1 + {:commando/macro :vector-dot-product + :vector1-str ["1" "2" "3"] + :vector2-str ["4" "5" "6"]} + :vector-dot-2 + {:commando/macro :vector-dot-product + :vector1-str ["10" "20" "30"] + :vector2-str ["4" "5" "6"]}})] (is (commando/ok? r)) (is (= 32 (get-in (:instruction r) [:vector-dot-1]))) (is (= 320 (get-in (:instruction r) [:vector-dot-2])))))) diff --git a/test/unit/commando/impl/command_map_test.cljc b/test/unit/commando/impl/command_map_test.cljc index 1badcfd..2c7f534 100644 --- a/test/unit/commando/impl/command_map_test.cljc +++ b/test/unit/commando/impl/command_map_test.cljc @@ -7,59 +7,59 @@ (deftest command-map (testing "Path objects" - (let [path-obj (sut/->CommandMapPath ["product" 0] {:a 99})] + (let [path-obj (sut/command-map-path ["product" 0] {:a 99})] (is (= (sut/command-path path-obj) ["product" 0])) (is (= (sut/command-data path-obj) {:a 99})) - (is (= (sut/->CommandMapPath ["A"] {:a "ONE"}) (sut/->CommandMapPath ["A"] {:a "ONE"}))) - (is (not= (sut/->CommandMapPath ["A"] {:a "ONE"}) (sut/->CommandMapPath ["CHANGED"] {:a "ONE"}))) - (is (= (sut/->CommandMapPath ["A"] {:a "ONE"}) (sut/->CommandMapPath ["A"] {:a "CHANGED"}))) - (is (= (sut/->CommandMapPath ["A"] {:a "ONE"}) (sut/->CommandMapPath ["A"] {:a "CHANGED"})))) - (is (= (conj #{(sut/->CommandMapPath ["product" 0] {:a 99})} (sut/->CommandMapPath ["product" 0] {:a 99})) - #{(sut/->CommandMapPath ["product" 0] {:a "NOT SAME"})})) - (is (= (disj #{(sut/->CommandMapPath ["product" 0] {:a 99}) (sut/->CommandMapPath ["product" 1] {:a 99})} - (sut/->CommandMapPath ["product" 1] {:a "ANOTHER"})) - #{(sut/->CommandMapPath ["product" 0] {:a 99})})) + (is (= (sut/command-map-path ["A"] {:a "ONE"}) (sut/command-map-path ["A"] {:a "ONE"}))) + (is (not= (sut/command-map-path ["A"] {:a "ONE"}) (sut/command-map-path ["CHANGED"] {:a "ONE"}))) + (is (= (sut/command-map-path ["A"] {:a "ONE"}) (sut/command-map-path ["A"] {:a "CHANGED"}))) + (is (= (sut/command-map-path ["A"] {:a "ONE"}) (sut/command-map-path ["A"] {:a "CHANGED"})))) + (is (= (conj #{(sut/command-map-path ["product" 0] {:a 99})} (sut/command-map-path ["product" 0] {:a 99})) + #{(sut/command-map-path ["product" 0] {:a "NOT SAME"})})) + (is (= (disj #{(sut/command-map-path ["product" 0] {:a 99}) (sut/command-map-path ["product" 1] {:a 99})} + (sut/command-map-path ["product" 1] {:a "ANOTHER"})) + #{(sut/command-map-path ["product" 0] {:a 99})})) (is (= (mapv str (sort-by sut/command-path - [(sut/->CommandMapPath ["A" 10] {:a 99}) - (sut/->CommandMapPath ["A" 0] {:a 99}) - (sut/->CommandMapPath ["B"] {:a 99}) - (sut/->CommandMapPath ["X"] {:a 99})])) + [(sut/command-map-path ["A" 10] {:a 99}) + (sut/command-map-path ["A" 0] {:a 99}) + (sut/command-map-path ["B"] {:a 99}) + (sut/command-map-path ["X"] {:a 99})])) ["root,B" "root,X" "root,A,0" "root,A,10"])) (is (= (mapv str (sort-by str - [(sut/->CommandMapPath ["A" 10] {:a 99}) - (sut/->CommandMapPath ["A" 0] {:a 99}) - (sut/->CommandMapPath ["B"] {:a 99}) - (sut/->CommandMapPath ["X"] {:a 99})])) + [(sut/command-map-path ["A" 10] {:a 99}) + (sut/command-map-path ["A" 0] {:a 99}) + (sut/command-map-path ["B"] {:a 99}) + (sut/command-map-path ["X"] {:a 99})])) ["root,A,0" "root,A,10" "root,B" "root,X"])) (let [map-with-paths - {(sut/->CommandMapPath ["cheque"] {:a 99}) #{(sut/->CommandMapPath ["product" 0] {:a 99}) - (sut/->CommandMapPath ["product" 1] {:a 99})} - (sut/->CommandMapPath ["product" 0] {:a 2}) #{(sut/->CommandMapPath ["product" 0 :productValue] {:a 2})} - (sut/->CommandMapPath ["product" 0 :productValue] {:a 1}) #{} - (sut/->CommandMapPath ["product" 1] {:a 2}) #{(sut/->CommandMapPath ["product" 1 :productValue] {:a 2})} - (sut/->CommandMapPath ["product" 1 :productValue] {:a 1}) #{}}] - (is (= (get map-with-paths (sut/->CommandMapPath ["cheque"] {})) - #{(sut/->CommandMapPath ["product" 0] {}) (sut/->CommandMapPath ["product" 1] {})})))) + {(sut/command-map-path ["cheque"] {:a 99}) #{(sut/command-map-path ["product" 0] {:a 99}) + (sut/command-map-path ["product" 1] {:a 99})} + (sut/command-map-path ["product" 0] {:a 2}) #{(sut/command-map-path ["product" 0 :productValue] {:a 2})} + (sut/command-map-path ["product" 0 :productValue] {:a 1}) #{} + (sut/command-map-path ["product" 1] {:a 2}) #{(sut/command-map-path ["product" 1 :productValue] {:a 2})} + (sut/command-map-path ["product" 1 :productValue] {:a 1}) #{}}] + (is (= (get map-with-paths (sut/command-map-path ["cheque"] {})) + #{(sut/command-map-path ["product" 0] {}) (sut/command-map-path ["product" 1] {})})))) (testing "command-id function - returns string representation" - (let [cmd-path (sut/->CommandMapPath ["goal" :sub] {:type :test})] + (let [cmd-path (sut/command-map-path ["goal" :sub] {:type :test})] (is (= "root,goal,:sub[test]" (sut/command-id cmd-path)) "Returns correct string ID for command") (is (nil? (sut/command-id {})) "Returns nil for non-CommandMapPath objects") (is (nil? (sut/command-id nil)) "Returns nil for nil input") (is (nil? (sut/command-id "string")) "Returns nil for string input"))) (testing "command-map? predicate - identifies CommandMapPath objects" - (let [cmd-path (sut/->CommandMapPath ["test"] {})] + (let [cmd-path (sut/command-map-path ["test"] {})] (is (sut/command-map? cmd-path) "Returns true for CommandMapPath objects") (is (not (sut/command-map? {})) "Returns false for regular maps") (is (not (sut/command-map? [])) "Returns false for vectors") (is (not (sut/command-map? nil)) "Returns false for nil") (is (not (sut/command-map? "string")) "Returns false for strings"))) (testing "start-with? function - tests path hierarchy relationships" - (let [parent (sut/->CommandMapPath ["goal"] {}) - child (sut/->CommandMapPath ["goal" :sub] {}) - grandchild (sut/->CommandMapPath ["goal" :sub :deep] {}) - unrelated (sut/->CommandMapPath ["other"] {})] + (let [parent (sut/command-map-path ["goal"] {}) + child (sut/command-map-path ["goal" :sub] {}) + grandchild (sut/command-map-path ["goal" :sub :deep] {}) + unrelated (sut/command-map-path ["other"] {})] (is (sut/start-with? child parent) "Child path starts with parent path") (is (sut/start-with? grandchild parent) "Grandchild path starts with parent path") (is (sut/start-with? grandchild child) "Grandchild path starts with child path") @@ -67,25 +67,25 @@ (is (not (sut/start-with? child unrelated)) "Unrelated paths do not start with each other") (is (sut/start-with? parent parent) "Path starts with itself"))) (testing "API functions with edge cases - handle unusual inputs gracefully" - (let [empty-path (sut/->CommandMapPath [] {:type :root}) - mixed-keys (sut/->CommandMapPath ["string" :keyword 42 'symbol] {})] + (let [empty-path (sut/command-map-path [] {:type :root}) + mixed-keys (sut/command-map-path ["string" :keyword 42 'symbol] {})] (is (= "root[root]" (sut/command-id empty-path)) "Empty path generates correct ID") (is (= [] (sut/command-path empty-path)) "Empty path is accessible") (is (= "root,string,:keyword,42,symbol" (sut/command-id mixed-keys)) "Mixed key types in path generate correct ID") (is (= ["string" :keyword 42 'symbol] (sut/command-path mixed-keys)) "Mixed key types are preserved in path"))) (testing "Hash consistency - equal objects have equal hashes" - (let [cmd1 (sut/->CommandMapPath ["test"] {:data 1}) - cmd2 (sut/->CommandMapPath ["test"] {:data 2}) - cmd3 (sut/->CommandMapPath ["different"] {:data 1})] + (let [cmd1 (sut/command-map-path ["test"] {:data 1}) + cmd2 (sut/command-map-path ["test"] {:data 2}) + cmd3 (sut/command-map-path ["different"] {:data 1})] (is (= cmd1 cmd2) "Objects with same path are equal") (is (= (hash cmd1) (hash cmd2)) "Equal objects have same hash") (is (not= cmd1 cmd3) "Objects with different paths are not equal") (is (not= (hash cmd1) (hash cmd3)) "Unequal objects have different hashes"))) (testing "Collection behavior edge cases - comprehensive set/map operations" - (let [cmd1 (sut/->CommandMapPath ["a"] {}) - cmd2 (sut/->CommandMapPath ["a"] {:different "data"}) - cmd3 (sut/->CommandMapPath ["b"] {})] + (let [cmd1 (sut/command-map-path ["a"] {}) + cmd2 (sut/command-map-path ["a"] {:different "data"}) + cmd3 (sut/command-map-path ["b"] {})] (is (= #{cmd1} (conj #{cmd1} cmd2)) "Set deduplication based on path equality, set treats equal-path objects as identical") (is (= {cmd1 :value} diff --git a/test/unit/commando/impl/dependency_test.cljc b/test/unit/commando/impl/dependency_test.cljc index 7a0451e..5f4fb3f 100644 --- a/test/unit/commando/impl/dependency_test.cljc +++ b/test/unit/commando/impl/dependency_test.cljc @@ -2,10 +2,11 @@ (:require #?(:cljs [cljs.test :refer [deftest is testing]] :clj [clojure.test :refer [deftest is testing]]) - [commando.commands.builtin :as cmds-builtin] - [commando.core :as commando] - [commando.impl.command-map :as cm] - [commando.impl.registry :as commando-registry])) + [commando.commands.builtin :as cmds-builtin] + [commando.core :as commando] + [commando.impl.command-map :as cm] + [commando.impl.pathtrie :as pathtrie] + [commando.impl.registry :as commando-registry])) (def test-add-id-command {:type :test/add-id @@ -22,84 +23,95 @@ ;; -- Command path objects -- -(def parent-cmd (cm/->CommandMapPath [:parent] test-add-id-command)) -(def child-cmd (cm/->CommandMapPath [:parent :child] test-add-id-command)) -(def target-cmd (cm/->CommandMapPath [:target] test-add-id-command)) -(def ref-cmd (cm/->CommandMapPath [:ref] cmds-builtin/command-from-spec)) +(def parent-cmd (cm/command-map-path [:parent] test-add-id-command)) +(def child-cmd (cm/command-map-path [:parent :child] test-add-id-command)) +(def target-cmd (cm/command-map-path [:target] test-add-id-command)) +(def ref-cmd (cm/command-map-path [:ref] cmds-builtin/command-from-spec)) -(def chain-cmd-a (cm/->CommandMapPath [:a] cmds-builtin/command-from-spec)) -(def chain-cmd-b (cm/->CommandMapPath [:b] cmds-builtin/command-from-spec)) -(def chain-cmd-c (cm/->CommandMapPath [:c] test-add-id-command)) +(def chain-cmd-a (cm/command-map-path [:a] cmds-builtin/command-from-spec)) +(def chain-cmd-b (cm/command-map-path [:b] cmds-builtin/command-from-spec)) +(def chain-cmd-c (cm/command-map-path [:c] test-add-id-command)) -(def diamond-cmd-a (cm/->CommandMapPath [:a] cmds-builtin/command-from-spec)) -(def diamond-cmd-b (cm/->CommandMapPath [:b] cmds-builtin/command-from-spec)) -(def diamond-cmd-c (cm/->CommandMapPath [:c] cmds-builtin/command-from-spec)) -(def diamond-cmd-d (cm/->CommandMapPath [:d] test-add-id-command)) +(def diamond-cmd-a (cm/command-map-path [:a] cmds-builtin/command-from-spec)) +(def diamond-cmd-b (cm/command-map-path [:b] cmds-builtin/command-from-spec)) +(def diamond-cmd-c (cm/command-map-path [:c] cmds-builtin/command-from-spec)) +(def diamond-cmd-d (cm/command-map-path [:d] test-add-id-command)) -(def deep-shallow (cm/->CommandMapPath [:deep :nested :cmd] cmds-builtin/command-from-spec)) -(def shallow-target (cm/->CommandMapPath [:target] test-add-id-command)) +(def deep-shallow (cm/command-map-path [:deep :nested :cmd] cmds-builtin/command-from-spec)) +(def shallow-target (cm/command-map-path [:target] test-add-id-command)) -(def sibling1 (cm/->CommandMapPath [:container :sib1] cmds-builtin/command-from-spec)) -(def sibling2 (cm/->CommandMapPath [:container :sib2] test-add-id-command)) +(def sibling1 (cm/command-map-path [:container :sib1] cmds-builtin/command-from-spec)) +(def sibling2 (cm/command-map-path [:container :sib2] test-add-id-command)) ;; -- Status maps -- +(defn- status-map-with-trie [m] + (assoc m :internal/path-trie (pathtrie/build-path-trie (:internal/cm-list m)))) + (def failed-status-map - {:status :failed - :instruction {} - :registry registry - :internal/cm-list []}) + (status-map-with-trie + {:status :failed + :instruction {} + :registry registry + :internal/cm-list []})) (def empty-ok-status-map - {:status :ok - :instruction {:a 1} - :registry registry - :internal/cm-list []}) + (status-map-with-trie + {:status :ok + :instruction {:a 1} + :registry registry + :internal/cm-list []})) (def all-inside-status-map - {:status :ok - :instruction {:parent {:test/add-id :fn - :child {:test/add-id :fn}}} - :registry registry - :internal/cm-list [parent-cmd child-cmd]}) + (status-map-with-trie + {:status :ok + :instruction {:parent {:test/add-id :fn + :child {:test/add-id :fn}}} + :registry registry + :internal/cm-list [parent-cmd child-cmd]})) (def point-deps-status-map - {:status :ok - :instruction {:target {:test/add-id :fn} - :ref {:commando/from [:target]}} - :registry registry - :internal/cm-list [target-cmd ref-cmd]}) + (status-map-with-trie + {:status :ok + :instruction {:target {:test/add-id :fn} + :ref {:commando/from [:target]}} + :registry registry + :internal/cm-list [target-cmd ref-cmd]})) (def chained-deps-map - {:status :ok - :instruction {:a {:commando/from [:b]} - :b {:commando/from [:c]} - :c {:test/add-id :fn}} - :registry registry - :internal/cm-list [chain-cmd-a chain-cmd-b chain-cmd-c]}) + (status-map-with-trie + {:status :ok + :instruction {:a {:commando/from [:b]} + :b {:commando/from [:c]} + :c {:test/add-id :fn}} + :registry registry + :internal/cm-list [chain-cmd-a chain-cmd-b chain-cmd-c]})) (def diamond-deps-map - {:status :ok - :instruction {:a {:commando/from [:b]} - :b {:commando/from [:d]} - :c {:commando/from [:d]} - :d {:test/add-id :fn}} - :registry registry - :internal/cm-list [diamond-cmd-a diamond-cmd-b diamond-cmd-c diamond-cmd-d]}) + (status-map-with-trie + {:status :ok + :instruction {:a {:commando/from [:b]} + :b {:commando/from [:d]} + :c {:commando/from [:d]} + :d {:test/add-id :fn}} + :registry registry + :internal/cm-list [diamond-cmd-a diamond-cmd-b diamond-cmd-c diamond-cmd-d]})) (def deep-cross-ref-map - {:status :ok - :instruction {:deep {:nested {:cmd {:commando/from [:target]}}} - :target {:test/add-id :fn}} - :registry registry - :internal/cm-list [deep-shallow shallow-target]}) + (status-map-with-trie + {:status :ok + :instruction {:deep {:nested {:cmd {:commando/from [:target]}}} + :target {:test/add-id :fn}} + :registry registry + :internal/cm-list [deep-shallow shallow-target]})) (def sibling-deps-map - {:status :ok - :instruction {:container {:sib1 {:commando/from [:container :sib2]} - :sib2 {:test/add-id :fn}}} - :registry registry - :internal/cm-list [sibling1 sibling2]}) + (status-map-with-trie + {:status :ok + :instruction {:container {:sib1 {:commando/from [:container :sib2]} + :sib2 {:test/add-id :fn}}} + :registry registry + :internal/cm-list [sibling1 sibling2]})) (defn cmd-by-path [path commands] (first (filter #(= (cm/command-path %) path) commands))) @@ -110,7 +122,7 @@ {:status :ok :instruction {:ref {:commando/from [:nonexistent]}} :registry registry - :internal/cm-list [(cm/->CommandMapPath [:ref] cmds-builtin/command-from-spec)]})) + :internal/cm-list [(cm/command-map-path [:ref] cmds-builtin/command-from-spec)]})) "Returns failed status for non-existent path references") (is (commando/ok? (#'commando/build-deps-tree empty-ok-status-map)) "Success status with empty command list")) (testing "Dependency patterns" @@ -142,10 +154,10 @@ :cache {:commando/from [:products :load]}} :orders {:create {:commando/from [:users :validate]} :prepare {:commando/from [:products :cache]}}} - cmds (:internal/cm-list (#'commando/find-commands - {:status :ok :instruction large-instruction :registry registry})) - result (#'commando/build-deps-tree - {:status :ok :instruction large-instruction :registry registry :internal/cm-list cmds}) + found (#'commando/find-commands + {:status :ok :instruction large-instruction :registry registry}) + cmds (:internal/cm-list found) + result (#'commando/build-deps-tree found) deps (:internal/cm-dependency result)] (is (commando/ok? result) "Successfully processes large dependency tree") (is (contains? (get deps (cmd-by-path [:users :fetch] cmds)) (cmd-by-path [:config :database] cmds)) @@ -158,32 +170,35 @@ "orders.prepare depends on products.cache"))) (testing "Empty command list" (let [result (#'commando/build-deps-tree - {:status :ok :instruction {} :registry registry :internal/cm-list []})] + (status-map-with-trie + {:status :ok :instruction {} :registry registry :internal/cm-list []}))] (is (commando/ok? result) "Handles empty command list") (is (empty? (:internal/cm-dependency result)) "Dependency map is empty")))) (deftest dependency-modes-test (testing ":all-inside mode" - (let [goal2-cmd (cm/->CommandMapPath [:goal-2] test-add-id-command) - goal2-someval-cmd (cm/->CommandMapPath [:goal-2 :some-val] test-add-id-command) - test-status-map {:status :ok - :instruction {:goal-2 {:test/add-id :fn - :some-val {:test/add-id :nested}}} - :registry registry - :internal/cm-list [goal2-cmd goal2-someval-cmd]} + (let [goal2-cmd (cm/command-map-path [:goal-2] test-add-id-command) + goal2-someval-cmd (cm/command-map-path [:goal-2 :some-val] test-add-id-command) + test-status-map (status-map-with-trie + {:status :ok + :instruction {:goal-2 {:test/add-id :fn + :some-val {:test/add-id :nested}}} + :registry registry + :internal/cm-list [goal2-cmd goal2-someval-cmd]}) result (#'commando/build-deps-tree test-status-map) deps (:internal/cm-dependency result)] (is (commando/ok? result) "Successfully processes :all-inside dependency") (is (contains? (get deps goal2-cmd) goal2-someval-cmd) "goal-2 command depends on goal-2.some-val command (nested inside)"))) (testing ":point mode" - (let [goal1-cmd (cm/->CommandMapPath [:goal-1] test-add-id-command) - ref-cmd (cm/->CommandMapPath [:ref] cmds-builtin/command-from-spec) - test-status-map {:status :ok - :instruction {:goal-1 {:test/add-id :fn} - :ref {:commando/from [:goal-1]}} - :registry registry - :internal/cm-list [goal1-cmd ref-cmd]} + (let [goal1-cmd (cm/command-map-path [:goal-1] test-add-id-command) + ref-cmd (cm/command-map-path [:ref] cmds-builtin/command-from-spec) + test-status-map (status-map-with-trie + {:status :ok + :instruction {:goal-1 {:test/add-id :fn} + :ref {:commando/from [:goal-1]}} + :registry registry + :internal/cm-list [goal1-cmd ref-cmd]}) result (#'commando/build-deps-tree test-status-map) deps (:internal/cm-dependency result)] (is (commando/ok? result) "Successfully processes :point dependency") @@ -194,11 +209,12 @@ :recognize-fn #(and (map? %) (contains? % :test/none)) :apply identity :dependencies {:mode :none}} - none-cmd (cm/->CommandMapPath [:standalone] none-command) - test-status-map {:status :ok - :instruction {:standalone {:test/none :independent}} - :registry (commando/registry-create [none-command]) - :internal/cm-list [none-cmd]} + none-cmd (cm/command-map-path [:standalone] none-command) + test-status-map (status-map-with-trie + {:status :ok + :instruction {:standalone {:test/none :independent}} + :registry (commando/registry-create [none-command]) + :internal/cm-list [none-cmd]}) result (#'commando/build-deps-tree test-status-map) deps (:internal/cm-dependency result)] (is (commando/ok? result) "Successfully processes :none dependency") diff --git a/test/unit/commando/impl/finding_commands_test.cljc b/test/unit/commando/impl/finding_commands_test.cljc index cfd58d9..219cc30 100644 --- a/test/unit/commando/impl/finding_commands_test.cljc +++ b/test/unit/commando/impl/finding_commands_test.cljc @@ -22,21 +22,21 @@ (deftest find-commands (testing "Basic cases" - (is (= [(cm/->CommandMapPath [] #'commando-registry/default-command-map-spec)] + (is (= #{(cm/command-map-path [] #'commando-registry/default-command-map-spec)} (:internal/cm-list (#'commando/find-commands {:status :ok :instruction {} :registry registry}))) "Empty instruction return _map command") - (is (= [(cm/->CommandMapPath [] #'commando-registry/default-command-map-spec) - (cm/->CommandMapPath [:some-val] #'commando-registry/default-command-map-spec) - (cm/->CommandMapPath [:some-other] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:my-value] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:i] #'commando-registry/default-command-map-spec) - (cm/->CommandMapPath [:v] #'commando-registry/default-command-vec-spec) - (cm/->CommandMapPath [:some-val :a] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:i :am] #'commando-registry/default-command-map-spec) - (cm/->CommandMapPath [:i :am :deep] #'commando-registry/default-command-value-spec)] + (is (= #{(cm/command-map-path [] #'commando-registry/default-command-map-spec) + (cm/command-map-path [:some-val] #'commando-registry/default-command-map-spec) + (cm/command-map-path [:some-other] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:my-value] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:i] #'commando-registry/default-command-map-spec) + (cm/command-map-path [:v] #'commando-registry/default-command-vec-spec) + (cm/command-map-path [:some-val :a] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:i :am] #'commando-registry/default-command-map-spec) + (cm/command-map-path [:i :am :deep] #'commando-registry/default-command-value-spec)} (:internal/cm-list (#'commando/find-commands {:status :ok :instruction {:some-val {:a 2} @@ -46,11 +46,11 @@ :v []} :registry registry}))) "Instruction return internal commands _map, _vec, _value.") - (is (= [(cm/->CommandMapPath [] #'commando-registry/default-command-map-spec) - (cm/->CommandMapPath [:set] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:list] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:primitive] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:java-obj] #'commando-registry/default-command-value-spec)] + (is (= #{(cm/command-map-path [] #'commando-registry/default-command-map-spec) + (cm/command-map-path [:set] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:list] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:primitive] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:java-obj] #'commando-registry/default-command-value-spec)} (:internal/cm-list (#'commando/find-commands {:status :ok :instruction {:set #{:commando/from [:target]} @@ -60,12 +60,12 @@ :cljs (js/Date.))} :registry registry}))) "Any type that not Map,Vector(and registry not contain other commands) became a _value standart internal command") - (is (= [(cm/->CommandMapPath [] #'commando-registry/default-command-map-spec) - (cm/->CommandMapPath [:set] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:list] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:valid] #'commando-registry/default-command-vec-spec) - (cm/->CommandMapPath [:target] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:valid 0] cmds-builtin/command-from-spec)] + (is (= #{(cm/command-map-path [] #'commando-registry/default-command-map-spec) + (cm/command-map-path [:set] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:list] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:valid] #'commando-registry/default-command-vec-spec) + (cm/command-map-path [:target] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:valid 0] cmds-builtin/command-from-spec)} (:internal/cm-list (#'commando/find-commands {:status :ok :instruction {:set #{:not-found} @@ -75,13 +75,13 @@ :registry registry}))) "commando/from find and returned with corresponding command-map-path object") (is (= - [(cm/->CommandMapPath [] #'commando-registry/default-command-map-spec) - (cm/->CommandMapPath [:a] #'commando-registry/default-command-map-spec) - (cm/->CommandMapPath [:target] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:a "some"] #'commando-registry/default-command-map-spec) - (cm/->CommandMapPath [:a "some" :c] #'commando-registry/default-command-vec-spec) - (cm/->CommandMapPath [:a "some" :c 0] #'commando-registry/default-command-value-spec) - (cm/->CommandMapPath [:a "some" :c 1] cmds-builtin/command-from-spec)] + #{(cm/command-map-path [] #'commando-registry/default-command-map-spec) + (cm/command-map-path [:a] #'commando-registry/default-command-map-spec) + (cm/command-map-path [:target] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:a "some"] #'commando-registry/default-command-map-spec) + (cm/command-map-path [:a "some" :c] #'commando-registry/default-command-vec-spec) + (cm/command-map-path [:a "some" :c 0] #'commando-registry/default-command-value-spec) + (cm/command-map-path [:a "some" :c 1] cmds-builtin/command-from-spec)} (:internal/cm-list (#'commando/find-commands {:status :ok :instruction {:a {"some" {:c [:some {:commando/from [:target]}]}} diff --git a/test/unit/commando/impl/graph_test.cljc b/test/unit/commando/impl/graph_test.cljc index c0e8f3e..c9a1535 100644 --- a/test/unit/commando/impl/graph_test.cljc +++ b/test/unit/commando/impl/graph_test.cljc @@ -20,17 +20,17 @@ (commando-registry/build) (commando-registry/enrich-runtime-registry))) -(def chain-cmd-a (cm/->CommandMapPath [:a] cmds-builtin/command-from-spec)) -(def chain-cmd-b (cm/->CommandMapPath [:b] cmds-builtin/command-from-spec)) -(def chain-cmd-c (cm/->CommandMapPath [:c] test-add-id-command)) +(def chain-cmd-a (cm/command-map-path [:a] cmds-builtin/command-from-spec)) +(def chain-cmd-b (cm/command-map-path [:b] cmds-builtin/command-from-spec)) +(def chain-cmd-c (cm/command-map-path [:c] test-add-id-command)) -(def diamond-cmd-a (cm/->CommandMapPath [:a] cmds-builtin/command-from-spec)) -(def diamond-cmd-b (cm/->CommandMapPath [:b] cmds-builtin/command-from-spec)) -(def diamond-cmd-c (cm/->CommandMapPath [:c] cmds-builtin/command-from-spec)) -(def diamond-cmd-d (cm/->CommandMapPath [:d] test-add-id-command)) +(def diamond-cmd-a (cm/command-map-path [:a] cmds-builtin/command-from-spec)) +(def diamond-cmd-b (cm/command-map-path [:b] cmds-builtin/command-from-spec)) +(def diamond-cmd-c (cm/command-map-path [:c] cmds-builtin/command-from-spec)) +(def diamond-cmd-d (cm/command-map-path [:d] test-add-id-command)) -(def circular-cmd-a (cm/->CommandMapPath [:a] cmds-builtin/command-from-spec)) -(def circular-cmd-b (cm/->CommandMapPath [:b] cmds-builtin/command-from-spec)) +(def circular-cmd-a (cm/command-map-path [:a] cmds-builtin/command-from-spec)) +(def circular-cmd-b (cm/command-map-path [:b] cmds-builtin/command-from-spec)) (deftest sort-entities-by-deps (testing "Status handling" diff --git a/test/unit/commando/impl/pathtrie_test.cljc b/test/unit/commando/impl/pathtrie_test.cljc new file mode 100644 index 0000000..cd29284 --- /dev/null +++ b/test/unit/commando/impl/pathtrie_test.cljc @@ -0,0 +1,26 @@ +(ns commando.impl.pathtrie-test + (:require + #?(:cljs [cljs.test :refer [deftest is testing]] + :clj [clojure.test :refer [deftest is testing]]) + [commando.impl.command-map :as cm] + [commando.impl.pathtrie :as pathtrie])) + +;; ----------- +;; Trie operations test +;; ----------- + +(deftest trie-operations-test + (testing "Incremental trie update matches full rebuild" + (let [cmd-a (cm/command-map-path [:a] {:type :test}) + cmd-b (cm/command-map-path [:b] {:type :test}) + cmd-c (cm/command-map-path [:c :d] {:type :test}) + cmd-e (cm/command-map-path [:a :x] {:type :test}) + original-cmds [cmd-a cmd-b cmd-c] + original-trie (pathtrie/build-path-trie original-cmds) + ;; Remove :a subtree, insert cmd-e + updated-trie (-> original-trie + (pathtrie/trie-remove-paths [[:a]]) + (pathtrie/trie-insert-commands [cmd-e])) + full-rebuild (pathtrie/build-path-trie [cmd-b cmd-c cmd-e])] + (is (= updated-trie full-rebuild) + "Incremental trie update produces same result as full rebuild")))) diff --git a/test/unit/commando/impl/registry_test.clj b/test/unit/commando/impl/registry_test.cljc similarity index 100% rename from test/unit/commando/impl/registry_test.clj rename to test/unit/commando/impl/registry_test.cljc diff --git a/test/unit/commando/impl/utils_test.cljc b/test/unit/commando/impl/utils_test.cljc index 4ec25d6..81dd5d7 100644 --- a/test/unit/commando/impl/utils_test.cljc +++ b/test/unit/commando/impl/utils_test.cljc @@ -84,8 +84,7 @@ :data "{:level \"1\"}"}))) (let [e (binding [sut/*execute-config* - {:debug-result false - :error-data-string false}] + (sut/execute-config-update {:error-data-string false})] (try (malli/assert :int "string") (catch Exception e @@ -148,8 +147,7 @@ :data "{}"}))) (let [e (binding [sut/*execute-config* - {:debug-result false - :error-data-string false}] + (sut/execute-config-update {:error-data-string false})] (try (malli/assert :int "string") (catch :default e