001 (ns cmp.worker.select
002 ^{:author "wactbprot"
003 :doc "Worker selects a definition from the same `mp-id`
004 by evaluating the related conditions."}
005 (:require [cmp.config :as cfg]
006 [cmp.exchange :as exch]
007 [com.brunobonacci.mulog :as mu]
008 [cmp.st-mem :as st]
009 [cmp.st-utils :as stu]
010 [clojure.string :as string]
011 [cmp.utils :as u]))
012
013 (defn cond-match?
014 "Tests a single condition of the form defined in
015 the `definitions` section.
016
017 Example:
018 ```clojure
019 (cond-match? 10 :gt 1)
020 ;; true
021 ```
022 "
023 [l m r]
024 (condp = (keyword m)
025 :eq (= l r)
026 :lt (< (read-string (str l)) (read-string (str r)))
027 :gt (> (read-string (str l)) (read-string (str r)))))
028
029 (defn conds-match?
030 "Checks if `:cond-match` in every map
031 in the `cond`ition-`vec`tor `v` is true."
032 [v]
033 (every? true? (map :cond-match v)))
034
035 (defn filter-match
036 "Checks if `:cond-match` in every map
037 in the `cond`ition-`vec`tor `v` is true."
038 [v]
039 (when (conds-match? v) (first v)))
040
041 (defn gen-callback
042 [{mp-id :mp-id no-idx :no-idx state-key :StateKey}]
043 (let [ctrl-key (stu/defins-ctrl-key mp-id no-idx)]
044 (fn [msg]
045 (condp = (keyword (st/key->val ctrl-key))
046 :run (mu/log ::start-defins! :message "run callback for" :key ctrl-key)
047 :ready (do
048 (st/set-state! state-key :executed "ready callback")
049 (st/de-register! mp-id "definitions" no-idx "ctrl" "b"))
050 :error (st/set-state! state-key :error "error callback for")))))
051
052 (defn start-defins!
053 "Starts the matching `definitions` structure. `register`s
054 a level b callback. Sets the state of the calling element to `executed`
055 if the `ctrl` turns to ready (or error if error)."
056 [{mp-id :mp-id no-idx :no-idx state-key :StateKey :as task}]
057 (let [ctrl-key (stu/defins-ctrl-key mp-id no-idx)]
058 (st/register! mp-id "definitions" no-idx "ctrl" (gen-callback task) "b")
059 (st/set-state! ctrl-key :run)))
060
061 (defn cond-key->cond-map
062 "Builds a `cond`ition`-map` belonging to the key `k`. Replaces the
063 compare value fetched from the exchange interface by means of the
064 `exch/read!`-function.
065
066 Example:
067 ```clojure
068 (cond-key->cond-map \"ref@definitions@1@cond@0\")
069 ;; {:mp-name \"ref\",
070 ;; :struct \"definitions\",
071 ;; :no-idx 1,
072 ;; :no-jdy 0,
073 ;; :comp-value \"Pa\",
074 ;; :meth \"eq\",
075 ;; :exch-value \"Pa\"}
076
077 ;; where:
078
079 (st/key->val \"ref@definitions@1@cond@0\")
080 ;;{:ExchangePath \"A.Unit\", :Methode \"eq\", :Value \"Pa\"}
081
082 ;; and:
083
084 (st/key->val \"ref@exchange@A\")
085 ;; {:Unit \"Pa\", :Value 100}
086 ``` "
087 [k]
088 (let [key-map (stu/key->info-map k)
089 val-map (st/key->val k)
090 left-val (exch/read! (:mp-id key-map) (:ExchangePath val-map))
091 meth (:Methode val-map)
092 right-val (:Value val-map)]
093 (assoc key-map :cond-match (cond-match? left-val meth right-val))))
094
095 (defn class-key->cond-keys
096 "Turns a `class-key` into `cond-keys`."
097 [k]
098 (when k
099 (let [m (stu/key->info-map k)]
100 (st/key->keys (stu/defins-cond-key (:mp-id m) (:no-idx m))))))
101
102 (defn class-keys
103 "Returns the keys where the class is `cls`."
104 [mp-id cls]
105 (let [pat (stu/defins-class-key mp-id "*")]
106 (st/filter-keys-where-val pat cls)))
107
108 (defn select-definition!
109 "Selects and runs a `Definition` from the `Definitions` section of the
110 current `mp`. Builds a `cond`ition`-map` (analog to the `state-map`)
111 in order to avoid the spreading of side effects and easy testing.
112
113 Example:
114 ```clojure
115 (ns cmp.worker.select)
116 (select-definition! {:MpName ref
117 :Action select
118 :TaskName Common-select_definition,
119 :DefinitionClass wait} )
120 ;; match map:
121 {:mp-id ref,
122 :struct definitions
123 :no-idx 1,
124 :func cond
125 :seq-idx 1,
126 :par-idx nil,
127 :cond-match true}
128 ```
129 If more than one than one of the definitions condition match
130 the first is used:
131
132 ```clojure
133 (first (filter conds-match? match-ks))
134 ;; ref@definitions@1@class
135 ```"
136 [{mp-id :MpName cls :DefinitionClass state-key :StateKey}]
137 (st/set-state! state-key :working)
138 (let [cond-keys (mapv class-key->cond-keys (class-keys mp-id cls))
139 cond-vec (mapv (fn [ks]
140 (mapv cond-key->cond-map ks))
141 cond-keys)]
142 (if-let [match-map (first (remove nil? (map filter-match cond-vec)))]
143 (start-defins! (assoc match-map :StateKey state-key))
144 (st/set-state! state-key :error "no matching definition"))))